From: Daniel Kraft <d@domob.eu>
Date: Mon, 8 Sep 2008 09:17:27 +0000 (+0200)
Subject: re PR fortran/37199 (array assignment from function writes out of bounds)
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=0a991dec381afa2561e106e5f1b0f9d0973bc3e8;p=platform%2Fupstream%2Fgcc.git

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
--- 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
--- 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
--- 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
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