https://gcc.gnu.org/bugzilla/show_bug.cgi?id=109948
Paul Thomas <pault at gcc dot gnu.org> changed:
What |Removed |Added
----------------------------------------------------------------------------
Blocks| |87477
--- Comment #8 from Paul Thomas <pault at gcc dot gnu.org> ---
I have flagged that this PR blocks PR87477.
Guarding ref->u.ar.as is good practice. However, it turns out that the
associate name symbol has a perfectly good array_spec. This version "double
fixes" the PR and is somewhat more satisfactory.
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 83e45f1b693..9863cdc1583 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -5640,7 +5640,12 @@ gfc_expression_rank (gfc_expr *e)
if (ref->type != REF_ARRAY)
continue;
- if (ref->u.ar.type == AR_FULL)
+ if (ref->u.ar.as == NULL
+ && e->expr_type == EXPR_VARIABLE
+ && e->symtree->n.sym->as)
+ ref->u.ar.as = e->symtree->n.sym->as;
+
+ if (ref->u.ar.type == AR_FULL && ref->u.ar.as)
{
rank = ref->u.ar.as->rank;
break;
Gratifyingly, this does the right thing:
implicit none
type tlap
real, allocatable :: z(:)
end type tlap
type(tlap) :: y_in
real :: x_out(3) =[0.0,0.0,0.0]
integer :: pid = 1
y_in%z = [1.0,-2.0,3.0]
call foo(y_in, x_out)
print *, x_out
call foo(y_in, x_out)
print *, x_out
contains
subroutine foo(y, x)
type(tlap) :: y
real :: x(:)
associate(z=>y%z)
if (getpid() == 1) then
where ( z < 0.0 ) x(:) = z(:)
else
where ( z > 0.0 ) x(:) = z(:)
endif
end associate
end subroutine foo
integer function getpid()
getpid = pid
pid = pid + 1
end function getpid
end
Cheers
Paul
Referenced Bugs:
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=87477
[Bug 87477] [meta-bug] [F03] issues concerning the ASSOCIATE statement
