[flang] Revert to returning default INTEGER for LEN() and offset-in-CHARACTER intrins...

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

diff --git a/flang/documentation/Extensions.md b/flang/documentation/Extensions.md
index 91c6dfc..745a64a 100644 (file)
--- a/flang/documentation/Extensions.md
+++ b/flang/documentation/Extensions.md
@@ -20,8 +20,9 @@ Intentional violations of the standard
   rule imposes an artificially small constraint in some cases
   where Fortran mandates that something have the default `INTEGER`
   type: specifically, the results of references to the intrinsic functions
-  `LEN`, `SIZE`, `LBOUND`, `UBOUND`, and `SHAPE`.  We return
-  `INTEGER(KIND=8)` in these cases.
+  `SIZE`, `LBOUND`, `UBOUND`, `SHAPE`, and the location reductions
+  `FINDLOC`, `MAXLOC`, and `MINLOC`.  We return `INTEGER(KIND=8)` by
+  default in these cases.
 
 Extensions, deletions, and legacy features supported by default
 ===============================================================

diff --git a/flang/lib/evaluate/intrinsics.cc b/flang/lib/evaluate/intrinsics.cc
index 885f74b..b259ab1 100644 (file)
--- a/flang/lib/evaluate/intrinsics.cc
+++ b/flang/lib/evaluate/intrinsics.cc
@@ -445,7 +445,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
     {"index",
         {{"string", SameChar}, {"substring", SameChar},
             {"back", AnyLogical, Rank::scalar, Optionality::optional},
-            SubscriptDefaultKIND},
+            DefaultingKIND},
         KINDInt},
     {"int", {{"a", AnyNumeric, Rank::elementalOrBOZ}, DefaultingKIND}, KINDInt},
     {"int_ptr_kind", {}, DefaultInt, Rank::scalar},
@@ -467,9 +467,9 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
         {{"array", AnyData, Rank::anyOrAssumedRank}, SubscriptDefaultKIND},
         KINDInt, Rank::vector},
     {"leadz", {{"i", AnyInt}}, DefaultInt},
-    {"len", {{"string", AnyChar, Rank::anyOrAssumedRank}, SubscriptDefaultKIND},
+    {"len", {{"string", AnyChar, Rank::anyOrAssumedRank}, DefaultingKIND},
         KINDInt, Rank::scalar},
-    {"len_trim", {{"string", AnyChar}, SubscriptDefaultKIND}, KINDInt},
+    {"len_trim", {{"string", AnyChar}, DefaultingKIND}, KINDInt},
     {"lge", {{"string_a", SameChar}, {"string_b", SameChar}}, DefaultLogical},
     {"lgt", {{"string_a", SameChar}, {"string_b", SameChar}}, DefaultLogical},
     {"lle", {{"string_a", SameChar}, {"string_b", SameChar}}, DefaultLogical},
@@ -618,7 +618,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
     {"scan",
         {{"string", SameChar}, {"set", SameChar},
             {"back", AnyLogical, Rank::elemental, Optionality::optional},
-            SubscriptDefaultKIND},
+            DefaultingKIND},
         KINDInt},
     {"selected_char_kind", {{"name", DefaultChar, Rank::scalar}}, DefaultInt,
         Rank::scalar},
@@ -695,7 +695,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
     {"verify",
         {{"string", SameChar}, {"set", SameChar},
             {"back", AnyLogical, Rank::elemental, Optionality::optional},
-            SubscriptDefaultKIND},
+            DefaultingKIND},
         KINDInt},
 };
 

diff --git a/flang/lib/evaluate/shape.cc b/flang/lib/evaluate/shape.cc
index a74dfca..5e2d70d 100644 (file)
--- a/flang/lib/evaluate/shape.cc
+++ b/flang/lib/evaluate/shape.cc
@@ -475,6 +475,32 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
       const auto *expr{call.arguments().front().value().UnwrapExpr()};
       CHECK(expr != nullptr);
       return Shape{MaybeExtentExpr{ExtentExpr{expr->Rank()}}};
