[flang] Forward references to COMMON from specification expr under IMPLICIT NONE

[klausler]

Summary

As a near-universal extension, Fortran compilers permit forward references
to dummy arguments and variables in COMMON blocks from specification expressions
before an explicit type-declaration-stmt appears for those variables
under IMPLICIT NONE, so long as those variables are later explicitly typed
with the types that regular implicit typing rules would have given them
(usually default INTEGER).

F18 implemented this extension for dummy arguments, but not variables in
COMMON blocks. Extend the extension to also accept variables in COMMON.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/docs/Extensions.md

* Static initialization of `LOGICAL` with `INTEGER` is allowed in `DATA` statements
   The results are *not* normalized to canonical `.TRUE.`/`.FALSE.`.
   Static initialization of `INTEGER` with `LOGICAL` is also permitted.
 * An effectively empty source file (no program unit) is accepted and
   produces an empty relocatable output file.
 * A `RETURN` statement may appear in a main program.
 * DATA statement initialization is allowed for procedure pointers outside
   structure constructors.
 * Nonstandard intrinsic functions: ISNAN, SIZEOF
-* A forward reference to a default INTEGER scalar dummy argument is
-  permitted to appear in a specification expression, such as an array
-  bound, in a scope with IMPLICIT NONE(TYPE) if the name
-  of the dummy argument would have caused it to be implicitly typed
+* A forward reference to a default INTEGER scalar dummy argument or
+  `COMMON` block variable is permitted to appear in a specification
+  expression, such as an array bound, in a scope with IMPLICIT NONE(TYPE)
+  if the name of the variable would have caused it to be implicitly typed
   as default INTEGER if IMPLICIT NONE(TYPE) were absent.
 * OPEN(ACCESS='APPEND') is interpreted as OPEN(POSITION='APPEND')
   to ease porting from Sun Fortran.
 * Intrinsic subroutines EXIT([status]) and ABORT()
 * The definition of simple contiguity in 9.5.4 applies only to arrays;
   we also treat scalars as being trivially contiguous, so that they
   can be used in contexts like data targets in pointer assignments
   with bounds remapping.

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

ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     IOListLeadingComma, AbbreviatedEditDescriptor, ProgramParentheses,
     PercentRefAndVal, OmitFunctionDummies, CrayPointer, Hollerith, ArithmeticIF,
     Assign, AssignedGOTO, Pause, OpenACC, OpenMP, CruftAfterAmpersand,
     ClassicCComments, AdditionalFormats, BigIntLiterals, RealDoControls,
     EquivalenceNumericWithCharacter, EquivalenceNonDefaultNumeric,
     EquivalenceSameNonSequence, AdditionalIntrinsics, AnonymousParents,
     OldLabelDoEndStatements, LogicalIntegerAssignment, EmptySourceFile,
     ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways,
-    ForwardRefDummyImplicitNone, OpenAccessAppend, BOZAsDefaultInteger,
+    ForwardRefImplicitNone, OpenAccessAppend, BOZAsDefaultInteger,
     DistinguishableSpecifics, DefaultSave, PointerInSeqType, NonCharacterFormat,
     SaveMainProgram, SaveBigMainProgramVariables)
 
 using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
 
 class LanguageFeatureControl {
 public:
   LanguageFeatureControl() {

flang/lib/Semantics/resolve-names.cpp

void ScopeHandler::ApplyImplicitRules(
   }
   if (!context().HasError(symbol)) {
     Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
     context().SetError(symbol);
   }
 }
 
 // Extension: Allow forward references to scalar integer dummy arguments
-// to appear in specification expressions under IMPLICIT NONE(TYPE) when
-// what would otherwise have been their implicit type is default INTEGER.
+// or variables in COMMON to appear in specification expressions under
+// IMPLICIT NONE(TYPE) when what would otherwise have been their implicit
+// type is default INTEGER.
 bool ScopeHandler::ImplicitlyTypeForwardRef(Symbol &symbol) {
-  if (!inSpecificationPart_ || context().HasError(symbol) || !IsDummy(symbol) ||
+  if (!inSpecificationPart_ || context().HasError(symbol) ||
+      !(IsDummy(symbol) || FindCommonBlockContaining(symbol)) ||
       symbol.Rank() != 0 ||
       !context().languageFeatures().IsEnabled(
-          common::LanguageFeature::ForwardRefDummyImplicitNone)) {
+          common::LanguageFeature::ForwardRefImplicitNone)) {
     return false;
   }
   const DeclTypeSpec *type{
       GetImplicitType(symbol, false /*ignore IMPLICIT NONE*/)};
   if (!type || !type->IsNumeric(TypeCategory::Integer)) {
     return false;
   }
   auto kind{evaluate::ToInt64(type->numericTypeSpec().kind())};
   if (!kind || *kind != context().GetDefaultKind(TypeCategory::Integer)) {
     return false;
   }
   if (!ConvertToObjectEntity(symbol)) {
     return false;
   }
-  // TODO: check no INTENT(OUT)?
+  // TODO: check no INTENT(OUT) if dummy?
   if (context().languageFeatures().ShouldWarn(
-          common::LanguageFeature::ForwardRefDummyImplicitNone)) {
+          common::LanguageFeature::ForwardRefImplicitNone)) {
     Say(symbol.name(),
-        "Dummy argument '%s' was used without being explicitly typed"_warn_en_US,
+        "'%s' was used without (or before) being explicitly typed"_warn_en_US,
         symbol.name());
   }
   symbol.set(Symbol::Flag::Implicit);
   symbol.SetType(*type);
   return true;
 }
 
 // Ensure that the symbol for an intrinsic procedure is marked with
