[PATCH] D119847: [flang] Handle CALL C_F_POINTER(without SHAPE=)

[Peter Klausler via Phabricator via llvm-commits]

This revision was automatically updated to reflect the committed changes.
Closed by commit rGf6ded53fb03b: [flang] Handle CALL C_F_POINTER(without SHAPE=) (authored by klausler).
Herald added a project: LLVM.
Herald added a subscriber: llvm-commits.

Repository:
  rG LLVM Github Monorepo

CHANGES SINCE LAST ACTION
  https://reviews.llvm.org/D119847/new/

https://reviews.llvm.org/D119847

Files:
  flang/lib/Evaluate/intrinsics.cpp
  flang/lib/Semantics/expression.cpp
  flang/test/Semantics/c_f_pointer.f90


Index: flang/test/Semantics/c_f_pointer.f90
===================================================================
--- flang/test/Semantics/c_f_pointer.f90
+++ flang/test/Semantics/c_f_pointer.f90
@@ -29,4 +29,6 @@
   call c_f_pointer(scalarC, charDeferredF)
   !ERROR: FPTR= argument to C_F_POINTER() may not be a coindexed object
   call c_f_pointer(scalarC, coindexed[0]%p)
+  !ERROR: FPTR= argument to C_F_POINTER() must have a type
+  call c_f_pointer(scalarC, null())
 end program
Index: flang/lib/Semantics/expression.cpp
===================================================================
--- flang/lib/Semantics/expression.cpp
+++ flang/lib/Semantics/expression.cpp
@@ -2387,13 +2387,20 @@
       ProcedureDesignator *proc{std::get_if<ProcedureDesignator>(&callee->u)};
       CHECK(proc);
       if (CheckCall(call.source, *proc, callee->arguments)) {
-        bool hasAlternateReturns{HasAlternateReturns(callee->arguments)};
         callStmt.typedCall.Reset(
             new ProcedureRef{std::move(*proc), std::move(callee->arguments),
-                hasAlternateReturns},
+                HasAlternateReturns(callee->arguments)},
             ProcedureRef::Deleter);
+        return;
       }
     }
+    if (!context_.AnyFatalError()) {
+      std::string buf;
+      llvm::raw_string_ostream dump{buf};
+      parser::DumpTree(dump, callStmt);
+      Say("Internal error: Expression analysis failed on CALL statement: %s"_err_en_US,
+          dump.str());
+    }
   }
 }
 
Index: flang/lib/Evaluate/intrinsics.cpp
===================================================================
--- flang/lib/Evaluate/intrinsics.cpp
+++ flang/lib/Evaluate/intrinsics.cpp
@@ -2154,6 +2154,9 @@
         fptr.intent = common::Intent::Out;
         fptr.attrs.set(characteristics::DummyDataObject::Attr::Pointer);
         dummies.emplace_back("fptr"s, std::move(fptr));
+      } else {
+        context.messages().Say(
+            "FPTR= argument to C_F_POINTER() must have a type"_err_en_US);
       }
       if (arguments[2] && fptrRank == 0) {
         context.messages().Say(
@@ -2162,23 +2165,22 @@
         context.messages().Say(
             "SHAPE= argument to C_F_POINTER() must appear when FPTR= is an array"_err_en_US);
       }
-      if (arguments[2]) {
-        DynamicType shapeType{
-            TypeCategory::Integer, defaults_.sizeIntegerKind()};
-        if (auto type{arguments[2]->GetType()}) {
-          if (type->category() == TypeCategory::Integer) {
-            shapeType = *type;
-          }
+    }
+  }
+  if (dummies.size() == 2) {
+    DynamicType shapeType{TypeCategory::Integer, defaults_.sizeIntegerKind()};
+    if (arguments[2]) {
+      if (auto type{arguments[2]->GetType()}) {
+        if (type->category() == TypeCategory::Integer) {
+          shapeType = *type;
         }
-        characteristics::DummyDataObject shape{
-            characteristics::TypeAndShape{shapeType, 1}};
-        shape.intent = common::Intent::In;
-        shape.attrs.set(characteristics::DummyDataObject::Attr::Optional);
-        dummies.emplace_back("shape"s, std::move(shape));
       }
     }
-  }
-  if (dummies.size() == 3) {
+    characteristics::DummyDataObject shape{
+        characteristics::TypeAndShape{shapeType, 1}};
+    shape.intent = common::Intent::In;
+    shape.attrs.set(characteristics::DummyDataObject::Attr::Optional);
+    dummies.emplace_back("shape"s, std::move(shape));
     return SpecificCall{
         SpecificIntrinsic{"__builtin_c_f_pointer"s,
             characteristics::Procedure{std::move(dummies), attrs}},


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D119847.408963.patch
Type: text/x-patch
Size: 3573 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/llvm-commits/attachments/20220215/54e54917/attachment.bin>