[flang] Settle ambiguity between C795 and C721

[klausler]

Summary

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.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Semantics/check-declarations.cpp

private:
   };
   std::map<SourceName, std::vector<ProcedureInfo>> nameToInfo_;
 };
 
 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());
   }
 }
 
 void CheckHelper::Check(const ArraySpec &shape) {
   for (const auto &spec : shape) {
if (symbol.attrs().test(Attr::VOLATILE) &&
       messages_.Say(
           "A pure subprogram may not have a variable with the VOLATILE attribute"_err_en_US);
     }
     if (IsProcedure(symbol) && !IsPureProcedure(symbol) && IsDummy(symbol)) {
       messages_.Say(
           "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) ==
                     ProcedureDefinitionClass::Dummy)) ||
         symbol.test(Symbol::Flag::ParentComp)};
     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>();
       }
     }
     if (IsProcedurePointer(symbol) && symbol.HasExplicitInterface()) {
       // Don't check function result types here
     } else {

flang/test/Semantics/call05.f90

module m
   type(t), pointer :: mp(:), mpmat(:,:)
   type(t), allocatable :: ma(:), mamat(:,:)
   class(t), pointer :: pp(:)
   class(t), allocatable :: pa(:)
   class(t2), pointer :: pp2(:)
   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(:)
   type(pdt(1)), pointer :: nmp(:)
   type(pdt(1)), allocatable :: nma(:)
 
  contains
 

flang/test/Semantics/call31.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
 ! Confirm enforcement of constraint C723 in F2018 for procedure pointers
 
       module m
        contains
         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
           call subr_1(plocal)
         end subroutine
 
         subroutine subr_1(parg_1)
           !PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type

flang/test/Semantics/resolve73.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! 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)
     integer, len :: param
     class(*), allocatable :: x
   end type
   type(derived(34)) :: a
   interface
     function fun()
       character(len=4) :: 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"
     type is (character(len=*))
       print *, "hello"
     class is (derived(param=*))
       print *, "hello"
     class default
       print *, "hello"
   end select
 
   allocate (character(len=*) :: arg)
 end subroutine s

flang/test/Semantics/resolve74.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! C722 A function name shall not be declared with an asterisk type-param-value 
 ! unless it is of type CHARACTER and is the name of a dummy function or the 
 ! name of the result of an external function.
 subroutine s()
 
   type derived(param)
     integer, len :: param
   end type
   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
     subroutine subr(dummyFunc)
       character(len=*) :: dummyFunc
     end subroutine subr
   end interface
 
   contains
     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
 
 end subroutine s

flang/test/Semantics/resolve75.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! C726 The length specified for a character statement function or for a 
 ! statement function dummy argument of type character shall be a constant 
 ! expression.
 subroutine s()
   implicit character(len=3) (c)
   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