Dear all,
the attached patch fixes an ICE occuring for ALLOCATE with SOURCE
(or MOLD) of deferred character length in the scalar case, which
looked obscure because the ICE disappears at -O1 and higher.
The dump tree suggests that it is a wrong decl for the temporary
source that was e.g.
character(kind=1) source.2[1:];
whereas I had expected
character(kind=1)[1:] * source.2;
and which we now get after the patch. Or am I missing something?
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
From 4d12f6d0cf63ea6a2deb5398e6478dde114e76b8 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Fri, 28 Jun 2024 21:44:06 +0200
Subject: [PATCH] Fortran: fix ALLOCATE with SOURCE of deferred character
length [PR114019]
gcc/fortran/ChangeLog:
PR fortran/114019
* trans-stmt.cc (gfc_trans_allocate): Fix handling of case of
scalar character expression being used for SOURCE.
gcc/testsuite/ChangeLog:
PR fortran/114019
* gfortran.dg/allocate_with_source_33.f90: New test.
---
gcc/fortran/trans-stmt.cc | 5 +-
.../gfortran.dg/allocate_with_source_33.f90 | 53 +++++++++++++++++++
2 files changed, 57 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/allocate_with_source_33.f90
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 93b633e212e..60275e18867 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6464,7 +6464,10 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
else if (se.expr != NULL_TREE && temp_var_needed)
{
tree var, desc;
- tmp = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)) || is_coarray ?
+ tmp = (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr))
+ || is_coarray
+ || (code->expr3->ts.type == BT_CHARACTER
+ && code->expr3->rank == 0)) ?
se.expr
: build_fold_indirect_ref_loc (input_location, se.expr);
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_33.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_33.f90
new file mode 100644
index 00000000000..7b1a26c464c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_33.f90
@@ -0,0 +1,53 @@
+! { dg-do compile }
+! { dg-options "-O0" }
+!
+! PR fortran/114019 - allocation with source of deferred character length
+
+subroutine s
+ implicit none
+ character(1) :: w = "4"
+ character(*), parameter :: str = "123"
+ character(5), pointer :: chr_pointer1
+ character(:), pointer :: chr_pointer2
+ character(:), pointer :: chr_ptr_arr(:)
+ character(5), allocatable :: chr_alloc1
+ character(:), allocatable :: chr_alloc2
+ character(:), allocatable :: chr_all_arr(:)
+ allocate (chr_pointer1, source=w// str//w)
+ allocate (chr_pointer2, source=w// str//w)
+ allocate (chr_ptr_arr, source=w//[str//w])
+ allocate (chr_alloc1, source=w// str//w)
+ allocate (chr_alloc2, source=w// str//w)
+ allocate (chr_all_arr, source=w//[str//w])
+ allocate (chr_pointer1, mold =w// str//w)
+ allocate (chr_pointer2, mold =w// str//w)
+ allocate (chr_ptr_arr, mold =w//[str//w])
+ allocate (chr_alloc1, mold =w// str//w)
+ allocate (chr_alloc2, mold =w// str//w)
+ allocate (chr_all_arr, mold =w//[str//w])
+end
+
+subroutine s2
+ implicit none
+ integer, parameter :: ck=4
+ character(kind=ck,len=1) :: w = ck_"4"
+ character(kind=ck,len=*), parameter :: str = ck_"123"
+ character(kind=ck,len=5), pointer :: chr_pointer1
+ character(kind=ck,len=:), pointer :: chr_pointer2
+ character(kind=ck,len=:), pointer :: chr_ptr_arr(:)
+ character(kind=ck,len=5), allocatable :: chr_alloc1
+ character(kind=ck,len=:), allocatable :: chr_alloc2
+ character(kind=ck,len=:), allocatable :: chr_all_arr(:)
+ allocate (chr_pointer1, source=w// str//w)
+ allocate (chr_pointer2, source=w// str//w)
+ allocate (chr_ptr_arr, source=w//[str//w])
+ allocate (chr_alloc1, source=w// str//w)
+ allocate (chr_alloc2, source=w// str//w)
+ allocate (chr_all_arr, source=w//[str//w])
+ allocate (chr_pointer1, mold =w// str//w)
+ allocate (chr_pointer2, mold =w// str//w)
+ allocate (chr_ptr_arr, mold =w//[str//w])
+ allocate (chr_alloc1, mold =w// str//w)
+ allocate (chr_alloc2, mold =w// str//w)
+ allocate (chr_all_arr, mold =w//[str//w])
+end
--
2.35.3
