[Flang] To fix issue #55826: Add semantic check for another variation of multiple part-ref with non-zero rank.

[DanielCChen]

Summary

This is to address the GitHub issue #55826.
It is to diagnose the case when a type bound procedure is passed as an actual procedure argument.

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

[DanielCChen]

I tried to add “rG LLVM Github Monorepo” in the Repository field before creating the revision, but it disappeared. Does someone know why it happened?

[DanielCChen]

Ping: I appreciate it if reviewers can review the change. Thanks to all.

[peixin]

LGTM. Thanks for this work.

@DanielCChen If your patch gets approved by @klausler or @jeanPerier in the area of semantic analysis, you can land your patch if others don't have any comments. Sometimes, I wait for one more day and land the patch.

[DanielCChen]

Thanks @klausler and @peixin! I will wait a day or so to see if others have any more comments.

flang/lib/Semantics/expression.cpp

MaybeExpr ExpressionAnalyzer::Designate(DataRef &&ref) {
   const Symbol &last{ref.GetLastSymbol()};
   const Symbol &symbol{BypassGeneric(last).GetUltimate()};
   if (semantics::IsProcedure(symbol)) {
     if (symbol.attrs().test(semantics::Attr::ABSTRACT)) {
       Say("Abstract procedure interface '%s' may not be used as a designator"_err_en_US,
           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");
     } else if (!symbol.attrs().test(semantics::Attr::INTRINSIC)) {
       if (symbol.has<semantics::GenericDetails>()) {
         Say("'%s' is not a specific procedure"_err_en_US, symbol.name());
       } else {
         return Expr<SomeType>{ProcedureDesignator{symbol}};

flang/test/Semantics/expr-errors04.f90

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(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 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
 
   !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
 
   !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
 
   !ERROR: An allocatable or pointer component reference must be applied to a scalar base
   print *, t(1)%t3(1)%t2(1)%t1%p
   !ERROR: An allocatable or pointer component reference must be applied to a scalar base
   print *, t%t3(1)%t2(1)%t1(1,1)%p