Commit d8df7c40 by Thomas Koenig

Revert r10-7920-g06eca1ac .

2020-04-27  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/93956
	PR fortran/94788
	* expr.c (gfc_check_pointer_assign): Revert patch for PR 93956.
	* interface.c: Likewise.

2020-04-27  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/93956
	PR fortran/94788
	* gfortran.dg/pointer_assign_13.f90: Remove.
parent 6dffa67b
2020-04-27 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/93956
PR fortran/94788
* expr.c (gfc_check_pointer_assign): Revert patch for PR 93956.
* interface.c: Likewise.
2020-04-25 Thomas Koenig <tkoenig@gcc.gnu.org> 2020-04-25 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/94578 PR fortran/94578
......
...@@ -4242,11 +4242,8 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue, ...@@ -4242,11 +4242,8 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
if (rvalue->expr_type == EXPR_NULL) if (rvalue->expr_type == EXPR_NULL)
return true; return true;
/* A function may also return subref arrray pointer. */ if (rvalue->expr_type == EXPR_VARIABLE && is_subref_array (rvalue))
lvalue->symtree->n.sym->attr.subref_array_pointer = 1;
if ((rvalue->expr_type == EXPR_VARIABLE && is_subref_array (rvalue))
|| rvalue->expr_type == EXPR_FUNCTION)
lvalue->symtree->n.sym->attr.subref_array_pointer = 1;
attr = gfc_expr_attr (rvalue); attr = gfc_expr_attr (rvalue);
......
...@@ -3788,36 +3788,6 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a) ...@@ -3788,36 +3788,6 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a)
return true; return true;
} }
/* Go through the argument list of a procedure and look for
pointers which may be set, possibly introducing a span. */
static void
gfc_set_subref_array_pointer_arg (gfc_formal_arglist *dummy_args,
gfc_actual_arglist *actual_args)
{
gfc_formal_arglist *f;
gfc_actual_arglist *a;
gfc_symbol *a_sym;
for (f = dummy_args, a = actual_args; f && a ; f = f->next, a = a->next)
{
if (f->sym == NULL)
continue;
if (!f->sym->attr.pointer || f->sym->attr.intent == INTENT_IN)
continue;
if (a->expr == NULL || a->expr->expr_type != EXPR_VARIABLE)
continue;
a_sym = a->expr->symtree->n.sym;
if (!a_sym->attr.pointer)
continue;
a_sym->attr.subref_array_pointer = 1;
}
return;
}
/* Check how a procedure is used against its interface. If all goes /* Check how a procedure is used against its interface. If all goes
well, the actual argument list will also end up being properly well, the actual argument list will also end up being properly
...@@ -3998,10 +3968,6 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where) ...@@ -3998,10 +3968,6 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
if (warn_aliasing) if (warn_aliasing)
check_some_aliasing (dummy_args, *ap); check_some_aliasing (dummy_args, *ap);
/* Set the subref_array_pointer_arg if needed. */
if (dummy_args)
gfc_set_subref_array_pointer_arg (dummy_args, *ap);
return true; return true;
} }
......
2020-04-27 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/93956
PR fortran/94788
* gfortran.dg/pointer_assign_13.f90: Remove.
2020-04-27 Jakub Jelinek <jakub@redhat.com> 2020-04-27 Jakub Jelinek <jakub@redhat.com>
PR target/94780 PR target/94780
......
! { dg-do run }
! PR 93956 - span was set incorrectly, leading to wrong code.
! Original test case by "martin".
program array_temps
implicit none
type :: tt
integer :: u = 1
integer :: v = 2
end type tt
type(tt), dimension(:), pointer :: r
integer :: n
integer, dimension(:), pointer :: p, q, u
n = 10
allocate(r(1:n))
call foo(r%v,n)
p => get(r(:))
call foo(p, n)
call get2(r,u)
call foo(u,n)
q => r%v
call foo(q, n)
deallocate(r)
contains
subroutine foo(a, n)
integer, dimension(:), intent(in) :: a
integer, intent(in) :: n
if (sum(a(1:n)) /= 2*n) stop 1
end subroutine foo
function get(x) result(q)
type(tt), dimension(:), target, intent(in) :: x
integer, dimension(:), pointer :: q
q => x(:)%v
end function get
subroutine get2(x,q)
type(tt), dimension(:), target, intent(in) :: x
integer, dimension(:), pointer, intent(out) :: q
q => x(:)%v
end subroutine get2
end program array_temps
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment