From 4d12f6d0cf63ea6a2deb5398e6478dde114e76b8 Mon Sep 17 00:00:00 2001 From: Harald Anlauf 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