forked from OSchip/llvm-project
[flang] Allow extension cases of EQUIVALENCE with optional warnings
EQUIVALENCE storage association of objects whose types are not both default-kind numeric storage sequences, or not both default-kind character storage sequences, are not standard conformant. However, most Fortran compilers admit such usage, with warnings in strict conformance mode. This patch allos EQUIVALENCE of objects that have sequence types that are either identical, both numeric sequences (of default kind or not), or both character sequences. Non-sequence types, and sequences types that are not homogeneously numeric or character, remain errors. Differential Revision: https://reviews.llvm.org/D119848
This commit is contained in:
parent
bbb0f2c759
commit
6bd72fa661
|
@ -141,7 +141,9 @@ end
|
|||
not be known (e.g., `IAND(X'1',X'2')`).
|
||||
* BOZ literals can also be used as REAL values in some contexts where the
|
||||
type is unambiguous, such as initializations of REAL parameters.
|
||||
* EQUIVALENCE of numeric and character sequences (a ubiquitous extension)
|
||||
* EQUIVALENCE of numeric and character sequences (a ubiquitous extension),
|
||||
as well as of sequences of non-default kinds of numeric types
|
||||
with each other.
|
||||
* Values for whole anonymous parent components in structure constructors
|
||||
(e.g., `EXTENDEDTYPE(PARENTTYPE(1,2,3))` rather than `EXTENDEDTYPE(1,2,3)`
|
||||
or `EXTENDEDTYPE(PARENTTYPE=PARENTTYPE(1,2,3))`).
|
||||
|
|
|
@ -27,7 +27,8 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
|
|||
OmitFunctionDummies, CrayPointer, Hollerith, ArithmeticIF, Assign,
|
||||
AssignedGOTO, Pause, OpenACC, OpenMP, CruftAfterAmpersand, ClassicCComments,
|
||||
AdditionalFormats, BigIntLiterals, RealDoControls,
|
||||
EquivalenceNumericWithCharacter, AdditionalIntrinsics, AnonymousParents,
|
||||
EquivalenceNumericWithCharacter, EquivalenceNonDefaultNumeric,
|
||||
EquivalenceSameNonSequence, AdditionalIntrinsics, AnonymousParents,
|
||||
OldLabelDoEndStatements, LogicalIntegerAssignment, EmptySourceFile,
|
||||
ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways,
|
||||
ForwardRefDummyImplicitNone, OpenAccessAppend, BOZAsDefaultInteger,
|
||||
|
|
|
@ -1106,6 +1106,11 @@ bool AreTypeParamCompatible(
|
|||
const Symbol &GetUsedModule(const UseDetails &);
|
||||
const Symbol *FindFunctionResult(const Symbol &);
|
||||
|
||||
// Type compatibility predicate: are x and y effectively the same type?
|
||||
// Uses DynamicType::IsTkCompatible(), which handles the case of distinct
|
||||
// but identical derived types.
|
||||
bool AreTkCompatibleTypes(const DeclTypeSpec *x, const DeclTypeSpec *y);
|
||||
|
||||
} // namespace Fortran::semantics
|
||||
|
||||
#endif // FORTRAN_EVALUATE_TOOLS_H_
|
||||
|
|
|
@ -1518,4 +1518,15 @@ SemanticsContext &Symbol::GetSemanticsContext() const {
|
|||
return DEREF(owner_).context();
|
||||
}
|
||||
|
||||
bool AreTkCompatibleTypes(const DeclTypeSpec *x, const DeclTypeSpec *y) {
|
||||
if (x && y) {
|
||||
if (auto xDt{evaluate::DynamicType::From(*x)}) {
|
||||
if (auto yDt{evaluate::DynamicType::From(*y)}) {
|
||||
return xDt->IsTkCompatibleWith(*yDt);
|
||||
}
|
||||
}
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
} // namespace Fortran::semantics
|
||||
|
|
|
@ -202,9 +202,8 @@ TYPE_CONTEXT_PARSER("intrinsic type spec"_en_US,
|
|||
"CHARACTER" >> maybe(Parser<CharSelector>{}))),
|
||||
construct<IntrinsicTypeSpec>(construct<IntrinsicTypeSpec::Logical>(
|
||||
"LOGICAL" >> maybe(kindSelector))),
|
||||
construct<IntrinsicTypeSpec>("DOUBLE COMPLEX" >>
|
||||
extension<LanguageFeature::DoubleComplex>(
|
||||
construct<IntrinsicTypeSpec::DoubleComplex>())),
|
||||
extension<LanguageFeature::DoubleComplex>(construct<IntrinsicTypeSpec>(
|
||||
"DOUBLE COMPLEX" >> construct<IntrinsicTypeSpec::DoubleComplex>())),
|
||||
extension<LanguageFeature::Byte>(
|
||||
construct<IntrinsicTypeSpec>(construct<IntegerTypeSpec>(
|
||||
"BYTE" >> construct<std::optional<KindSelector>>(pure(1)))))))
|
||||
|
|
|
@ -855,8 +855,8 @@ public:
|
|||
auto at{state.GetLocation()};
|
||||
auto result{parser_.Parse(state)};
|
||||
if (result) {
|
||||
state.Nonstandard(
|
||||
CharBlock{at, state.GetLocation()}, LF, "nonstandard usage"_en_US);
|
||||
state.Nonstandard(CharBlock{at, std::max(state.GetLocation(), at + 1)},
|
||||
LF, "nonstandard usage"_en_US);
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
|
|
@ -8,6 +8,7 @@
|
|||
|
||||
#include "resolve-names-utils.h"
|
||||
#include "flang/Common/Fortran-features.h"
|
||||
#include "flang/Common/Fortran.h"
|
||||
#include "flang/Common/idioms.h"
|
||||
#include "flang/Common/indirection.h"
|
||||
#include "flang/Evaluate/fold.h"
|
||||
|
@ -412,45 +413,58 @@ void EquivalenceSets::FinishSet(const parser::CharBlock &source) {
|
|||
currSet_.clear();
|
||||
}
|
||||
|
||||
// Report an error if sym1 and sym2 cannot be in the same equivalence set.
|
||||
// Report an error or warning if sym1 and sym2 cannot be in the same equivalence
|
||||
// set.
|
||||
bool EquivalenceSets::CheckCanEquivalence(
|
||||
const parser::CharBlock &source, const Symbol &sym1, const Symbol &sym2) {
|
||||
std::optional<parser::MessageFixedText> msg;
|
||||
const DeclTypeSpec *type1{sym1.GetType()};
|
||||
const DeclTypeSpec *type2{sym2.GetType()};
|
||||
bool isNum1{IsNumericSequenceType(type1)};
|
||||
bool isNum2{IsNumericSequenceType(type2)};
|
||||
bool isDefaultNum1{IsDefaultNumericSequenceType(type1)};
|
||||
bool isAnyNum1{IsAnyNumericSequenceType(type1)};
|
||||
bool isDefaultNum2{IsDefaultNumericSequenceType(type2)};
|
||||
bool isAnyNum2{IsAnyNumericSequenceType(type2)};
|
||||
bool isChar1{IsCharacterSequenceType(type1)};
|
||||
bool isChar2{IsCharacterSequenceType(type2)};
|
||||
if (sym1.attrs().test(Attr::PROTECTED) &&
|
||||
!sym2.attrs().test(Attr::PROTECTED)) { // C8114
|
||||
msg = "Equivalence set cannot contain '%s'"
|
||||
" with PROTECTED attribute and '%s' without"_err_en_US;
|
||||
} else if (isNum1) {
|
||||
} else if ((isDefaultNum1 && isDefaultNum2) || (isChar1 && isChar2)) {
|
||||
// ok & standard conforming
|
||||
} else if (!(isAnyNum1 || isChar1) &&
|
||||
!(isAnyNum2 || isChar2)) { // C8110 - C8113
|
||||
if (AreTkCompatibleTypes(type1, type2)) {
|
||||
if (context_.ShouldWarn(LanguageFeature::EquivalenceSameNonSequence)) {
|
||||
msg = "nonstandard: Equivalence set contains '%s' and '%s' with same "
|
||||
"type "
|
||||
"that is neither numeric nor character sequence type"_en_US;
|
||||
}
|
||||
} else {
|
||||
msg = "Equivalence set cannot contain '%s' and '%s' with distinct types "
|
||||
"that are not both numeric or character sequence types"_err_en_US;
|
||||
}
|
||||
} else if (isAnyNum1) {
|
||||
if (isChar2) {
|
||||
if (context_.ShouldWarn(
|
||||
LanguageFeature::EquivalenceNumericWithCharacter)) {
|
||||
msg = "Equivalence set contains '%s' that is numeric sequence "
|
||||
msg = "nonstandard: Equivalence set contains '%s' that is numeric "
|
||||
"sequence "
|
||||
"type and '%s' that is character"_en_US;
|
||||
}
|
||||
} else if (!isNum2) { // C8110
|
||||
msg = "Equivalence set cannot contain '%s'"
|
||||
" that is numeric sequence type and '%s' that is not"_err_en_US;
|
||||
}
|
||||
} else if (isChar1) {
|
||||
if (isNum2) {
|
||||
if (context_.ShouldWarn(
|
||||
LanguageFeature::EquivalenceNumericWithCharacter)) {
|
||||
msg = "Equivalence set contains '%s' that is character sequence "
|
||||
"type and '%s' that is numeric"_en_US;
|
||||
} else if (isAnyNum2 &&
|
||||
context_.ShouldWarn(LanguageFeature::EquivalenceNonDefaultNumeric)) {
|
||||
if (isDefaultNum1) {
|
||||
msg =
|
||||
"nonstandard: Equivalence set contains '%s' that is a default "
|
||||
"numeric "
|
||||
"sequence type and '%s' that is numeric with non-default kind"_en_US;
|
||||
} else if (!isDefaultNum2) {
|
||||
msg = "nonstandard: Equivalence set contains '%s' and '%s' that are "
|
||||
"numeric "
|
||||
"sequence types with non-default kinds"_en_US;
|
||||
}
|
||||
} else if (!isChar2) { // C8111
|
||||
msg = "Equivalence set cannot contain '%s'"
|
||||
" that is character sequence type and '%s' that is not"_err_en_US;
|
||||
}
|
||||
} else if (!isNum2 && !isChar2 && *type1 != *type2) { // C8112, C8113
|
||||
msg = "Equivalence set cannot contain '%s' and '%s' with different types"
|
||||
" that are neither numeric nor character sequence types"_err_en_US;
|
||||
}
|
||||
if (msg) {
|
||||
context_.Say(source, std::move(*msg), sym1.name(), sym2.name());
|
||||
|
@ -678,15 +692,14 @@ bool EquivalenceSets::IsCharacterSequenceType(const DeclTypeSpec *type) {
|
|||
// Numeric or logical type of default kind or DOUBLE PRECISION or DOUBLE COMPLEX
|
||||
bool EquivalenceSets::IsDefaultKindNumericType(const IntrinsicTypeSpec &type) {
|
||||
if (auto kind{evaluate::ToInt64(type.kind())}) {
|
||||
auto category{type.category()};
|
||||
auto defaultKind{context_.GetDefaultKind(category)};
|
||||
switch (category) {
|
||||
switch (type.category()) {
|
||||
case TypeCategory::Integer:
|
||||
case TypeCategory::Logical:
|
||||
return *kind == defaultKind;
|
||||
return *kind == context_.GetDefaultKind(TypeCategory::Integer);
|
||||
case TypeCategory::Real:
|
||||
case TypeCategory::Complex:
|
||||
return *kind == defaultKind || *kind == context_.doublePrecisionKind();
|
||||
return *kind == context_.GetDefaultKind(TypeCategory::Real) ||
|
||||
*kind == context_.doublePrecisionKind();
|
||||
default:
|
||||
return false;
|
||||
}
|
||||
|
@ -694,12 +707,19 @@ bool EquivalenceSets::IsDefaultKindNumericType(const IntrinsicTypeSpec &type) {
|
|||
return false;
|
||||
}
|
||||
|
||||
bool EquivalenceSets::IsNumericSequenceType(const DeclTypeSpec *type) {
|
||||
bool EquivalenceSets::IsDefaultNumericSequenceType(const DeclTypeSpec *type) {
|
||||
return IsSequenceType(type, [&](const IntrinsicTypeSpec &type) {
|
||||
return IsDefaultKindNumericType(type);
|
||||
});
|
||||
}
|
||||
|
||||
bool EquivalenceSets::IsAnyNumericSequenceType(const DeclTypeSpec *type) {
|
||||
return IsSequenceType(type, [&](const IntrinsicTypeSpec &type) {
|
||||
return type.category() == TypeCategory::Logical ||
|
||||
common::IsNumericTypeCategory(type.category());
|
||||
});
|
||||
}
|
||||
|
||||
// Is type an intrinsic type that satisfies predicate or a sequence type
|
||||
// whose components do.
|
||||
bool EquivalenceSets::IsSequenceType(const DeclTypeSpec *type,
|
||||
|
|
|
@ -128,8 +128,9 @@ private:
|
|||
bool CheckSubstringBound(const parser::Expr &, bool);
|
||||
bool IsCharacterSequenceType(const DeclTypeSpec *);
|
||||
bool IsDefaultKindNumericType(const IntrinsicTypeSpec &);
|
||||
bool IsNumericSequenceType(const DeclTypeSpec *);
|
||||
bool IsSequenceType(
|
||||
bool IsDefaultNumericSequenceType(const DeclTypeSpec *);
|
||||
static bool IsAnyNumericSequenceType(const DeclTypeSpec *);
|
||||
static bool IsSequenceType(
|
||||
const DeclTypeSpec *, std::function<bool(const IntrinsicTypeSpec &)>);
|
||||
|
||||
SemanticsContext &context_;
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
!RUN: %python %S/test_errors.py %s %flang_fc1
|
||||
!RUN: not %flang_fc1 -pedantic %s 2>&1 | FileCheck %s
|
||||
subroutine s1
|
||||
integer i, j
|
||||
real r(2)
|
||||
!ERROR: Equivalence set must have more than one object
|
||||
!CHECK: error: Equivalence set must have more than one object
|
||||
equivalence(i, j),(r(1))
|
||||
end
|
||||
|
||||
|
@ -13,24 +13,24 @@ subroutine s2
|
|||
integer :: b(10)
|
||||
end type
|
||||
type(t) :: x
|
||||
!ERROR: Derived type component 'x%a' is not allowed in an equivalence set
|
||||
!CHECK: error: Derived type component 'x%a' is not allowed in an equivalence set
|
||||
equivalence(x%a, i)
|
||||
!ERROR: Derived type component 'x%b(2)' is not allowed in an equivalence set
|
||||
!CHECK: error: Derived type component 'x%b(2)' is not allowed in an equivalence set
|
||||
equivalence(i, x%b(2))
|
||||
end
|
||||
|
||||
integer function f3(x)
|
||||
real x
|
||||
!ERROR: Dummy argument 'x' is not allowed in an equivalence set
|
||||
!CHECK: error: Dummy argument 'x' is not allowed in an equivalence set
|
||||
equivalence(i, x)
|
||||
!ERROR: Function result 'f3' is not allow in an equivalence set
|
||||
!CHECK: error: Function result 'f3' is not allow in an equivalence set
|
||||
equivalence(f3, i)
|
||||
end
|
||||
|
||||
subroutine s4
|
||||
integer :: y
|
||||
!ERROR: Pointer 'x' is not allowed in an equivalence set
|
||||
!ERROR: Allocatable variable 'y' is not allowed in an equivalence set
|
||||
!CHECK: error: Pointer 'x' is not allowed in an equivalence set
|
||||
!CHECK: error: Allocatable variable 'y' is not allowed in an equivalence set
|
||||
equivalence(x, y)
|
||||
real, pointer :: x
|
||||
allocatable :: y
|
||||
|
@ -40,22 +40,22 @@ subroutine s5
|
|||
integer, parameter :: k = 123
|
||||
real :: x(10)
|
||||
real, save :: y[1:*]
|
||||
!ERROR: Coarray 'y' is not allowed in an equivalence set
|
||||
!CHECK: error: Coarray 'y' is not allowed in an equivalence set
|
||||
equivalence(x, y)
|
||||
!ERROR: Variable 'z' with BIND attribute is not allowed in an equivalence set
|
||||
!CHECK: error: Variable 'z' with BIND attribute is not allowed in an equivalence set
|
||||
equivalence(x, z)
|
||||
!ERROR: Variable 'z' with BIND attribute is not allowed in an equivalence set
|
||||
!CHECK: error: Variable 'z' with BIND attribute is not allowed in an equivalence set
|
||||
equivalence(x(2), z(3))
|
||||
real, bind(C) :: z(10)
|
||||
!ERROR: Named constant 'k' is not allowed in an equivalence set
|
||||
!CHECK: error: Named constant 'k' is not allowed in an equivalence set
|
||||
equivalence(x(2), k)
|
||||
!ERROR: Variable 'w' in common block with BIND attribute is not allowed in an equivalence set
|
||||
!CHECK: error: Variable 'w' in common block with BIND attribute is not allowed in an equivalence set
|
||||
equivalence(x(10), w)
|
||||
logical :: w(10)
|
||||
bind(C, name="c") /c/
|
||||
common /c/ w
|
||||
integer, target :: u
|
||||
!ERROR: Variable 'u' with TARGET attribute is not allowed in an equivalence set
|
||||
!CHECK: error: Variable 'u' with TARGET attribute is not allowed in an equivalence set
|
||||
equivalence(x(1), u)
|
||||
end
|
||||
|
||||
|
@ -71,9 +71,9 @@ subroutine s6
|
|||
real :: x0
|
||||
type(t1) :: x1
|
||||
type(t2) :: x2
|
||||
!ERROR: Derived type object 'x1' with pointer ultimate component is not allowed in an equivalence set
|
||||
!CHECK: error: Derived type object 'x1' with pointer ultimate component is not allowed in an equivalence set
|
||||
equivalence(x0, x1)
|
||||
!ERROR: Derived type object 'x2' with pointer ultimate component is not allowed in an equivalence set
|
||||
!CHECK: error: Derived type object 'x2' with pointer ultimate component is not allowed in an equivalence set
|
||||
equivalence(x0, x2)
|
||||
end
|
||||
|
||||
|
@ -82,7 +82,7 @@ subroutine s7
|
|||
end type
|
||||
real :: x0
|
||||
type(t1) :: x1
|
||||
!ERROR: Nonsequence derived type object 'x1' is not allowed in an equivalence set
|
||||
!CHECK: error: Nonsequence derived type object 'x1' is not allowed in an equivalence set
|
||||
equivalence(x0, x1)
|
||||
end
|
||||
|
||||
|
@ -92,9 +92,9 @@ module m8
|
|||
end
|
||||
subroutine s8
|
||||
use m8
|
||||
!ERROR: Use-associated variable 'x' is not allowed in an equivalence set
|
||||
!CHECK: error: Use-associated variable 'x' is not allowed in an equivalence set
|
||||
equivalence(x, z)
|
||||
!ERROR: Use-associated variable 'y' is not allowed in an equivalence set
|
||||
!CHECK: error: Use-associated variable 'y' is not allowed in an equivalence set
|
||||
equivalence(y(1), z)
|
||||
end
|
||||
|
||||
|
@ -103,17 +103,17 @@ subroutine s9
|
|||
real :: d(10)
|
||||
integer, parameter :: n = 2
|
||||
integer :: i, j
|
||||
!ERROR: Substring with nonconstant bound 'n+j' is not allowed in an equivalence set
|
||||
!CHECK: error: Substring with nonconstant bound 'n+j' is not allowed in an equivalence set
|
||||
equivalence(c(n+1:n+j), i)
|
||||
!ERROR: Substring with zero length is not allowed in an equivalence set
|
||||
!CHECK: error: Substring with zero length is not allowed in an equivalence set
|
||||
equivalence(c(n:1), i)
|
||||
!ERROR: Array with nonconstant subscript 'j-1' is not allowed in an equivalence set
|
||||
!CHECK: error: Array with nonconstant subscript 'j-1' is not allowed in an equivalence set
|
||||
equivalence(d(j-1), i)
|
||||
!ERROR: Array section 'd(1:n)' is not allowed in an equivalence set
|
||||
!CHECK: error: Array section 'd(1:n)' is not allowed in an equivalence set
|
||||
equivalence(d(1:n), i)
|
||||
character(4) :: a(10)
|
||||
equivalence(c, a(10)(1:2))
|
||||
!ERROR: 'a(10_8)(2_8:2_8)' and 'a(10_8)(1_8:1_8)' cannot have the same first storage unit
|
||||
!CHECK: error: 'a(10_8)(2_8:2_8)' and 'a(10_8)(1_8:1_8)' cannot have the same first storage unit
|
||||
equivalence(c, a(10)(2:3))
|
||||
end
|
||||
|
||||
|
@ -121,23 +121,23 @@ subroutine s10
|
|||
integer, parameter :: i(4) = [1, 2, 3, 4]
|
||||
real :: x(10)
|
||||
real :: y(4)
|
||||
!ERROR: Array with vector subscript 'i' is not allowed in an equivalence set
|
||||
!CHECK: error: Array with vector subscript 'i' is not allowed in an equivalence set
|
||||
equivalence(x(i), y)
|
||||
end
|
||||
|
||||
subroutine s11(n)
|
||||
integer :: n
|
||||
real :: x(n), y
|
||||
!ERROR: Automatic object 'x' is not allowed in an equivalence set
|
||||
!CHECK: error: Automatic object 'x' is not allowed in an equivalence set
|
||||
equivalence(x(1), y)
|
||||
end
|
||||
|
||||
module s12
|
||||
real, protected :: a
|
||||
integer :: b
|
||||
!ERROR: Equivalence set cannot contain 'a' with PROTECTED attribute and 'b' without
|
||||
!CHECK: error: Equivalence set cannot contain 'a' with PROTECTED attribute and 'b' without
|
||||
equivalence(a, b)
|
||||
!ERROR: Equivalence set cannot contain 'a' with PROTECTED attribute and 'b' without
|
||||
!CHECK: error: Equivalence set cannot contain 'a' with PROTECTED attribute and 'b' without
|
||||
equivalence(b, a)
|
||||
end
|
||||
|
||||
|
@ -153,25 +153,41 @@ module s13
|
|||
type(t1) :: w
|
||||
end type
|
||||
type(t2) :: c
|
||||
!ERROR: Equivalence set cannot contain 'b' that is character sequence type and 'a' that is not
|
||||
!CHECK: nonstandard: Equivalence set contains 'a' that is numeric sequence type and 'b' that is character
|
||||
equivalence(a, b)
|
||||
!ERROR: Equivalence set cannot contain 'c' that is numeric sequence type and 'a' that is not
|
||||
!CHECK: nonstandard: Equivalence set contains 'c' that is a default numeric sequence type and 'a' that is numeric with non-default kind
|
||||
equivalence(c, a)
|
||||
double precision :: d
|
||||
double complex :: e
|
||||
!OK: d and e are considered to be a default kind numeric type
|
||||
equivalence(c, d, e)
|
||||
type :: t3
|
||||
sequence
|
||||
real :: x
|
||||
character :: ch
|
||||
end type t3
|
||||
type(t3) :: s, r
|
||||
type :: t4
|
||||
sequence
|
||||
character :: ch
|
||||
real :: x
|
||||
end type t4
|
||||
type(t4) :: t
|
||||
!CHECK: nonstandard: Equivalence set contains 's' and 'r' with same type that is neither numeric nor character sequence type
|
||||
equivalence(s, r)
|
||||
!CHECK: error: Equivalence set cannot contain 's' and 't' with distinct types that are not both numeric or character sequence types
|
||||
equivalence(s, t)
|
||||
end
|
||||
|
||||
module s14
|
||||
real :: a(10), b, c, d
|
||||
!ERROR: 'a(2_8)' and 'a(1_8)' cannot have the same first storage unit
|
||||
!CHECK: error: 'a(2_8)' and 'a(1_8)' cannot have the same first storage unit
|
||||
equivalence(a(1), a(2))
|
||||
equivalence(b, a(3))
|
||||
!ERROR: 'a(4_8)' and 'a(3_8)' cannot have the same first storage unit
|
||||
!CHECK: error: 'a(4_8)' and 'a(3_8)' cannot have the same first storage unit
|
||||
equivalence(a(4), b)
|
||||
equivalence(c, a(5))
|
||||
!ERROR: 'a(6_8)' and 'a(5_8)' cannot have the same first storage unit
|
||||
!CHECK: error: 'a(6_8)' and 'a(5_8)' cannot have the same first storage unit
|
||||
equivalence(a(6), d)
|
||||
equivalence(c, d)
|
||||
end
|
||||
|
@ -179,7 +195,7 @@ end
|
|||
module s15
|
||||
real :: a(2), b(2)
|
||||
equivalence(a(2),b(1))
|
||||
!ERROR: 'a(3_8)' and 'a(1_8)' cannot have the same first storage unit
|
||||
!CHECK: error: 'a(3_8)' and 'a(1_8)' cannot have the same first storage unit
|
||||
equivalence(b(2),a(1))
|
||||
end module
|
||||
|
||||
|
@ -204,13 +220,13 @@ contains
|
|||
real function f17a()
|
||||
implicit none
|
||||
real :: y
|
||||
!ERROR: No explicit type declared for 'dupname'
|
||||
equivalence (dupName, y)
|
||||
!CHECK: error: No explicit type declared for 'dupname'
|
||||
equivalence (dupName, y)
|
||||
end function f17a
|
||||
real function f17b()
|
||||
real :: y
|
||||
! The following implicitly declares an object called "dupName" local to
|
||||
! The following implicitly declares an object called "dupName" local to
|
||||
! the function f17b(). OK since there's no "implicit none
|
||||
equivalence (dupName, y)
|
||||
equivalence (dupName, y)
|
||||
end function f17b
|
||||
end module m17
|
||||
|
|
Loading…
Reference in New Issue