[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

diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 86ac6ae..31f2fda 100644 (file)
--- 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 897f327..0d4156d 100644 (file)
--- 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 0ab7f24..7e8cbb0 100644 (file)
--- a/flang/test/Semantics/bindings01.f90
+++ b/flang/test/Semantics/bindings01.f90
@@ -215,6 +215,24 @@ contains
   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