[flang-commits] [flang] 41a964c - [flang] Settle ambiguity between C795 and C721
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon Mar 27 17:37:37 PDT 2023
Author: Peter Klausler
Date: 2023-03-27T17:37:30-07:00
New Revision: 41a964cff0068ba417d355b499f10ecedd4a4636
URL: https://github.com/llvm/llvm-project/commit/41a964cff0068ba417d355b499f10ecedd4a4636
DIFF: https://github.com/llvm/llvm-project/commit/41a964cff0068ba417d355b499f10ecedd4a4636.diff
LOG: [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
Added:
Modified:
flang/lib/Semantics/check-declarations.cpp
flang/test/Semantics/call05.f90
flang/test/Semantics/call31.f90
flang/test/Semantics/resolve73.f90
flang/test/Semantics/resolve74.f90
flang/test/Semantics/resolve75.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 9b5d28cf574b..0e4ba83cae36 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/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>();
diff --git a/flang/test/Semantics/call05.f90 b/flang/test/Semantics/call05.f90
index 002a81deffe0..269a0a3034a9 100644
--- a/flang/test/Semantics/call05.f90
+++ b/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(:)
diff --git a/flang/test/Semantics/call31.f90 b/flang/test/Semantics/call31.f90
index eb4411195073..429c3a869bf0 100644
--- a/flang/test/Semantics/call31.f90
+++ b/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
diff --git a/flang/test/Semantics/resolve73.f90 b/flang/test/Semantics/resolve73.f90
index 1ec9f09c44be..f02a3ab960a4 100644
--- a/flang/test/Semantics/resolve73.f90
+++ b/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"
diff --git a/flang/test/Semantics/resolve74.f90 b/flang/test/Semantics/resolve74.f90
index 14d1c8a29b86..a248fc3c9088 100644
--- a/flang/test/Semantics/resolve74.f90
+++ b/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
diff --git a/flang/test/Semantics/resolve75.f90 b/flang/test/Semantics/resolve75.f90
index b0d9072d5658..77c8065e86f9 100644
--- a/flang/test/Semantics/resolve75.f90
+++ b/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
More information about the flang-commits
mailing list