maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] Semantic checks for C712 through C727 

I've updated the compiler and test source with references to the contraints at
the points where they were enforced and tested.  Many of these were already
implemented and required no code change.  A few constraint checks were both
implemented and tested, and I only added references to the constraint
numbers in the compiler source and tests.  Here are the things I had to
implement:

Constraint C716 states that, in a REAL constant, if both a kind-param and an
exponent letter appear, the exponent letter must be 'E'.

Constraints C715 and C719 require that a KIND value be actually implemented.

Constraint C722 requires that functions that return assumed-length character
types are external.

Constraint C726 disallows assumed lenght charater types for dummy arguments and
return types.

Original-commit: flang-compiler/f18@45998741e5
Reviewed-on: https://github.com/flang-compiler/f18/pull/1031
Tree-same-pre-rewrite: false
This commit is contained in:
Pete Steinfeld 2020-02-26 20:19:48 -08:00
parent c388d26f41
commit 657aaf8b8d
18 changed files with 265 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
flang/include/flang/Semantics/expression.h
View File

@ -186,7 +186,7 @@ public:
auto result{Analyze(x.thing)};
if (result) {
*result = Fold(std::move(*result));
if (!IsConstantExpr(*result)) { //C886,C887
if (!IsConstantExpr(*result)) { // C886, C887, C713
SayAt(x, "Must be a constant value"_err_en_US);
ResetExpr(x);
return std::nullopt;

8
flang/include/flang/Semantics/tools.h
View File

@ -48,7 +48,7 @@ const DeclTypeSpec *FindParentTypeSpec(const DerivedTypeSpec &);
const DeclTypeSpec *FindParentTypeSpec(const DeclTypeSpec &);
const DeclTypeSpec *FindParentTypeSpec(const Scope &);
const DeclTypeSpec *FindParentTypeSpec(const Symbol &);
// Return the Symbol of the variable of a construct association, if it exists
const Symbol *GetAssociationRoot(const Symbol &);
@ -78,6 +78,10 @@ bool DoesScopeContain(const Scope *, const Symbol &);
bool IsUseAssociated(const Symbol &, const Scope &);
bool IsHostAssociated(const Symbol &, const Scope &);
bool IsDummy(const Symbol &);
bool IsStmtFunction(const Symbol &);
bool IsInStmtFunction(const Symbol &);
bool IsStmtFunctionDummy(const Symbol &);
bool IsStmtFunctionResult(const Symbol &);
bool IsPointerDummy(const Symbol &);
bool IsFunction(const Symbol &);
bool IsPureProcedure(const Symbol &);
@ -154,7 +158,7 @@ inline bool IsAssumedSizeArray(const Symbol &symbol) {
return details && details->IsAssumedSize();
}
bool IsAssumedLengthCharacter(const Symbol &);
bool IsAssumedLengthCharacterFunction(const Symbol &);
bool IsAssumedLengthExternalCharacterFunction(const Symbol &);
// Is the symbol modifiable in this scope
std::optional<parser::MessageFixedText> WhyNotModifiable(
const Symbol &, const Scope &);

2
flang/lib/Evaluate/tools.cpp
View File

@ -101,7 +101,7 @@ ConvertRealOperandsResult ConvertRealOperands(
return {AsSameKindExprs<TypeCategory::Real>(
ConvertTo(ry, std::move(bx)), std::move(ry))};
},
[&](auto &&, auto &&) -> ConvertRealOperandsResult {
[&](auto &&, auto &&) -> ConvertRealOperandsResult { // C718
messages.Say("operands must be INTEGER or REAL"_err_en_US);
return std::nullopt;
},

27
flang/lib/Semantics/check-declarations.cpp
View File

@ -105,9 +105,11 @@ private:
void CheckHelper::Check(const ParamValue &value, bool canBeAssumed) {
if (value.isAssumed()) {
if (!canBeAssumed) { // C795
if (!canBeAssumed) { // C795, C721, C726
messages_.Say(
"An assumed (*) type parameter may be used only for a dummy argument, associate name, or named constant"_err_en_US);
"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);
}
} else {
CheckSpecExpr(value.GetExplicit());
@ -186,16 +188,19 @@ void CheckHelper::Check(const Symbol &symbol) {
}
}
}
if (type) {
if (type) { // Section 7.2, paragraph 7
bool canHaveAssumedParameter{IsNamedConstant(symbol) ||
IsAssumedLengthCharacterFunction(symbol) ||
IsAssumedLengthExternalCharacterFunction(symbol) || // C722
symbol.test(Symbol::Flag::ParentComp)};
if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
canHaveAssumedParameter |= object->isDummy() ||
(object->isFuncResult() &&
type->category() == DeclTypeSpec::Character);
} else {
canHaveAssumedParameter |= symbol.has<AssocEntityDetails>();
if (!IsStmtFunctionDummy(symbol)) { // C726
if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
canHaveAssumedParameter |= object->isDummy() ||
(object->isFuncResult() &&
type->category() == DeclTypeSpec::Character) ||
IsStmtFunctionResult(symbol); // Avoids multiple messages
} else {
canHaveAssumedParameter |= symbol.has<AssocEntityDetails>();
}
}
Check(*type, canHaveAssumedParameter);
if (InPure() && InFunction() && IsFunctionResult(symbol)) {
@ -216,7 +221,7 @@ void CheckHelper::Check(const Symbol &symbol) {
}
}
}
if (IsAssumedLengthCharacterFunction(symbol)) { // C723
if (IsAssumedLengthExternalCharacterFunction(symbol)) { // C723
if (symbol.attrs().test(Attr::RECURSIVE)) {
messages_.Say(
"An assumed-length CHARACTER(*) function cannot be RECURSIVE"_err_en_US);

27
flang/lib/Semantics/expression.cpp
View File

@ -500,10 +500,10 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::RealLiteralConstant &x) {
// Use a local message context around the real literal for better
// provenance on any messages.
auto restorer{GetContextualMessages().SetLocation(x.real.source)};
// If a kind parameter appears, it defines the kind of the literal and any
// letter used in an exponent part (e.g., the 'E' in "6.02214E+23")
// should agree. In the absence of an explicit kind parameter, any exponent
// letter determines the kind. Otherwise, defaults apply.
// If a kind parameter appears, it defines the kind of the literal and the
// letter used in an exponent part must be 'E' (e.g., the 'E' in
// "6.02214E+23"). In the absence of an explicit kind parameter, any
// exponent letter determines the kind. Otherwise, defaults apply.
auto &defaults{context_.defaultKinds()};
int defaultKind{defaults.GetDefaultKind(TypeCategory::Real)};
const char *end{x.real.source.end()};
@ -525,14 +525,13 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::RealLiteralConstant &x) {
defaultKind = *letterKind;
}
auto kind{AnalyzeKindParam(x.kind, defaultKind)};
if (letterKind && kind != *letterKind && expoLetter != 'e') {
Say("Explicit kind parameter on real constant disagrees with "
"exponent letter '%c'"_en_US,
expoLetter);
if (x.kind && letterKind && expoLetter != 'e') { // C716
Say("Explicit kind parameter on REAL constant can only be used with"
" exponent letter 'E'"_err_en_US);
}
auto result{common::SearchTypes(
RealTypeVisitor{kind, x.real.source, GetFoldingContext()})};
if (!result) {
if (!result) { // C717
Say("Unsupported REAL(KIND=%d)"_err_en_US, kind);
}
return AsMaybeExpr(std::move(result));
@ -704,7 +703,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::NamedConstant &n) {
if (IsConstantExpr(folded)) {
return {folded};
}
Say(n.v.source, "must be a constant"_err_en_US);
Say(n.v.source, "must be a constant"_err_en_US); // C718
}
return std::nullopt;
}
@ -1820,8 +1819,8 @@ void ExpressionAnalyzer::CheckForBadRecursion(
if (proc.attrs().test(semantics::Attr::NON_RECURSIVE)) { // 15.6.2.1(3)
msg = Say("NON_RECURSIVE procedure '%s' cannot call itself"_err_en_US,
callSite);
} else if (IsAssumedLengthCharacterFunction(proc)) { // 15.6.2.1(3)
msg = Say(
} else if (IsAssumedLengthExternalCharacterFunction(proc)) {
msg = Say( // 15.6.2.1(3)
"Assumed-length CHARACTER(*) function '%s' cannot call itself"_err_en_US,
callSite);
}
@ -2422,7 +2421,7 @@ DynamicType ExpressionAnalyzer::GetDefaultKindOfType(
bool ExpressionAnalyzer::CheckIntrinsicKind(
TypeCategory category, std::int64_t kind) {
if (IsValidKindOfIntrinsicType(category, kind)) {
if (IsValidKindOfIntrinsicType(category, kind)) { // C712, C714, C715
return true;
} else {
Say("%s(KIND=%jd) is not a supported type"_err_en_US,
@ -2471,7 +2470,7 @@ bool ExpressionAnalyzer::EnforceTypeConstraint(parser::CharBlock at,
const MaybeExpr &result, TypeCategory category, bool defaultKind) {
if (result) {
if (auto type{result->GetType()}) {
if (type->category() != category) { // C885
if (type->category() != category) { // C885
Say(at, "Must have %s type, but is %s"_err_en_US,
ToUpperCase(EnumToString(category)),
ToUpperCase(type->AsFortran()));

8
flang/lib/Semantics/resolve-names.cpp
View File

@ -2602,6 +2602,7 @@ bool SubprogramVisitor::HandleStmtFunction(const parser::StmtFunctionStmt &x) {
if (resultType) {
resultDetails.set_type(*resultType);
}
resultDetails.set_funcResult(true);
Symbol &result{MakeSymbol(name, std::move(resultDetails))};
ApplyImplicitRules(result);
details.set_result(result);
@ -3271,6 +3272,13 @@ void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Character &) {
}
void DeclarationVisitor::Post(const parser::CharSelector::LengthAndKind &x) {
charInfo_.kind = EvaluateSubscriptIntExpr(x.kind);
std::optional<std::int64_t> intKind{ToInt64(charInfo_.kind)};
if (intKind &&
!evaluate::IsValidKindOfIntrinsicType(
TypeCategory::Character, *intKind)) { // C715, C719
Say(currStmtSource().value(),
"KIND value (%jd) not valid for CHARACTER"_err_en_US, *intKind);
}
if (x.length) {
charInfo_.length = GetParamValue(*x.length, common::TypeParamAttr::Len);
}

35
flang/lib/Semantics/tools.cpp
View File

@ -196,6 +196,29 @@ bool IsDummy(const Symbol &symbol) {
}
}
bool IsStmtFunction(const Symbol &symbol) {
const auto *subprogram{symbol.detailsIf<SubprogramDetails>()};
if (subprogram && subprogram->stmtFunction()) {
return true;
}
return false;
}
bool IsInStmtFunction(const Symbol &symbol) {
if (const Symbol * function{symbol.owner().symbol()}) {
return IsStmtFunction(*function);
}
return false;
}
bool IsStmtFunctionDummy(const Symbol &symbol) {
return IsDummy(symbol) && IsInStmtFunction(symbol);
}
bool IsStmtFunctionResult(const Symbol &symbol) {
return IsFunctionResult(symbol) && IsInStmtFunction(symbol);
}
bool IsPointerDummy(const Symbol &symbol) {
return IsPointer(symbol) && IsDummy(symbol);
}
@ -686,11 +709,13 @@ bool IsAssumedLengthCharacter(const Symbol &symbol) {
}
}
bool IsAssumedLengthCharacterFunction(const Symbol &symbol) {
// Assumed-length character functions only appear as such in their
// definitions; their interfaces, pointers to them, and dummy procedures
// cannot be assumed-length.
return symbol.has<SubprogramDetails>() && IsAssumedLengthCharacter(symbol);
// C722 and C723: For a function to be assumed length, it must be external and
// of CHARACTER type
bool IsAssumedLengthExternalCharacterFunction(const Symbol &symbol) {
return IsAssumedLengthCharacter(symbol) &&
((symbol.has<SubprogramDetails>() && symbol.owner().IsGlobal()) ||
(symbol.test(Symbol::Flag::Function) &&
symbol.attrs().test(Attr::EXTERNAL)));
}
const Symbol *IsExternalInPureContext(

5
flang/test/Semantics/CMakeLists.txt
View File

@ -31,6 +31,7 @@ set(ERROR_TESTS
io09.f90
io10.f90
kinds02.f90
kinds04.f90
resolve01.f90
resolve02.f90
resolve03.f90
@ -103,6 +104,9 @@ set(ERROR_TESTS
resolve70.f90
resolve71.f90
resolve72.f90
resolve73.f90
resolve74.f90
resolve75.f90
stop01.f90
structconst01.f90
structconst02.f90
@ -207,6 +211,7 @@ set(ERROR_TESTS
critical02.f90
critical03.f90
block-data01.f90
complex01.f90
data01.f90
)

4
flang/test/Semantics/call05.f90
View File

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

32
flang/test/Semantics/complex01.f90 Normal file
View File

@ -0,0 +1,32 @@
! C718 Each named constant in a complex literal constant shall be of type
! integer or real.
subroutine s()
integer :: ivar = 35
integer, parameter :: iconst = 35
real :: rvar = 68.9
real, parameter :: rconst = 68.9
character :: cvar = 'hello'
character, parameter :: cconst = 'hello'
logical :: lvar = .true.
logical, parameter :: lconst = .true.
complex :: cvar1 = (1, 1)
complex :: cvar2 = (1.0, 1.0)
complex :: cvar3 = (1.0, 1)
complex :: cvar4 = (1, 1.0)
complex :: cvar5 = (iconst, 1.0)
complex :: cvar6 = (iconst, rconst)
complex :: cvar7 = (rconst, iconst)
!ERROR: must be a constant
complex :: cvar8 = (ivar, 1.0)
!ERROR: must be a constant
!ERROR: must be a constant
complex :: cvar9 = (ivar, rvar)
!ERROR: must be a constant
!ERROR: must be a constant
complex :: cvar10 = (rvar, ivar)
!ERROR: operands must be INTEGER or REAL
complex :: cvar11 = (cconst, 1.0)
!ERROR: operands must be INTEGER or REAL
complex :: cvar12 = (lconst, 1.0)
end subroutine s

27
flang/test/Semantics/kinds02.f90
View File

@ -1,3 +1,15 @@
! C712 The value of scalar-int-constant-expr shall be nonnegative and
! shall specify a representation method that exists on the processor.
! C714 The value of kind-param shall be nonnegative.
! C715 The value of kind-param shall specify a representation method that
! exists on the processor.
! C719 The value of scalar-int-constant-expr shall be nonnegative and shall
! specify a representation method that exists on the processor.
! C725 The optional comma in a length-selector is permitted only if no
! double-colon separator appears in the typedeclaration- stmt.
! C727 The value of kind-param shall specify a representation method that
! exists on the processor.
!
!ERROR: INTEGER(KIND=0) is not a supported type
integer(kind=0) :: j0
!ERROR: INTEGER(KIND=-1) is not a supported type
@ -40,4 +52,19 @@ logical(kind=-1) :: lm1
logical(kind=3) :: l3
!ERROR: LOGICAL(KIND=16) is not a supported type
logical(kind=16) :: l16
character (len=99, kind=1) :: cvar1
character (len=99, kind=2) :: cvar2
character *4, cvar3
character *(5), cvar4
!ERROR: KIND value (3) not valid for CHARACTER
character (len=99, kind=3) :: cvar5
!ERROR: KIND value (-1) not valid for CHARACTER
character (len=99, kind=-1) :: cvar6
character(len=*), parameter :: cvar7 = 1_"abcd"
character(len=*), parameter :: cvar8 = 2_"abcd"
!ERROR: CHARACTER(KIND=3) is not a supported type
character(len=*), parameter :: cvar9 = 3_"abcd"
character(len=*), parameter :: cvar10 = 4_"abcd"
!ERROR: CHARACTER(KIND=8) is not a supported type
character(len=*), parameter :: cvar11 = 8_"abcd"
end program

31
flang/test/Semantics/kinds04.f90 Normal file
View File

@ -0,0 +1,31 @@
! C716 If both kind-param and exponent-letter appear, exponent-letter
! shall be E.
! C717 The value of kind-param shall specify an approximation method that
! exists on the processor.
subroutine s(var)
real :: realvar1 = 4.0E6_4
real :: realvar2 = 4.0D6
real :: realvar3 = 4.0Q6
!ERROR: Explicit kind parameter on REAL constant can only be used with exponent letter 'E'
real :: realvar4 = 4.0D6_8
!ERROR: Explicit kind parameter on REAL constant can only be used with exponent letter 'E'
real :: realvar5 = 4.0Q6_16
real :: realvar6 = 4.0E6_8
real :: realvar7 = 4.0E6_10
real :: realvar8 = 4.0E6_16
!ERROR: Unsupported REAL(KIND=32)
real :: realvar9 = 4.0E6_32
double precision :: doublevar1 = 4.0E6_4
double precision :: doublevar2 = 4.0D6
double precision :: doublevar3 = 4.0Q6
!ERROR: Explicit kind parameter on REAL constant can only be used with exponent letter 'E'
double precision :: doublevar4 = 4.0D6_8
!ERROR: Explicit kind parameter on REAL constant can only be used with exponent letter 'E'
double precision :: doublevar5 = 4.0Q6_16
double precision :: doublevar6 = 4.0E6_8
double precision :: doublevar7 = 4.0E6_10
double precision :: doublevar8 = 4.0E6_16
!ERROR: Unsupported REAL(KIND=32)
double precision :: doublevar9 = 4.0E6_32
end subroutine s

1
flang/test/Semantics/resolve35.f90
View File

@ -66,6 +66,7 @@ subroutine s6b
integer :: l = 4
forall(integer(k) :: i = 1:10)
end forall
! C713 A scalar-int-constant-name shall be a named constant of type integer.
!ERROR: Must be a constant value
forall(integer(l) :: i = 1:10)
end forall

1
flang/test/Semantics/resolve37.f90
View File

@ -6,6 +6,7 @@ integer :: n = 2
!ERROR: Must be a constant value
parameter(m=n)
integer(k) :: x
! C713 A scalar-int-constant-name shall be a named constant of type integer.
!ERROR: Must have INTEGER type, but is REAL(4)
integer(l) :: y
!ERROR: Must be a constant value

1
flang/test/Semantics/resolve41.f90
View File

@ -4,6 +4,7 @@ module m
!ERROR: Must have INTEGER type, but is REAL(4)
integer :: aa = 2_a
integer :: b = 8
! C713 A scalar-int-constant-name shall be a named constant of type integer.
!ERROR: Must be a constant value
integer :: bb = 2_b
!TODO: should get error -- not scalar

40
flang/test/Semantics/resolve73.f90 Normal file
View File

@ -0,0 +1,40 @@
! 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
! 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),
! or
! * in an external function, to declare the character length parameter of the function result.
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
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
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

37
flang/test/Semantics/resolve74.f90 Normal file
View File

@ -0,0 +1,37 @@
! 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
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
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
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
type(derived(param=*)) :: fails2
end function fails2
end subroutine s

13
flang/test/Semantics/resolve75.f90 Normal file
View File

@ -0,0 +1,13 @@
! 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
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
dStmtFunc3 (x) = "abc"
end subroutine s