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

[flang] Revert to returning default INTEGER for LEN() and offset-in-CHARACTER intrinsics; further shape analysis of intrinsic results 

Original-commit: flang-compiler/f18@561f5965b2
Reviewed-on: https://github.com/flang-compiler/f18/pull/782
Tree-same-pre-rewrite: false
This commit is contained in:
peter klausler 2019-10-16 11:53:03 -07:00
parent f090eb878e
commit 4abdc30b63
6 changed files with 122 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
flang/documentation/Extensions.md
View File

@ -20,8 +20,9 @@ Intentional violations of the standard
rule imposes an artificially small constraint in some cases rule imposes an artificially small constraint in some cases
where Fortran mandates that something have the default `INTEGER` where Fortran mandates that something have the default `INTEGER`
type: specifically, the results of references to the intrinsic functions type: specifically, the results of references to the intrinsic functions
`LEN`, `SIZE`, `LBOUND`, `UBOUND`, and `SHAPE`. We return `SIZE`, `LBOUND`, `UBOUND`, `SHAPE`, and the location reductions
`INTEGER(KIND=8)` in these cases. `FINDLOC`, `MAXLOC`, and `MINLOC`. We return `INTEGER(KIND=8)` by
default in these cases.
Extensions, deletions, and legacy features supported by default Extensions, deletions, and legacy features supported by default
=============================================================== ===============================================================

10
flang/lib/evaluate/intrinsics.cc
View File

@ -445,7 +445,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"index", {"index",
{{"string", SameChar}, {"substring", SameChar}, {{"string", SameChar}, {"substring", SameChar},
{"back", AnyLogical, Rank::scalar, Optionality::optional}, {"back", AnyLogical, Rank::scalar, Optionality::optional},
SubscriptDefaultKIND}, DefaultingKIND},
KINDInt}, KINDInt},
{"int", {{"a", AnyNumeric, Rank::elementalOrBOZ}, DefaultingKIND}, KINDInt}, {"int", {{"a", AnyNumeric, Rank::elementalOrBOZ}, DefaultingKIND}, KINDInt},
{"int_ptr_kind", {}, DefaultInt, Rank::scalar}, {"int_ptr_kind", {}, DefaultInt, Rank::scalar},
@ -467,9 +467,9 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{{"array", AnyData, Rank::anyOrAssumedRank}, SubscriptDefaultKIND}, {{"array", AnyData, Rank::anyOrAssumedRank}, SubscriptDefaultKIND},
KINDInt, Rank::vector}, KINDInt, Rank::vector},
{"leadz", {{"i", AnyInt}}, DefaultInt}, {"leadz", {{"i", AnyInt}}, DefaultInt},
{"len", {{"string", AnyChar, Rank::anyOrAssumedRank}, SubscriptDefaultKIND}, {"len", {{"string", AnyChar, Rank::anyOrAssumedRank}, DefaultingKIND},
KINDInt, Rank::scalar}, KINDInt, Rank::scalar},
{"len_trim", {{"string", AnyChar}, SubscriptDefaultKIND}, KINDInt}, {"len_trim", {{"string", AnyChar}, DefaultingKIND}, KINDInt},
{"lge", {{"string_a", SameChar}, {"string_b", SameChar}}, DefaultLogical}, {"lge", {{"string_a", SameChar}, {"string_b", SameChar}}, DefaultLogical},
{"lgt", {{"string_a", SameChar}, {"string_b", SameChar}}, DefaultLogical}, {"lgt", {{"string_a", SameChar}, {"string_b", SameChar}}, DefaultLogical},
{"lle", {{"string_a", SameChar}, {"string_b", SameChar}}, DefaultLogical}, {"lle", {{"string_a", SameChar}, {"string_b", SameChar}}, DefaultLogical},
@ -618,7 +618,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"scan", {"scan",
{{"string", SameChar}, {"set", SameChar}, {{"string", SameChar}, {"set", SameChar},
{"back", AnyLogical, Rank::elemental, Optionality::optional}, {"back", AnyLogical, Rank::elemental, Optionality::optional},
SubscriptDefaultKIND}, DefaultingKIND},
KINDInt}, KINDInt},
{"selected_char_kind", {{"name", DefaultChar, Rank::scalar}}, DefaultInt, {"selected_char_kind", {{"name", DefaultChar, Rank::scalar}}, DefaultInt,
Rank::scalar}, Rank::scalar},
@ -695,7 +695,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"verify", {"verify",
{{"string", SameChar}, {"set", SameChar}, {{"string", SameChar}, {"set", SameChar},
{"back", AnyLogical, Rank::elemental, Optionality::optional}, {"back", AnyLogical, Rank::elemental, Optionality::optional},
SubscriptDefaultKIND}, DefaultingKIND},
KINDInt}, KINDInt},
}; };

