diff mbox series

[Fortran] PR67125 - ALLOCATE with source-expr lbounds/ubound off by one

Message ID 20181012112854.GA11980@physik.fu-berlin.de
State New
Headers show
Series [Fortran] PR67125 - ALLOCATE with source-expr lbounds/ubound off by one | expand

Commit Message

Tobias Burnus Oct. 12, 2018, 11:28 a.m. UTC 
Hello all,

"When an ALLOCATE statement is executed for an array with no
 allocate-shape-spec-list, the bounds of source-expr determine
 the bounds of the array." (F2018, 9.7.1.2 (6))

That seems to work fine for arrays which have an array descriptor.
However, as the current code shows, it fails for array constructors
where the lbound is zero instead of the expected one.

It turns out (PR67125) that functions results which don't use array
descriptors have the same problem as do stack/static allocated
array variables (PR87580).

I am not sure that my check for array descriptors is the best but
it seems to work and fixes the problem.

OK for the trunk?
Build and regtested on x86-64-linux.

Tobias

Comments

Paul Richard Thomas Oct. 16, 2018, 8:57 a.m. UTC | #1 
Hi Tobias,

Your patch is OK for trunk and, I would suggest 8-branch.

As a matter of curiosity, why did you not use the condition:
if (!(expr3_desc && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr3_desc)))  ?

Your solution is fine, though.

Cheers

Paul

On Fri, 12 Oct 2018 at 12:29, Tobias Burnus
<tobias.burnus@physik.fu-berlin.de> wrote:
>
> Hello all,
>
> "When an ALLOCATE statement is executed for an array with no
>  allocate-shape-spec-list, the bounds of source-expr determine
>  the bounds of the array." (F2018, 9.7.1.2 (6))
>
> That seems to work fine for arrays which have an array descriptor.
> However, as the current code shows, it fails for array constructors
> where the lbound is zero instead of the expected one.
>
> It turns out (PR67125) that functions results which don't use array
> descriptors have the same problem as do stack/static allocated
> array variables (PR87580).
>
> I am not sure that my check for array descriptors is the best but
> it seems to work and fixes the problem.
>
> OK for the trunk?
> Build and regtested on x86-64-linux.
>
> Tobias
Tobias Burnus Oct. 16, 2018, 9:09 p.m. UTC | #2 
Hi Paul,

thanks for the review; committed as Rev. 265212.

Using your check in gfc_array_allocate won't work as already early in 
gfc_trans_allocate everything is converted to a descriptor – likewise, 
checking "expr3" wouldn't work either.

I was pondering whether to check it elsewhere in gfc_trans_allocate, but 
I think it wouldn't be straight forward either and, hence, I left it as is.

After looking at the current code of the function, I decided to check 
CLASS – and decided to add those additional experiments to the test case 
– see attachment (committed as Rev. 265215).


Tobias

Paul Richard Thomas wrote:
> Hi Tobias,
>
> Your patch is OK for trunk and, I would suggest 8-branch.
>
> As a matter of curiosity, why did you not use the condition:
> if (!(expr3_desc && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr3_desc)))  ?
>
> Your solution is fine, though.
>
> Cheers
>
> Paul
>
> On Fri, 12 Oct 2018 at 12:29, Tobias Burnus
> <tobias.burnus@physik.fu-berlin.de> wrote:
>> Hello all,
>>
>> "When an ALLOCATE statement is executed for an array with no
>>   allocate-shape-spec-list, the bounds of source-expr determine
>>   the bounds of the array." (F2018, 9.7.1.2 (6))
>>
>> That seems to work fine for arrays which have an array descriptor.
>> However, as the current code shows, it fails for array constructors
>> where the lbound is zero instead of the expected one.
>>
>> It turns out (PR67125) that functions results which don't use array
>> descriptors have the same problem as do stack/static allocated
>> array variables (PR87580).
>>
>> I am not sure that my check for array descriptors is the best but
>> it seems to work and fixes the problem.
>>
>> OK for the trunk?
>> Build and regtested on x86-64-linux.
>>
>> Tobias
>
>
diff mbox series

