[flang] Allow function result as ALLOCATABLE arg

[luporl]

Summary

Allow the result of a function that has the ALLOCATABLE attribute
to be used as an actual argument in procedures that expect an
ALLOCATABLE dummy argument. This is allowed by gfortran and ifort,
but as it is not standards conforming, a portability warning is
emitted when this extension is used.

Fixes https://github.com/llvm/llvm-project/issues/60226

[klausler]

I don't think that this patch implements correct Fortran behavior. While function result can indeed have the ALLOCATABLE attribute within the function, the attribute is not part of the function's characteristics, and in the calling context the result of the function is a value, not a variable (*), and it explicitly does not have the ALLOCATABLE attribute.

See Note 1 in 8.5.3: "Only variables and components can have the ALLOCATABLE attribute. The result of referencing a func- tion whose result variable has the ALLOCATABLE attribute is a value that does not itself have the ALLOCATABLE attribute."

(*) A function can return an object pointer, and in that case it is a variable in the calling context.

[luporl]

In D147614#4246191, @klausler wrote:

I don't think that this patch implements correct Fortran behavior. While function result can indeed have the ALLOCATABLE attribute within the function, the attribute is not part of the function's characteristics, and in the calling context the result of the function is a value, not a variable (*), and it explicitly does not have the ALLOCATABLE attribute.

See Note 1 in 8.5.3: "Only variables and components can have the ALLOCATABLE attribute. The result of referencing a func- tion whose result variable has the ALLOCATABLE attribute is a value that does not itself have the ALLOCATABLE attribute."

(*) A function can return an object pointer, and in that case it is a variable in the calling context.

I agree that F2018 standard doesn't allow the result of a function that has the ALLOCATABLE attribute to be used as an actual argument in procedures that expect an ALLOCATABLE dummy argument, given Note 1 in 8.5.3.

However, in F2003 and F2008 standards there is no such note in the description of the ALLOCATABLE attribute.
So, isn't it possible that this is allowed by them? If so, couldn't we support this when -std=f2003 or -std=f2008 is specified?
This would improve our compatibility with other compilers, such as gfortran and ifort.

On a quick search through F2003/F2008 docs, I didn't find anything that disallows this use of an ALLOCATABLE function result, but I don't have much knowledge of the standards to assert this.

[klausler]

We don't have a means to restrict the compiler to use only an earlier edition of the standard, and generally with Fortran that hasn't been desirable (with the famous exception of F'2003's introduction of (re)allocation of left-hand sides of assignments to allocatables, which can cause slowdowns that are easily fixed with a minor source change).

J3 seems to have gone out of its way here to make F'2008 conforming code non-conforming with F'2018. It may have been inadvertent. But if it was intentional, and for a good reason, then we might expect these two compilers to catch up and start emitting errors where they currently do not do so.

You could ask the J3 committee's mailing list for clarification on this point, and you might or might not get a useful response.

If it turns out that it's a defensible extension to retain the old behavior, you should also extend the analysis of procedure characteristics to represent an allocatable function result as a distinguishing characteristic for the purpose of procedure pointer and actual/dummy procedure compatibility checking.

[luporl]

Ok, thanks for the detailed response.
I'll try to ask J3 committee's mailing list for clarification on this point, as you suggested.

[luporl]

Before sending an email to J3 committee's mailing list, I did some research in its archives and found some interesting discussions:

1. https://mailman.j3-fortran.org/pipermail/j3/2017-March/010158.html
2. https://mailman.j3-fortran.org/pipermail/j3/2012-April/005029.html

