[flang] Semantic-check for procedure pointers with assumed character length

[tislam]

Summary

Apply C723 from Fortran 2018 standard for procedure pointers that have assumed character length.

C723 A function name declared with an asterisk type-param-value shall not be an array, a pointer, elemental, or pure. A function
name declared with an asterisk type-param-value shall not have the RECURSIVE attribute.

[tislam]

Reference: github issue https://github.com/llvm/llvm-project/issues/58757

[DanielCChen]

flang/lib/Semantics/check-declarations.cpp

356

According to C724 of F2018, a procedure pointer cannot have a result type that is of assumed-length character type, character(*), regardless if it is a dummy procedure or not, so IsDummy should not be checked.

358

I noticed other similar messages use "cannot" instead of "can not". Is there a rule for how the error message should be written?

[clementval]

flang/lib/Semantics/check-declarations.cpp

358

I'm not aware of any rule but consistency is probably better,

[peixin]

I think you are checking C723, not C724.

[DanielCChen]

In D139333#3980113, @peixin wrote:

I think you are checking C723, not C724.

The constraint that disallows this is
"A function name declared with an asterisk type-param-value shall not be an array, a pointer, elemental, or pure. A function
name declared with an asterisk type-param-value shall not have the RECURSIVE attribute."
in which, "A function name ..... shall not be...., a pointer" disallow a procedure pointer to have assumed-length character type as its result type.

[peixin]

"A function name declared with an asterisk type-param-value shall not be an array, a pointer, elemental, or pure. A function
name declared with an asterisk type-param-value shall not have the RECURSIVE attribute."

This is C723, not C724.

[DanielCChen]

In D139333#3980379, @peixin wrote:

"A function name declared with an asterisk type-param-value shall not be an array, a pointer, elemental, or pure. A function
name declared with an asterisk type-param-value shall not have the RECURSIVE attribute."

This is C723, not C724.

Ah, Got it. I probably got the version of the standard wrong. Thanks!

[tislam]

In D139333#3980379, @peixin wrote:

"A function name declared with an asterisk type-param-value shall not be an array, a pointer, elemental, or pure. A function
name declared with an asterisk type-param-value shall not have the RECURSIVE attribute."

This is C723, not C724.

Thanks @peixin. I have updated the summary to mention C723.

[klausler]

Assumed-length character function pointer dummy arguments work fine with gfortran and ifort, so this should be a supported extension with a portability warning, not a hard error.

module m
 contains
  subroutine subr(p)
    procedure(character(*)), pointer :: p
    print *, p()
  end subroutine
end module

character(*) function f()
  f = 'abcdefgh'
end function

program test
  use m
  character(4), external :: f
  procedure(character(4)), pointer :: p
  p => f
  call subr(p)
end

[tislam]

Addressed review comments. Changes include the following.

• The message category is changed from ERROR to PORTABILITY.
• The part "can not" is changed to "cannot" in the message text.
• Added a new test Semantics/call30.f90 based on the example from @klausler. I added a local procedure pointer with character(*) return type, to the original example.

[klausler]

flang/lib/Semantics/check-declarations.cpp

358

"should not" would be better for a warning.

[tislam]

Changed "cannot" to "should not" in the message text.

[peixin]

@klausler has accepted this. He is the expert in this area. @tislam So I think you can land this now.

flang/lib/Semantics/check-declarations.cpp

if (IsElementalProcedure(symbol)) {
       messages_.Say(
           "An assumed-length CHARACTER(*) function cannot be PURE"_err_en_US);
     }
     if (const Symbol *result{FindFunctionResult(symbol)}) {
       if (IsPointer(*result)) {
         messages_.Say(
             "An assumed-length CHARACTER(*) function cannot return a POINTER"_err_en_US);
       }
+    } else if (IsPointer(symbol)) {
+      messages_.Say(
+          "A procedure pointer should not have assumed-length CHARACTER(*) result type"_port_en_US);
     }
   }
   if (symbol.attrs().test(Attr::VALUE)) {
     CheckValue(symbol, derived);
   }
   if (symbol.attrs().test(Attr::CONTIGUOUS) && IsPointer(symbol) &&
       symbol.Rank() == 0) { // C830
     messages_.Say("CONTIGUOUS POINTER must be an array"_err_en_US);

flang/test/Semantics/call01.f90

contains
   character(1) function nested
     !ERROR: Assumed-length CHARACTER(*) function 'f14' cannot call itself
     !ERROR: Assumed-length character function must be defined with a length to be called
     nested = f14(n-1) ! 15.6.2.1(3)
   end function nested
 end function
 
 subroutine s01(f1, f2, fp1, fp2)
+  !PORTABILITY: A procedure pointer should not have assumed-length CHARACTER(*) result type
   character*(*) :: f1, f3, fp1
   external :: f1, f3
   pointer :: fp1
+  !PORTABILITY: A procedure pointer should not have assumed-length CHARACTER(*) result type
   procedure(character*(*)), pointer :: fp2
   interface
     character*(*) function f2()
     end function
     !ERROR: A function interface may not declare an assumed-length CHARACTER(*) result
     character*(*) function f4()
     end function
   end interface
   print *, f1()
   print *, f2()
   !ERROR: Assumed-length character function must be defined with a length to be called
   print *, f3()
   print *, fp1()
   print *, fp2()
 end subroutine

flang/test/Semantics/call31.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
+! Confirm enforcement of constraint C723 in F2018 for procedure pointers
+
+      module m
+       contains
+        subroutine subr(parg)
+          !PORTABILITY: A procedure pointer should not have assumed-length CHARACTER(*) result type
+          procedure(character(*)), pointer :: parg
+          !PORTABILITY: A procedure pointer should not have assumed-length CHARACTER(*) result type
+          procedure(character(*)), pointer :: plocal
+          print *, parg()
+          plocal => parg
+          call subr_1(plocal)
+        end subroutine
+
+        subroutine subr_1(parg_1)
+          !PORTABILITY: A procedure pointer should not have assumed-length CHARACTER(*) result type
+          procedure(character(*)), pointer :: parg_1
+          print *, parg_1()
+        end subroutine
+      end module
+
+      character(*) function f()
+        f = 'abcdefgh'
+      end function
+
+      program test
+        use m
+        character(4), external :: f
+        procedure(character(4)), pointer :: p
+        p => f
+        call subr(p)
+      end
+