[v2] Fix fortran/PR114024

Message ID 204319dc-e3ce-47f3-9a95-676f03649aad@gmx.de
State New
Headers
Series [v2] Fix fortran/PR114024 |

Checks

Context Check Description
linaro-tcwg-bot/tcwg_gcc_build--master-arm success Testing passed
linaro-tcwg-bot/tcwg_gcc_build--master-aarch64 fail Patch failed to apply
linaro-tcwg-bot/tcwg_gcc_check--master-arm fail Patch failed to apply

Commit Message

Harald Anlauf Feb. 23, 2024, 9:15 p.m. UTC
  Hi Steve, all,

here's an updated patch with an enhanced testcase that also
checks MOLD= besides SOURCE=.

Regtested on x86_64-pc-linux-gnu.  Is it OK for mainline?

Cheers,
Harald

On 2/22/24 22:32, Harald Anlauf wrote:
> On 2/22/24 22:01, Steve Kargl wrote:
>> BTW, my patch and I suspect your improved patch also
>> fixes 'allocate(x,mold=z%re)'.  Consider,
>>
>>     complex z(3)
>>     real, allocatable :: x(:)
>>     z = 42ha
>>     allocate(x, mold=z%re)
>>     print *, size(x)
>>     end
>>
>> % gfortran13 -o z a.f90
>> a.f90:9:25:
>>
>>      9 |    allocate(x, mold=z%re)
>>        |                         1
>> internal compiler error: in retrieve_last_ref, at
>> fortran/trans-array.cc:6070
>> 0x247d7a679 __libc_start1
>>          /usr/src/lib/libc/csu/libc_start1.c:157
>>
>> % gfcx -o z a.f90 && ./z
>>             3
>>
>
> Nice!  I completely forgot about MOLD...
>
> So the only missing pieces are a really comprehensive testcase
> and successful regtests...
  

Comments

Bernhard Reutner-Fischer Feb. 23, 2024, 9:32 p.m. UTC | #1
On 23 February 2024 22:15:17 CET, Harald Anlauf <anlauf@gmx.de> wrote:
>Hi Steve, all,
>
>here's an updated patch with an enhanced testcase that also
>checks MOLD= besides SOURCE=.
>
>Regtested on x86_64-pc-linux-gnu.  Is it OK for mainline?

LGTM
cheers

>
>Cheers,
>Harald
  
Steve Kargl Feb. 23, 2024, 9:34 p.m. UTC | #2
On Fri, Feb 23, 2024 at 10:15:17PM +0100, Harald Anlauf wrote:
> Hi Steve, all,
> 
> here's an updated patch with an enhanced testcase that also
> checks MOLD= besides SOURCE=.
> 
> Regtested on x86_64-pc-linux-gnu.  Is it OK for mainline?
> 

From my viewpoint, yes.

Thanks for finding a better solution than I had conjured.
  

Patch

From a176c2f44f812d82aeb430fadf23ab4b6dd5bd65 Mon Sep 17 00:00:00 2001
From: Steve Kargl <kargl@gcc.gnu.org>
Date: Fri, 23 Feb 2024 22:05:04 +0100
Subject: [PATCH] Fortran: ALLOCATE statement, SOURCE/MOLD expressions with
 subrefs [PR114024]

	PR fortran/114024

gcc/fortran/ChangeLog:

	* trans-stmt.cc (gfc_trans_allocate): When a source expression has
	substring references, part-refs, or %re/%im inquiries, wrap the
	entity in parentheses to force evaluation of the expression.

gcc/testsuite/ChangeLog:

	* gfortran.dg/allocate_with_source_27.f90: New test.
	* gfortran.dg/allocate_with_source_28.f90: New test.

Co-Authored-By: Harald Anlauf <anlauf@gmx.de>
---
 gcc/fortran/trans-stmt.cc                     | 10 ++-
 .../gfortran.dg/allocate_with_source_27.f90   | 20 +++++
 .../gfortran.dg/allocate_with_source_28.f90   | 90 +++++++++++++++++++
 3 files changed, 118 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/allocate_with_source_27.f90
 create mode 100644 gcc/testsuite/gfortran.dg/allocate_with_source_28.f90

diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 5247d3d39d7..e09828e218b 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6355,8 +6355,14 @@  gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
 	vtab_needed = (al->expr->ts.type == BT_CLASS);
 
       gfc_init_se (&se, NULL);