+    } else if (intrinsic->name == "all" || intrinsic->name == "any" ||
+        intrinsic->name == "count" || intrinsic->name == "iall" ||
+        intrinsic->name == "iany" || intrinsic->name == "iparity" ||
+        intrinsic->name == "maxloc" || intrinsic->name == "maxval" ||
+        intrinsic->name == "minloc" || intrinsic->name == "minval" ||
+        intrinsic->name == "norm2" || intrinsic->name == "parity" ||
+        intrinsic->name == "product" || intrinsic->name == "sum") {
+      // Reduction with DIM=
+      if (call.arguments().size() >= 2) {
+        auto arrayShape{
+            (*this)(UnwrapExpr<Expr<SomeType>>(call.arguments().at(0)))};
+        const auto *dimArg{UnwrapExpr<Expr<SomeType>>(call.arguments().at(1))};
+        if (arrayShape.has_value() && dimArg != nullptr) {
+          if (auto dim{ToInt64(*dimArg)}) {
+            if (*dim >= 1 &&
+                static_cast<std::size_t>(*dim) <= arrayShape->size()) {
+              arrayShape->erase(arrayShape->begin() + (*dim - 1));
+              return std::move(*arrayShape);
+            }
+          }
+        }
+      }
+    } else if (intrinsic->name == "cshift" || intrinsic->name == "eoshift") {
+      if (!call.arguments().empty()) {
+        return (*this)(call.arguments()[0]);
+      }
     } else if (intrinsic->name == "reshape") {
       if (call.arguments().size() >= 2 && call.arguments().at(1).has_value()) {
         // SHAPE(RESHAPE(array,shape)) -> shape
@@ -484,19 +510,6 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
           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->name == "cshift" || intrinsic->name == "eoshift") {
-      if (!call.arguments().empty()) {
-        return (*this)(call.arguments()[0]);
-      }
     } else if (intrinsic->name == "spread") {
       // SHAPE(SPREAD(ARRAY,DIM,NCOPIES)) = SHAPE(ARRAY) with NCOPIES inserted
       // at position DIM.
@@ -517,6 +530,15 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
           }
         }
       }
+    } 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());

diff --git a/flang/lib/semantics/check-call.cc b/flang/lib/semantics/check-call.cc
index dee7e6b..32edfa2 100644 (file)
--- a/flang/lib/semantics/check-call.cc
+++ b/flang/lib/semantics/check-call.cc
@@ -18,6 +18,7 @@
 #include "../evaluate/characteristics.h"
 #include "../evaluate/shape.h"
 #include "../evaluate/tools.h"
+#include "../parser/characters.h"
 #include "../parser/message.h"
 #include <map>
 #include <string>
@@ -110,6 +111,7 @@ static void InspectType(
 }
 
 static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
+    const std::string &dummyName,
     const evaluate::Expr<evaluate::SomeType> &actual,
     const characteristics::TypeAndShape &actualType,
     const characteristics::Procedure &proc, evaluate::FoldingContext &context,
@@ -152,12 +154,14 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
   if (actualIsPolymorphic && dummyIsPolymorphic &&
       actualIsCoindexed) {  // 15.5.2.4(2)
     messages.Say(
-        "Coindexed polymorphic object may not be associated with a polymorphic dummy argument"_err_en_US);
+        "Coindexed polymorphic object may not be associated with a polymorphic %s"_err_en_US,
+        dummyName);
   }
   if (actualIsPolymorphic && !dummyIsPolymorphic &&
       actualIsAssumedSize) {  // 15.5.2.4(2)
     messages.Say(
-        "Assumed-size polymorphic array may not be associated with a monomorphic dummy argument"_err_en_US);
+        "Assumed-size polymorphic array may not be associated with a monomorphic %s"_err_en_US,
+        dummyName);
   }
 
   // derived type actual argument checks
