Commit 41a964cf authored by Peter Klausler's avatar Peter Klausler
Browse files

[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
parent 7b0c4184

flang/lib/Semantics/check-declarations.cpp

+5 −7
Original line number Diff line number Diff line
@@ -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

+2 −2
Original line number Diff line number Diff line
@@ -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

+1 −1
Original line number Diff line number Diff line
@@ -6,7 +6,7 @@ 
        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

+10 −3
Original line number Diff line number Diff line
@@ -7,12 +7,13 @@ 
! * 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 @@ subroutine s(arg) 
    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

+4 −4
Original line number Diff line number Diff line
@@ -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 @@ subroutine s() 
      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