Skip to content

Commit

Permalink
Fortran: function results never have the ALLOCATABLE attribute [PR109…
Browse files Browse the repository at this point in the history
…500]

Fortran 2018 8.5.3 (ALLOCATABLE attribute) explains in Note 1 that the
result of referencing a function whose result variable has the ALLOCATABLE
attribute is a value that does not itself have the ALLOCATABLE attribute.

gcc/fortran/ChangeLog:

	PR fortran/109500
	* interface.cc (gfc_compare_actual_formal): Reject allocatable
	functions being used as actual argument for allocable dummy.

gcc/testsuite/ChangeLog:

	PR fortran/109500
	* gfortran.dg/allocatable_function_11.f90: New test.

Co-authored-by: Steven G. Kargl <kargl@gcc.gnu.org>
  • Loading branch information
2 people authored and ouuleilei-bot committed Apr 20, 2023
1 parent afc7e20 commit 7f56c10
Show file tree
Hide file tree
Showing 2 changed files with 48 additions and 0 deletions.
12 changes: 12 additions & 0 deletions gcc/fortran/interface.cc
Original file line number Diff line number Diff line change
Expand Up @@ -3638,6 +3638,18 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
goto match;
}

if (a->expr->expr_type == EXPR_FUNCTION
&& a->expr->value.function.esym
&& f->sym->attr.allocatable)
{
if (where)
gfc_error ("Actual argument for %qs at %L is a function result "
"and the dummy argument is ALLOCATABLE",
f->sym->name, &a->expr->where);
ok = false;
goto match;
}

/* Check intent = OUT/INOUT for definable actual argument. */
if (!in_statement_function
&& (f->sym->attr.intent == INTENT_OUT
Expand Down
36 changes: 36 additions & 0 deletions gcc/testsuite/gfortran.dg/allocatable_function_11.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,36 @@
! { dg-do compile }
! PR fortran/109500 - check F2018:8.5.3 Note 1
!
! The result of referencing a function whose result variable has the
! ALLOCATABLE attribute is a value that does not itself have the
! ALLOCATABLE attribute.

program main
implicit none
integer, allocatable :: p
procedure(f), pointer :: pp
pp => f
p = f()
print *, allocated (p)
print *, is_allocated (p)
print *, is_allocated (f()) ! { dg-error "is a function result" }
print *, is_allocated (pp()) ! { dg-error "is a function result" }
call s (p)
call s (f()) ! { dg-error "is a function result" }
call s (pp()) ! { dg-error "is a function result" }

contains
subroutine s(p)
integer, allocatable :: p
end subroutine s

function f()
integer, allocatable :: f
allocate (f, source=42)
end function

logical function is_allocated(p)
integer, allocatable :: p
is_allocated = allocated(p)
end function
end program

0 comments on commit 7f56c10

Please sign in to comment.