[flang-commits] [PATCH] D136963: [flang] Catch C721 violations in defined interfaces

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: jeanPerier.
klausler added a project: Flang.
Herald added a subscriber: jdoerfert.
Herald added a project: All.
klausler requested review of this revision.

Fortran's constraint C721 allows an assumed-length CHARACTER
entity to be declared in a very limited set of circumstances that
does not include an explicit external interface definition.


https://reviews.llvm.org/D136963

Files:
  flang/lib/Semantics/check-declarations.cpp
  flang/test/Semantics/call01.f90
  flang/test/Semantics/resolve67.f90


Index: flang/test/Semantics/resolve67.f90
===================================================================
--- flang/test/Semantics/resolve67.f90
+++ flang/test/Semantics/resolve67.f90
@@ -35,7 +35,7 @@
 
 module m3
   interface operator(/)
-    !ERROR: OPERATOR(/) function 'divide' may not have assumed-length CHARACTER(*) result
+    !ERROR: A function interface may not declare an assumed-length CHARACTER(*) result
     character(*) function divide(x, y)
       character(*), intent(in) :: x, y
     end
@@ -57,6 +57,23 @@
       end interface
     end
   end interface
+ contains
+  subroutine s(alcf1, alcf2)
+    interface
+      character(*) function alcf1(x, y)
+        character(*), intent(in) :: x, y
+      end function
+      character(*) function alcf2(x, y)
+        character(*), intent(in) :: x, y
+      end function
+    end interface
+    interface operator(+)
+      !ERROR: OPERATOR(+) function 'alcf1' may not have assumed-length CHARACTER(*) result
+      procedure alcf1
+    end interface
+    !ERROR: OPERATOR(-) function 'alcf2' may not have assumed-length CHARACTER(*) result
+    generic :: operator(-) => alcf2
+  end subroutine
 end
 
 module m4
Index: flang/test/Semantics/call01.f90
===================================================================
--- flang/test/Semantics/call01.f90
+++ flang/test/Semantics/call01.f90
@@ -126,6 +126,7 @@
   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
@@ -133,8 +134,6 @@
   print *, f2()
   !ERROR: Assumed-length character function must be defined with a length to be called
   print *, f3()
-  !ERROR: Assumed-length character function must be defined with a length to be called
-  print *, f4()
   print *, fp1()
   print *, fp2()
 end subroutine
Index: flang/lib/Semantics/check-declarations.cpp
===================================================================
--- flang/lib/Semantics/check-declarations.cpp
+++ flang/lib/Semantics/check-declarations.cpp
@@ -970,6 +970,11 @@
       }
     }
   }
+  if (details.isInterface() && !details.isDummy() && details.isFunction() &&
+      IsAssumedLengthCharacter(details.result())) { // C721
+    messages_.Say(details.result().name(),
+        "A function interface may not declare an assumed-length CHARACTER(*) result"_err_en_US);
+  }
 }
 
 void CheckHelper::CheckDerivedType(
@@ -1297,6 +1302,12 @@
   } else if (!proc.functionResult.has_value()) {
     msg = "%s procedure '%s' must be a function"_err_en_US;
   } else if (proc.functionResult->IsAssumedLengthCharacter()) {
+    const auto *subpDetails{specific.detailsIf<SubprogramDetails>()};
+    if (subpDetails && !subpDetails->isDummy() && subpDetails->isInterface()) {
+      // Error is caught by more general test for interfaces with
+      // assumed-length character function results
+      return true;
+    }
     msg = "%s function '%s' may not have assumed-length CHARACTER(*)"
           " result"_err_en_US;
   } else if (auto m{CheckNumberOfArgs(kind, proc.dummyArguments.size())}) {


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D136963.471581.patch
Type: text/x-patch
Size: 3160 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20221028/09c60b1d/attachment.bin>