[flang] Allow extension cases of EQUIVALENCE with optional warnings

[klausler]

Summary

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.

flang/docs/Extensions.md

* BOZ literals can be used as INTEGER values in contexts where the type is
   procedures with explicit interfaces whose corresponding dummy
   argument has a numeric type to which the BOZ literal may be
   converted.  BOZ literals are interpreted as default INTEGER only
   when they appear as the first items of array constructors with no
   explicit type.  Otherwise, they generally cannot be used if the type would
   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))`).
 * Some intrinsic functions are specified in the standard as requiring the
   same type and kind for their arguments (viz., ATAN with two arguments,
   ATAN2, DIM, HYPOT, MAX, MIN, MOD, and MODULO);
   we allow distinct types to be used, promoting
   the arguments as if they were operands to an intrinsic `+` operator,

flang/include/flang/Common/Fortran-features.h

ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     DoubleComplex, Byte, StarKind, QuadPrecision, SlashInitialization,
     TripletInArrayConstructor, MissingColons, SignedComplexLiteral,
     OldStyleParameter, ComplexConstructor, PercentLOC, SignedPrimary, FileName,
     Carriagecontrol, Convert, Dispose, IOListLeadingComma,
     AbbreviatedEditDescriptor, ProgramParentheses, PercentRefAndVal,
     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,
     DistinguishableSpecifics, DefaultSave, PointerInSeqType, NonCharacterFormat)
 
 using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
 
 class LanguageFeatureControl {

flang/include/flang/Evaluate/tools.h

 // 15.5.2.4(4), type compatibility for dummy and actual arguments.
 // Also used for assignment compatibility checking
 bool AreTypeParamCompatible(
     const semantics::DerivedTypeSpec &, const semantics::DerivedTypeSpec &);
 
 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_

flang/lib/Evaluate/tools.cpp

bool SymbolSourcePositionCompare::operator()(
   return x->GetSemanticsContext().allCookedSources().Precedes(
       x->name(), y->name());
 }
 
 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

flang/lib/Parser/Fortran-parsers.cpp

first(construct<IntrinsicTypeSpec>(integerTypeSpec),
         construct<IntrinsicTypeSpec>("DOUBLE PRECISION" >>
             construct<IntrinsicTypeSpec::DoublePrecision>()),
         construct<IntrinsicTypeSpec>(construct<IntrinsicTypeSpec::Complex>(
             "COMPLEX" >> maybe(kindSelector))),
         construct<IntrinsicTypeSpec>(construct<IntrinsicTypeSpec::Character>(
             "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)))))))
 
 // R705 integer-type-spec -> INTEGER [kind-selector]
 TYPE_PARSER(construct<IntegerTypeSpec>("INTEGER" >> maybe(kindSelector)))
 
 // R706 kind-selector -> ( [KIND =] scalar-int-constant-expr )

flang/lib/Parser/basic-parsers.h

std::optional<resultType> Parse(ParseState &state) const {
     if (UserState * ustate{state.userState()}) {
       if (!ustate->features().IsEnabled(LF)) {
         return std::nullopt;
       }
     }
     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;
   }
 
 private:
   const PA parser_;
 };
 

flang/lib/Semantics/resolve-names-utils.h

private:
   const EquivalenceObject *Find(const EquivalenceSet &, const Symbol &);
   bool CheckDesignator(const parser::Designator &);
   bool CheckDataRef(const parser::CharBlock &, const parser::DataRef &);
   bool CheckObject(const parser::Name &);
   bool CheckArrayBound(const parser::Expr &);
   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_;
   std::vector<EquivalenceSet> sets_; // all equivalence sets in this scope
   // Map object to index of set it is in
   std::map<EquivalenceObject, std::size_t> objectToSet_;
   EquivalenceSet currSet_; // equivalence set currently being constructed
   struct {
     Symbol *symbol{nullptr};
     std::vector<ConstantSubscript> subscripts;
     std::optional<ConstantSubscript> substringStart;
   } currObject_; // equivalence object currently being constructed
 };
 
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_RESOLVE_NAMES_H_

flang/lib/Semantics/resolve-names-utils.cpp

 //===-- lib/Semantics/resolve-names-utils.cpp -----------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #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"
 #include "flang/Evaluate/tools.h"
 #include "flang/Evaluate/type.h"
 #include "flang/Parser/char-block.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Semantics/expression.h"
if (existing.empty()) {
     MergeInto(source, currSet_, dstIndex);
     while (++it != existing.end()) {
       MergeInto(source, sets_[*it], dstIndex);
     }
   }
   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());
     return false;
   }
   return true;
 }
 
return IsSequenceType(type, [&](const IntrinsicTypeSpec &type) {
     return type.category() == TypeCategory::Character && kind &&
         kind.value() == context_.GetDefaultKind(TypeCategory::Character);
   });
 }
 
 // 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;
     }
   }
   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,
     std::function<bool(const IntrinsicTypeSpec &)> predicate) {
   if (!type) {
     return false;
   } else if (const IntrinsicTypeSpec * intrinsic{type->AsIntrinsic()}) {
     return predicate(*intrinsic);

flang/test/Semantics/equivalence01.f90

-!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
 
 subroutine s2
   integer i
   type t
     integer :: a
     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
 end
 
 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
 
 subroutine s6
   type t1
     sequence
     real, pointer :: p
   end type
   type :: t2
     sequence
     type(t1) :: b
   end type
   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
 
 subroutine s7
   type t1
   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
 
 module m8
   real :: x
   real :: y(10)
 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
 
 subroutine s9
   character(10) :: c
   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
 
 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
 
 module s13
   logical(8) :: a
   character(4) :: b
   type :: t1
     sequence
     complex :: z
   end type
   type :: t2
     sequence
     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
 
 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
 
 subroutine s16
 
   integer var, dupName
 
   ! There should be no error message for the following
   equivalence (dupName, var)
 
   interface
     subroutine interfaceSub (dupName)
       integer dupName
     end subroutine interfaceSub
   end interface
 
 end subroutine s16
 
 module m17
   real :: dupName
 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