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

Peter Klausler via flang-commits flang-commits at lists.llvm.org
Fri Mar 10 09:20:00 PST 2023


Author: Peter Klausler
Date: 2023-03-10T09:19:52-08:00
New Revision: d38765604f9372dab74a82b573302bd6401c6698

URL: https://github.com/llvm/llvm-project/commit/d38765604f9372dab74a82b573302bd6401c6698
DIFF: https://github.com/llvm/llvm-project/commit/d38765604f9372dab74a82b573302bd6401c6698.diff

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

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.

Differential Revision: https://reviews.llvm.org/D145743

Added: 
    

Modified: 
    flang/docs/Extensions.md
    flang/include/flang/Common/Fortran-features.h
    flang/lib/Semantics/resolve-names.cpp
    flang/test/Semantics/implicit11.f90
    flang/test/Semantics/resolve103.f90

Removed: 
    


################################################################################
diff  --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 7f685c72eada3..a71363cb3b6ea 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -199,10 +199,10 @@ end
 * 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.

diff  --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
index b94cf2c6d21f1..6cf90f518b91e 100644
--- a/flang/include/flang/Common/Fortran-features.h
+++ b/flang/include/flang/Common/Fortran-features.h
@@ -31,7 +31,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     EquivalenceSameNonSequence, AdditionalIntrinsics, AnonymousParents,
     OldLabelDoEndStatements, LogicalIntegerAssignment, EmptySourceFile,
     ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways,
-    ForwardRefDummyImplicitNone, OpenAccessAppend, BOZAsDefaultInteger,
+    ForwardRefImplicitNone, OpenAccessAppend, BOZAsDefaultInteger,
     DistinguishableSpecifics, DefaultSave, PointerInSeqType, NonCharacterFormat,
     SaveMainProgram, SaveBigMainProgramVariables)
 

diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 637d133798a51..f90a4862c4b12 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -2435,13 +2435,15 @@ void ScopeHandler::ApplyImplicitRules(
 }
 
 // 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{
@@ -2456,11 +2458,11 @@ bool ScopeHandler::ImplicitlyTypeForwardRef(Symbol &symbol) {
   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);
@@ -2639,13 +2641,13 @@ bool ScopeHandler::CheckPossibleBadForwardRef(const Symbol &symbol) {
       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;
     }

diff  --git a/flang/test/Semantics/implicit11.f90 b/flang/test/Semantics/implicit11.f90
index 3c68ab5b848b2..8d5a1bd0be7bc 100644
--- a/flang/test/Semantics/implicit11.f90
+++ b/flang/test/Semantics/implicit11.f90
@@ -40,6 +40,7 @@ subroutine s3()
   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

diff  --git a/flang/test/Semantics/resolve103.f90 b/flang/test/Semantics/resolve103.f90
index dbc3bca6cbc48..8f55968f43375 100644
--- a/flang/test/Semantics/resolve103.f90
+++ b/flang/test/Semantics/resolve103.f90
@@ -1,17 +1,17 @@
 ! 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)
@@ -19,10 +19,35 @@ subroutine foo2(a, n2)
   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


        


More information about the flang-commits mailing list