diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/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}}, diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -2387,13 +2387,20 @@ ProcedureDesignator *proc{std::get_if(&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()); + } } } diff --git a/flang/test/Semantics/c_f_pointer.f90 b/flang/test/Semantics/c_f_pointer.f90 --- a/flang/test/Semantics/c_f_pointer.f90 +++ b/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