[flang] Handle CALL C_F_POINTER(without SHAPE=)

[klausler]

Summary

Calls to C_F_POINTER() without the optional SHAPE= third argument
were failing to be recognized as proper calls to the intrinsic,
but the failure was not generating any error message. This led to
a crash in lowering, which rightfully expects a typed expression
to be associated with the call.

So (1) catch silent failures to convert CALL statements as internal
errors, as is done for expressions and assignment statements; and
(2) clean up C_F_POINTER intrinsic handling to cope with only two
arguments and to emit an error for a FPTR= argument with no type.

flang/lib/Evaluate/intrinsics.cpp

if (const auto *expr{arguments[1].value().UnwrapExpr()}) {
           context.messages().Say(
               "FPTR= argument to C_F_POINTER() may not be a coindexed object"_err_en_US);
         }
         characteristics::DummyDataObject fptr{
             characteristics::TypeAndShape{*type, fptrRank}};
         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(
             "SHAPE= argument to C_F_POINTER() may not appear when FPTR= is scalar"_err_en_US);
       } else if (!arguments[2] && fptrRank > 0) {
         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;
-          }
-        }
-        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) {
+    }
+  }
+  if (dummies.size() == 2) {
+    DynamicType shapeType{TypeCategory::Integer, defaults_.sizeIntegerKind()};
+    }
     return SpecificCall{
         SpecificIntrinsic{"__builtin_c_f_pointer"s,
             characteristics::Procedure{std::move(dummies), attrs}},
         std::move(arguments)};
   } else {
     return std::nullopt;
   }
 }

flang/lib/Semantics/expression.cpp

void ExpressionAnalyzer::Analyze(const parser::CallStmt &callStmt) {
   }
   if (!analyzer.fatalErrors()) {
     if (std::optional<CalleeAndArguments> callee{
             GetCalleeAndArguments(std::get<parser::ProcedureDesignator>(call.t),
                 analyzer.GetActuals(), true /* subroutine */)}) {
       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());
     }
   }
 }
 
 const Assignment *ExpressionAnalyzer::Analyze(const parser::AssignmentStmt &x) {
   if (!x.typedAssignment) {
     ArgumentAnalyzer analyzer{*this};
     analyzer.Analyze(std::get<parser::Variable>(x.t));

flang/test/Semantics/c_f_pointer.f90

program test
   !ERROR: SHAPE= argument to C_F_POINTER() must appear when FPTR= is an array
   call c_f_pointer(scalarC, arrayIntF)
   !ERROR: SHAPE= argument to C_F_POINTER() may not appear when FPTR= is scalar
   call c_f_pointer(scalarC, scalarIntF, [1_8])
   !ERROR: FPTR= argument to C_F_POINTER() may not have a deferred type parameter
   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