]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Fortran: fix initialization of allocatable non-deferred character [PR59252]
authorHarald Anlauf <anlauf@gmx.de>
Fri, 7 Feb 2025 20:21:10 +0000 (21:21 +0100)
committerHarald Anlauf <anlauf@gmx.de>
Fri, 7 Feb 2025 20:42:21 +0000 (21:42 +0100)
PR fortran/59252

gcc/fortran/ChangeLog:

* trans-expr.cc (gfc_trans_subcomponent_assign): Initialize
allocatable non-deferred character with NULL properly.

gcc/testsuite/ChangeLog:

* gfortran.dg/allocatable_char_1.f90: New test.

gcc/fortran/trans-expr.cc
gcc/testsuite/gfortran.dg/allocatable_char_1.f90 [new file with mode: 0644]

index f923aeb946051305f109f7c7dba481a8e5d8dfad..1329efcd6eb59a4b7f676c2c054737488defd179 100644 (file)
@@ -9836,9 +9836,13 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm,
       tmp = gfc_trans_alloc_subarray_assign (tmp, cm, expr);
       gfc_add_expr_to_block (&block, tmp);
     }
-  else if (init && cm->attr.allocatable && expr->expr_type == EXPR_NULL)
+  else if (cm->attr.allocatable && expr->expr_type == EXPR_NULL
+          && (init
+              || (cm->ts.type == BT_CHARACTER
+                  && !(cm->ts.deferred || cm->attr.pdt_string))))
     {
-      /* NULL initialization for allocatable components.  */
+      /* NULL initialization for allocatable components.
+        Deferred-length character is dealt with later.  */
       gfc_add_modify (&block, dest, fold_convert (TREE_TYPE (dest),
                                                  null_pointer_node));
     }
diff --git a/gcc/testsuite/gfortran.dg/allocatable_char_1.f90 b/gcc/testsuite/gfortran.dg/allocatable_char_1.f90
new file mode 100644 (file)
index 0000000..1d6c25c
--- /dev/null
@@ -0,0 +1,47 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR fortran/59252
+
+module mod
+  implicit none
+
+  type t1
+     character(256), allocatable :: label
+  end type t1
+
+  type t2
+     type(t1),       allocatable :: appv(:)
+  end type t2
+
+contains
+  subroutine construct(res)
+    type(t2), allocatable, intent(inout) :: res
+    if (.not. allocated(res)) allocate(res)
+  end subroutine construct
+
+  subroutine construct_appv(appv)
+    type(t1), allocatable, intent(inout) :: appv(:)
+    if (.not. allocated(appv)) allocate(appv(20))
+  end subroutine construct_appv
+
+  type(t1) function foo () result (res)
+  end function foo
+end module mod
+
+program testy
+  use mod
+  implicit none
+  type(t2), allocatable :: res
+  type(t1)              :: s
+
+  ! original test from pr59252
+  call construct     (res)
+  call construct_appv(res%appv)
+  deallocate (res)
+
+  ! related test from pr118747 comment 2:
+  s = foo ()
+end program testy
+
+! { dg-final { scan-tree-dump-not "__builtin_memmove" "original" } }