@@ -169,18 +173,21 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
     if (dummy.type.type().IsAssumedType()) {
       if (!derived.parameters().empty()) {  // 15.5.2.4(2)
         messages.Say(
-            "Actual argument associated with TYPE(*) dummy argument may not have a parameterized derived type"_err_en_US);
+            "Actual argument associated with TYPE(*) %s may not have a parameterized derived type"_err_en_US,
+            dummyName);
       }
       if (concerns.typeBoundProcedure) {  // 15.5.2.4(2)
         if (auto *msg{messages.Say(
-                "Actual argument associated with TYPE(*) dummy argument may not have type-bound procedures"_err_en_US)}) {
+                "Actual argument associated with TYPE(*) %s may not have type-bound procedures"_err_en_US,
+                dummyName)}) {
           msg->Attach(concerns.typeBoundProcedure->name(),
               "Declaration of type-bound procedure"_en_US);
         }
       }
       if (concerns.finalProcedure) {  // 15.5.2.4(2)
         if (auto *msg{messages.Say(
-                "Actual argument associated with TYPE(*) dummy argument may not have FINAL procedures"_err_en_US)}) {
+                "Actual argument associated with TYPE(*) %s may not have FINAL procedures"_err_en_US,
+                dummyName)}) {
           msg->Attach(concerns.finalProcedure->name(),
               "Declaration of FINAL procedure"_en_US);
         }
@@ -190,7 +197,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
         dummy.intent != common::Intent::In && !dummyIsValue) {
       // 15.5.2.4(6)
       if (auto *msg{messages.Say(
-              "Coindexed actual argument with ALLOCATABLE ultimate component must be associated with a dummy argument with VALUE or INTENT(IN) attributes"_err_en_US)}) {
+              "Coindexed actual argument with ALLOCATABLE ultimate component must be associated with a %s with VALUE or INTENT(IN) attributes"_err_en_US,
+              dummyName)}) {
         msg->Attach(concerns.allocatable->name(),
             "Declaration of ALLOCATABLE component"_en_US);
       }
@@ -198,7 +206,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
     if (concerns.coarray &&
         actualIsVolatile != dummyIsVolatile) {  // 15.5.2.4(22)
       if (auto *msg{messages.Say(
-              "VOLATILE attributes must match when actual argument has a coarray ultimate component"_err_en_US)}) {
+              "VOLATILE attribute must match for %s when actual argument has a coarray ultimate component"_err_en_US,
+              dummyName)}) {
         msg->Attach(
             concerns.coarray->name(), "Declaration of coarray component"_en_US);
       }
@@ -216,11 +225,13 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
     // 15.5.2.4(16)
     if (actualRank == 0) {
       messages.Say(
-          "Scalar actual argument may not be associated with assumed-shape dummy argument"_err_en_US);
+          "Scalar actual argument may not be associated with assumed-shape %s"_err_en_US,
+          dummyName);
     }
     if (actualIsAssumedSize) {
       if (auto *msg{messages.Say(
-              "Assumed-size array may not be associated with assumed-shape dummy argument"_err_en_US)}) {
+              "Assumed-size array may not be associated with assumed-shape %s"_err_en_US,
+              dummyName)}) {
         msg->Attach(actualLastSymbol->name(),
             "Declaration of assumed-size array actual argument"_en_US);
       }
