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

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f80f6a0..39b68d8 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index d253976..216b3df 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -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:

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index af93d15..ec3132f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/array_function_2.f90 b/gcc/testsuite/gfortran.dg/array_function_2.f90
new file mode 100644 (file)
index 0000000..a937411
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_function_2.f90
@@ -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