-      /* When expr3 is a variable, i.e., a very simple expression,
-	     then convert it once here.  */
+      /* When expr3 is a variable, i.e., a very simple expression, then
+	 convert it once here.  If one has a source expression that has
+	 substring references, part-refs, or %re/%im inquiries, wrap the
+	 entity in parentheses to force evaluation of the expression.  */
+      if (code->expr3->expr_type == EXPR_VARIABLE
+	  && is_subref_array (code->expr3))
+	code->expr3 = gfc_get_parentheses (code->expr3);
+
       if (code->expr3->expr_type == EXPR_VARIABLE
 	  || code->expr3->expr_type == EXPR_ARRAY
 	  || code->expr3->expr_type == EXPR_CONSTANT)
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_27.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_27.f90
new file mode 100644
index 00000000000..d0f0f3c4a84
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_27.f90
@@ -0,0 +1,20 @@ 
+!
+! { dg-do run }
+!
+! fortran/PR114024
+! https://github.com/fujitsu/compiler-test-suite
+! Modified from Fortran/0093/0093_0130.f90
+!
+program foo
+   implicit none
+   complex :: cmp(3)
+   real, allocatable :: xx(:), yy(:), zz(:)
+   cmp = (3., 6.78)
+   allocate(xx, source = cmp%re)          ! This caused an ICE.
+   allocate(yy, source = cmp(1:3)%re)     ! This caused an ICE.
+   allocate(zz, source = (cmp%re))
+   if (any(xx /= [3., 3., 3.])) stop 1
+   if (any(yy /= [3., 3., 3.])) stop 2
+   if (any(zz /= [3., 3., 3.])) stop 3
+end program foo
+
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_28.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_28.f90
new file mode 100644
index 00000000000..976c567cf22
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_28.f90
@@ -0,0 +1,90 @@ 
+! { dg-do run }
+!
+! PR fortran/114024
+
+program foo
+  implicit none
+  complex :: cmp(3) = (3.,4.)
+  type ci           ! pseudo "complex integer" type
+     integer :: re
+     integer :: im
+  end type ci
+  type cr           ! pseudo "complex" type
+     real :: re
+     real :: im
+  end type cr
+  type u
+     type(ci) :: ii(3)
+     type(cr) :: rr(3)
+  end type u
+  type(u) :: cc
+
+  cc% ii% re = nint (cmp% re)
+  cc% ii% im = nint (cmp% im)
+  cc% rr% re = cmp% re
+  cc% rr% im = cmp% im
+ 
+ call test_substring ()
+  call test_int_real ()
+  call test_poly ()
+
+contains
+
+  subroutine test_substring ()
+    character(4)              :: str(3) = ["abcd","efgh","ijkl"]
+    character(:), allocatable :: ac(:)
+    allocate (ac, source=str(1::2)(2:4))
+    if (size (ac) /= 2 .or. len (ac) /= 3) stop 11
+    if (ac(2) /= "jkl")                    stop 12
+    deallocate (ac)
+    allocate (ac, mold=str(1::2)(2:4))
+    if (size (ac) /= 2 .or. len (ac) /= 3) stop 13
+    deallocate (ac)
+  end
+
+  subroutine test_int_real ()
+    integer, allocatable  :: aa(:)
+    real, pointer         :: pp(:)
+    allocate (aa, source = cc% ii% im)
+    if (size (aa) /= 3)      stop 21
+    if (any (aa /= cmp% im)) stop 22
+    allocate (pp, source = cc% rr% re)
+    if (size (pp) /= 3)      stop 23
+    if (any (pp /= cmp% re)) stop 24
+    deallocate (aa, pp)
+  end
+
+  subroutine test_poly ()
+    class(*), allocatable :: uu(:), vv(:)
+    allocate (uu, source = cc% ii% im)
+    allocate (vv, source = cc% rr% re)
+    if (size (uu) /= 3) stop 31
+    if (size (vv) /= 3) stop 32
+    call check (uu)
+    call check (vv)
+    deallocate (uu, vv)
+    allocate (uu, mold = cc% ii% im)
+    allocate (vv, mold = cc% rr% re)
+    if (size (uu) /= 3) stop 33
+    if (size (vv) /= 3) stop 34
+    deallocate (uu, vv)
+  end
+
+  subroutine check (x)
+    class(*), intent(in) :: x(:)
+    select type (x)
+    type is (integer)
+       if (any (x /= cmp% im)) then
+          print *, "'integer':", x
+          stop 41
+       end if
+    type is (real)
+       if (any (x /= cmp% re)) then
+          print *, "'real':", x
+          stop 42
+       end if
+    type is (character(*))
+       print *, "'character':", x
+    end select
+  end
+end
-- 
2.35.3