[flang] Enable and pass call08.f90

Refine a check

Original-commit: flang-compiler/f18@bb96c195d4
Reviewed-on: https://github.com/flang-compiler/f18/pull/812
This commit is contained in:
peter klausler 2019-11-04 14:06:52 -08:00
parent 5d76a55b01
commit 2c89c31a59
3 changed files with 45 additions and 11 deletions

View File

@ -298,6 +298,10 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
bool dummyIsContiguous{
dummy.attrs.test(characteristics::DummyDataObject::Attr::Contiguous)};
bool actualIsContiguous{IsSimplyContiguous(actual, context.intrinsics())};
bool dummyIsAssumedRank{dummy.type.attrs().test(
characteristics::TypeAndShape::Attr::AssumedRank)};
bool dummyIsAssumedShape{dummy.type.attrs().test(
characteristics::TypeAndShape::Attr::AssumedShape)};
if ((actualIsAsynchronous || actualIsVolatile) &&
(dummyIsAsynchronous || dummyIsVolatile) && !dummyIsValue) {
if (actualIsCoindexed) { // C1538
@ -306,10 +310,6 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
dummyName);
}
if (actualRank > 0 && !actualIsContiguous) {
bool dummyIsAssumedRank{dummy.type.attrs().test(
characteristics::TypeAndShape::Attr::AssumedRank)};
bool dummyIsAssumedShape{dummy.type.attrs().test(
characteristics::TypeAndShape::Attr::AssumedShape)};
if (dummyIsContiguous ||
!(dummyIsAssumedShape || dummyIsAssumedRank ||
(actualIsPointer && dummyIsPointer))) { // C1539 & C1540
@ -402,6 +402,39 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
}
}
}
// 15.5.2.8 -- coarray dummy arguments
if (dummy.type.corank() > 0) {
if (actualType.corank() == 0) {
messages.Say(
"Actual argument associated with coarray %s must be a coarray"_err_en_US,
dummyName);
}
if (dummyIsVolatile) {
if (!actualIsVolatile) {
messages.Say(
"non-VOLATILE coarray may not be associated with VOLATILE coarray %s"_err_en_US,
dummyName);
}
} else {
if (actualIsVolatile) {
messages.Say(
"VOLATILE coarray may not be associated with non-VOLATILE coarray %s"_err_en_US,
dummyName);
}
}
if (actualRank == dummy.type.Rank() && !actualIsContiguous) {
if (dummyIsContiguous) {
messages.Say(
"Actual argument associated with a CONTIGUOUS coarray %s must be simply contiguous"_err_en_US,
dummyName);
} else if (!dummyIsAssumedShape && !dummyIsAssumedRank) {
messages.Say(
"Actual argument associated with coarray %s (not assumed shape or rank) must be simply contiguous"_err_en_US,
dummyName);
}
}
}
}
static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,

View File

@ -180,6 +180,7 @@ set(ERROR_TESTS
call05.f90
call06.f90
call07.f90
call08.f90
call13.f90
call14.f90
misc-declarations.f90

View File

@ -43,19 +43,19 @@ module m
call s02(c2) ! ok
call s03(c4) ! ok
call s04(c4) ! ok
!ERROR: Effective argument associated with a coarray dummy argument must be a coarray
!ERROR: Actual argument associated with coarray dummy argument 'x=' must be a coarray
call s01(scalar)
!ERROR: VOLATILE coarray cannot be associated with non-VOLATILE dummy argument
!ERROR: VOLATILE coarray may not be associated with non-VOLATILE coarray dummy argument 'x='
call s01(c2)
!ERROR: non-VOLATILE coarray cannot be associated with VOLATILE dummy argument
!ERROR: non-VOLATILE coarray may not be associated with VOLATILE coarray dummy argument 'x='
call s02(c1)
!ERROR: Effective argument associated with a CONTIGUOUS coarray dummy argument must be simply contiguous
!ERROR: Actual argument associated with a CONTIGUOUS coarray dummy argument 'x=' must be simply contiguous
call s03(c3)
!ERROR: Effective argument associated with a CONTIGUOUS coarray dummy argument must be simply contiguous
!ERROR: Actual argument associated with a CONTIGUOUS coarray dummy argument 'x=' must be simply contiguous
call s03(x)
!ERROR: Effective argument associated with a CONTIGUOUS coarray dummy argument must be simply contiguous
!ERROR: Actual argument associated with coarray dummy argument 'x=' (not assumed shape or rank) must be simply contiguous
call s04(c3)
!ERROR: Effective argument associated with a CONTIGUOUS coarray dummy argument must be simply contiguous
!ERROR: Actual argument associated with coarray dummy argument 'x=' (not assumed shape or rank) must be simply contiguous
call s04(x)
end subroutine
end module