[flang] Add semantic check for multiple part-ref with nonzero rank for TBP

As Fortran 2018 C919, there shall not be more than one part-ref with
nonzero rank. Support this semantic check for type-bound procedure to
address the issue https://github.com/llvm/llvm-project/issues/55811.

Reviewed By: klausler

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

flang/lib/Semantics/expression.cpp

@@ -1977,13 +1977,16 @@ auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
             return std::nullopt;
           }
         }
+        std::optional<DataRef> dataRef{ExtractDataRef(std::move(*dtExpr))};
+        if (dataRef.has_value() && !CheckRanks(std::move(*dataRef))) {
+          return std::nullopt;
+        }
         if (const Symbol *
             resolution{GetBindingResolution(dtExpr->GetType(), *sym)}) {
           AddPassArg(arguments, std::move(*dtExpr), *sym, false);
           return CalleeAndArguments{
               ProcedureDesignator{*resolution}, std::move(arguments)};
-        } else if (std::optional<DataRef> dataRef{
+        } else if (dataRef.has_value()) {
-                       ExtractDataRef(std::move(*dtExpr))}) {
           if (sym->attrs().test(semantics::Attr::NOPASS)) {
             return CalleeAndArguments{
                 ProcedureDesignator{Component{std::move(*dataRef), *sym}},

flang/test/Semantics/expr-errors04.f90

@@ -2,10 +2,23 @@
 ! Regression test for more than one part-ref with nonzero rank
 
 program m
+  interface
+    function real_info1(i)
+    end
+    subroutine real_info2()
+    end
+    subroutine real_generic()
+    end
+  end interface
   type mt
     complex :: c, c2(2)
     integer :: x, x2(2)
     character(10) :: s, s2(2)
+   contains
+    procedure, nopass :: info1 => real_info1
+    procedure, nopass :: info2 => real_info2
+    procedure, nopass :: real_generic
+    generic :: g1 => real_generic
   end type
   type mt2
     type(mt) :: t1(2,2)
@@ -73,4 +86,26 @@ program m
   print *, t(1)%t3%t2(1)%t1%c2(1)%RE
   !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
   print *, t%t3%t2%t1%c2(1)%IM
+
+  !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 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
+
+  !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 t%t3%t2%t1(1)%info2
+  !ERROR: Reference to rank-2 object 't1' has 1 subscripts
+  call t%t3%t2%t1(1)%g1
+
+  !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 t%t3%t2%t1(1:)%info2
+  !ERROR: Reference to rank-2 object 't1' has 1 subscripts
+  call t%t3%t2%t1(1:)%g1
+
 end