[flang] Fix some bugs exposed by testing new checks

Original-commit: flang-compiler/f18@9cc70dcad6
Reviewed-on: https://github.com/flang-compiler/f18/pull/782
Tree-same-pre-rewrite: false

flang/lib/evaluate/fold.cc

@@ -412,7 +412,7 @@ Expr<Type<TypeCategory::Integer, KIND>> LBOUND(FoldingContext &context,
   if (const auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
     if (int rank{array->Rank()}; rank > 0) {
       std::optional<int> dim;
-      if (args[1].has_value()) {
+      if (funcRef.Rank() == 0) {
         // Optional DIM= argument is present: result is scalar.
         if (auto dim64{GetInt64Arg(args[1])}) {
           if (*dim64 < 1 || *dim64 > rank) {
@@ -467,7 +467,7 @@ Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,
   if (auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
     if (int rank{array->Rank()}; rank > 0) {
       std::optional<int> dim;
-      if (args[1].has_value()) {
+      if (funcRef.Rank() == 0) {
         // Optional DIM= argument is present: result is scalar.
         if (auto dim64{GetInt64Arg(args[1])}) {
           if (*dim64 < 1 || *dim64 > rank) {

flang/lib/evaluate/shape.cc

@@ -477,10 +477,21 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
     } else if (intrinsic->name == "reshape") {
       if (call.arguments().size() >= 2 && call.arguments().at(1).has_value()) {
         // SHAPE(RESHAPE(array,shape)) -> shape
-        const auto *shapeExpr{call.arguments().at(1).value().UnwrapExpr()};
+        if (const auto *shapeExpr{
-        auto shape{std::get<Expr<SomeInteger>>(DEREF(shapeExpr).u)};
+                call.arguments().at(1).value().UnwrapExpr()}) {
+          auto shape{std::get<Expr<SomeInteger>>(shapeExpr->u)};
           return AsShape(context_, ConvertToType<ExtentType>(std::move(shape)));
         }
+      }
+    } else if (intrinsic->name == "transpose") {
+      if (call.arguments().size() >= 1) {
+        if (auto shape{(*this)(call.arguments().at(0))}) {
+          if (shape->size() == 2) {
+            std::swap((*shape)[0], (*shape)[1]);
+            return shape;
+          }
+        }
+      }
     } else if (intrinsic->characteristics.value().attrs.test(characteristics::
                        Procedure::Attr::NullPointer)) {  // NULL(MOLD=)
       return (*this)(call.arguments());

flang/lib/semantics/check-call.cc

@@ -307,14 +307,17 @@ static void CheckExplicitInterfaceArg(const evaluate::ActualArgument &arg,
     const characteristics::Procedure &proc, evaluate::FoldingContext &context,
     const Scope &scope) {
   auto &messages{context.messages()};
-  if (const auto *object{
+  std::visit(
-          std::get_if<characteristics::DummyDataObject>(&dummy.u)}) {
+      common::visitors{
+          [&](const characteristics::DummyDataObject &object) {
             if (const auto *expr{arg.UnwrapExpr()}) {
-      if (auto type{
+              if (auto type{characteristics::TypeAndShape::Characterize(
-              characteristics::TypeAndShape::Characterize(*expr, context)}) {
+                      *expr, context)}) {
-        CheckExplicitDataArg(*object, *expr, *type, proc, context, scope);
+                CheckExplicitDataArg(
-      } else if (object->type.type().IsTypelessIntrinsicArgument() &&
+                    object, *expr, *type, proc, context, scope);
-          std::holds_alternative<evaluate::BOZLiteralConstant>(expr->u)) {
+              } else if (object.type.type().IsTypelessIntrinsicArgument() &&
+                  std::holds_alternative<evaluate::BOZLiteralConstant>(
+                      expr->u)) {
                 // ok
               } else {
                 messages.Say(
@@ -322,7 +325,7 @@ static void CheckExplicitInterfaceArg(const evaluate::ActualArgument &arg,
               }
             } else if (const Symbol * assumed{arg.GetAssumedTypeDummy()}) {
               // An assumed-type dummy is being forwarded.
-      if (!object->type.type().IsAssumedType()) {
+              if (!object.type.type().IsAssumedType()) {
                 messages.Say(
                     "Assumed-type TYPE(*) '%s' may be associated only with an assumed-TYPE(*) dummy argument"_err_en_US,
                     assumed->name());
@@ -331,10 +334,13 @@ static void CheckExplicitInterfaceArg(const evaluate::ActualArgument &arg,
               messages.Say(
                   "Actual argument is not an expression or variable"_err_en_US);
             }
-  } else {
+          },
+          [](const auto &) {
             // TODO check actual procedure compatibility
             // TODO check alternate return
-  }
+          },
+      },
+      dummy.u);
 }
 
 static void RearrangeArguments(const characteristics::Procedure &proc,
@@ -427,26 +433,20 @@ void CheckArguments(const characteristics::Procedure &proc,
   bool explicitInterface{proc.HasExplicitInterface()};
   if (explicitInterface) {
     auto buffer{CheckExplicitInterface(proc, actuals, context, scope)};
+    if (treatingExternalAsImplicit && !buffer.empty()) {
+      if (auto *msg{context.messages().Say(
+              "Warning: if the procedure's interface were explicit, this reference would be in error:"_en_US)}) {
+        buffer.AttachTo(*msg);
+      }
+    }
     if (auto *msgs{context.messages().messages()}) {
       msgs->Merge(std::move(buffer));
     }
   }
   if (!explicitInterface || treatingExternalAsImplicit) {
-    parser::Messages buffer;
-    parser::ContextualMessages messages{context.messages().at(), &buffer};
     for (auto &actual : actuals) {
       if (actual.has_value()) {
-        CheckImplicitInterfaceArg(*actual, messages);
+        CheckImplicitInterfaceArg(*actual, context.messages());
-      }
-    }
-    if (!buffer.empty()) {
-      if (treatingExternalAsImplicit) {
-        if (auto *msg{context.messages().Say(
-                "Warning: if the procedure's interface were explicit, this reference would be in error:"_en_US)}) {
-          buffer.AttachTo(*msg);
-        }
-      } else if (auto *msgs{context.messages().messages()}) {
-        msgs->Merge(std::move(buffer));
       }
     }
   }