[flang] Settle ambiguity between C795 and C721

C721 says that a type parameter value of '*' is permitted in the type-spec
for a named constant; C795 says that such type parameters are allowed
in type-specs only for a few kinds of things, not including named
constants.  The interpretation seems to depend on context, with C721
applying to intrinsic types (i.e., character) and C795 applying only
to derived types.

Differential Revision: https://reviews.llvm.org/D146586

Author: klausler

flang/lib/Semantics/check-declarations.cpp

@@ -190,9 +190,7 @@ void CheckHelper::Check(const ParamValue &value, bool canBeAssumed) {
   if (value.isAssumed()) {
     if (!canBeAssumed) { // C795, C721, C726
       messages_.Say(
-          "An assumed (*) type parameter may be used only for a (non-statement"
-          " function) dummy argument, associate name, named constant, or"
-          " external function result"_err_en_US);
+          "An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, character named constant, or external function result"_err_en_US);
     }
   } else {
     CheckSpecExpr(value.GetExplicit());
@@ -323,8 +321,9 @@ void CheckHelper::Check(const Symbol &symbol) {
           "A dummy procedure of a pure subprogram must be pure"_err_en_US);
     }
   }
-  if (type) { // Section 7.2, paragraph 7
-    bool canHaveAssumedParameter{IsNamedConstant(symbol) ||
+  if (type) { // Section 7.2, paragraph 7; C795
+    bool isChar{type->category() == DeclTypeSpec::Character};
+    bool canHaveAssumedParameter{(isChar && IsNamedConstant(symbol)) ||
         (IsAssumedLengthCharacter(symbol) && // C722
             (IsExternal(symbol) ||
                 ClassifyProcedure(symbol) ==
@@ -333,8 +332,7 @@ void CheckHelper::Check(const Symbol &symbol) {
     if (!IsStmtFunctionDummy(symbol)) { // C726
       if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
         canHaveAssumedParameter |= object->isDummy() ||
-            (object->isFuncResult() &&
-                type->category() == DeclTypeSpec::Character) ||
+            (isChar && object->isFuncResult()) ||
             IsStmtFunctionResult(symbol); // Avoids multiple messages
       } else {
         canHaveAssumedParameter |= symbol.has<AssocEntityDetails>();

flang/test/Semantics/call05.f90

@@ -20,9 +20,9 @@ module m
   class(t2), allocatable :: pa2(:)
   class(*), pointer :: up(:)
   class(*), allocatable :: ua(:)
-  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, named constant, or external function result
+  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, character named constant, or external function result
   type(pdt(*)), pointer :: amp(:)
-  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, named constant, or external function result
+  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, character named constant, or external function result
   type(pdt(*)), allocatable :: ama(:)
   type(pdt(:)), pointer :: dmp(:)
   type(pdt(:)), allocatable :: dma(:)

flang/test/Semantics/call31.f90

@@ -6,7 +6,7 @@ module m
         subroutine subr(parg)
           !PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type
           procedure(character(*)), pointer :: parg
-          !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, named constant, or external function result
+          !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, character named constant, or external function result
           procedure(character(*)), pointer :: plocal
           print *, parg()
           plocal => parg

flang/test/Semantics/resolve73.f90

@@ -2,17 +2,18 @@
 ! C721 A type-param-value of * shall be used only
 ! * to declare a dummy argument,
 ! * to declare a named constant,
-! * in the type-spec of an ALLOCATE statement wherein each allocate-object is 
+! * in the type-spec of an ALLOCATE statement wherein each allocate-object is
 !   a dummy argument of type CHARACTER with an assumed character length,
-! * in the type-spec or derived-type-spec of a type guard statement (11.1.11), 
+! * in the type-spec or derived-type-spec of a type guard statement (11.1.11),
 !   or
 ! * in an external function, to declare the character length parameter of the function result.
+! Note also C795 for derived types (C721 applies to intrinsic types)
 subroutine s(arg)
   character(len=*), pointer :: arg
   character*(*), parameter  :: cvar1 = "abc"
   character*4,  cvar2
   character(len=4_4) :: cvar3
-  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, named constant, or external function result
+  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, character named constant, or external function result
   character(len=*) :: cvar4
 
   type derived(param)
@@ -26,6 +27,12 @@ function fun()
     end function fun
   end interface
 
+  type t(len)
+    integer, len :: len
+  end type
+  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, character named constant, or external function result
+  type(t(*)), parameter :: p2 = t(123)() ! C795
+
   select type (ax => a%x)
     type is (integer)
       print *, "hello"

flang/test/Semantics/resolve74.f90

@@ -10,7 +10,7 @@ subroutine s()
   type(derived(34)) :: a
 
   procedure(character(len=*)) :: externCharFunc
-  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, named constant, or external function result
+  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, character named constant, or external function result
   procedure(type(derived(param =*))) :: externDerivedFunc
 
   interface
@@ -24,14 +24,14 @@ function works()
       type(derived(param=4)) :: works
     end function works
 
-  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, named constant, or external function result
+  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, character named constant, or external function result
     function fails1()
       character(len=*) :: fails1
     end function fails1
 
-  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, named constant, or external function result
+  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, character named constant, or external function result
     function fails2()
-  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, named constant, or external function result
+  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, character named constant, or external function result
       type(derived(param=*)) :: fails2
     end function fails2
 

flang/test/Semantics/resolve75.f90

@@ -7,8 +7,8 @@ subroutine s()
   implicit character(len=*) (d)
   stmtFunc1 (x) = x * 32
   cStmtFunc2 (x) = "abc"
-  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, named constant, or external function result
+  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, character named constant, or external function result
   cStmtFunc3 (dummy) = "abc"
-  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, named constant, or external function result
+  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, character named constant, or external function result
   dStmtFunc3 (x) = "abc"
 end subroutine s