[flang-commits] [flang] f13d600 - [flang] Add semantic check for multiple part-ref with non-zero rank

[Kelvin Li via flang-commits]

Author: Kelvin Li
Date: 2023-01-19T10:54:44-05:00
New Revision: f13d6001324e9c9653d8568c1d86e182b217e272

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

LOG: [flang] Add semantic check for multiple part-ref with non-zero rank

This patch is to diagnose the case when a type bound procedure is passed as an actual procedure argument.

   call sub0(t%t3%t2%t%info1)

Fix: https://github.com/llvm/llvm-project/issues/55826

Committed on behalf of DanielCChen

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

Added: 
    

Modified: 
    flang/lib/Semantics/expression.cpp
    flang/test/Semantics/expr-errors04.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index a6fc90693aae3..a4c1843600715 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -207,6 +207,9 @@ MaybeExpr ExpressionAnalyzer::Designate(DataRef &&ref) {
           last.name());
     }
     if (auto *component{std::get_if<Component>(&ref.u)}) {
+      if (!CheckDataRef(ref)) {
+        return std::nullopt;
+      }
       return Expr<SomeType>{ProcedureDesignator{std::move(*component)}};
     } else if (!std::holds_alternative<SymbolRef>(ref.u)) {
       DIE("unexpected alternative in DataRef");

diff  --git a/flang/test/Semantics/expr-errors04.f90 b/flang/test/Semantics/expr-errors04.f90
index b8e0f221215b9..be794c7c78f6d 100644
--- a/flang/test/Semantics/expr-errors04.f90
+++ b/flang/test/Semantics/expr-errors04.f90
@@ -92,6 +92,8 @@ subroutine real_generic()
   !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
   call sub0(t%t3%t2%t1%info1(i))
   !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+  call sub0(t%t3%t2%t1%info1)
+  !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
   call t%t3%t2%t1%info2
   !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
   call t%t3%t2%t1%g1
@@ -99,6 +101,8 @@ subroutine real_generic()
   !ERROR: Reference to rank-2 object 't1' has 1 subscripts
   call sub0(t%t3%t2%t1(1)%info1(i))
   !ERROR: Reference to rank-2 object 't1' has 1 subscripts
+  call sub0(t%t3%t2%t1(1)%info1)
+  !ERROR: Reference to rank-2 object 't1' has 1 subscripts
   call t%t3%t2%t1(1)%info2
   !ERROR: Reference to rank-2 object 't1' has 1 subscripts
   call t%t3%t2%t1(1)%g1
@@ -106,6 +110,8 @@ subroutine real_generic()
   !ERROR: Reference to rank-2 object 't1' has 1 subscripts
   call sub0(t%t3%t2%t1(1:)%info1(i))
   !ERROR: Reference to rank-2 object 't1' has 1 subscripts
+  call sub0(t%t3%t2%t1(1:)%info1)
+  !ERROR: Reference to rank-2 object 't1' has 1 subscripts
   call t%t3%t2%t1(1:)%info2
   !ERROR: Reference to rank-2 object 't1' has 1 subscripts
   call t%t3%t2%t1(1:)%g1