[flang-commits] [flang] [flang] Catch more semantic errors with coarrays (PR #125536)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon Feb 3 09:18:15 PST 2025
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/125536
Detect and report a bunch of uncaught semantic errors with coarray declarations. Add more tests, and clean up bad usage in existing tests.
>From c7862c0b93abc8b25ce069eaa3b99304e2412a7d Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Mon, 3 Feb 2025 09:15:00 -0800
Subject: [PATCH] [flang] Catch more semantic errors with coarrays
Detect and report a bunch of uncaught semantic errors with
coarray declarations. Add more tests, and clean up bad usage
in existing tests.
---
flang/include/flang/Semantics/tools.h | 2 +
flang/lib/Evaluate/tools.cpp | 6 +-
flang/lib/Semantics/check-declarations.cpp | 98 ++++++++++++++++++----
flang/lib/Semantics/resolve-names.cpp | 41 ++++-----
flang/lib/Semantics/tools.cpp | 7 ++
flang/test/Lower/pre-fir-tree04.f90 | 1 +
flang/test/Semantics/allocate11.f90 | 18 +++-
flang/test/Semantics/assign02.f90 | 6 +-
flang/test/Semantics/associated.f90 | 2 +-
flang/test/Semantics/bind-c09.f90 | 2 +-
flang/test/Semantics/call10.f90 | 5 +-
flang/test/Semantics/call12.f90 | 6 +-
flang/test/Semantics/change_team01.f90 | 1 +
flang/test/Semantics/coarrays01.f90 | 6 +-
flang/test/Semantics/coarrays02.f90 | 50 +++++++++++
flang/test/Semantics/critical02.f90 | 2 +-
flang/test/Semantics/doconcurrent01.f90 | 7 +-
flang/test/Semantics/doconcurrent08.f90 | 4 +-
flang/test/Semantics/form_team01.f90 | 3 +-
flang/test/Semantics/init01.f90 | 1 +
flang/test/Semantics/resolve07.f90 | 1 +
flang/test/Semantics/resolve50.f90 | 3 +-
flang/test/Semantics/resolve55.f90 | 2 +-
flang/test/Semantics/resolve88.f90 | 6 +-
flang/test/Semantics/resolve94.f90 | 1 +
flang/test/Semantics/this_image01.f90 | 2 +-
26 files changed, 207 insertions(+), 76 deletions(-)
create mode 100644 flang/test/Semantics/coarrays02.f90
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 87ddd38e5ae655b..dbdae37e4551c63 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -630,6 +630,8 @@ using PotentialAndPointerComponentIterator =
// dereferenced.
PotentialComponentIterator::const_iterator FindEventOrLockPotentialComponent(
const DerivedTypeSpec &, bool ignoreCoarrays = false);
+PotentialComponentIterator::const_iterator FindCoarrayPotentialComponent(
+ const DerivedTypeSpec &);
UltimateComponentIterator::const_iterator FindCoarrayUltimateComponent(
const DerivedTypeSpec &);
UltimateComponentIterator::const_iterator FindPointerUltimateComponent(
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 16b026071909738..7181265b862fb13 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1812,7 +1812,11 @@ bool IsSaved(const Symbol &original) {
} else if (scopeKind == Scope::Kind::DerivedType) {
return false; // this is a component
} else if (symbol.attrs().test(Attr::SAVE)) {
- return true; // explicit SAVE attribute
+ // explicit or implied SAVE attribute
+ // N.B.: semantics sets implied SAVE for main program
+ // local variables whose derived types have coarray
+ // potential subobject components.
+ return true;
} else if (IsDummy(symbol) || IsFunctionResult(symbol) ||
IsAutomatic(symbol) || IsNamedConstant(symbol)) {
return false;
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 5c26469b9fa2482..712347ff0a37b37 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -683,20 +683,10 @@ void CheckHelper::CheckObjectEntity(
const DeclTypeSpec *type{details.type()};
const DerivedTypeSpec *derived{type ? type->AsDerived() : nullptr};
bool isComponent{symbol.owner().IsDerivedType()};
- if (details.coshape().empty()) { // not a coarray
- if (!isComponent && !IsPointer(symbol) && derived) {
- if (IsEventTypeOrLockType(derived)) {
- messages_.Say(
- "Variable '%s' with EVENT_TYPE or LOCK_TYPE must be a coarray"_err_en_US,
- symbol.name());
- } else if (auto component{FindEventOrLockPotentialComponent(
- *derived, /*ignoreCoarrays=*/true)}) {
- messages_.Say(
- "Variable '%s' with EVENT_TYPE or LOCK_TYPE potential component '%s' must be a coarray"_err_en_US,
- symbol.name(), component.BuildResultDesignatorName());
- }
- }
- } else { // it's a coarray
+ const Symbol *commonBlock{FindCommonBlockContaining(symbol)};
+ bool isLocalVariable{!commonBlock && !isComponent && !details.isDummy() &&
+ symbol.owner().kind() != Scope::Kind::OtherConstruct};
+ if (int corank{evaluate::GetCorank(symbol)}; corank > 0) { // it's a coarray
bool isDeferredCoshape{details.coshape().CanBeDeferredShape()};
if (IsAllocatable(symbol)) {
if (!isDeferredCoshape) { // C827
@@ -726,6 +716,46 @@ void CheckHelper::CheckObjectEntity(
messages_.Say("Coarray '%s' may not be an assumed-rank array"_err_en_US,
symbol.name());
}
+ if (IsNamedConstant(symbol)) {
+ messages_.Say(
+ "Coarray '%s' may not be a named constant"_err_en_US, symbol.name());
+ }
+ if (IsFunctionResult(symbol)) {
+ messages_.Say("Function result may not be a coarray"_err_en_US);
+ } else if (commonBlock) {
+ messages_.Say("Coarray '%s' may not be in COMMON block '/%s/'"_err_en_US,
+ symbol.name(), commonBlock->name());
+ } else if (isLocalVariable && !IsAllocatableOrPointer(symbol) &&
+ !IsSaved(symbol)) {
+ messages_.Say("Local coarray must have the SAVE attribute"_err_en_US);
+ }
+ for (int j{0}; j < corank; ++j) {
+ if (auto lcbv{evaluate::ToInt64(evaluate::Fold(
+ context().foldingContext(), evaluate::GetLCOBOUND(symbol, j)))}) {
+ if (auto ucbv{
+ evaluate::ToInt64(evaluate::Fold(context().foldingContext(),
+ evaluate::GetUCOBOUND(symbol, j)))}) {
+ if (ucbv < lcbv) {
+ messages_.Say(
+ "Cobounds %jd:%jd of codimension %d produce an empty coarray"_err_en_US,
+ std::intmax_t{*lcbv}, std::intmax_t{*ucbv}, j + 1);
+ }
+ }
+ }
+ }
+ } else { // not a coarray
+ if (!isComponent && !IsPointer(symbol) && derived) {
+ if (IsEventTypeOrLockType(derived)) {
+ messages_.Say(
+ "Variable '%s' with EVENT_TYPE or LOCK_TYPE must be a coarray"_err_en_US,
+ symbol.name());
+ } else if (auto component{FindEventOrLockPotentialComponent(
+ *derived, /*ignoreCoarrays=*/true)}) {
+ messages_.Say(
+ "Variable '%s' with EVENT_TYPE or LOCK_TYPE potential component '%s' must be a coarray"_err_en_US,
+ symbol.name(), component.BuildResultDesignatorName());
+ }
+ }
}
if (details.isDummy()) {
if (IsIntentOut(symbol)) {
@@ -926,6 +956,42 @@ void CheckHelper::CheckObjectEntity(
symbol.name());
}
+ if (derived) {
+ bool isUnsavedLocal{
+ isLocalVariable && !IsAllocatable(symbol) && !IsSaved(symbol)};
+ if (IsFunctionResult(symbol) || IsPointer(symbol) ||
+ evaluate::IsCoarray(symbol) || isUnsavedLocal) {
+ if (auto badPotential{FindCoarrayPotentialComponent(*derived)}) {
+ if (IsFunctionResult(symbol)) { // F'2023 C825
+ SayWithDeclaration(*badPotential,
+ "Function result '%s' may not have a coarray potential component '%s'"_err_en_US,
+ symbol.name(), badPotential.BuildResultDesignatorName());
+ } else if (IsPointer(symbol)) { // F'2023 C825
+ SayWithDeclaration(*badPotential,
+ "Pointer '%s' may not have a coarray potential component '%s'"_err_en_US,
+ symbol.name(), badPotential.BuildResultDesignatorName());
+ } else if (evaluate::IsCoarray(symbol)) { // F'2023 C825
+ SayWithDeclaration(*badPotential,
+ "Coarray '%s' may not have a coarray potential component '%s'"_err_en_US,
+ symbol.name(), badPotential.BuildResultDesignatorName());
+ } else if (isUnsavedLocal) { // F'2023 C826
+ SayWithDeclaration(*badPotential,
+ "Local variable '%s' without the SAVE attribute may not have a coarray potential subobject component '%s'"_err_en_US,
+ symbol.name(), badPotential.BuildResultDesignatorName());
+ } else {
+ DIE("caught unexpected bad coarray potential component");
+ }
+ }
+ } else if (isComponent && (IsAllocatable(symbol) || symbol.Rank() > 0)) {
+ if (auto badUltimate{FindCoarrayUltimateComponent(*derived)}) {
+ // TODO: still an error in F'2023?
+ SayWithDeclaration(*badUltimate,
+ "Allocatable or array component '%s' may not have a coarray ultimate component '%s'"_err_en_US,
+ symbol.name(), badUltimate.BuildResultDesignatorName());
+ }
+ }
+ }
+
// Check CUDA attributes and special circumstances of being in device
// subprograms
const Scope &progUnit{GetProgramUnitContaining(symbol)};
@@ -3161,10 +3227,6 @@ parser::Messages CheckHelper::WhyNotInteroperableFunctionResult(
msgs.Say(symbol.name(),
"Interoperable function result must be scalar"_err_en_US);
}
- if (symbol.Corank()) {
- msgs.Say(symbol.name(),
- "Interoperable function result may not be a coarray"_err_en_US);
- }
return msgs;
}
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index c4562727f09b3f4..a1f4b0f54b9948c 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -6043,32 +6043,6 @@ void DeclarationVisitor::Post(const parser::ComponentDecl &x) {
"POINTER or ALLOCATABLE"_err_en_US);
}
}
- // TODO: This would be more appropriate in CheckDerivedType()
- if (auto it{FindCoarrayUltimateComponent(*derived)}) { // C748
- std::string ultimateName{it.BuildResultDesignatorName()};
- // Strip off the leading "%"
- if (ultimateName.length() > 1) {
- ultimateName.erase(0, 1);
- if (attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) {
- evaluate::AttachDeclaration(
- Say(name.source,
- "A component with a POINTER or ALLOCATABLE attribute may "
- "not "
- "be of a type with a coarray ultimate component (named "
- "'%s')"_err_en_US,
- ultimateName),
- derived->typeSymbol());
- }
- if (!arraySpec().empty() || !coarraySpec().empty()) {
- evaluate::AttachDeclaration(
- Say(name.source,
- "An array or coarray component may not be of a type with a "
- "coarray ultimate component (named '%s')"_err_en_US,
- ultimateName),
- derived->typeSymbol());
- }
- }
- }
}
}
if (OkToAddComponent(name)) {
@@ -9804,6 +9778,21 @@ void ResolveNamesVisitor::ResolveSpecificationParts(ProgramTree &node) {
object->set_cudaDataAttr(common::CUDADataAttr::Device);
}
}
+ // Main program local objects usually don't have an implied SAVE attribute,
+ // as one might think, but in the exceptional case of a derived type
+ // local object that contains a coarray, we have to mark it as an
+ // implied SAVE so that evaluate::IsSaved() will return true.
+ if (node.scope()->kind() == Scope::Kind::MainProgram) {
+ if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
+ if (const DeclTypeSpec * type{object->type()}) {
+ if (const DerivedTypeSpec * derived{type->AsDerived()}) {
+ if (!IsSaved(symbol) && FindCoarrayPotentialComponent(*derived)) {
+ SetImplicitAttr(symbol, Attr::SAVE);
+ }
+ }
+ }
+ }
+ }
}
}
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 9ebfbbb5317b662..b28ca61eafe9373 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -1386,6 +1386,13 @@ template class ComponentIterator<ComponentKind::Potential>;
template class ComponentIterator<ComponentKind::Scope>;
template class ComponentIterator<ComponentKind::PotentialAndPointer>;
+PotentialComponentIterator::const_iterator FindCoarrayPotentialComponent(
+ const DerivedTypeSpec &derived) {
+ PotentialComponentIterator potentials{derived};
+ return std::find_if(potentials.begin(), potentials.end(),
+ [](const Symbol &symbol) { return evaluate::IsCoarray(symbol); });
+}
+
UltimateComponentIterator::const_iterator FindCoarrayUltimateComponent(
const DerivedTypeSpec &derived) {
UltimateComponentIterator ultimates{derived};
diff --git a/flang/test/Lower/pre-fir-tree04.f90 b/flang/test/Lower/pre-fir-tree04.f90
index e5f804245854211..07077ff0473dded 100644
--- a/flang/test/Lower/pre-fir-tree04.f90
+++ b/flang/test/Lower/pre-fir-tree04.f90
@@ -5,6 +5,7 @@
! CHECK: Subroutine test_coarray
Subroutine test_coarray
use iso_fortran_env, only: team_type, event_type, lock_type
+ save
type(team_type) :: t
type(event_type) :: done[*]
type(lock_type) :: alock[*]
diff --git a/flang/test/Semantics/allocate11.f90 b/flang/test/Semantics/allocate11.f90
index 6440248b6f4a96d..1b7495e9fc07d77 100644
--- a/flang/test/Semantics/allocate11.f90
+++ b/flang/test/Semantics/allocate11.f90
@@ -38,7 +38,14 @@ subroutine C937(var)
type B
type(A) y
- !ERROR: A component with a POINTER or ALLOCATABLE attribute may not be of a type with a coarray ultimate component (named 'y%x')
+ !ERROR: Allocatable or array component 'forward' may not have a coarray ultimate component '%y%x'
+ type(B), allocatable :: forward
+ real :: u
+ end type
+
+ type B2
+ type(A) y
+ !ERROR: Pointer 'forward' may not have a coarray potential component '%y%x'
type(B), pointer :: forward
real :: u
end type
@@ -48,11 +55,14 @@ subroutine C937(var)
end type
type D
- !ERROR: A component with a POINTER or ALLOCATABLE attribute may not be of a type with a coarray ultimate component (named 'x')
- type(A), pointer :: potential
+ !ERROR: Allocatable or array component 'potential' may not have a coarray ultimate component '%x'
+ type(A), allocatable :: potential
end type
-
+ type D2
+ !ERROR: Pointer 'potential' may not have a coarray potential component '%x'
+ type(A), pointer :: potential
+ end type
class(*), allocatable :: var
! unlimited polymorphic is the ONLY way to get an allocatable/pointer 'var' that can be
diff --git a/flang/test/Semantics/assign02.f90 b/flang/test/Semantics/assign02.f90
index 707d5ed3cfaa55b..a40d204982b2f60 100644
--- a/flang/test/Semantics/assign02.f90
+++ b/flang/test/Semantics/assign02.f90
@@ -74,8 +74,8 @@ subroutine s4(x)
! C1020
subroutine s5
- real, target :: x[*]
- real, target, volatile :: y[*]
+ real, target, save :: x[*]
+ real, target, volatile, save :: y[*]
real, pointer :: p
real, pointer, volatile :: q
p => x
@@ -148,7 +148,7 @@ function f2()
! C1026 (R1037) A data-target shall not be a coindexed object.
subroutine s10
- real, target :: a[*]
+ real, target, save :: a[*]
real, pointer :: b
!ERROR: A coindexed object may not be a pointer target
b => a[1]
diff --git a/flang/test/Semantics/associated.f90 b/flang/test/Semantics/associated.f90
index 143274480659965..c814980377b9fde 100644
--- a/flang/test/Semantics/associated.f90
+++ b/flang/test/Semantics/associated.f90
@@ -90,7 +90,7 @@ subroutine test(assumedRank)
type(t2) :: t2x
type(t2), target :: t2xtarget
integer, target :: targetIntArr(2)
- integer, target :: targetIntCoarray[*]
+ integer, target, save :: targetIntCoarray[*]
integer, pointer :: intPointerArr(:)
procedure(objPtrFunc), pointer :: objPtrFuncPointer
diff --git a/flang/test/Semantics/bind-c09.f90 b/flang/test/Semantics/bind-c09.f90
index 953f2d751234f31..e08e4f001c69610 100644
--- a/flang/test/Semantics/bind-c09.f90
+++ b/flang/test/Semantics/bind-c09.f90
@@ -44,6 +44,6 @@ function func8() result(res) bind(c)
end
function func9() result(res) bind(c)
- ! ERROR: Interoperable function result may not be a coarray
+ ! ERROR: Function result may not be a coarray
integer :: res[10, *]
end
diff --git a/flang/test/Semantics/call10.f90 b/flang/test/Semantics/call10.f90
index 2d2f57934cd8aa2..81c28082a843fee 100644
--- a/flang/test/Semantics/call10.f90
+++ b/flang/test/Semantics/call10.f90
@@ -200,8 +200,9 @@ pure subroutine s13
!ERROR: An image control statement may not appear in a pure subprogram
sync all ! C1599
end subroutine
- pure subroutine s14
- integer :: img, nimgs, i[*], tmp
+ pure subroutine s14(i)
+ integer :: img, nimgs, tmp
+ integer, intent(in out) :: i[*]
! implicit sync all
img = this_image()
nimgs = num_images()
diff --git a/flang/test/Semantics/call12.f90 b/flang/test/Semantics/call12.f90
index 2e5591ad927daf2..cd4006a53b3e75c 100644
--- a/flang/test/Semantics/call12.f90
+++ b/flang/test/Semantics/call12.f90
@@ -40,7 +40,9 @@ pure function test(ptr, in, hpd, hhpd)
type(hasHiddenPtr), intent(in) :: hhpd
type(hasPtr), allocatable :: alloc
type(hasHiddenPtr), allocatable :: hpAlloc
+ !ERROR: Pointer 'hcp' may not have a coarray potential component '%co'
type(hasCoarray), pointer :: hcp
+ type(hasCoarray), allocatable :: hca
integer :: n
common /block/ y
external :: extfunc
@@ -60,8 +62,8 @@ pure function test(ptr, in, hpd, hhpd)
!BECAUSE: 'in' is an INTENT(IN) dummy argument
in%a = 0. ! C1594(1)
!ERROR: Left-hand side of assignment is not definable
- !BECAUSE: A pure subprogram may not define the coindexed object 'hcp%co[1_8]'
- hcp%co[1] = 0. ! C1594(1)
+ !BECAUSE: A pure subprogram may not define the coindexed object 'hca%co[1_8]'
+ hca%co[1] = 0. ! C1594(1)
!ERROR: The left-hand side of a pointer assignment is not definable
!BECAUSE: 'ptr' may not be defined in pure subprogram 'test' because it is a POINTER dummy argument of a pure function
ptr => z ! C1594(2)
diff --git a/flang/test/Semantics/change_team01.f90 b/flang/test/Semantics/change_team01.f90
index 43be1c10fb842b8..a5e53e98fc98687 100644
--- a/flang/test/Semantics/change_team01.f90
+++ b/flang/test/Semantics/change_team01.f90
@@ -4,6 +4,7 @@
subroutine test
use, intrinsic :: iso_fortran_env, only: team_type
+ save
type(team_type) :: team
integer, codimension[*] :: selector
integer, codimension[2,*] :: selector2d
diff --git a/flang/test/Semantics/coarrays01.f90 b/flang/test/Semantics/coarrays01.f90
index 0a6f88a7e748c90..0dfcd1a41c95dc8 100644
--- a/flang/test/Semantics/coarrays01.f90
+++ b/flang/test/Semantics/coarrays01.f90
@@ -2,7 +2,7 @@
! Test selector and team-value in CHANGE TEAM statement
! OK
-subroutine s1
+subroutine s1(y)
use iso_fortran_env, only: team_type
type(team_type) :: t
real :: y[10,*]
@@ -11,7 +11,7 @@ subroutine s1
form team(1, t)
end
-subroutine s2
+subroutine s2(y,y2,x)
use iso_fortran_env
type(team_type) :: t
real :: y[10,*], y2[*], x[*]
@@ -27,7 +27,7 @@ subroutine s2
end team
end
-subroutine s3
+subroutine s3(y)
type :: team_type
end type
type :: foo
diff --git a/flang/test/Semantics/coarrays02.f90 b/flang/test/Semantics/coarrays02.f90
new file mode 100644
index 000000000000000..e52f3e3ef3a406b
--- /dev/null
+++ b/flang/test/Semantics/coarrays02.f90
@@ -0,0 +1,50 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! More coarray error tests.
+module m
+ integer :: local[*] ! ok in module
+end
+program main
+ use iso_fortran_env
+ !ERROR: Coarray 'namedconst' may not be a named constant
+ !ERROR: Local coarray must have the SAVE attribute
+ integer, parameter :: namedConst = 123
+ codimension namedConst[*]
+ !ERROR: Coarray 'coarr1' may not be in COMMON block '//'
+ real :: coarr1[*]
+ common//coarr1
+ !ERROR: Variable 'event' with EVENT_TYPE or LOCK_TYPE must be a coarray
+ type(event_type) event
+ !ERROR: Variable 'lock' with EVENT_TYPE or LOCK_TYPE must be a coarray
+ type(lock_type) lock
+ integer :: local[*] ! ok in main
+end
+
+function func1()
+ !ERROR: Function result may not be a coarray
+ integer :: func1[*]
+ !ERROR: Local coarray must have the SAVE attribute
+ integer :: local[*]
+ integer, save :: saved[*] ! ok
+ integer :: inited[*] = 1 ! ok
+ func = 1
+end
+
+function func2()
+ type t
+ real, allocatable :: comp[:]
+ end type
+ type t2
+ !ERROR: Allocatable or array component 'allo' may not have a coarray ultimate component '%comp'
+ type(t), allocatable :: allo
+ !ERROR: Allocatable or array component 'arr' may not have a coarray ultimate component '%comp'
+ type(t) :: arr(1)
+ end type
+ !ERROR: Function result 'func2' may not have a coarray potential component '%comp'
+ type(t) func2
+ !ERROR: Pointer 'ptr' may not have a coarray potential component '%comp'
+ type(t), pointer :: ptr
+ !ERROR: Coarray 'coarr' may not have a coarray potential component '%comp'
+ type(t), save :: coarr[*]
+ !ERROR: Local variable 'local' without the SAVE attribute may not have a coarray potential subobject component '%comp'
+ type(t) :: local
+end
diff --git a/flang/test/Semantics/critical02.f90 b/flang/test/Semantics/critical02.f90
index 692b06b025861f9..9c957d1e859c55a 100644
--- a/flang/test/Semantics/critical02.f90
+++ b/flang/test/Semantics/critical02.f90
@@ -61,7 +61,7 @@ end subroutine test6
subroutine test7()
use iso_fortran_env
- type(event_type) :: x[*], y[*]
+ type(event_type), save :: x[*], y[*]
critical
!ERROR: An image control statement is not allowed in a CRITICAL construct
event post (x)
diff --git a/flang/test/Semantics/doconcurrent01.f90 b/flang/test/Semantics/doconcurrent01.f90
index 9d2c9e1ab3115c6..ab14d970b8501e4 100644
--- a/flang/test/Semantics/doconcurrent01.f90
+++ b/flang/test/Semantics/doconcurrent01.f90
@@ -69,7 +69,7 @@ end subroutine do_concurrent_test2
subroutine s1()
use iso_fortran_env
- type(event_type) :: x[*]
+ type(event_type), save :: x[*]
do concurrent (i = 1:n)
!ERROR: An image control statement is not allowed in DO CONCURRENT
event post (x)
@@ -78,7 +78,7 @@ end subroutine s1
subroutine s2()
use iso_fortran_env
- type(event_type) :: x[*]
+ type(event_type), save :: x[*]
do concurrent (i = 1:n)
!ERROR: An image control statement is not allowed in DO CONCURRENT
event wait (x)
@@ -124,8 +124,7 @@ subroutine s6()
type(type0) :: type1_field
end type
- type(type1) :: pvar;
- type(type1) :: qvar;
+ type(type1), save :: pvar, qvar
integer, allocatable, dimension(:) :: array1
integer, allocatable, dimension(:) :: array2
integer, allocatable, codimension[:] :: ca, cb
diff --git a/flang/test/Semantics/doconcurrent08.f90 b/flang/test/Semantics/doconcurrent08.f90
index 52b382741d0731f..e09d1ab32acb2a1 100644
--- a/flang/test/Semantics/doconcurrent08.f90
+++ b/flang/test/Semantics/doconcurrent08.f90
@@ -85,13 +85,13 @@ subroutine s1()
type(HasAllocPolyType) :: nonAllocatableWithAllocPoly
! OK because the declared variable is not allocatable
- type(HasAllocPolyCoarrayType) :: nonAllocatableWithAllocPolyCoarray
+ type(HasAllocPolyCoarrayType), save :: nonAllocatableWithAllocPolyCoarray
! Bad because even though the declared the allocatable component is a coarray
type(HasAllocPolyCoarrayType), allocatable :: allocWithAllocPolyCoarray
! OK since it has no polymorphic component
- type(HasAllocCoarrayType) :: nonAllocWithAllocCoarray
+ type(HasAllocCoarrayType), save :: nonAllocWithAllocCoarray
! OK since it has no component that's polymorphic, oops
type(HasPointerPolyType), allocatable :: allocatableWithPointerPoly
diff --git a/flang/test/Semantics/form_team01.f90 b/flang/test/Semantics/form_team01.f90
index 3b82e5b41666e88..1510a8bb98f74b2 100644
--- a/flang/test/Semantics/form_team01.f90
+++ b/flang/test/Semantics/form_team01.f90
@@ -8,8 +8,7 @@ subroutine test
integer :: team_index
integer :: statvar
character(len=50) :: errvar
- integer, codimension[*] :: co_team_number
- integer, codimension[*] :: co_team_index
+ integer, codimension[*], save :: co_team_number, co_team_index
type(team_type), dimension(1) :: array_team
integer, dimension(1) :: array_team_number
integer, dimension(1) :: array_team_index
diff --git a/flang/test/Semantics/init01.f90 b/flang/test/Semantics/init01.f90
index 65d524b16a23a2a..a1313e7c234d512 100644
--- a/flang/test/Semantics/init01.f90
+++ b/flang/test/Semantics/init01.f90
@@ -18,6 +18,7 @@ subroutine objectpointers(j)
end type
type(t1), target, save :: o1
type(t1), save :: o2
+!ERROR: Local variable 'o3' without the SAVE attribute may not have a coarray potential subobject component '%c2'
type(t1), target :: o3
!ERROR: An initial data target may not be a reference to an ALLOCATABLE 'x1'
real, pointer :: p1 => x1
diff --git a/flang/test/Semantics/resolve07.f90 b/flang/test/Semantics/resolve07.f90
index 481094a51335f11..a280769ac25257b 100644
--- a/flang/test/Semantics/resolve07.f90
+++ b/flang/test/Semantics/resolve07.f90
@@ -18,6 +18,7 @@ subroutine s2
end
subroutine s3
+ save
dimension :: x(4), x2(8)
!ERROR: The dimensions of 'x' have already been declared
allocatable :: x(:)
diff --git a/flang/test/Semantics/resolve50.f90 b/flang/test/Semantics/resolve50.f90
index cc4dc030a990598..5650fff32e16af2 100644
--- a/flang/test/Semantics/resolve50.f90
+++ b/flang/test/Semantics/resolve50.f90
@@ -3,6 +3,7 @@
subroutine s1
use iso_fortran_env
+ save
type(team_type) :: t
complex :: x[*]
real :: y[*]
@@ -22,7 +23,7 @@ subroutine s1
subroutine s2
use iso_fortran_env
type(team_type) :: t
- real :: y[10,*], y2[*], x[*]
+ real, save :: y[10,*], y2[*], x[*]
! C1113
!ERROR: The codimensions of 'x' have already been declared
change team(t, x[10,*] => y, x[*] => y2)
diff --git a/flang/test/Semantics/resolve55.f90 b/flang/test/Semantics/resolve55.f90
index 0a40a1943574808..5f7a3044e834cf7 100644
--- a/flang/test/Semantics/resolve55.f90
+++ b/flang/test/Semantics/resolve55.f90
@@ -81,7 +81,7 @@ end subroutine s6
subroutine s7()
! Cannot have a coarray
- integer, codimension[*] :: coarray_var
+ integer, codimension[*], save :: coarray_var
!ERROR: Coarray 'coarray_var' not allowed in a LOCAL locality-spec
do concurrent(i=1:5) local(coarray_var)
end do
diff --git a/flang/test/Semantics/resolve88.f90 b/flang/test/Semantics/resolve88.f90
index 3794e9b28a6d3bc..34eb192347d0246 100644
--- a/flang/test/Semantics/resolve88.f90
+++ b/flang/test/Semantics/resolve88.f90
@@ -64,11 +64,11 @@ module m
type testType
type(coarrayType) :: goodField
- !ERROR: A component with a POINTER or ALLOCATABLE attribute may not be of a type with a coarray ultimate component (named 'goodcoarrayfield')
+ !ERROR: Pointer 'pointerfield' may not have a coarray potential component '%goodcoarrayfield'
type(coarrayType), pointer :: pointerField
- !ERROR: A component with a POINTER or ALLOCATABLE attribute may not be of a type with a coarray ultimate component (named 'goodcoarrayfield')
+ !ERROR: Allocatable or array component 'allocatablefield' may not have a coarray ultimate component '%goodcoarrayfield'
type(coarrayType), allocatable :: allocatableField
- !ERROR: An array or coarray component may not be of a type with a coarray ultimate component (named 'goodcoarrayfield')
+ !ERROR: Allocatable or array component 'arrayfield' may not have a coarray ultimate component '%goodcoarrayfield'
type(coarrayType), dimension(3) :: arrayField
end type testType
diff --git a/flang/test/Semantics/resolve94.f90 b/flang/test/Semantics/resolve94.f90
index 19c06ad0d16228d..75755fb2b2038e2 100644
--- a/flang/test/Semantics/resolve94.f90
+++ b/flang/test/Semantics/resolve94.f90
@@ -6,6 +6,7 @@
! C931 A stat-variable in an image-selector shall not be a coindexed object.
subroutine s1()
use ISO_FORTRAN_ENV
+ save
type(team_type) :: team1, team2
real :: rCoarray[10,20,*]
real :: rVar1, rVar2
diff --git a/flang/test/Semantics/this_image01.f90 b/flang/test/Semantics/this_image01.f90
index fdcccdaeed0e39a..eb25cd4e5a7efdd 100644
--- a/flang/test/Semantics/this_image01.f90
+++ b/flang/test/Semantics/this_image01.f90
@@ -8,7 +8,7 @@ subroutine test
type(team_type) :: coteam[*]
integer :: coscalar[*], coarray(3)[*]
save :: coteam, coscalar, coarray
- real coarray1[*], coarray2[2,*], coarray3[2,3,*]
+ real, save :: coarray1[*], coarray2[2,*], coarray3[2,3,*]
integer indices(3)
! correct calls, should produce no errors
More information about the flang-commits
mailing list