@@ -229,24 +240,29 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
     // Actual is scalar, dummy is an array.  15.5.2.4(14), 15.5.2.11
     if (actualIsCoindexed) {
       messages.Say(
-          "Coindexed scalar actual argument must be associated with a scalar dummy argument"_err_en_US);
+          "Coindexed scalar actual argument must be associated with a scalar %s"_err_en_US,
+          dummyName);
     }
     if (actualLastSymbol && actualLastSymbol->Rank() == 0 &&
         !(dummy.type.type().IsAssumedType() && dummyIsAssumedSize)) {
       messages.Say(
-          "Whole scalar actual argument may not be associated with a dummy argument array"_err_en_US);
+          "Whole scalar actual argument may not be associated with a %s array"_err_en_US,
+          dummyName);
     }
     if (actualIsPolymorphic) {
       messages.Say(
-          "Element of polymorphic array may not be associated with a dummy argument array"_err_en_US);
+          "Element of polymorphic array may not be associated with a %s array"_err_en_US,
+          dummyName);
     }
     if (actualLastSymbol && actualLastSymbol->attrs().test(Attr::POINTER)) {
       messages.Say(
-          "Element of pointer array may not be associated with a dummy argument array"_err_en_US);
+          "Element of pointer array may not be associated with a %s array"_err_en_US,
+          dummyName);
     }
     if (actualLastObject && actualLastObject->IsAssumedShape()) {
       messages.Say(
-          "Element of assumed-shape array may not be associated with a dummy argument array"_err_en_US);
+          "Element of assumed-shape array may not be associated with a %s array"_err_en_US,
+          dummyName);
     }
   }
 
@@ -279,7 +295,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
       (dummyIsAsynchronous || dummyIsVolatile) && !dummyIsValue) {
     if (actualIsCoindexed) {  // C1538
       messages.Say(
-          "Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE"_err_en_US);
+          "Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with %s with ASYNCHRONOUS or VOLATILE attributes unless VALUE"_err_en_US,
+          dummyName);
     }
     if (actualRank > 0 && !IsSimplyContiguous(actual, context.intrinsics())) {
       bool dummyIsContiguous{
@@ -296,7 +313,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
           !(dummyIsAssumedShape || dummyIsAssumedRank ||
               (actualIsPointer && dummyIsPointer))) {  // C1539 & C1540
         messages.Say(
-            "ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument"_err_en_US);
+            "ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous %s"_err_en_US,
+            dummyName);
       }
     }
   }