Item 1 makes it clear that the intention is to prohibit code such as move_alloc ( F(X), V ).
In item 2, F2008 5.3.3 "ALLOCATABLE attribute" is quoted to argue that a similiar construct (DO, WHILE(ALLOCATED(F())) is not conforming:

An entity with the ALLOCATABLE attribute is a VARIABLE

Lastly, I tried to compile a program that uses a function result as an ALLOCATABLE argument, with NAG compiler, and it reports an error (even with -f2003 or -f2008):
Expected an ALLOCATABLE variable for argument P

Therefore, now I am convinced that this was not intended to be supported in F2003/F2008. The purpose of the note in F2018 then seems to be that of clarifying this point.

[klausler]

In D147614#4249905, @luporl wrote:

Before sending an email to J3 committee's mailing list, I did some research in its archives and found some interesting discussions:

1. https://mailman.j3-fortran.org/pipermail/j3/2017-March/010158.html
2. https://mailman.j3-fortran.org/pipermail/j3/2012-April/005029.html

Item 1 makes it clear that the intention is to prohibit code such as move_alloc ( F(X), V ).
In item 2, F2008 5.3.3 "ALLOCATABLE attribute" is quoted to argue that a similiar construct (DO, WHILE(ALLOCATED(F())) is not conforming:

An entity with the ALLOCATABLE attribute is a VARIABLE

Lastly, I tried to compile a program that uses a function result as an ALLOCATABLE argument, with NAG compiler, and it reports an error (even with -f2003 or -f2008):
Expected an ALLOCATABLE variable for argument P

Therefore, now I am convinced that this was not intended to be supported in F2003/F2008. The purpose of the note in F2018 then seems to be that of clarifying this point.

However, since they do seem to work with at least two other compilers, perhaps they should be supported in f18 too for maximum portability.

[klausler]

In D147614#4249510, @klausler wrote:

If it turns out that it's a defensible extension to retain the old behavior, you should also extend the analysis of procedure characteristics to represent an allocatable function result as a distinguishing characteristic for the purpose of procedure pointer and actual/dummy procedure compatibility checking.

It looks like the standard already states that whether a function result is allocatable or not is defined as a characteristic of a procedure, and that I included that attribute as part of the definition of function result characteristics. So the necessary compatibility checks should already work.

Suggestion: if this extension already works in f18, add a portability warning when it's used, and document it in Extensions.md. We should try to make it as easy as possible to port code to this new compiler, especially when it comes to language extensions supported by multiple other existing Fortran compilers that are unambiguous, well defined, and actually used in existing code.

[luporl]

OK, I think I rushed a little bit with regards to this topic.
Increasing the compatibility with other compilers would be great.

[jeanPerier]

Can you add a small lowering test to check lowering is OK with this extension (given lowering deals with pointer and allocatable in a very similar way, it probably is, but it is best to ensure this remains so).

In previous discussion with @klausler, I think we had quickly discussed that this extension would raise the question: what if the callee deallocate/reallocates the allocatable? Lowering inserts clean-up code when it faces a function that returns an allocatable. Can you make sure that this cleanup code is conditional on the allocation status after the call, and that it is not assuming that the base address to be cleaned-up is the same as the one at the point where the allocatable was returned (in case the call reallocated it)?

[luporl]

• Added a portability warning and documented the use of function results as allocatable arguments in Extensions.md.
• Changed IsAllocatableOrPointerObject() to handle allocatable function results (without this, lowering of intrinsic arguments triggers an assert).
• Changed allocated() checks to emit an error when trying to use a function result as argument (because gfortran doesn't support this).
• Added a lowering test, to confirm that the generated FIR handles deallocation/reallocation of allocatable function results properly.

[luporl]

While inspecting the FIR for the lowering test, I noticed that the x variable is not deallocated automatically, even if the function call is removed and x is allocated with allocate().
It seems to be a known issue: https://github.com/orgs/llvm/projects/12/views/1?pane=issue&itemId=23809512

[jeanPerier]

While inspecting the FIR for the lowering test, I noticed that the x variable is not deallocated automatically, even if the function call is removed and x is allocated with allocate().
It seems to be a known issue: https://github.com/orgs/llvm/projects/12/views/1?pane=issue&itemId=23809512

Yes, that is a know issue, since it does not cause "correctness issues" it had been sitting for a while even though it is not a hard TODO.

Thanks for the update and answers. The lowering aspects looks good to me.

[luporl]

gfortran just turned returning a function result as an ALLOCATABLE arg into an error: https://gcc.gnu.org/bugzilla/show_bug.cgi?id=109500

In the report, it's said that this was likely only supported by accident and that the new Intel Fortran compiler, ifx, also doesn't support this.
So flang would be one of the only supporting this extension, that IMHO doesn't seem worth anymore, even though this patch is almost ready to land (the lowering test need to be updated to work with recent changes).

Any comments on this?

[klausler]

The purpose of this patch was to remove a code porting barrier, but if the other compilers that support(ed) this feature no longer do so, then the motivation of the patch seems to have evaporated.

[jeanPerier]

In D147614#4327470, @luporl wrote:

Any comments on this?

Thanks for this update. I agree with Peter here. Thanks a lot for the work and the update on this patch though, it is appreciated, even if this does not make it in!

[luporl]

Thanks for all comments and feedback. Closing this now.

flang/docs/Extensions.md

 * 15.6.4 paragraph 2 prohibits an implicitly typed statement function
   from sharing the same name as a symbol in its scope's host, if it
   has one.
   We accept this usage with a portability warning.
 * A module name from a `USE` statement can also be used as a
   non-global name in the same scope.  This is not conforming,
   but it is useful and unambiguous.
 * The argument to `RANDOM_NUMBER` may not be an assumed-size array.
+* Note 1 in 8.5.3 prohibits using the result of referencing a function whose
+  result variable has the ALLOCATABLE attribute as an allocatable actual
+  argument.
+  As other compilers accept this, so does f18, with a portability warning.
 
 ## Extensions, deletions, and legacy features supported by default
 
 * Tabs in source
 * `<>` as synonym for `.NE.` and `/=`
 * `$` and `@` as legal characters in names
 * Initialization in type declaration statements using `/values/`
 * Kind specification with `*`, e.g. `REAL*4`

flang/include/flang/Evaluate/call.h

struct ProcedureDesignator {
   // passed-object ActualArgument.
   // Always null when the procedure is intrinsic.
   const Component *GetComponent() const;
 
   const Symbol *GetInterfaceSymbol() const;
 
   std::string GetName() const;
   std::optional<DynamicType> GetType() const;
+  const Symbol *GetResult() const;
   int Rank() const;
   bool IsElemental() const;
   bool IsPure() const;
   std::optional<Expr<SubscriptInteger>> LEN() const;
   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
 
   std::variant<SpecificIntrinsic, SymbolRef,
       common::CopyableIndirection<Component>>
public:
   const ProcedureDesignator &proc() const { return proc_; }
   ActualArguments &arguments() { return arguments_; }
   const ActualArguments &arguments() const { return arguments_; }
 
   std::optional<Expr<SubscriptInteger>> LEN() const;
   int Rank() const;
   bool IsElemental() const { return proc_.IsElemental(); }
   bool hasAlternateReturns() const { return hasAlternateReturns_; }
+  const Symbol *GetResult() const { return proc_.GetResult(); }
 
   Expr<SomeType> *UnwrapArgExpr(int n) {
     if (static_cast<std::size_t>(n) < arguments_.size() && arguments_[n]) {
       return arguments_[n]->UnwrapExpr();
     } else {
       return nullptr;
     }
   }

flang/include/flang/Evaluate/tools.h

 bool IsProcedurePointer(const Expr<SomeType> &);
 bool IsProcedurePointerTarget(const Expr<SomeType> &);
 bool IsBareNullPointer(const Expr<SomeType> *); // NULL() w/o MOLD= or type
 bool IsNullObjectPointer(const Expr<SomeType> &);
 bool IsNullProcedurePointer(const Expr<SomeType> &);
 bool IsNullPointer(const Expr<SomeType> &);
 bool IsObjectPointer(const Expr<SomeType> &, FoldingContext &);
 
+bool IsFunctionRef(const Expr<SomeType> &);
+
 // Can Expr be passed as absent to an optional dummy argument.
 // See 15.5.2.12 point 1 for more details.
 bool MayBePassedAsAbsentOptional(const Expr<SomeType> &, FoldingContext &);
 
 // Extracts the chain of symbols from a designator, which has perhaps been
 // wrapped in an Expr<>, removing all of the (co)subscripts.  The
 // base object will be the first symbol in the result vector.
 struct GetSymbolVectorHelper

flang/lib/Evaluate/call.cpp

if (const auto &result{intrinsic->characteristics.value().functionResult}) {
       }
     }
   } else {
     return DynamicType::From(GetSymbol());
   }
   return std::nullopt;
 }
 
+const Symbol *ProcedureDesignator::GetResult() const {
+  if (const Symbol * procSym{GetSymbol()}) {
+    if (const auto *subprogram{
+            std::get_if<semantics::SubprogramDetails>(&procSym->details())}) {
+      if (subprogram->isFunction()) {
+        return &subprogram->result();
+      }
+    }
+  }
+  return nullptr;
+}
+
 int ProcedureDesignator::Rank() const {
   if (const Symbol * symbol{GetSymbol()}) {
     // Subtle: will be zero for functions returning procedure pointers
     return symbol->Rank();
   }
   if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&u)}) {
     if (const auto &result{intrinsic->characteristics.value().functionResult}) {
       if (const auto *typeAndShape{result->GetTypeAndShape()}) {

flang/lib/Evaluate/intrinsics.cpp

 // Applies any semantic checks peculiar to an intrinsic.
 // TODO: Move the rest of these checks to Semantics/check-call.cpp, which is
 // where ASSOCIATED() and TRANSFER() are now validated.
 static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
   bool ok{true};
   const std::string &name{call.specificIntrinsic.name};
   if (name == "allocated") {
     const auto &arg{call.arguments[0]};
+    bool funcRef{false};
     if (arg) {
       if (const auto *expr{arg->UnwrapExpr()}) {
         ok = evaluate::IsAllocatableDesignator(*expr);
+        funcRef = evaluate::IsFunctionRef(*expr);
       }
     }
     if (!ok) {
       context.messages().Say(
           arg ? arg->sourceLocation() : context.messages().at(),
           "Argument of ALLOCATED() must be an ALLOCATABLE object or component"_err_en_US);
+    } else if (funcRef) {
+      context.messages().Say(
+          "Argument of ALLOCATED() must be an ALLOCATABLE variable"_err_en_US);
     }
   } else if (name == "associated") {
     // Now handled in Semantics/check-call.cpp
   } else if (name == "atomic_and" || name == "atomic_or" ||
       name == "atomic_xor") {
     return CheckForCoindexedObject(context, call.arguments[2], name, "stat");
   } else if (name == "atomic_cas") {
     return CheckForCoindexedObject(context, call.arguments[4], name, "stat");

flang/lib/Evaluate/tools.cpp

 bool IsProcedure(const Expr<SomeType> &expr) {
   return std::holds_alternative<ProcedureDesignator>(expr.u);
 }
 bool IsFunction(const Expr<SomeType> &expr) {
   const auto *designator{std::get_if<ProcedureDesignator>(&expr.u)};
   return designator && designator->GetType().has_value();
 }
 
+bool IsFunctionRef(const Expr<SomeType> &expr) {
+  if (const ProcedureRef * proc{GetProcedureRef(expr)}) {
+    return proc->GetResult() != nullptr;
+  }
+  return false;
+}
+
 bool IsProcedurePointer(const Expr<SomeType> &expr) {
   return common::visit(common::visitors{
                            [](const NullPointer &) { return true; },
                            [](const ProcedureRef &) { return false; },
                            [&](const auto &) {
                              const Symbol *last{GetLastSymbol(expr)};
                              return last && IsProcedurePointer(*last);
                            },
if (toType.category() == TypeCategory::Integer &&
         fromType->category() == TypeCategory::Logical) {
       return DataConstantConversionHelper<TypeCategory::Integer,
           TypeCategory::Logical>(context, toType, expr);
     }
   }
   return std::nullopt;
 }
 
+static const semantics::Symbol *GetFunctionResult(const Expr<SomeType> &expr) {
+  if (const ProcedureRef * proc{GetProcedureRef(expr)}) {
+    return proc->GetResult();
+  }
+  return nullptr;
+}
+
 bool IsAllocatableOrPointerObject(
     const Expr<SomeType> &expr, FoldingContext &context) {
   const semantics::Symbol *sym{UnwrapWholeSymbolOrComponentDataRef(expr)};
+  if (!sym) {
+    sym = GetFunctionResult(expr);
+  }
   return (sym && semantics::IsAllocatableOrPointer(*sym)) ||
       evaluate::IsObjectPointer(expr, context);
 }
 
 bool IsAllocatableDesignator(const Expr<SomeType> &expr) {
   // Allocatable sub-objects are not themselves allocatable (9.5.3.1 NOTE 2).
-  if (const semantics::Symbol *
-      sym{UnwrapWholeSymbolOrComponentOrCoarrayRef(expr)}) {
-    return semantics::IsAllocatable(sym->GetUltimate());
+  const semantics::Symbol *sym{UnwrapWholeSymbolOrComponentOrCoarrayRef(expr)};
+  if (!sym) {
+    sym = GetFunctionResult(expr);
   }
-  return false;
+  return sym && semantics::IsAllocatable(sym->GetUltimate());
 }
 
 bool MayBePassedAsAbsentOptional(
     const Expr<SomeType> &expr, FoldingContext &context) {
   const semantics::Symbol *sym{UnwrapWholeSymbolOrComponentDataRef(expr)};
   // 15.5.2.12 1. is pretty clear that an unallocated allocatable/pointer actual
   // may be passed to a non-allocatable/non-pointer optional dummy. Note that
   // other compilers (like nag, nvfortran, ifort, gfortran and xlf) seems to

flang/lib/Semantics/check-call.cpp

static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
   // 15.5.2.6 -- dummy is ALLOCATABLE
   bool actualIsAllocatable{evaluate::IsAllocatableDesignator(actual)};
   if (dummyIsAllocatable) {
     if (!actualIsAllocatable) {
       messages.Say(
           "ALLOCATABLE %s must be associated with an ALLOCATABLE actual argument"_err_en_US,
           dummyName);
     }
+    if (actualIsAllocatable && IsFunctionRef(actual)) {
+      messages.Say(
+          "Function reference associated with ALLOCATABLE %s"_port_en_US,
+          dummyName);
+    }
     if (actualIsAllocatable && actualIsCoindexed &&
         dummy.intent != common::Intent::In) {
       messages.Say(
           "ALLOCATABLE %s must have INTENT(IN) to be associated with a coindexed actual argument"_err_en_US,
           dummyName);
     }
     if (!actualIsCoindexed && actualLastSymbol &&
         actualLastSymbol->Corank() != dummy.type.corank()) {

flang/test/Lower/allocatable-result.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! Test the use of allocatable function results as allocatable arguments.
+
+!CHECK-LABEL: func @_QPtest() {
+subroutine test()
+  integer, allocatable, dimension(:) :: x
+  interface
+    function f(x)
+      integer, allocatable, dimension(:) :: f, x
+    end function
+  end interface
+
+!CHECK:   %[[T0_ADDR:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>>
+!CHECK:   %[[T1_ADDR:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>>
+!CHECK:   %[[X_ADDR:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>>
+!CHECK:   %[[X_ARR_ADDR:.*]] = fir.alloca !fir.heap<!fir.array<?xi32>>
+!CHECK:   %[[X_LB_ADDR:.*]] = fir.alloca index
+!CHECK:   %[[X_EXT_ADDR:.*]] = fir.alloca index
+!CHECK:   %[[ZERO_ARR_HEAP:.*]] = fir.zero_bits !fir.heap<!fir.array<?xi32>>
+!CHECK:   fir.store %[[ZERO_ARR_HEAP]] to %[[X_ARR_ADDR]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+!CHECK:   %[[X_LB:.*]] = fir.load %[[X_LB_ADDR]] : !fir.ref<index>
+!CHECK:   %[[X_EXT:.*]] = fir.load %[[X_EXT_ADDR]] : !fir.ref<index>
+!CHECK:   %[[X_ARR_HEAP:.*]] = fir.load %[[X_ARR_ADDR]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+!CHECK:   %[[X_SHAPE:.*]] = fir.shape_shift %[[X_LB]], %[[X_EXT]] : (index, index) -> !fir.shapeshift<1>
+!CHECK:   %[[X_BOX:.*]] = fir.embox %[[X_ARR_HEAP]](%[[X_SHAPE]]) : (!fir.heap<!fir.array<?xi32>>, !fir.shapeshift<1>) -> !fir.box<!fir.heap<!fir.array<?xi32>>>
+!CHECK:   fir.store %[[X_BOX]] to %[[X_ADDR]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! Call f(x)
+!CHECK:   %[[F0:.*]] = fir.call @_QPf(%[[X_ADDR]]){{.*}} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.box<!fir.heap<!fir.array<?xi32>>>
+!CHECK:   fir.save_result %[[F0]] to %[[T1_ADDR]] : !fir.box<!fir.heap<!fir.array<?xi32>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+!CHECK:   %[[X_BOX:.*]] = fir.load %[[X_ADDR]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+!CHECK:   %[[ZERO:.*]] = arith.constant 0 : index
+!CHECK:   %[[X_DIMS:.*]]:3 = fir.box_dims %[[X_BOX]], %[[ZERO]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>, index) -> (index, index, index)
+!CHECK:   %[[X_ARR_HEAP:.*]] = fir.box_addr %[[X_BOX]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+!CHECK:   fir.store %[[X_ARR_HEAP]] to %[[X_ARR_ADDR]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+!CHECK:   fir.store %[[X_DIMS]]#1 to %[[X_EXT_ADDR]] : !fir.ref<index>
+!CHECK:   fir.store %[[X_DIMS]]#0 to %[[X_LB_ADDR]] : !fir.ref<index>
+! Call f(f(x))
+!CHECK:   %[[F1:.*]] = fir.call @_QPf(%[[T1_ADDR]]){{.*}} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.box<!fir.heap<!fir.array<?xi32>>>
+!CHECK:   fir.save_result %[[F1]] to %[[T0_ADDR]] : !fir.box<!fir.heap<!fir.array<?xi32>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+!CHECK:   %[[T0_BOX:.*]] = fir.load %[[T0_ADDR]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+!CHECK:   %[[ZERO:.*]] = arith.constant 0 : index
+!CHECK:   %[[T0_DIMS:.*]]:3 = fir.box_dims %[[T0_BOX]], %[[ZERO]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>, index) -> (index, index, index)
+!CHECK:   %[[T0_ARR_HEAP:.*]] = fir.box_addr %[[T0_BOX]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+!CHECK:   %[[T0_SHAPE:.*]] = fir.shape_shift %[[T0_DIMS]]#0, %[[T0_DIMS]]#1 : (index, index) -> !fir.shapeshift<1>
+!CHECK:   %[[T0_ARR:.*]] = fir.array_load %[[T0_ARR_HEAP]](%[[T0_SHAPE]]) : (!fir.heap<!fir.array<?xi32>>, !fir.shapeshift<1>) -> !fir.array<?xi32>
+! Check if X is allocated
+!CHECK:   %[[X_ARR_HEAP:.*]] = fir.load %[[X_ARR_ADDR]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+!CHECK:   %[[X_ARR_HEAP_AS_INT:.*]] = fir.convert %[[X_ARR_HEAP]] : (!fir.heap<!fir.array<?xi32>>) -> i64
+!CHECK:   %[[ZERO:.*]] = arith.constant 0 : i64
+!CHECK:   %[[X_ALLOCATED:.*]] = arith.cmpi ne, %[[X_ARR_HEAP_AS_INT]], %[[ZERO]] : i64
+!CHECK:   %[[RES_NOT_X_AND_RES_ARR_HEAP:.*]]:2 = fir.if %[[X_ALLOCATED]] -> (i1, !fir.heap<!fir.array<?xi32>>) {
+! Skip if-else contents, that copies T0 to X or to a new temporary, that
+! later replaces X.
+!CHECK:   }
+! Update X, if needed
+!CHECK:   fir.if %[[RES_NOT_X_AND_RES_ARR_HEAP]]#0 {
+!CHECK:     fir.if %[[X_ALLOCATED]] {
+!CHECK:       fir.freemem %[[X_ARR_HEAP]] : !fir.heap<!fir.array<?xi32>>
+!CHECK:     }
+!CHECK:     fir.store %[[RES_NOT_X_AND_RES_ARR_HEAP]]#1 to %[[X_ARR_ADDR]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+!CHECK:     fir.store %[[T0_DIMS]]#1 to %[[X_EXT_ADDR]] : !fir.ref<index>
+!CHECK:     %[[ONE:.*]] = arith.constant 1 : index
+!CHECK:     fir.store %[[ONE]] to %[[X_LB_ADDR]] : !fir.ref<index>
+!CHECK:   }
+! Deallocate T0
+!CHECK:   %[[T0_BOX:.*]] = fir.load %[[T0_ADDR]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+!CHECK:   %[[T0_ARR_HEAP:.*]] = fir.box_addr %[[T0_BOX]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+!CHECK:   %[[T0_ARR_HEAP_AS_INT:.*]] = fir.convert %[[T0_ARR_HEAP]] : (!fir.heap<!fir.array<?xi32>>) -> i64
+!CHECK:   %[[ZERO:.*]] = arith.constant 0 : i64
+!CHECK:   %[[T0_ARR_HEAP_ALLOCATED:.*]] = arith.cmpi ne, %[[T0_ARR_HEAP_AS_INT]], %[[ZERO]] : i64
+!CHECK:   fir.if %[[T0_ARR_HEAP_ALLOCATED]] {
+!CHECK:     fir.freemem %[[T0_ARR_HEAP]] : !fir.heap<!fir.array<?xi32>>
+!CHECK:   }
+! Deallocate T1
+!CHECK:   %[[T1_BOX:.*]] = fir.load %[[T1_ADDR]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+!CHECK:   %[[T1_ARR_HEAP:.*]] = fir.box_addr %[[T1_BOX]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+!CHECK:   %[[T1_ARR_HEAP_AS_INT:.*]] = fir.convert %[[T1_ARR_HEAP]] : (!fir.heap<!fir.array<?xi32>>) -> i64
+!CHECK:   %[[ZERO:.*]] = arith.constant 0 : i64
+!CHECK:   %[[T1_ARR_HEAP_ALLOCATED:.*]] = arith.cmpi ne, %[[T1_ARR_HEAP_AS_INT]], %[[ZERO]] : i64
+!CHECK:   fir.if %[[T1_ARR_HEAP_ALLOCATED]] {
+!CHECK:     fir.freemem %[[T1_ARR_HEAP]] : !fir.heap<!fir.array<?xi32>>
+!CHECK:   }
+!CHECK:   return
+!CHECK: }
+
+  x = f(f(x))
+end subroutine
+
+!CHECK: func private @_QPf(!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.box<!fir.heap<!fir.array<?xi32>>>

flang/test/Semantics/allocated.f90

subroutine alloc(coarray_alloc, coarray_not_alloc, t2_not_alloc)
   !ERROR: Argument of ALLOCATED() must be an ALLOCATABLE object or component
   print *, allocated(coarray_alloc_array(1:10))
   !ERROR: Argument of ALLOCATED() must be an ALLOCATABLE object or component
   print *, allocated(coarray_alloc_array(1:10)[2,2])
   !ERROR: Argument of ALLOCATED() must be an ALLOCATABLE object or component
   print *, allocated(t2_not_alloc%coarray_alloc_array(1))
   !ERROR: Argument of ALLOCATED() must be an ALLOCATABLE object or component
   print *, allocated(t2_not_alloc%coarray_alloc_array(1)[2])
-  !ERROR: Argument of ALLOCATED() must be an ALLOCATABLE object or component
+  !ERROR: Argument of ALLOCATED() must be an ALLOCATABLE variable
   print *, allocated(return_allocatable())
 end subroutine

flang/test/Semantics/call06.f90

contains
 
   subroutine test(x)
     real :: scalar
     real, allocatable, intent(in) :: x
     !ERROR: ALLOCATABLE dummy argument 'x=' must be associated with an ALLOCATABLE actual argument
     call s01(scalar)
     !ERROR: ALLOCATABLE dummy argument 'x=' must be associated with an ALLOCATABLE actual argument
     call s01(1.)
-    !ERROR: ALLOCATABLE dummy argument 'x=' must be associated with an ALLOCATABLE actual argument
-    call s01(allofunc()) ! subtle: ALLOCATABLE function result isn't
+    !PORTABILITY: Function reference associated with ALLOCATABLE dummy argument 'x='
+    call s01(allofunc())
     call s02(cov) ! ok
     call s03(com) ! ok
     !ERROR: ALLOCATABLE dummy argument 'x=' has corank 1 but actual argument has corank 2
     call s02(com)
     !ERROR: ALLOCATABLE dummy argument 'x=' has corank 2 but actual argument has corank 1
     call s03(cov)
     call s04(cov[1]) ! ok
     !ERROR: ALLOCATABLE dummy argument 'x=' must have INTENT(IN) to be associated with a coindexed actual argument