mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-26 09:50:40 +08:00
Code Issues Packages Projects Releases Wiki Activity

Revert r10-7920-g06eca1acafa27e19e82dc73927394a7a4d0bdbc5 .

Browse Source 
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.
This commit is contained in:
Thomas Koenig 2020-04-27 23:49:36 +02:00
parent 6dffa67b46
commit d8df7c404e
5 changed files with 15 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View File

@ -1,3 +1,10 @@
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>
PR fortran/94578

7
gcc/fortran/expr.c
View File

@ -4242,11 +4242,8 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
if (rvalue->expr_type == EXPR_NULL)
return true;
/* A function may also return subref arrray pointer. */
if ((rvalue->expr_type == EXPR_VARIABLE && is_subref_array (rvalue))
|| rvalue->expr_type == EXPR_FUNCTION)
lvalue->symtree->n.sym->attr.subref_array_pointer = 1;
if (rvalue->expr_type == EXPR_VARIABLE && is_subref_array (rvalue))
lvalue->symtree->n.sym->attr.subref_array_pointer = 1;
attr = gfc_expr_attr (rvalue);

34
gcc/fortran/interface.c
View File

@ -3788,36 +3788,6 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a)
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
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)
if (warn_aliasing)
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;
}

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
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>
PR target/94780

47
gcc/testsuite/gfortran.dg/pointer_assign_13.f90
View File

@ -1,47 +0,0 @@
! { 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