@@ -307,6 +325,10 @@ static void CheckExplicitInterfaceArg(const evaluate::ActualArgument &arg,
     const characteristics::Procedure &proc, evaluate::FoldingContext &context,
     const Scope &scope) {
   auto &messages{context.messages()};
+  std::string dummyName{"dummy argument"};
+  if (!dummy.name.empty()) {
+    dummyName += " '"s + parser::ToLowerCaseLetters(dummy.name) + "='";
+  }
   std::visit(
       common::visitors{
           [&](const characteristics::DummyDataObject &object) {
@@ -314,7 +336,7 @@ static void CheckExplicitInterfaceArg(const evaluate::ActualArgument &arg,
               if (auto type{characteristics::TypeAndShape::Characterize(
                       *expr, context)}) {
                 CheckExplicitDataArg(
-                    object, *expr, *type, proc, context, scope);
+                    object, dummyName, *expr, *type, proc, context, scope);
               } else if (object.type.type().IsTypelessIntrinsicArgument() &&
                   std::holds_alternative<evaluate::BOZLiteralConstant>(
                       expr->u)) {
@@ -327,8 +349,8 @@ static void CheckExplicitInterfaceArg(const evaluate::ActualArgument &arg,
               // An assumed-type dummy is being forwarded.
               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());
+                    "Assumed-type TYPE(*) '%s' may be associated only with an assumed-TYPE(*) %s"_err_en_US,
+                    assumed->name(), dummyName);
               }
             } else {
               messages.Say(
@@ -416,9 +438,9 @@ parser::Messages CheckExplicitInterface(const characteristics::Procedure &proc,
               "an actual argument in this procedure reference"_err_en_US,
               index);
         } else {
-          messages.Say(
-              "Dummy argument '%s' (#%d) is not OPTIONAL and is not associated "
-              "with an actual argument in this procedure reference"_err_en_US,
+          messages.Say("Dummy argument '%s=' (#%d) is not OPTIONAL and is not "
+                       "associated with an actual argument in this procedure "
+                       "reference"_err_en_US,
               dummy.name, index);
         }
       }

diff --git a/flang/test/semantics/call03.f90 b/flang/test/semantics/call03.f90
index 2688ede..d8e76d6 100644 (file)
--- a/flang/test/semantics/call03.f90
+++ b/flang/test/semantics/call03.f90
@@ -96,7 +96,7 @@ module m01
 
   subroutine test01(x) ! 15.5.2.4(2)
     class(t), intent(in) :: x[*]
-    !ERROR: Coindexed polymorphic object may not be associated with a polymorphic dummy argument
+    !ERROR: Coindexed polymorphic object may not be associated with a polymorphic dummy argument 'x='
     call poly(x[1])
   end subroutine
 
@@ -105,7 +105,7 @@ module m01
   end subroutine
   subroutine test02(x) ! 15.5.2.4(2)
     class(t), intent(in) :: x(*)
-    !ERROR: Assumed-size polymorphic array may not be associated with a monomorphic dummy argument
+    !ERROR: Assumed-size polymorphic array may not be associated with a monomorphic dummy argument 'x='
     call mono(x)
   end subroutine
 
@@ -114,19 +114,19 @@ module m01
   end subroutine
   subroutine test03 ! 15.5.2.4(2)
     type(pdt(0)) :: x
-    !ERROR: Actual argument associated with TYPE(*) dummy argument may not have a parameterized derived type
+    !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have a parameterized derived type
     call typestar(x)
   end subroutine
 
   subroutine test04 ! 15.5.2.4(2)
     type(tbp) :: x
-    !ERROR: Actual argument associated with TYPE(*) dummy argument may not have type-bound procedures
+    !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have type-bound procedures
     call typestar(x)
   end subroutine
 
   subroutine test05 ! 15.5.2.4(2)
     type(final) :: x
-    !ERROR: Actual argument associated with TYPE(*) dummy argument may not have FINAL procedures
+    !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have FINAL procedures
     call typestar(x)
   end subroutine
 
@@ -146,13 +146,13 @@ module m01
   end subroutine
   subroutine test07(x) ! 15.5.2.4(6)
     type(alloc) :: x[*]
-    !ERROR: Coindexed actual argument with ALLOCATABLE ultimate component must be associated with a dummy argument with VALUE or INTENT(IN) attributes
+    !ERROR: Coindexed actual argument with ALLOCATABLE ultimate component must be associated with a dummy argument 'x=' with VALUE or INTENT(IN) attributes
     call out01(x[1])
   end subroutine
 
   subroutine test08(x) ! 15.5.2.4(13)
     real :: x(1)[*]
-    !ERROR: Coindexed scalar actual argument must be associated with a scalar dummy argument
+    !ERROR: Coindexed scalar actual argument must be associated with a scalar dummy argument 'x='
     call assumedsize(x(1)[1])
   end subroutine
 
@@ -165,13 +165,13 @@ module m01
     real :: ashape(:)
     class(t) :: polyarray(*)
     character(10) :: c(:)
-    !ERROR: Whole scalar actual argument may not be associated with a dummy argument array
+    !ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array
     call assumedsize(x)
-    !ERROR: Element of pointer array may not be associated with a dummy argument array
+    !ERROR: Element of pointer array may not be associated with a dummy argument 'x=' array
     call assumedsize(p(1))
-    !ERROR: Element of assumed-shape array may not be associated with a dummy argument array
+    !ERROR: Element of assumed-shape array may not be associated with a dummy argument 'x=' array
     call assumedsize(ashape(1))
-    !ERROR: Element of polymorphic array may not be associated with a dummy argument array
+    !ERROR: Element of polymorphic array may not be associated with a dummy argument 'x=' array
     call polyassumedsize(polyarray(1))
     call charray(c(1:1))  ! not an error if character
     call assumedsize(arr(1))  ! not an error if element in sequence
@@ -182,11 +182,11 @@ module m01
   subroutine test10(a) ! 15.5.2.4(16)
     real :: scalar, matrix(2,3)
     real :: a(*)
-    !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument
+    !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'x='
     call assumedshape(scalar)
     !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
     call assumedshape(matrix)
-    !ERROR: Assumed-size array may not be associated with assumed-shape dummy argument
+    !ERROR: Assumed-size array may not be associated with assumed-shape dummy argument 'x='
     call assumedshape(a)
   end subroutine
 
@@ -239,9 +239,9 @@ module m01
     type(ultimateCoarray), volatile :: b
     call coarr(a)  ! ok
     call volcoarr(b)  ! ok
-    !ERROR: VOLATILE attributes must match when actual argument has a coarray ultimate component
+    !ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component
     call coarr(b)
-    !ERROR: VOLATILE attributes must match when actual argument has a coarray ultimate component
+    !ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component
     call volcoarr(a)
   end subroutine
 
@@ -255,17 +255,17 @@ module m01
     call asynchronousValue(b[1])  ! ok
     call asynchronousValue(c[1])  ! ok
     call asynchronousValue(d[1])  ! ok
-    !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE
+    !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
     call asynchronous(b[1])
-    !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE
+    !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
     call volatile(b[1])
-    !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE
+    !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
     call asynchronous(c[1])
-    !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE
+    !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
     call volatile(c[1])
-    !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE
+    !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
     call asynchronous(d[1])
-    !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE
+    !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
     call volatile(d[1])
   end subroutine
 
@@ -280,17 +280,17 @@ module m01
     call valueassumedsize(b(::2)) ! ok
     call valueassumedsize(c(::2)) ! ok
     call valueassumedsize(d(::2)) ! ok
-    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument
+    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
     call volatileassumedsize(b(::2))
-    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument
+    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
     call volatilecontiguous(b(::2))
-    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument
+    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
     call volatileassumedsize(c(::2))
-    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument
+    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
     call volatilecontiguous(c(::2))
-    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument
+    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
     call volatileassumedsize(d(::2))
-    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument
+    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
     call volatilecontiguous(d(::2))
   end subroutine
 
@@ -309,17 +309,17 @@ module m01
     call valueassumedsize(b) ! ok
     call valueassumedsize(c) ! ok
     call valueassumedsize(d) ! ok
-    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument
+    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
     call volatileassumedsize(b)
-    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument
+    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
     call volatilecontiguous(b)
-    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument
+    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
     call volatileassumedsize(c)
-    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument
+    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
     call volatilecontiguous(c)
-    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument
+    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
     call volatileassumedsize(d)
-    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument
+    !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
     call volatilecontiguous(d)
   end subroutine
 

diff --git a/flang/test/semantics/symbol13.f90 b/flang/test/semantics/symbol13.f90
index 508f07a..a732a4e 100644 (file)
--- a/flang/test/semantics/symbol13.f90
+++ b/flang/test/semantics/symbol13.f90
@@ -16,7 +16,7 @@
 
 !DEF: /f1 (Function) Subprogram CHARACTER(1_8,1)
 !DEF: /f1/x1 INTENT(IN) ObjectEntity CHARACTER(2_4,1)
-!DEF: /f1/x2 INTENT(IN) ObjectEntity CHARACTER(3_8,1)
+!DEF: /f1/x2 INTENT(IN) ObjectEntity CHARACTER(3_4,1)
 character*1 function f1(x1, x2)
  !DEF: /f1/n PARAMETER ObjectEntity INTEGER(4)
  integer, parameter :: n = 2
@@ -29,7 +29,7 @@ character*1 function f1(x1, x2)
  type :: t
   !REF: /f1/len
   !REF: /f1/x2
-  !DEF: /f1/t/c1 ObjectEntity CHARACTER(4_8,1)
+  !DEF: /f1/t/c1 ObjectEntity CHARACTER(4_4,1)
   !DEF: /f1/t/c2 ObjectEntity CHARACTER(6_8,1)
   character*(len(x2)+1) :: c1, c2*6
  end type t