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

[peixin]

Summary

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.

[peixin]

Merge two If conditions.

flang/lib/Semantics/expression.cpp

if (const Symbol * sym{sc.component.symbol}) {
           if (sym) {
             // re-resolve the name to the specific binding
             sc.component.symbol = const_cast<Symbol *>(sym);
           } else {
             EmitGenericResolutionError(*sc.component.symbol, pair.second);
             return std::nullopt;
           }
         }
+        std::optional<DataRef> dataRef{ExtractDataRef(std::move(*dtExpr))};
+        if (dataRef.has_value()) {
+          if (!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{
-                       ExtractDataRef(std::move(*dtExpr))}) {
+        } else if (dataRef.has_value()) {
           if (sym->attrs().test(semantics::Attr::NOPASS)) {
             return CalleeAndArguments{
                 ProcedureDesignator{Component{std::move(*dataRef), *sym}},
                 std::move(arguments)};
           } else {
             AddPassArg(arguments,
                 Expr<SomeDerived>{Designator<SomeDerived>{std::move(*dataRef)}},
                 *sym);

flang/test/Semantics/expr-errors04.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! 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)
   end type
   type mt3
     type(mt2) :: t2(2)
   end type
   type mt4
program m
   !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
   print *, t(1)%t3%t2%t1%c2(1)%RE
   !ERROR: Subscripts of component 'c2' of rank-2 derived type array have rank 1 but must all be scalar
   print *, t(1)%t3(1)%t2%t1%c2(1:)%RE
   !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
   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