OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/31630 (ICE on nasty derived types code)

Browse Source 
2007-04-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31630
	* resolve.c (resolve_symbol): Allow resolution of formal
	namespaces nested within formal namespaces coming from modules.

	PR fortran/31620
	* trans-expr.c (gfc_trans_assignment): Make the call to
	gfc_trans_zero_assign conditional on the lhs array ref being
	the only reference.

2007-04-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31630
	* gfortran.dg/used_types_17.f90: New test.

	PR fortran/31620
	* gfortran.dg/zero_array_components_1.f90: New test.

From-SVN: r124069
This commit is contained in:
Paul Thomas 2007-04-23 15:13:48 +00:00
parent a8a423360b
commit 6e0d7c6e0d
6 changed files with 93 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/fortran/ChangeLog
View File

@ -1,3 +1,14 @@
2007-04-23 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31630
* resolve.c (resolve_symbol): Allow resolution of formal
namespaces nested within formal namespaces coming from modules.
PR fortran/31620
* trans-expr.c (gfc_trans_assignment): Make the call to
gfc_trans_zero_assign conditional on the lhs array ref being
the only reference.
2007-04-23 Tobias Burnus <burnus@net-b.de>
* primary.c (match_integer_constant): Mention -fno-range-check

9
gcc/fortran/resolve.c
View File

@ -6339,12 +6339,15 @@ resolve_symbol (gfc_symbol *sym)
formal_arg_flag = 0;
/* Resolve formal namespaces. */
/* Resolve formal namespaces. The symbols in formal namespaces that
themselves are from procedures in formal namespaces will not stand
resolution, except when they are use associated.
TODO: Fix the symbols in formal namespaces so that resolution can
be done unconditionally. */
if (formal_ns_flag && sym != NULL && sym->formal_ns != NULL)
{
formal_ns_save = formal_ns_flag;
formal_ns_flag = 0;
formal_ns_flag = sym->attr.use_assoc ? 1 : 0;
gfc_resolve (sym->formal_ns);
formal_ns_flag = formal_ns_save;
}

1
gcc/fortran/trans-expr.c
View File

@ -3943,6 +3943,7 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
if (expr1->expr_type == EXPR_VARIABLE
&& expr1->rank > 0
&& expr1->ref
&& expr1->ref->next == NULL
&& gfc_full_array_ref_p (expr1->ref)
&& is_zero_initializer_p (expr2))
{

8
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,11 @@
2007-04-23 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31630
* gfortran.dg/used_types_17.f90: New test.
PR fortran/31620
* gfortran.dg/zero_array_components_1.f90: New test.
2007-04-23 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
PR fortran/31616

50
gcc/testsuite/gfortran.dg/used_types_17.f90 Normal file
View File

@ -0,0 +1,50 @@
! { dg do-compile }
! Tests the fix for PR31630, in which the association of the argument
! of 'cmp' did not work.
!
! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
!
module box_module
type box
integer :: m = 0
end type box
end module box_module
module sort_box_module
contains
subroutine heapsort_box(cmp)
interface
subroutine cmp(a)
use box_module
type(box) :: a
end subroutine cmp
end interface
optional :: cmp
end subroutine heapsort_box
end module sort_box_module
module boxarray_module
use box_module
implicit none
type boxarray
type(box), allocatable :: bxs(:)
end type boxarray
contains
subroutine boxarray_build_l(ba)
type(boxarray) :: ba
allocate(ba%bxs(1))
end subroutine boxarray_build_l
subroutine boxarray_sort()
use sort_box_module
call heapsort_box
end subroutine boxarray_sort
end module boxarray_module
! { dg-final { cleanup-modules "box_module sort_box_module boxarray_module" } }

17
gcc/testsuite/gfortran.dg/zero_array_components_1.f90 Normal file
View File

@ -0,0 +1,17 @@
! { dg do-run }
! Tests the fix for PR31620, in which zeroing the component a for the array,
! would zero all the components of the array.
!
! David Ham <David@ham.dropbear.id.au>
!
program test_assign
type my_type
integer :: a
integer :: b
end type my_type
type(my_type), dimension(1) :: mine ! note that MINE is an array
mine%b=4
mine%a=1
mine%a=0
if (any (mine%b .ne. 4)) call abort ()
end program test_assign