48
flang/lib/evaluate/shape.cc
View File

@ -475,6 +475,32 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
const auto *expr{call.arguments().front().value().UnwrapExpr()}; const auto *expr{call.arguments().front().value().UnwrapExpr()};
CHECK(expr != nullptr); CHECK(expr != nullptr);
return Shape{MaybeExtentExpr{ExtentExpr{expr->Rank()}}}; return Shape{MaybeExtentExpr{ExtentExpr{expr->Rank()}}};
} else if (intrinsic->name == "all" || intrinsic->name == "any" ||
intrinsic->name == "count" || intrinsic->name == "iall" ||
intrinsic->name == "iany" || intrinsic->name == "iparity" ||
intrinsic->name == "maxloc" || intrinsic->name == "maxval" ||
intrinsic->name == "minloc" || intrinsic->name == "minval" ||
intrinsic->name == "norm2" || intrinsic->name == "parity" ||
intrinsic->name == "product" || intrinsic->name == "sum") {
// Reduction with DIM=
if (call.arguments().size() >= 2) {
auto arrayShape{
(*this)(UnwrapExpr<Expr<SomeType>>(call.arguments().at(0)))};
const auto *dimArg{UnwrapExpr<Expr<SomeType>>(call.arguments().at(1))};
if (arrayShape.has_value() && dimArg != nullptr) {
if (auto dim{ToInt64(*dimArg)}) {
if (*dim >= 1 &&
static_cast<std::size_t>(*dim) <= arrayShape->size()) {
arrayShape->erase(arrayShape->begin() + (*dim - 1));
return std::move(*arrayShape);
}
}
}
}
} else if (intrinsic->name == "cshift" || intrinsic->name == "eoshift") {
if (!call.arguments().empty()) {
return (*this)(call.arguments()[0]);
}
} else if (intrinsic->name == "reshape") { } else if (intrinsic->name == "reshape") {
if (call.arguments().size() >= 2 && call.arguments().at(1).has_value()) { if (call.arguments().size() >= 2 && call.arguments().at(1).has_value()) {
// SHAPE(RESHAPE(array,shape)) -> shape // SHAPE(RESHAPE(array,shape)) -> shape
@ -484,19 +510,6 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
return AsShape(context_, ConvertToType<ExtentType>(std::move(shape))); return AsShape(context_, ConvertToType<ExtentType>(std::move(shape)));
} }
} }
} else if (intrinsic->name == "transpose") {
if (call.arguments().size() >= 1) {
if (auto shape{(*this)(call.arguments().at(0))}) {
if (shape->size() == 2) {
std::swap((*shape)[0], (*shape)[1]);
return shape;
}
}
}
} else if (intrinsic->name == "cshift" || intrinsic->name == "eoshift") {
if (!call.arguments().empty()) {
return (*this)(call.arguments()[0]);
}
} else if (intrinsic->name == "spread") { } else if (intrinsic->name == "spread") {
// SHAPE(SPREAD(ARRAY,DIM,NCOPIES)) = SHAPE(ARRAY) with NCOPIES inserted // SHAPE(SPREAD(ARRAY,DIM,NCOPIES)) = SHAPE(ARRAY) with NCOPIES inserted
// at position DIM. // at position DIM.
@ -517,6 +530,15 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
} }
} }
} }
} else if (intrinsic->name == "transpose") {
if (call.arguments().size() >= 1) {
if (auto shape{(*this)(call.arguments().at(0))}) {
if (shape->size() == 2) {
std::swap((*shape)[0], (*shape)[1]);
return shape;
}
}
}
} else if (intrinsic->characteristics.value().attrs.test(characteristics:: } else if (intrinsic->characteristics.value().attrs.test(characteristics::
Procedure::Attr::NullPointer)) { // NULL(MOLD=) Procedure::Attr::NullPointer)) { // NULL(MOLD=)
return (*this)(call.arguments()); return (*this)(call.arguments());

66
flang/lib/semantics/check-call.cc
View File

@ -18,6 +18,7 @@
#include "../evaluate/characteristics.h" #include "../evaluate/characteristics.h"
#include "../evaluate/shape.h" #include "../evaluate/shape.h"
#include "../evaluate/tools.h" #include "../evaluate/tools.h"
#include "../parser/characters.h"
#include "../parser/message.h" #include "../parser/message.h"
#include <map> #include <map>
#include <string> #include <string>
@ -110,6 +111,7 @@ static void InspectType(
} }
static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
const std::string &dummyName,
const evaluate::Expr<evaluate::SomeType> &actual, const evaluate::Expr<evaluate::SomeType> &actual,
const characteristics::TypeAndShape &actualType, const characteristics::TypeAndShape &actualType,
const characteristics::Procedure &proc, evaluate::FoldingContext &context, const characteristics::Procedure &proc, evaluate::FoldingContext &context,
@ -152,12 +154,14 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
if (actualIsPolymorphic && dummyIsPolymorphic && if (actualIsPolymorphic && dummyIsPolymorphic &&
actualIsCoindexed) { // 15.5.2.4(2) actualIsCoindexed) { // 15.5.2.4(2)
messages.Say( messages.Say(
"Coindexed polymorphic object may not be associated with a polymorphic dummy argument"_err_en_US); "Coindexed polymorphic object may not be associated with a polymorphic %s"_err_en_US,
dummyName);
} }
if (actualIsPolymorphic && !dummyIsPolymorphic && if (actualIsPolymorphic && !dummyIsPolymorphic &&
actualIsAssumedSize) { // 15.5.2.4(2) actualIsAssumedSize) { // 15.5.2.4(2)
messages.Say( messages.Say(
"Assumed-size polymorphic array may not be associated with a monomorphic dummy argument"_err_en_US); "Assumed-size polymorphic array may not be associated with a monomorphic %s"_err_en_US,
dummyName);
} }
// derived type actual argument checks // derived type actual argument checks
@ -169,18 +173,21 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
if (dummy.type.type().IsAssumedType()) { if (dummy.type.type().IsAssumedType()) {
if (!derived.parameters().empty()) { // 15.5.2.4(2) if (!derived.parameters().empty()) { // 15.5.2.4(2)
messages.Say( messages.Say(
"Actual argument associated with TYPE(*) dummy argument may not have a parameterized derived type"_err_en_US); "Actual argument associated with TYPE(*) %s may not have a parameterized derived type"_err_en_US,
dummyName);
} }
if (concerns.typeBoundProcedure) { // 15.5.2.4(2) if (concerns.typeBoundProcedure) { // 15.5.2.4(2)
if (auto *msg{messages.Say( if (auto *msg{messages.Say(
"Actual argument associated with TYPE(*) dummy argument may not have type-bound procedures"_err_en_US)}) { "Actual argument associated with TYPE(*) %s may not have type-bound procedures"_err_en_US,
dummyName)}) {
msg->Attach(concerns.typeBoundProcedure->name(), msg->Attach(concerns.typeBoundProcedure->name(),
"Declaration of type-bound procedure"_en_US); "Declaration of type-bound procedure"_en_US);
} }
} }
if (concerns.finalProcedure) { // 15.5.2.4(2) if (concerns.finalProcedure) { // 15.5.2.4(2)
if (auto *msg{messages.Say( if (auto *msg{messages.Say(
"Actual argument associated with TYPE(*) dummy argument may not have FINAL procedures"_err_en_US)}) { "Actual argument associated with TYPE(*) %s may not have FINAL procedures"_err_en_US,
dummyName)}) {
msg->Attach(concerns.finalProcedure->name(), msg->Attach(concerns.finalProcedure->name(),
"Declaration of FINAL procedure"_en_US); "Declaration of FINAL procedure"_en_US);
} }
@ -190,7 +197,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
dummy.intent != common::Intent::In && !dummyIsValue) { dummy.intent != common::Intent::In && !dummyIsValue) {
// 15.5.2.4(6) // 15.5.2.4(6)
if (auto *msg{messages.Say( if (auto *msg{messages.Say(
"Coindexed actual argument with ALLOCATABLE ultimate component must be associated with a dummy argument with VALUE or INTENT(IN) attributes"_err_en_US)}) { "Coindexed actual argument with ALLOCATABLE ultimate component must be associated with a %s with VALUE or INTENT(IN) attributes"_err_en_US,
dummyName)}) {
msg->Attach(concerns.allocatable->name(), msg->Attach(concerns.allocatable->name(),
"Declaration of ALLOCATABLE component"_en_US); "Declaration of ALLOCATABLE component"_en_US);
} }
@ -198,7 +206,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
if (concerns.coarray && if (concerns.coarray &&
actualIsVolatile != dummyIsVolatile) { // 15.5.2.4(22) actualIsVolatile != dummyIsVolatile) { // 15.5.2.4(22)
if (auto *msg{messages.Say( if (auto *msg{messages.Say(
"VOLATILE attributes must match when actual argument has a coarray ultimate component"_err_en_US)}) { "VOLATILE attribute must match for %s when actual argument has a coarray ultimate component"_err_en_US,
dummyName)}) {
msg->Attach( msg->Attach(
concerns.coarray->name(), "Declaration of coarray component"_en_US); concerns.coarray->name(), "Declaration of coarray component"_en_US);
} }
@ -216,11 +225,13 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
// 15.5.2.4(16) // 15.5.2.4(16)
if (actualRank == 0) { if (actualRank == 0) {
messages.Say( messages.Say(
"Scalar actual argument may not be associated with assumed-shape dummy argument"_err_en_US); "Scalar actual argument may not be associated with assumed-shape %s"_err_en_US,
dummyName);
} }
if (actualIsAssumedSize) { if (actualIsAssumedSize) {
if (auto *msg{messages.Say( if (auto *msg{messages.Say(
"Assumed-size array may not be associated with assumed-shape dummy argument"_err_en_US)}) { "Assumed-size array may not be associated with assumed-shape %s"_err_en_US,
dummyName)}) {
msg->Attach(actualLastSymbol->name(), msg->Attach(actualLastSymbol->name(),
"Declaration of assumed-size array actual argument"_en_US); "Declaration of assumed-size array actual argument"_en_US);
} }
@ -229,24 +240,29 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
// Actual is scalar, dummy is an array. 15.5.2.4(14), 15.5.2.11 // Actual is scalar, dummy is an array. 15.5.2.4(14), 15.5.2.11
if (actualIsCoindexed) { if (actualIsCoindexed) {
messages.Say( messages.Say(
"Coindexed scalar actual argument must be associated with a scalar dummy argument"_err_en_US); "Coindexed scalar actual argument must be associated with a scalar %s"_err_en_US,
dummyName);
} }
if (actualLastSymbol && actualLastSymbol->Rank() == 0 && if (actualLastSymbol && actualLastSymbol->Rank() == 0 &&
!(dummy.type.type().IsAssumedType() && dummyIsAssumedSize)) { !(dummy.type.type().IsAssumedType() && dummyIsAssumedSize)) {
messages.Say( messages.Say(
"Whole scalar actual argument may not be associated with a dummy argument array"_err_en_US); "Whole scalar actual argument may not be associated with a %s array"_err_en_US,
dummyName);
} }
if (actualIsPolymorphic) { if (actualIsPolymorphic) {
messages.Say( messages.Say(
"Element of polymorphic array may not be associated with a dummy argument array"_err_en_US); "Element of polymorphic array may not be associated with a %s array"_err_en_US,
dummyName);
} }
if (actualLastSymbol && actualLastSymbol->attrs().test(Attr::POINTER)) { if (actualLastSymbol && actualLastSymbol->attrs().test(Attr::POINTER)) {
messages.Say( messages.Say(
"Element of pointer array may not be associated with a dummy argument array"_err_en_US); "Element of pointer array may not be associated with a %s array"_err_en_US,
dummyName);
} }
if (actualLastObject && actualLastObject->IsAssumedShape()) { if (actualLastObject && actualLastObject->IsAssumedShape()) {
messages.Say( messages.Say(
"Element of assumed-shape array may not be associated with a dummy argument array"_err_en_US); "Element of assumed-shape array may not be associated with a %s array"_err_en_US,
dummyName);
} }
} }
@ -279,7 +295,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
(dummyIsAsynchronous || dummyIsVolatile) && !dummyIsValue) { (dummyIsAsynchronous || dummyIsVolatile) && !dummyIsValue) {
if (actualIsCoindexed) { // C1538 if (actualIsCoindexed) { // C1538
messages.Say( messages.Say(
"Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE"_err_en_US); "Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with %s with ASYNCHRONOUS or VOLATILE attributes unless VALUE"_err_en_US,
dummyName);
} }
if (actualRank > 0 && !IsSimplyContiguous(actual, context.intrinsics())) { if (actualRank > 0 && !IsSimplyContiguous(actual, context.intrinsics())) {
bool dummyIsContiguous{ bool dummyIsContiguous{
@ -296,7 +313,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
!(dummyIsAssumedShape || dummyIsAssumedRank || !(dummyIsAssumedShape || dummyIsAssumedRank ||
(actualIsPointer && dummyIsPointer))) { // C1539 & C1540 (actualIsPointer && dummyIsPointer))) { // C1539 & C1540
messages.Say( messages.Say(
"ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument"_err_en_US); "ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous %s"_err_en_US,
dummyName);
} }
} }
} }
@ -307,6 +325,10 @@ static void CheckExplicitInterfaceArg(const evaluate::ActualArgument &arg,
const characteristics::Procedure &proc, evaluate::FoldingContext &context, const characteristics::Procedure &proc, evaluate::FoldingContext &context,
const Scope &scope) { const Scope &scope) {
auto &messages{context.messages()}; auto &messages{context.messages()};
std::string dummyName{"dummy argument"};
if (!dummy.name.empty()) {
dummyName += " '"s + parser::ToLowerCaseLetters(dummy.name) + "='";
}
std::visit( std::visit(
common::visitors{ common::visitors{
[&](const characteristics::DummyDataObject &object) { [&](const characteristics::DummyDataObject &object) {
@ -314,7 +336,7 @@ static void CheckExplicitInterfaceArg(const evaluate::ActualArgument &arg,
if (auto type{characteristics::TypeAndShape::Characterize( if (auto type{characteristics::TypeAndShape::Characterize(
*expr, context)}) { *expr, context)}) {
CheckExplicitDataArg( CheckExplicitDataArg(
object, *expr, *type, proc, context, scope); object, dummyName, *expr, *type, proc, context, scope);
} else if (object.type.type().IsTypelessIntrinsicArgument() && } else if (object.type.type().IsTypelessIntrinsicArgument() &&
std::holds_alternative<evaluate::BOZLiteralConstant>( std::holds_alternative<evaluate::BOZLiteralConstant>(
expr->u)) { expr->u)) {
@ -327,8 +349,8 @@ static void CheckExplicitInterfaceArg(const evaluate::ActualArgument &arg,
// An assumed-type dummy is being forwarded. // An assumed-type dummy is being forwarded.
if (!object.type.type().IsAssumedType()) { if (!object.type.type().IsAssumedType()) {
messages.Say( messages.Say(
"Assumed-type TYPE(*) '%s' may be associated only with an assumed-TYPE(*) dummy argument"_err_en_US, "Assumed-type TYPE(*) '%s' may be associated only with an assumed-TYPE(*) %s"_err_en_US,
assumed->name()); assumed->name(), dummyName);
} }
} else { } else {
messages.Say( messages.Say(
@ -416,9 +438,9 @@ parser::Messages CheckExplicitInterface(const characteristics::Procedure &proc,
"an actual argument in this procedure reference"_err_en_US, "an actual argument in this procedure reference"_err_en_US,
index); index);
} else { } else {
messages.Say( messages.Say("Dummy argument '%s=' (#%d) is not OPTIONAL and is not "
"Dummy argument '%s' (#%d) is not OPTIONAL and is not associated " "associated with an actual argument in this procedure "
"with an actual argument in this procedure reference"_err_en_US, "reference"_err_en_US,
dummy.name, index); dummy.name, index);
} }
} }

66
flang/test/semantics/call03.f90
View File

@ -96,7 +96,7 @@ module m01
subroutine test01(x) ! 15.5.2.4(2) subroutine test01(x) ! 15.5.2.4(2)
class(t), intent(in) :: x[*] class(t), intent(in) :: x[*]
!ERROR: Coindexed polymorphic object may not be associated with a polymorphic dummy argument !ERROR: Coindexed polymorphic object may not be associated with a polymorphic dummy argument 'x='
call poly(x[1]) call poly(x[1])
end subroutine end subroutine
@ -105,7 +105,7 @@ module m01
end subroutine end subroutine
subroutine test02(x) ! 15.5.2.4(2) subroutine test02(x) ! 15.5.2.4(2)
class(t), intent(in) :: x(*) class(t), intent(in) :: x(*)
!ERROR: Assumed-size polymorphic array may not be associated with a monomorphic dummy argument !ERROR: Assumed-size polymorphic array may not be associated with a monomorphic dummy argument 'x='
call mono(x) call mono(x)
end subroutine end subroutine
@ -114,19 +114,19 @@ module m01
end subroutine end subroutine
subroutine test03 ! 15.5.2.4(2) subroutine test03 ! 15.5.2.4(2)
type(pdt(0)) :: x type(pdt(0)) :: x
!ERROR: Actual argument associated with TYPE(*) dummy argument may not have a parameterized derived type !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have a parameterized derived type
call typestar(x) call typestar(x)
end subroutine end subroutine
subroutine test04 ! 15.5.2.4(2) subroutine test04 ! 15.5.2.4(2)
type(tbp) :: x type(tbp) :: x
!ERROR: Actual argument associated with TYPE(*) dummy argument may not have type-bound procedures !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have type-bound procedures
call typestar(x) call typestar(x)
end subroutine end subroutine
subroutine test05 ! 15.5.2.4(2) subroutine test05 ! 15.5.2.4(2)
type(final) :: x type(final) :: x
!ERROR: Actual argument associated with TYPE(*) dummy argument may not have FINAL procedures !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have FINAL procedures
call typestar(x) call typestar(x)
end subroutine end subroutine
@ -146,13 +146,13 @@ module m01
end subroutine end subroutine
subroutine test07(x) ! 15.5.2.4(6) subroutine test07(x) ! 15.5.2.4(6)
type(alloc) :: x[*] type(alloc) :: x[*]
!ERROR: Coindexed actual argument with ALLOCATABLE ultimate component must be associated with a dummy argument with VALUE or INTENT(IN) attributes !ERROR: Coindexed actual argument with ALLOCATABLE ultimate component must be associated with a dummy argument 'x=' with VALUE or INTENT(IN) attributes
call out01(x[1]) call out01(x[1])
end subroutine end subroutine
subroutine test08(x) ! 15.5.2.4(13) subroutine test08(x) ! 15.5.2.4(13)
real :: x(1)[*] real :: x(1)[*]
!ERROR: Coindexed scalar actual argument must be associated with a scalar dummy argument !ERROR: Coindexed scalar actual argument must be associated with a scalar dummy argument 'x='
call assumedsize(x(1)[1]) call assumedsize(x(1)[1])
end subroutine end subroutine
@ -165,13 +165,13 @@ module m01
real :: ashape(:) real :: ashape(:)
class(t) :: polyarray(*) class(t) :: polyarray(*)
character(10) :: c(:) character(10) :: c(:)
!ERROR: Whole scalar actual argument may not be associated with a dummy argument array !ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array
call assumedsize(x) call assumedsize(x)
!ERROR: Element of pointer array may not be associated with a dummy argument array !ERROR: Element of pointer array may not be associated with a dummy argument 'x=' array
call assumedsize(p(1)) call assumedsize(p(1))
!ERROR: Element of assumed-shape array may not be associated with a dummy argument array !ERROR: Element of assumed-shape array may not be associated with a dummy argument 'x=' array
call assumedsize(ashape(1)) call assumedsize(ashape(1))
!ERROR: Element of polymorphic array may not be associated with a dummy argument array !ERROR: Element of polymorphic array may not be associated with a dummy argument 'x=' array
call polyassumedsize(polyarray(1)) call polyassumedsize(polyarray(1))
call charray(c(1:1)) ! not an error if character call charray(c(1:1)) ! not an error if character
call assumedsize(arr(1)) ! not an error if element in sequence call assumedsize(arr(1)) ! not an error if element in sequence
@ -182,11 +182,11 @@ module m01
subroutine test10(a) ! 15.5.2.4(16) subroutine test10(a) ! 15.5.2.4(16)
real :: scalar, matrix(2,3) real :: scalar, matrix(2,3)
real :: a(*) real :: a(*)
!ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'x='
call assumedshape(scalar) call assumedshape(scalar)
!ERROR: Rank of dummy argument is 1, but actual argument has rank 2 !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
call assumedshape(matrix) call assumedshape(matrix)
!ERROR: Assumed-size array may not be associated with assumed-shape dummy argument !ERROR: Assumed-size array may not be associated with assumed-shape dummy argument 'x='
call assumedshape(a) call assumedshape(a)
end subroutine end subroutine
@ -239,9 +239,9 @@ module m01
type(ultimateCoarray), volatile :: b type(ultimateCoarray), volatile :: b
call coarr(a) ! ok call coarr(a) ! ok
call volcoarr(b) ! ok call volcoarr(b) ! ok
!ERROR: VOLATILE attributes must match when actual argument has a coarray ultimate component !ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component
call coarr(b) call coarr(b)
!ERROR: VOLATILE attributes must match when actual argument has a coarray ultimate component !ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component
call volcoarr(a) call volcoarr(a)
end subroutine end subroutine
@ -255,17 +255,17 @@ module m01
call asynchronousValue(b[1]) ! ok call asynchronousValue(b[1]) ! ok
call asynchronousValue(c[1]) ! ok call asynchronousValue(c[1]) ! ok
call asynchronousValue(d[1]) ! ok call asynchronousValue(d[1]) ! ok
!ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
call asynchronous(b[1]) call asynchronous(b[1])
!ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
call volatile(b[1]) call volatile(b[1])
!ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
call asynchronous(c[1]) call asynchronous(c[1])
!ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
call volatile(c[1]) call volatile(c[1])
!ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
call asynchronous(d[1]) call asynchronous(d[1])
!ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
call volatile(d[1]) call volatile(d[1])
end subroutine end subroutine
@ -280,17 +280,17 @@ module m01
call valueassumedsize(b(::2)) ! ok call valueassumedsize(b(::2)) ! ok
call valueassumedsize(c(::2)) ! ok call valueassumedsize(c(::2)) ! ok
call valueassumedsize(d(::2)) ! ok call valueassumedsize(d(::2)) ! ok
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatileassumedsize(b(::2)) call volatileassumedsize(b(::2))
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatilecontiguous(b(::2)) call volatilecontiguous(b(::2))
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatileassumedsize(c(::2)) call volatileassumedsize(c(::2))
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatilecontiguous(c(::2)) call volatilecontiguous(c(::2))
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatileassumedsize(d(::2)) call volatileassumedsize(d(::2))
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatilecontiguous(d(::2)) call volatilecontiguous(d(::2))
end subroutine end subroutine
@ -309,17 +309,17 @@ module m01
call valueassumedsize(b) ! ok call valueassumedsize(b) ! ok
call valueassumedsize(c) ! ok call valueassumedsize(c) ! ok
call valueassumedsize(d) ! ok call valueassumedsize(d) ! ok
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatileassumedsize(b) call volatileassumedsize(b)
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatilecontiguous(b) call volatilecontiguous(b)
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatileassumedsize(c) call volatileassumedsize(c)
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatilecontiguous(c) call volatilecontiguous(c)
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatileassumedsize(d) call volatileassumedsize(d)
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatilecontiguous(d) call volatilecontiguous(d)
end subroutine end subroutine

4
flang/test/semantics/symbol13.f90
View File

@ -16,7 +16,7 @@
!DEF: /f1 (Function) Subprogram CHARACTER(1_8,1) !DEF: /f1 (Function) Subprogram CHARACTER(1_8,1)
!DEF: /f1/x1 INTENT(IN) ObjectEntity CHARACTER(2_4,1) !DEF: /f1/x1 INTENT(IN) ObjectEntity CHARACTER(2_4,1)
!DEF: /f1/x2 INTENT(IN) ObjectEntity CHARACTER(3_8,1) !DEF: /f1/x2 INTENT(IN) ObjectEntity CHARACTER(3_4,1)
character*1 function f1(x1, x2) character*1 function f1(x1, x2)
!DEF: /f1/n PARAMETER ObjectEntity INTEGER(4) !DEF: /f1/n PARAMETER ObjectEntity INTEGER(4)
integer, parameter :: n = 2 integer, parameter :: n = 2
@ -29,7 +29,7 @@ character*1 function f1(x1, x2)
type :: t type :: t
!REF: /f1/len !REF: /f1/len
!REF: /f1/x2 !REF: /f1/x2
!DEF: /f1/t/c1 ObjectEntity CHARACTER(4_8,1) !DEF: /f1/t/c1 ObjectEntity CHARACTER(4_4,1)
!DEF: /f1/t/c2 ObjectEntity CHARACTER(6_8,1) !DEF: /f1/t/c2 ObjectEntity CHARACTER(6_8,1)
character*(len(x2)+1) :: c1, c2*6 character*(len(x2)+1) :: c1, c2*6
end type t end type t