public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [PATCH, Fortran] Fix setting of array lower bound for named arrays
@ 2021-11-29 14:25 Chung-Lin Tang
  2021-11-29 20:21 ` Harald Anlauf
  0 siblings, 1 reply; 8+ messages in thread
From: Chung-Lin Tang @ 2021-11-29 14:25 UTC (permalink / raw)
  To: Fortran List, gcc-patches; +Cc: Tobias Burnus, Catherine Moore

[-- Attachment #1: Type: text/plain, Size: 1654 bytes --]

This patch by Tobias, fixes a case of setting array low-bounds, found
for particular uses of SOURCE=/MOLD=.

For example:
program A_M
   implicit none
   real, dimension (:), allocatable :: A, B
   allocate (A(0:5))
   call Init (A)
contains
   subroutine Init ( A )
     real, dimension ( 0 : ), intent ( in ) :: A
     integer, dimension ( 1 ) :: lb_B

     allocate (B, mold = A)
     ...
     lb_B = lbound (B, dim=1)   ! Error: lb_B assigned 1, instead of 0 like lower-bound of A.

Referencing the Fortran standard:

"16.9.109 LBOUND (ARRAY [, DIM, KIND])"
states:
"If DIM is present, ARRAY is a whole array, and either ARRAY is
  an assumed-size array of rank DIM or dimension DIM of ARRAY has
  nonzero extent, the result has a value equal to the lower bound
  for subscript DIM of ARRAY. Otherwise, if DIM is present, the
  result value is 1."

And on what is a "whole array":

"9.5.2 Whole arrays"
"A whole array is a named array or a structure component ..."

The attached patch adjusts the relevant part in gfc_trans_allocate() to only set
e3_has_nodescriptor only for non-named arrays.

Tobias has tested this once, and I've tested this patch as well on our complete set of
testsuites (which usually serves for OpenMP related stuff). Everything appears well with no regressions.

Is this okay for trunk?

Thanks,
Chung-Lin

2021-11-29  Tobias Burnus  <tobias@codesourcery.com>

gcc/fortran/ChangeLog:

	* trans-stmt.c (gfc_trans_allocate): Set e3_has_nodescriptor to true
	only for non-named arrays.

gcc/testsuite/ChangeLog:

	* gfortran.dg/allocate_with_source_26.f90: Adjust testcase.
	* gfortran.dg/allocate_with_mold_4.f90: New testcase.

[-- Attachment #2: fortran-named-arrays-lbound.patch --]
[-- Type: text/plain, Size: 3625 bytes --]

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index bdf7957..982e1e0 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -6660,16 +6660,13 @@ 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;
-	}
+      // We need to propagate the bounds of the expr3 for source=/mold=.
+      // However, for non-named arrays, the lbound has to be 1 and neither the
+      // bound used inside the called function even when returning an
+      // allocatable/pointer nor the zero used internally.
+      if (e3_is == E3_DESC
+	  && code->expr3->expr_type != EXPR_VARIABLE)
+	e3_has_nodescriptor = true;
     }
 
   /* Loop over all objects to allocate.  */
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_mold_4.f90 b/gcc/testsuite/gfortran.dg/allocate_with_mold_4.f90
new file mode 100644
index 0000000..d545fe1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_mold_4.f90
@@ -0,0 +1,24 @@
+program A_M
+  implicit none
+  real, parameter :: C(5:10) = 5.0
+  real, dimension (:), allocatable :: A, B
+  allocate (A(6))
+  call Init (A)
+contains
+  subroutine Init ( A )
+    real, dimension ( -1 : ), intent ( in ) :: A
+    integer, dimension ( 1 ) :: lb_B
+
+    allocate (B, mold = A)
+    if (any (lbound (B) /= lbound (A))) stop 1
+    if (any (ubound (B) /= ubound (A))) stop 2
+    if (any (shape (B) /= shape (A))) stop 3
+    if (size (B) /= size (A)) stop 4
+    deallocate (B)
+    allocate (B, mold = C)
+    if (any (lbound (B) /= lbound (C))) stop 5
+    if (any (ubound (B) /= ubound (C))) stop 6
+    if (any (shape (B) /= shape (C))) stop 7
+    if (size (B) /= size (C)) stop 8
+end
+end 
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_26.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_26.f90
index 28f24fc..323c8a3 100644
--- a/gcc/testsuite/gfortran.dg/allocate_with_source_26.f90
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_26.f90
@@ -34,23 +34,23 @@ program p
  if (lbound(p1, 1) /= 3 .or. ubound(p1, 1) /= 4 &
      .or. lbound(p2, 1) /= 3 .or. ubound(p2, 1) /= 4 &
      .or. lbound(p3, 1) /= 1 .or. ubound(p3, 1) /= 2 &
-     .or. lbound(p4, 1) /= 7 .or. ubound(p4, 1) /= 8 &
+     .or. lbound(p4, 1) /= 1 .or. ubound(p4, 1) /= 2 &
      .or. p1(3)%i /= 43 .or. p1(4)%i /= 56 &
      .or. p2(3)%i /= 43 .or. p2(4)%i /= 56 &
      .or. p3(1)%i /= 43 .or. p3(2)%i /= 56 &
-     .or. p4(7)%i /= 11 .or. p4(8)%i /= 12) then
+     .or. p4(1)%i /= 11 .or. p4(2)%i /= 12) then
    call abort()
  endif
 
  !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(c,1), ubound(c,1) ! prints 1 3
  !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(c,1) /= 1 .or. ubound(c,1) /= 3 & 
      .or. lbound(d,1) /= 1 .or. ubound(d,1) /= 5 &
      .or. lbound(e,1) /= 1 .or. ubound(e,1) /= 6) then
    call abort()

^ permalink raw reply	[flat|nested] 8+ messages in thread

end of thread, other threads:[~2021-11-30 20:01 UTC | newest]

Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-11-29 14:25 [PATCH, Fortran] Fix setting of array lower bound for named arrays Chung-Lin Tang
2021-11-29 20:21 ` Harald Anlauf
2021-11-29 20:21   ` Harald Anlauf
2021-11-29 20:56   ` Tobias Burnus
2021-11-29 21:11     ` Harald Anlauf
2021-11-30 17:24       ` Tobias Burnus
2021-11-30 19:54         ` Harald Anlauf
2021-11-30 20:01           ` Toon Moene

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).