[flang-commits] [flang] 98eb7d0 - [flang] Enforce C1529 as a warning, C919 as an error

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-12-17T09:10:56-08:00
New Revision: 98eb7d0a8d0b2fe79b997a3bd5eda9721399b8bc

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

LOG: [flang] Enforce C1529 as a warning, C919 as an error

Constraint C1529 requires that the base object of a type-bound procedure
reference be a scalar if the TBP has the NOPASS attribute.  Most
compilers do not enforce this constraint and it does not appear to
have any implementation justification, so emit portability warning.

On the other hand, we fail to enforce C919 for references to
procedure pointer components, whose base objects must of course
be scalars in order to avoid ambiguity and empty arrays, whether
NOPASS is present or not.

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

Added: 
    

Modified: 
    flang/docs/Extensions.md
    flang/lib/Semantics/expression.cpp
    flang/test/Semantics/bindings01.f90

Removed: 
    


################################################################################
diff  --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 86ac6ae876e80..31f2fda8c4cc8 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -252,6 +252,10 @@ end
   the target of a procedure pointer assignment statement.
 * An explicit `INTERFACE` can declare the interface of a
   procedure pointer even if it is not a dummy argument.
+* A `NOPASS` type-bound procedure binding is required by C1529
+  to apply only to a scalar data-ref, but most compilers don't
+  enforce it and the constraint is not necessary for a correct
+  implementation.
 
 ### Extensions supported when enabled by options
 

diff  --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 897f3271f7521..0d4156d621a44 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -2103,10 +2103,18 @@ auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
         if (dataRef && !CheckDataRef(*dataRef)) {
           return std::nullopt;
         }
-        if (dataRef && dataRef->Rank() > 0 && sym->attrs().test(semantics::Attr::NOPASS)) {
-          // C1529 seems unnecessary and most compilers don't enforce it.
-          Say(sc.component.source,
-            "Base of procedure component reference should be scalar when NOPASS component or binding '%s' is referenced"_port_en_US, sc.component.source);
+        if (dataRef && dataRef->Rank() > 0) {
+          if (sym->has<semantics::ProcBindingDetails>() &&
+              sym->attrs().test(semantics::Attr::NOPASS)) {
+            // C1529 seems unnecessary and most compilers don't enforce it.
+            AttachDeclaration(
+                Say(sc.component.source,
+                    "Base of NOPASS type-bound procedure reference should be scalar"_port_en_US),
+                *sym);
+          } else if (IsProcedurePointer(*sym)) { // C919
+            Say(sc.component.source,
+                "Base of procedure component reference must be scalar"_err_en_US);
+          }
         }
         if (const Symbol *resolution{
                 GetBindingResolution(dtExpr->GetType(), *sym)}) {

diff  --git a/flang/test/Semantics/bindings01.f90 b/flang/test/Semantics/bindings01.f90
index 0ab7f240dcbce..7e8cbb032f93b 100644
--- a/flang/test/Semantics/bindings01.f90
+++ b/flang/test/Semantics/bindings01.f90
@@ -215,6 +215,24 @@ subroutine b(*, passArg)
   end subroutine
 end module m7
 
+module m8 ! C1529 - warning only
+  type t
+    procedure(mysubr), pointer, nopass :: pp
+   contains
+    procedure, nopass :: tbp => mysubr
+  end type
+ contains
+  subroutine mysubr
+  end subroutine
+  subroutine test
+    type(t) a(2)
+    !PORTABILITY: Base of NOPASS type-bound procedure reference should be scalar
+    call a%tbp
+    !ERROR: Base of procedure component reference must be scalar
+    call a%pp
+  end subroutine
+end module
+
 program test
   use m1
   type,extends(t) :: t2