Patch

2018-10-12  Tobias Burnus  <burnus@net-b.de>


	PR fortran/67125
	* trans-array.c (gfc_array_init_size, gfc_array_allocate):
	Rename argument e3_is_array_constr to e3_has_nodescriptor
	and update comments.
	* trans-stmt.c (gfc_trans_allocate): Also fix lower bound
	to 1 for nonalloc/nonpointer func results/vars besides
	array constructors.

	PR fortran/67125
	* gfortran.dg/allocate_with_source_26.f90: New.

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index c4df4ebbc40..ea4cf8cd1b8 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5333,7 +5333,7 @@  gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
 		     gfc_expr ** lower, gfc_expr ** upper, stmtblock_t * pblock,
 		     stmtblock_t * descriptor_block, tree * overflow,
 		     tree expr3_elem_size, tree *nelems, gfc_expr *expr3,
-		     tree expr3_desc, bool e3_is_array_constr, gfc_expr *expr)
+		     tree expr3_desc, bool e3_has_nodescriptor, gfc_expr *expr)
 {
   tree type;
   tree tmp;
@@ -5412,10 +5412,11 @@  gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
       gfc_init_se (&se, NULL);
       if (expr3_desc != NULL_TREE)
 	{
-	  if (e3_is_array_constr)
-	    /* The lbound of a constant array [] starts at zero, but when
-	       allocating it, the standard expects the array to start at
-	       one.  */
+	  if (e3_has_nodescriptor)
+	    /* The lbound of nondescriptor arrays like array constructors,
+	       nonallocatable/nonpointer function results/variables,
+	       start at zero, but when allocating it, the standard expects
+	       the array to start at one.  */
 	    se.expr = gfc_index_one_node;
 	  else
 	    se.expr = gfc_conv_descriptor_lbound_get (expr3_desc,
@@ -5451,12 +5452,13 @@  gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
       gfc_init_se (&se, NULL);
       if (expr3_desc != NULL_TREE)
 	{
-	  if (e3_is_array_constr)
+	  if (e3_has_nodescriptor)
 	    {
-	      /* The lbound of a constant array [] starts at zero, but when
-	       allocating it, the standard expects the array to start at
-	       one.  Therefore fix the upper bound to be
-	       (desc.ubound - desc.lbound)+ 1.  */
+	      /* The lbound of nondescriptor arrays like array constructors,
+		 nonallocatable/nonpointer function results/variables,
+		 start at zero, but when allocating it, the standard expects
+		 the array to start at one.  Therefore fix the upper bound to be
+		 (desc.ubound - desc.lbound) + 1.  */
 	      tmp = fold_build2_loc (input_location, MINUS_EXPR,
 				     gfc_array_index_type,
 				     gfc_conv_descriptor_ubound_get (
@@ -5684,7 +5686,7 @@  bool
 gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
 		    tree errlen, tree label_finish, tree expr3_elem_size,
 		    tree *nelems, gfc_expr *expr3, tree e3_arr_desc,
-		    bool e3_is_array_constr)
+		    bool e3_has_nodescriptor)
 {
   tree tmp;
   tree pointer;
@@ -5813,7 +5815,7 @@  gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
 			      &offset, lower, upper,
 			      &se->pre, &set_descriptor_block, &overflow,
 			      expr3_elem_size, nelems, expr3, e3_arr_desc,
-			      e3_is_array_constr, expr);
+			      e3_has_nodescriptor, expr);
 
   if (dimension)
     {
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 6256e3fa805..52f7e8bdc5c 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5784,6 +5784,7 @@  gfc_trans_allocate (gfc_code * code)
   tree nelems;
   bool upoly_expr, tmp_expr3_len_flag = false, al_len_needs_set, is_coarray;
   bool needs_caf_sync, caf_refs_comp;
+  bool e3_has_nodescriptor = false;
   gfc_symtree *newsym = NULL;
   symbol_attribute caf_attr;
   gfc_actual_arglist *param_list;
@@ -6219,6 +6220,17 @@  gfc_trans_allocate (gfc_code * code)
 	}
       else
 	e3rhs = gfc_copy_expr (code->expr3);
+
+      // We need to propagate the bounds of the expr3 for source=/mold=;
+      // however, for nondescriptor arrays, we use internally a lower bound
+      // of zero instead of one, which needs to be corrected for the allocate obj
+      if (e3_is == E3_DESC)
+	{
+	  symbol_attribute attr = gfc_expr_attr (code->expr3);
+	  if (code->expr3->expr_type == EXPR_ARRAY ||
+	      (!attr.allocatable && !attr.pointer))
+	    e3_has_nodescriptor = true;
+	}
     }
 
   /* Loop over all objects to allocate.  */
@@ -6302,12 +6314,12 @@  gfc_trans_allocate (gfc_code * code)
 	}
       else
 	tmp = expr3_esize;
+
       if (!gfc_array_allocate (&se, expr, stat, errmsg, errlen,
 			       label_finish, tmp, &nelems,
 			       e3rhs ? e3rhs : code->expr3,
 			       e3_is == E3_DESC ? expr3 : NULL_TREE,
-			       code->expr3 != NULL && e3_is == E3_DESC
-			       && code->expr3->expr_type == EXPR_ARRAY))
+			       e3_has_nodescriptor))
 	{
 	  /* A scalar or derived type.  First compute the size to
 	     allocate.
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_26.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_26.f90
new file mode 100644
index 00000000000..38127c06bc0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_26.f90
@@ -0,0 +1,58 @@ 
+! { dg-do run }
+!
+! Ensure that the lower bound starts with the correct
+! value
+!
+! PR fortran/87580
+! PR fortran/67125
+!
+! Contributed by Antony Lewis and mrestelli
+!
+program p
+ implicit none
+ integer, allocatable :: a(:), b(:), c(:), d(:), e(:)
+ integer :: vec(6)
+
+ vec = [1,2,3,4,5,6]
+
+ allocate(a, source=f(3))
+ allocate(b, source=g(3))
+ allocate(c, source=h(3))
+ allocate(d, source=[1,2,3,4,5])
+ allocate(e, source=vec)
+
+ !write(*,*) lbound(a,1), ubound(a,1) ! prints 1 3
+ !write(*,*) lbound(b,1), ubound(b,1) ! prints 1 3
+ !write(*,*) lbound(c,1), ubound(c,1) ! prints 3 5
+ !write(*,*) lbound(d,1), ubound(d,1) ! prints 1 5
+ !write(*,*) lbound(e,1), ubound(e,1) ! prints 1 6
+
+ if (lbound(a,1) /= 1 .or. ubound(a,1) /= 3 &
+     .or. lbound(b,1) /= 1 .or. ubound(b,1) /= 3 &
+     .or. lbound(c,1) /= 3 .or. ubound(c,1) /= 5 &
+     .or. lbound(d,1) /= 1 .or. ubound(d,1) /= 5 &
+     .or. lbound(e,1) /= 1 .or. ubound(e,1) /= 6) then
+   call abort()
+ endif
+   
+contains
+
+ pure function f(i)
+  integer, intent(in) :: i
+  integer :: f(i)
+   f = 2*i
+ end function f
+
+ pure function g(i) result(r)
+  integer, value, intent(in) :: i
+  integer, allocatable :: r(:)
+  r = [1,2,3]
+ end function g
+
+ pure function h(i) result(r)
+  integer, value, intent(in) :: i
+  integer, allocatable :: r(:)
+  allocate(r(3:5))
+  r = [1,2,3]
+ end function h
+end program p