if (auto fwdRef{HadForwardRef(symbol)}) {
       }
       Say(*fwdRef,
           "Forward reference to '%s' is not allowed in the same specification part"_err_en_US,
           *fwdRef)
           .Attach(symbol.name(), "Later declaration of '%s'"_en_US, *fwdRef);
       context().SetError(symbol);
       return true;
     }
-    if (IsDummy(symbol) && isImplicitNoneType() &&
-        symbol.test(Symbol::Flag::Implicit) && !context().HasError(symbol)) {
-      // Dummy was implicitly typed despite IMPLICIT NONE(TYPE) in
+    if ((IsDummy(symbol) || FindCommonBlockContaining(symbol)) &&
+        isImplicitNoneType() && symbol.test(Symbol::Flag::Implicit) &&
+        !context().HasError(symbol)) {
+      // Dummy or COMMON was implicitly typed despite IMPLICIT NONE(TYPE) in
       // ApplyImplicitRules() due to use in a specification expression,
       // and no explicit type declaration appeared later.
-      Say(symbol.name(),
-          "No explicit type declared for dummy argument '%s'"_err_en_US);
+      Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
       context().SetError(symbol);
       return true;
     }
   }
   return false;
 }
 
 void ScopeHandler::MakeExternal(Symbol &symbol) {

flang/test/Semantics/implicit11.f90

 end
 
 subroutine s3()
   m = 1
 contains
   subroutine s3a()
     implicit none
     real :: a(m, n)
+    !WARN: '%s' was used without (or before) being explicitly typed
     !ERROR: No explicit type declared for 'n'
     common n
   end
   subroutine s3b()
     ! n is okay here because it is in a common block
     real :: a(m, n)
     common n
   end

flang/test/Semantics/resolve103.f90

 ! RUN: not %flang_fc1 -pedantic %s 2>&1 | FileCheck %s
-! Test extension: allow forward references to dummy arguments
+! Test extension: allow forward references to dummy arguments or COMMON
 ! from specification expressions in scopes with IMPLICIT NONE(TYPE),
 ! as long as those symbols are eventually typed later with the
 ! same integer type they would have had without IMPLICIT NONE.
 
-!CHECK: Dummy argument 'n1' was used without being explicitly typed
+!CHECK: warning: 'n1' was used without (or before) being explicitly typed
 !CHECK: error: No explicit type declared for dummy argument 'n1'
 subroutine foo1(a, n1)
   implicit none
   real a(n1)
 end
 
-!CHECK: Dummy argument 'n2' was used without being explicitly typed
+!CHECK: warning: 'n2' was used without (or before) being explicitly typed
 subroutine foo2(a, n2)
   implicit none
   real a(n2)
 !CHECK: error: The type of 'n2' has already been implicitly declared
   double precision n2
 end
 
-!CHECK: Dummy argument 'n3' was used without being explicitly typed
+!CHECK: warning: 'n3' was used without (or before) being explicitly typed
 !CHECK-NOT: error: Dummy argument 'n3'
 subroutine foo3(a, n3)
   implicit none
   real a(n3)
   integer n3
 end
+
+!CHECK: warning: 'n4' was used without (or before) being explicitly typed
+!CHECK: error: No explicit type declared for 'n4'
+subroutine foo4(a)
+  implicit none
+  real a(n4)
+  common /b4/ n4
+end
+
+!CHECK: warning: 'n5' was used without (or before) being explicitly typed
+subroutine foo5(a)
+  implicit none
+  real a(n5)
+  common /b5/ n5
+!CHECK: error: The type of 'n5' has already been implicitly declared
+  double precision n5
+end
+
+!CHECK: warning: 'n6' was used without (or before) being explicitly typed
+subroutine foo6(a)
+  implicit none
+  real a(n6)
+  common /b6/ n6
+  integer n6
+end