[flang-commits] [flang] [FLANG]Added support for procedure pointer returning polymorphic type (PR #176695)

[via flang-commits]

llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: None (ShashwathiNavada)

<details>
<summary>Changes</summary>

Flang compiler was throwing error for below declaration.

` procedure(class(derived_type()), pointer :: ptr
`

This should be valid according to section [15.4.3.6](https://j3-fortran.org/doc/year/25/25-007r1.pdf)
The error message is shown below.
```
error: CLASS entity 'x10' must be a dummy argument, allocatable, or object pointer
                  procedure(class(easy)),pointer, nopass :: X10      ! ok
                                                            ^^^
```
This patch allows procedure pointers to have polymorphic (CLASS) type. 
The implementation adds an exception in `CheckSymbolType() ` to allow polymorphic 
types for procedure pointers while explicitly excluding those with the ` EXTERNAL `
attribute. 

---
Full diff: https://github.com/llvm/llvm-project/pull/176695.diff


2 Files Affected:

- (modified) flang/lib/Semantics/check-declarations.cpp (+6-1) 
- (added) flang/test/Semantics/declarations09.f90 (+9) 


``````````diff
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 684c1dcc98fa3..df4280d179e1a 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -3860,7 +3860,12 @@ void CheckHelper::CheckSymbolType(const Symbol &symbol) {
   } else if (IsPointer(relevant) && !IsProcedure(relevant)) {
     // object pointers are always ok
   } else if (auto dyType{evaluate::DynamicType::From(relevant)}) {
-    if (dyType->IsPolymorphic() && !dyType->IsAssumedType() &&
+    if (IsProcedurePointer(symbol) && !symbol.attrs().test(Attr::EXTERNAL) &&
+        dyType->IsPolymorphic() && !result) {
+      // Procedure pointers are allowed to have polymorphic (CLASS) type.
+      // However, declarations like "CLASS(...), EXTERNAL, POINTER :: proc"
+      // are also classified as procedure pointers and must be excluded.
+    } else if (dyType->IsPolymorphic() && !dyType->IsAssumedType() &&
         !(IsDummy(symbol) && !IsProcedure(relevant))) { // C708
       messages_.Say(
           "CLASS entity '%s' must be a dummy argument, allocatable, or object pointer"_err_en_US,
diff --git a/flang/test/Semantics/declarations09.f90 b/flang/test/Semantics/declarations09.f90
new file mode 100644
index 0000000000000..ef01ea3131872
--- /dev/null
+++ b/flang/test/Semantics/declarations09.f90
@@ -0,0 +1,9 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+program test
+        type :: easy
+        integer :: i
+        end type
+        type :: check
+        procedure(class(easy)),pointer, nopass :: X10      !ok
+        end type
+end program 
\ No newline at end of file

``````````

</details>


https://github.com/llvm/llvm-project/pull/176695