mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-10 21:41:14 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/37199 (array assignment from function writes out of bounds)

Browse Source 
2008-09-08  Daniel Kraft  <d@domob.eu>

	PR fortran/37199
	* trans-expr.c (gfc_add_interface_mapping): Set new_sym->as.
	(gfc_map_intrinsic_function): Added checks against NULL bounds in
	array specs.

2008-09-08  Daniel Kraft  <d@domob.eu>

	PR fortran/37199
	* gfortran.dg/array_function_2.f90: New test.

From-SVN: r140102
This commit is contained in:
Daniel Kraft 2008-09-08 11:17:27 +02:00 committed by Daniel Kraft
parent 10c17e8fd0
commit 0a991dec38
4 changed files with 61 additions and 4 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 @@
2008-09-08 Daniel Kraft <d@domob.eu>
PR fortran/37199
* trans-expr.c (gfc_add_interface_mapping): Set new_sym->as.
(gfc_map_intrinsic_function): Added checks against NULL bounds in
array specs.
2008-09-08 Tobias Burnus <burnus@net.b.de>
PR fortran/37400

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

@ -1618,6 +1618,7 @@ gfc_add_interface_mapping (gfc_interface_mapping * mapping,
/* Create a new symbol to represent the actual argument. */
new_sym = gfc_new_symbol (sym->name, NULL);
new_sym->ts = sym->ts;
new_sym->as = gfc_copy_array_spec (sym->as);
new_sym->attr.referenced = 1;
new_sym->attr.dimension = sym->attr.dimension;
new_sym->attr.pointer = sym->attr.pointer;
@ -1798,8 +1799,9 @@ gfc_apply_interface_mapping_to_ref (gfc_interface_mapping * mapping,
/* Convert intrinsic function calls into result expressions. */
static bool
gfc_map_intrinsic_function (gfc_expr *expr, gfc_interface_mapping * mapping)
gfc_map_intrinsic_function (gfc_expr *expr, gfc_interface_mapping *mapping)
{
gfc_symbol *sym;
gfc_expr *new_expr;
@ -1813,7 +1815,7 @@ gfc_map_intrinsic_function (gfc_expr *expr, gfc_interface_mapping * mapping)
else
arg2 = NULL;
sym = arg1->symtree->n.sym;
sym = arg1->symtree->n.sym;
if (sym->attr.dummy)
return false;
@ -1850,6 +1852,13 @@ gfc_map_intrinsic_function (gfc_expr *expr, gfc_interface_mapping * mapping)
for (; d < dup; d++)
{
gfc_expr *tmp;
if (!sym->as->upper[d] || !sym->as->lower[d])
{
gfc_free_expr (new_expr);
return false;
}
tmp = gfc_add (gfc_copy_expr (sym->as->upper[d]), gfc_int_expr (1));
tmp = gfc_subtract (tmp, gfc_copy_expr (sym->as->lower[d]));
if (new_expr)
@ -1875,9 +1884,15 @@ gfc_map_intrinsic_function (gfc_expr *expr, gfc_interface_mapping * mapping)
gcc_unreachable ();
if (expr->value.function.isym->id == GFC_ISYM_LBOUND)
new_expr = gfc_copy_expr (sym->as->lower[d]);
{
if (sym->as->lower[d])
new_expr = gfc_copy_expr (sym->as->lower[d]);
}
else
new_expr = gfc_copy_expr (sym->as->upper[d]);
{
if (sym->as->upper[d])
new_expr = gfc_copy_expr (sym->as->upper[d]);
}
break;
default:

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2008-09-08 Daniel Kraft <d@domob.eu>
PR fortran/37199
* gfortran.dg/array_function_2.f90: New test.
2008-09-08 Tobias Burnus <burnus@net.b.de>
PR fortran/37400

30
gcc/testsuite/gfortran.dg/array_function_2.f90 Normal file
View File

@ -0,0 +1,30 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
! PR fortran/37199
! We used to produce wrong (segfaulting) code for this one because the
! temporary array for the function result had wrong bounds.
! Contributed by Gavin Salam <salam@lpthe.jussieu.fr>
program bounds_issue
implicit none
integer, parameter :: dp = kind(1.0d0)
real(dp), pointer :: pdf0(:,:), dpdf(:,:)
allocate(pdf0(0:282,-6:7))
allocate(dpdf(0:282,-6:7)) ! with dpdf(0:283,-6:7) [illegal] error disappears
!write(0,*) lbound(dpdf), ubound(dpdf)
dpdf = tmp_PConv(pdf0)
contains
function tmp_PConv(q_in) result(Pxq)
real(dp), intent(in) :: q_in(0:,-6:)
real(dp) :: Pxq(0:ubound(q_in,dim=1),-6:7)
Pxq = 0d0
!write(0,*) lbound(q_in), ubound(q_in)
!write(0,*) lbound(Pxq), ubound(Pxq)
return
end function tmp_PConv
end program bounds_issue