[flang] Do not return true for pointer sub-object in IsPointerObject

[jeanPerier]

Summary

evaluate::IsPointerObject used to return true for pointer suboject like
pointer(10) while these object are not pointers. This prevented some
checks like 15.5.2.7 to be correctly enforced (e.g., it was possible to
pass pointer(10) to a non intent(in) dummy pointer).

After updating IsPointerObject behavior and adding a test for 15.5.2.7 in
call07.f90, a test in call03.f90 for 15.5.2.4(14) was failing.
It appeared the related semantics check was relying on IsPointerObject
to return true for pointer(10). Adapt the code to detect pointer element
in another way.
While looking at the code, I also noticed that semantics was
rejecting character(1) pointer/assumed shape suboject when these are
allowed (the standard has a special case for character(1) in
15.5.2.4(14), and I verified that other compilers that enforce 15.5.2.4(14)
do accept this).

flang/lib/Evaluate/tools.cpp

 // IsObjectPointer()
 bool IsObjectPointer(const Expr<SomeType> &expr, FoldingContext &context) {
   if (IsNullPointer(expr)) {
     return true;
   } else if (IsProcedurePointerTarget(expr)) {
     return false;
   } else if (const auto *funcRef{UnwrapProcedureRef(expr)}) {
     return IsVariable(*funcRef);
-  } else if (const Symbol * symbol{GetLastSymbol(expr)}) {
+  } else if (const Symbol * symbol{UnwrapWholeSymbolOrComponentDataRef(expr)}) {
     return IsPointer(symbol->GetUltimate());
   } else {
     return false;
   }
 }
 
 bool IsBareNullPointer(const Expr<SomeType> *expr) {
   return expr && std::holds_alternative<NullPointer>(expr->u);

flang/lib/Semantics/check-call.cpp

if (dummy.type.attrs().test(
     }
   } else if (actualRank == 0 && dummy.type.Rank() > 0) {
     // Actual is scalar, dummy is an array.  15.5.2.4(14), 15.5.2.11
     if (actualIsCoindexed) {
       messages.Say(
           "Coindexed scalar actual argument must be associated with a scalar %s"_err_en_US,
           dummyName);
     }
-    if (!IsArrayElement(actual) &&
-        !(actualType.type().category() == TypeCategory::Character &&
-            actualType.type().kind() == 1) &&
+    bool actualIsArrayElement{IsArrayElement(actual)};
+    bool actualIsCKindCharacter{
+        actualType.type().category() == TypeCategory::Character &&
+        actualType.type().kind() == 1};
+    if (!actualIsCKindCharacter) {
+      if (!actualIsArrayElement &&
           !(dummy.type.type().IsAssumedType() && dummyIsAssumedSize) &&
           !dummyIsAssumedRank) {
         messages.Say(
             "Whole scalar actual argument may not be associated with a %s array"_err_en_US,
             dummyName);
       }
       if (actualIsPolymorphic) {
         messages.Say(
             "Polymorphic scalar may not be associated with a %s array"_err_en_US,
             dummyName);
       }
-    if (actualIsPointer) {
+      if (actualIsArrayElement && actualLastSymbol &&
+          IsPointer(*actualLastSymbol)) {
         messages.Say(
-          "Scalar POINTER target may not be associated with a %s array"_err_en_US,
+            "Element of pointer array may not be associated with a %s array"_err_en_US,
             dummyName);
       }
       if (actualLastSymbol && IsAssumedShape(*actualLastSymbol)) {
         messages.Say(
             "Element of assumed-shape array may not be associated with a %s array"_err_en_US,
             dummyName);
       }
     }
+  }
   if (actualLastObject && actualLastObject->IsCoarray() &&
       IsAllocatable(*actualLastSymbol) && dummy.intent == common::Intent::Out &&
       !(intrinsic &&
           evaluate::AcceptsIntentOutAllocatableCoarray(
               intrinsic->name))) { // C846
     messages.Say(
         "ALLOCATABLE coarray '%s' may not be associated with INTENT(OUT) %s"_err_en_US,
         actualLastSymbol->name(), dummyName);

flang/test/Semantics/call03.f90

subroutine test08(x) ! 15.5.2.4(13)
     real :: x(1)[*]
     !ERROR: Coindexed scalar actual argument must be associated with a scalar dummy argument 'x='
     call assumedsize(x(1)[1])
   end subroutine
 
   subroutine charray(x)
     character :: x(10)
   end subroutine
-  subroutine test09(ashape, polyarray, c) ! 15.5.2.4(14), 15.5.2.11
+  subroutine test09(ashape, polyarray, c, assumed_shape_char) ! 15.5.2.4(14), 15.5.2.11
     real :: x, arr(10)
     real, pointer :: p(:)
+    real, pointer :: p_scalar
+    character(10), pointer :: char_pointer(:)
+    character(*) :: assumed_shape_char(:)
     real :: ashape(:)
     class(t) :: polyarray(*)
     character(10) :: c(:)
     !ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array
     call assumedsize(x)
-    !ERROR: Scalar POINTER target may not be associated with a dummy argument 'x=' array
+    !ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array
+    call assumedsize(p_scalar)
+    !ERROR: Element of pointer array may not be associated with a dummy argument 'x=' array
     call assumedsize(p(1))
     !ERROR: Element of assumed-shape array may not be associated with a dummy argument 'x=' array
     call assumedsize(ashape(1))
     !ERROR: Polymorphic scalar may not be associated with a dummy argument 'x=' array
     call polyassumedsize(polyarray(1))
     call charray(c(1:1))  ! not an error if character
+    call charray(char_pointer(1))  ! not an error if character
+    call charray(assumed_shape_char(1))  ! not an error if character
     call assumedsize(arr(1))  ! not an error if element in sequence
     call assumedrank(x)  ! not an error
     call assumedtypeandsize(x)  ! not an error
   end subroutine
 
   subroutine test10(a) ! 15.5.2.4(16)
     real :: scalar, matrix(2,3)
     real :: a(*)

flang/test/Semantics/call07.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Test 15.5.2.7 constraints and restrictions for POINTER dummy arguments.
 
 module m
   real :: coarray(10)[*]
  contains
 
   subroutine s01(p)
     real, pointer, contiguous, intent(in) :: p(:)
   end subroutine
   subroutine s02(p)
     real, pointer :: p(:)
   end subroutine
   subroutine s03(p)
     real, pointer, intent(in) :: p(:)
   end subroutine
+  subroutine s04(p)
+    real, pointer :: p
+  end subroutine
 
   subroutine test
     !ERROR: CONTIGUOUS POINTER must be an array
     real, pointer, contiguous :: a01 ! C830
     real, pointer :: a02(:)
     real, target :: a03(10)
     real :: a04(10) ! not TARGET
     call s01(a03) ! ok
     !ERROR: Actual argument associated with CONTIGUOUS POINTER dummy argument 'p=' must be simply contiguous
     call s01(a02)
     !ERROR: Actual argument associated with CONTIGUOUS POINTER dummy argument 'p=' must be simply contiguous
     call s01(a03(::2))
     call s02(a02) ! ok
     call s03(a03) ! ok
     !ERROR: Actual argument associated with POINTER dummy argument 'p=' must also be POINTER unless INTENT(IN)
     call s02(a03)
+    !ERROR: Actual argument associated with POINTER dummy argument 'p=' must also be POINTER unless INTENT(IN)
+    call s04(a02(1))
     !ERROR: An array section with a vector subscript may not be a pointer target
     call s03(a03([1,2,4]))
     !ERROR: A coindexed object may not be a pointer target
     call s03(coarray(:)[1])
     !ERROR: Target associated with dummy argument 'p=' must be a designator or a call to a pointer-valued function
     call s03([1.])
     !ERROR: In assignment to object dummy argument 'p=', the target 'a04' is not an object with POINTER or TARGET attributes
     call s03(a04)
   end subroutine
 end module