[Bug fortran/114859] New: Seeing new segmentation fault in same_type_as

[Bug fortran/114859] New: Seeing new segmentation fault in same_type_as

[orion at nwra dot com]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114859

            Bug ID: 114859
           Summary: Seeing new segmentation fault in same_type_as
           Product: gcc
           Version: 14.0
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: fortran
          Assignee: unassigned at gcc dot gnu.org
          Reporter: orion at nwra dot com
  Target Milestone: ---

As seen here:
https://koschei.fedoraproject.org/package/amg4psblas?collection=f40 with the
change from  14.0.1-0.13.fc40 to
14.0.1-0.15.fc40 we are starting to see a new segmentation fault in a test
program.

gdb shows:

Thread 1 "amg_d_pde2d" received signal SIGSEGV, Segmentation fault.
0x00007ffff7aee1b0 in amg_d_jac_smoother_clone_settings_ (sm=..., smout=...,
info=0) at ../amgprec/impl/smoother/amg_d_jac_smoother_clone_settings.f90:66
66            if (.not.same_type_as(sm%sv,smout%sv)) then
(gdb) print sm
$1 = {_data = 0x555555733100, _vptr = 0x7ffff7dbf360
<__amg_d_jac_smoother_MOD___vtab_amg_d_jac_smoother_Amg_d_jac_smoother_type>}
(gdb) print smout
$2 = {_data = 0x55555572bc00, _vptr = 0x7ffff7dbf360
<__amg_d_jac_smoother_MOD___vtab_amg_d_jac_smoother_Amg_d_jac_smoother_type>}

valgrind:

==73== Conditional jump or move depends on uninitialised value(s)
==73==    at 0x49961A1: amg_d_jac_smoother_clone_settings_ (in
/builddir/build/BUILDROOT/amg4psblas-1.1.2-5.fc41.x86_64/usr/lib64/openmpi/lib/libamg_prec.so.1.1)
==73==    by 0x4C0E736: ??? (in
/builddir/build/BUILDROOT/amg4psblas-1.1.2-5.fc41.x86_64/usr/lib64/openmpi/lib/libamg_prec.so.1.1)
==73==    by 0x4A7825B: amg_d_hierarchy_bld_ (in
/builddir/build/BUILDROOT/amg4psblas-1.1.2-5.fc41.x86_64/usr/lib64/openmpi/lib/libamg_prec.so.1.1)
==73==    by 0x10F770: MAIN__ (amg_d_pde2d.F90:409)
==73==    by 0x10BBD2: main (amg_d_pde2d.F90:67)
==73==
==73== Uninitialised byte(s) found during client check request
==73==    at 0x7B61B51: ??? (in /usr/lib64/openmpi/lib/libopen-pal.so.80.0.2)
==73==    by 0x69F2ED6: PMPI_Bcast (in
/usr/lib64/openmpi/lib/libmpi.so.40.40.2)
==73==    by 0x5FDE07B: MPI_BCAST (in
/usr/lib64/openmpi/lib/libmpi_mpifh.so.40.40.0)
==73==    by 0x4F20D69: __psi_m_collective_mod_MOD_psb_mbcasts (in
/usr/lib64/openmpi/lib/libpsb_base.so.3.8)
==73==    by 0x4AC9B1E: __amg_base_prec_type_MOD_amg_dml_bcast (in
/builddir/build/BUILDROOT/amg4psblas-1.1.2-5.fc41.x86_64/usr/lib64/openmpi/lib/libamg_prec.so.1.1)
==73==    by 0x4A800B5: amg_d_hierarchy_bld_ (in
/builddir/build/BUILDROOT/amg4psblas-1.1.2-5.fc41.x86_64/usr/lib64/openmpi/lib/libamg_prec.so.1.1)
==73==    by 0x10F770: MAIN__ (amg_d_pde2d.F90:409)
==73==    by 0x10BBD2: main (amg_d_pde2d.F90:67)
==73==  Address 0x3e6a471c is 5,612 bytes inside a block of size 109,760
alloc'd
==73==    at 0x484382F: malloc (vg_replace_malloc.c:446)
==73==    by 0x4A32781: amg_dprecinit_ (in
/builddir/build/BUILDROOT/amg4psblas-1.1.2-5.fc41.x86_64/usr/lib64/openmpi/lib/libamg_prec.so.1.1)
==73==    by 0x10F52B: MAIN__ (amg_d_pde2d.F90:279)
==73==    by 0x10BBD2: main (amg_d_pde2d.F90:67)
==73==

The only warning I see for that function's source file is:

amg_d_jac_smoother_clone_settings.f90:48:28:

   48 |   character(len=20) :: name='d_jac_smoother_clone_settings'
      |                            1
Warning: CHARACTER expression at (1) is being truncated (29/20)
[-Wcharacter-truncation]

which seems unrelated.

I'm at a loss with how to proceed to debug this further.

[Bug fortran/114859] Seeing new segmentation fault in same_type_as

[jakub at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114859

Jakub Jelinek <jakub at gcc dot gnu.org> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |jakub at gcc dot gnu.org

--- Comment #1 from Jakub Jelinek <jakub at gcc dot gnu.org> ---
The Fedora versions don't provide any information to upstream,
14.0.1-0.13.fc40 is r14-9704 and 14.0.1-0.15.fc40 is r14-9924

[Bug fortran/114859] Seeing new segmentation fault in same_type_as

[jakub at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114859

--- Comment #2 from Jakub Jelinek <jakub at gcc dot gnu.org> ---
If it is Fortran FE, then the possible commits might be
r14-9893 r14-9874 r14-9873 r14-9753 r14-9752 r14-9720 r14-9719 r14-9712
Anyway, best would be to try to compile the
amg_d_jac_smoother_clone_settings.f90
CU with a different compiler from the rest and see whether that is what changes
the testcase, or if not, bisect among *.o files in the package, the *.mod files
should be hopefully compatible between the 2 compilers.  And when a single CU
is known to change the outcome, then bisect it with gcc revisions.

[Bug fortran/114859] Seeing new segmentation fault in same_type_as

[jakub at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114859

--- Comment #3 from Jakub Jelinek <jakub at gcc dot gnu.org> ---
Oh, and start by disabling LTO and see if it makes a difference.

[Bug fortran/114859] Seeing new segmentation fault in same_type_as

[jakub at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114859

--- Comment #4 from Jakub Jelinek <jakub at gcc dot gnu.org> ---
LTO doesn't seem to make a difference.  And without LTO bisection points at
openmpi-build/amgprec/impl/amg_d_hierarchy_bld.o
when this is compiled with r14-9704 even when all other sources are compiled
with
the newer compiler, the testcase works, while when this is compiled with
r14-9924
and all other sources with the older compiler, it crashes.

[Bug fortran/114859] [14 Regression] Seeing new segmentation fault in same_type_as since r14-9752

[jakub at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114859

Jakub Jelinek <jakub at gcc dot gnu.org> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|UNCONFIRMED                 |NEW
     Ever confirmed|0                           |1
                 CC|                            |pault at gcc dot gnu.org
           Priority|P3                          |P2
   Last reconfirmed|                            |2024-04-26
   Target Milestone|---                         |14.0
            Summary|Seeing new segmentation     |[14 Regression] Seeing new
                   |fault in same_type_as       |segmentation fault in
                   |                            |same_type_as since r14-9752

--- Comment #5 from Jakub Jelinek <jakub at gcc dot gnu.org> ---
Bisection shows the only change on that CU in that range is
r14-9752-g35408b3669fac104cd380582b32e32c64a603d8b
and the changes are mostly in the save_smoothers subroutine.
diff -upb on the original dump between r14-9751 and r14-9752 is:
--- amg_d_hierarchy_bld.f90.005t.original_      2024-04-26 12:41:01.409999711
-0400
+++ amg_d_hierarchy_bld.f90.005t.original       2024-04-26 12:42:21.511060046
-0400
@@ -211,9 +211,6 @@ void restore_smoothers (struct amg_d_one
 __attribute__((fn spec (". . w w w ")))
 void save_smoothers (struct amg_d_onelev_type & restrict level, struct
__class_amg_d_base_smoother_mod_Amg_d_base_smoother_type_a & restrict save1,
struct __class_amg_d_base_smoother_mod_Amg_d_base_smoother_type_a & restrict
save2, integer(kind=4) & restrict info)
 {
-  {
-    integer(kind=4) stat.18;
-
     *info = 0;
     if (save1->_data != 0B)
       {
@@ -328,7 +325,6 @@ void save_smoothers (struct amg_d_onelev
       }
     if (__builtin_expect ((integer(kind=8)) (stat.18 != 0), 0, 44)) goto L.34;
     (struct __vtype_amg_d_base_smoother_mod_Amg_d_base_smoother_type *)
save1->_vptr = (struct __vtype_amg_d_base_smoother_mod_Amg_d_base_smoother_type
*) level->sm._vptr;
-    (void) __builtin_memcpy ((void *) save1->_data, (void *)
save1->_vptr->_def_init, (unsigned long) save1->_vptr->_size);
     L.34:;
     *info = stat.18;
     if (*info == 0)
@@ -344,11 +340,11 @@ void save_smoothers (struct amg_d_onelev
         }
       }
     L.36:;
-    if (*info == 0 && level->sm2a._data != 0B)
-      {
         {
           integer(kind=4) stat.21;

+    if (*info == 0 && level->sm2a._data != 0B)
+      {
           if (__builtin_expect ((integer(kind=8)) (save2->_data != 0B), 0,
45))
             {
               stat.21 = 5014;
@@ -364,7 +360,6 @@ void save_smoothers (struct amg_d_onelev
             }
           if (__builtin_expect ((integer(kind=8)) (stat.21 != 0), 0, 44)) goto
L.38;
           (struct __vtype_amg_d_base_smoother_mod_Amg_d_base_smoother_type *)
save2->_vptr = (struct __vtype_amg_d_base_smoother_mod_Amg_d_base_smoother_type
*) level->sm2a._vptr;
-          (void) __builtin_memcpy ((void *) save2->_data, (void *)
save2->_vptr->_def_init, (unsigned long) save2->_vptr->_size);
           L.38:;
           *info = stat.21;
           if (*info == 0)
@@ -384,15 +379,13 @@ void save_smoothers (struct amg_d_onelev
       }
     L.37:;
     return;
-  }
 }


 __attribute__((fn spec (". . . . w ")))
 void amg_d_hierarchy_bld (struct psb_dspmat_type & a, struct psb_desc_type &
desc_a, struct __class_amg_d_prec_type_Amg_dprec_type_t & prec, integer(kind=4)
& restrict info)
 {
-  static void restore_smoothers (struct amg_d_onelev_type &, struct
__class_amg_d_base_smoother_mod_Amg_d_base_smoother_type_a & restrict, struct
__class_amg_d_base_smoother_mod_Amg_d_base_smoother_type_a & restrict,
integer(kind=4) & restrict);
-  static void save_smoothers (struct amg_d_onelev_type & restrict, struct
__class_amg_d_base_smoother_mod_Amg_d_base_smoother_type_a & restrict, struct
__class_amg_d_base_smoother_mod_Amg_d_base_smoother_type_a & restrict,
integer(kind=4) & restrict);
+  integer(kind=4) stat.18;
   integer(kind=8) D.9689;
   integer(kind=8) D.9690;
   integer(kind=8) D.9691;

so guess the only significant change is the removal of the two __builtin_memcpy
calls.

[Bug fortran/114859] [14 Regression] Seeing new segmentation fault in same_type_as since r14-9752

[jakub at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114859

--- Comment #6 from Jakub Jelinek <jakub at gcc dot gnu.org> ---
Created attachment 58046
  --> https://gcc.gnu.org/bugzilla/attachment.cgi?id=58046&action=edit
pr114859.tar.xz

Testcase + one module.
I was using
./f951 -quiet -I . amg_d_hierarchy_bld.f90 -m64 -march=x86-64 -mtune=generic
-mno-omit-leaf-frame-pointer -O2 -fexceptions -fstack-protector-strong
-fno-asynchronous-unwind-tables -fstack-clash-protection -fcf-protection=full
-fno-omit-frame-pointer -fPIC  -o amg_d_hierarchy_bld.s
-fdump-tree-{original,gimple}

[Bug fortran/114859] [14 Regression] Seeing new segmentation fault in same_type_as since r14-9752

[jakub at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114859

--- Comment #7 from Jakub Jelinek <jakub at gcc dot gnu.org> ---
Created attachment 58047
  --> https://gcc.gnu.org/bugzilla/attachment.cgi?id=58047&action=edit
pr114859-1.tar.xz

Another module.

Unfortunately, the last module is too large for the 1M limit.
It can be grabbed from
wget
https://kojipkgs.fedoraproject.org/packages/psblas3/3.8.1/5.post2.fc40/x86_64/psblas3-openmpi-devel-3.8.1-5.post2.fc40.x86_64.rpm
rpm2cpio psblas3-openmpi-devel-3.8.1-5.post2.fc40.x86_64.rpm | cpio -id
it is the
usr/lib64/gfortran/modules/openmpi/psblas3/psb_base_mod.mod
file.

[Bug fortran/114859] [14 Regression] Seeing new segmentation fault in same_type_as since r14-9752

[jakub at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114859

--- Comment #8 from Jakub Jelinek <jakub at gcc dot gnu.org> ---
The upstream sources are:
https://github.com/sfilippone/amg4psblas/archive/refs/tags/v1.1.2.tar.gz
https://github.com/sfilippone/psblas3/archive/refs/tags/v3.8.1-2.tar.gz

[Bug fortran/114859] [14/15 Regression] Seeing new segmentation fault in same_type_as since r14-9752

[jakub at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114859

--- Comment #9 from Jakub Jelinek <jakub at gcc dot gnu.org> ---
I see there roughly
module m1
  type  amg_d_base_solver_type
  contains
    procedure, pass(sv) :: apply_v => amg_d_base_solver_apply_vect
    procedure, pass(sv) :: apply_a => amg_d_base_solver_apply
  end type amg_d_base_solver_type

  interface
    subroutine amg_d_base_solver_apply_vect(alpha,sv,x)
      implicit none
      class(amg_d_base_solver_type), intent(inout) :: sv
      integer,intent(inout)          :: x
      real,intent(in)                     :: alpha
    end subroutine amg_d_base_solver_apply_vect
  end interface

  interface
    subroutine amg_d_base_solver_apply(alpha,sv,x)
      implicit none
      class(amg_d_base_solver_type), intent(inout) :: sv
      integer,intent(inout)          :: x
      real,intent(in)                     :: alpha
    end subroutine amg_d_base_solver_apply
  end interface
end module m1
module m2
  use m1
  type  amg_d_base_smoother_type
    class(amg_d_base_solver_type), allocatable :: sv
  contains
    procedure, pass(sm) :: apply_v => amg_d_base_smoother_apply_vect
    procedure, pass(sm) :: apply_a => amg_d_base_smoother_apply
  end type amg_d_base_smoother_type

  interface
    subroutine amg_d_base_smoother_apply_vect(alpha,sm,x)
      implicit none
      class(amg_s_base_smoother_type), intent(inout) :: sm
      integer,intent(inout)          :: x
      real,intent(in)                     :: alpha
    end subroutine amg_d_base_smoother_apply_vect
  end interface

  interface
    subroutine amg_d_base_smoother_apply(alpha,sm,x)
      implicit none
      class(amg_s_base_smoother_type), intent(inout) :: sm
      integer,intent(inout)          :: x
      real,intent(in)                     :: alpha
    end subroutine amg_d_base_smoother_apply
  end interface
end module m2
subroutine foo (save1)
  use m1, m2
  class(amg_d_base_smoother_type), allocatable , intent(inout) :: save1
  allocate(save1)
end subroutine

except that this doesn't compile.

[Bug fortran/114859] [14/15 Regression] Seeing new segmentation fault in same_type_as since r14-9752

[jakub at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114859

--- Comment #10 from Jakub Jelinek <jakub at gcc dot gnu.org> ---
Ah, the following shows what is happening and shows similar IL changes in the
*.optimized dump:
module m1
  type  amg_d_base_solver_type
  contains
    procedure, pass(sv) :: free => amg_d_base_solver_free
  end type amg_d_base_solver_type
  interface
    subroutine amg_d_base_solver_free(sv,x)
      import :: amg_d_base_solver_type
      implicit none
      class(amg_d_base_solver_type), intent(inout) :: sv
      integer,intent(inout)          :: x
    end subroutine amg_d_base_solver_free
  end interface
end module m1
module m2
  use m1
  type  amg_d_base_smoother_type
    class(amg_d_base_solver_type), allocatable :: sv
  contains
    procedure, pass(sm) :: free => amg_d_base_smoother_free
  end type amg_d_base_smoother_type
  interface
    subroutine amg_d_base_smoother_free(sm,x)
      import :: amg_d_base_smoother_type, amg_d_base_solver_type
      implicit none
      class(amg_d_base_smoother_type), intent(inout) :: sm
      integer,intent(inout)          :: x
    end subroutine amg_d_base_smoother_free
  end interface
end module m2
module m3
  use m2
  type amg_d_onelev_type
    class(amg_d_base_smoother_type), allocatable   :: sm
  end type amg_d_onelev_type
end module m3
subroutine foo (level, save1, info)
  use m1
  use m2
  use m3
  type(amg_d_onelev_type), intent(inout) :: level
  class(amg_d_base_smoother_type), allocatable , intent(inout) :: save1
  integer,intent(out) :: info
  info = 0
  if (allocated(save1)) then
    call save1%free(info)
    if (info  == 0) deallocate(save1,stat=info)
    if (info /= 0) return
  end if
  allocate(save1, mold=level%sm,stat=info)
end subroutine

[Bug fortran/114859] [14/15 Regression] Seeing new segmentation fault in same_type_as since r14-9752

[pault at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114859

Paul Thomas <pault at gcc dot gnu.org> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
           Assignee|unassigned at gcc dot gnu.org      |pault at gcc dot gnu.org

--- Comment #11 from Paul Thomas <pault at gcc dot gnu.org> ---
Created attachment 58054
  --> https://gcc.gnu.org/bugzilla/attachment.cgi?id=58054&action=edit
Fix for this PR

Hi Orion and Jakub,

Mea culpa, mea maxima culpa! I had totally overlooked the use of
gfc_trans_class_init_assign for application of 'mold' in class allocation.

  subroutine restore_smoothers(level,save1, save2,info)
....snip....
    if (allocated(level%sm)) then
      if (info  == 0) call level%sm%free(info)
      if (info  == 0) deallocate(level%sm,stat=info)
    end if
    if (allocated(save1)) then
      if (info  == 0) allocate(level%sm,mold=save1,stat=info) ! Repeats
below...
      if (info == 0) call save1%clone_settings(level%sm,info)
    end if
....snip....

the attached patch fixes both this problem and respects the standard for the
default initialization of INTENT(OUT) dummies. It regtests fine. A suitable
testcase is on its way.

@Jakub, As per your message of Fri Apr 26 11:03:31, I hope that the patch can
find its way to the 14.1 release candidate.

Regards

Paul

[Bug fortran/114859] [14/15 Regression] Seeing new segmentation fault in same_type_as since r14-9752

[jakub at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114859

--- Comment #12 from Jakub Jelinek <jakub at gcc dot gnu.org> ---
There is still time, probably until Tuesday morning, so if it is committed say
by Monday to trunk, it can be cherry-picked then.  I'd prefer to see the whole
patch before acking it for 14.1, possibly even build a test rpm which could
verify if the package now works again.

[Bug fortran/114859] [14/15 Regression] Seeing new segmentation fault in same_type_as since r14-9752

[pault at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114859

Paul Thomas <pault at gcc dot gnu.org> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |anlauf at gmx dot de

--- Comment #13 from Paul Thomas <pault at gcc dot gnu.org> ---
(In reply to Jakub Jelinek from comment #12)
> There is still time, probably until Tuesday morning, so if it is committed
> say by Monday to trunk, it can be cherry-picked then.  I'd prefer to see the
> whole patch before acking it for 14.1, possibly even build a test rpm which
> could verify if the package now works again.

OK - I am on to it.

Thanks

Paul

@Harald - I will submit to the list a bit later on and, hopefully, will commit
tonight.

[Bug fortran/114859] [14/15 Regression] Seeing new segmentation fault in same_type_as since r14-9752

[pault at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114859

Paul Thomas <pault at gcc dot gnu.org> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
  Attachment #58054|0                           |1
        is obsolete|                            |

--- Comment #14 from Paul Thomas <pault at gcc dot gnu.org> ---
Created attachment 58063
  --> https://gcc.gnu.org/bugzilla/attachment.cgi?id=58063&action=edit
Fix for this PR

Hi Jakub and Orion,

It took me a little while to reduce the problem to the testcase below. It goes
to the list as soon as regtesting is done.

The offending bit of code has been constrained even more than previously and
the return with empty_stmt (input_location) has been removed. It, apparently,
can make var_decls disappear.

Regards

Paul

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 072adf3fe77..0280c441ced 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1720,6 +1720,7 @@ gfc_trans_class_init_assign (gfc_code *code)
   gfc_se dst,src,memsz;
   gfc_expr *lhs, *rhs, *sz;
   gfc_component *cmp;
+  gfc_symbol *sym;

   gfc_start_block (&block);

@@ -1736,18 +1737,25 @@ gfc_trans_class_init_assign (gfc_code *code)
   /* The _def_init is always scalar.  */
   rhs->rank = 0;

-  /* Check def_init for initializers.  If this is a dummy with all default
-     initializer components NULL, return NULL_TREE and use the passed value as
-     required by F2018(8.5.10).  */
-  if (!lhs->ref && lhs->symtree->n.sym->attr.dummy)
+  /* Check def_init for initializers.  If this is an INTENT(OUT) dummy with
all
+     default initializer components NULL, return NULL_TREE and use the passed
+     value as required by F2018(8.5.10).  */
+  sym = code->expr1->expr_type == EXPR_VARIABLE ? code->expr1->symtree->n.sym
+                                               : NULL;
+  if (code->op != EXEC_ALLOCATE
+      && sym && sym->attr.dummy
+      && sym->attr.intent == INTENT_OUT)
     {
-      cmp = rhs->ref->next->u.c.component->ts.u.derived->components;
-      for (; cmp; cmp = cmp->next)
+      if (!lhs->ref && lhs->symtree->n.sym->attr.dummy)
        {
-         if (cmp->initializer)
-           break;
-         else if (!cmp->next)
-           return build_empty_stmt (input_location);
+         cmp = rhs->ref->next->u.c.component->ts.u.derived->components;
+         for (; cmp; cmp = cmp->next)
+           {
+             if (cmp->initializer)
+               break;
+             else if (!cmp->next)
+               return NULL_TREE;
+           }
        }
     }

diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index c34e0b4c0cd..d355009fa5e 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -7262,11 +7262,12 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist
*omp_allocate)
        {
          /* Use class_init_assign to initialize expr.  */
          gfc_code *ini;
-         ini = gfc_get_code (EXEC_INIT_ASSIGN);
+         ini = gfc_get_code (EXEC_ALLOCATE);
          ini->expr1 = gfc_find_and_cut_at_last_class_ref (expr, true);
          tmp = gfc_trans_class_init_assign (ini);
          gfc_free_statements (ini);
-         gfc_add_expr_to_block (&block, tmp);
+         if (tmp != NULL_TREE)
+           gfc_add_expr_to_block (&block, tmp);
        }
       else if ((init_expr = allocate_get_initializer (code, expr)))
        {
diff --git a/gcc/testsuite/gfortran.dg/pr114959.f90
b/gcc/testsuite/gfortran.dg/pr114959.f90
new file mode 100644
index 00000000000..5cc3c052c1d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr114959.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Fix the regression caused by r14-9752 (fix for PR112407)
+! Contributed by Orion Poplawski  <orion@nwra.com>
+! Problem isolated by Jakub Jelinek  <jakub@gcc.gnu.org> and further
+! reduced here.
+!
+module m
+  type :: smoother_type
+    integer :: i
+  end type
+  type :: onelev_type
+    class(smoother_type), allocatable :: sm
+    class(smoother_type), allocatable :: sm2a
+  end type
+contains
+  subroutine save_smoothers(level,save1, save2)
+    Implicit None
+    type(onelev_type), intent(inout) :: level
+    class(smoother_type), allocatable , intent(inout) :: save1, save2
+    integer(4) :: info
+
+    info  = 0
+! r14-9752 causes the 'stat' declaration from the first ALLOCATE statement
+! to disappear, which triggers an ICE in gimplify_var_or_parm_decl. The
+! second ALLOCATE statement has to be present for the ICE to occur.
+    allocate(save1, mold=level%sm,stat=info)
+    allocate(save2, mold=level%sm2a,stat=info)
+  end subroutine save_smoothers
+end module m
+! Two 'stat's from the allocate statements and two from the final wrapper.
+! { dg-final { scan-tree-dump-times "integer\\(kind..\\) stat" 4 "original" }
}

[Bug fortran/114859] [14/15 Regression] Seeing new segmentation fault in same_type_as since r14-9752

[jakub at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114859

--- Comment #15 from Jakub Jelinek <jakub at gcc dot gnu.org> ---
(In reply to Paul Thomas from comment #14)
> Created attachment 58063 [details]
> Fix for this PR

The patch bootstrapped/regtested on x86_64-linux fine in an rpm build and
amg4psblas-1.1.2 built with it fine and make check passed.

[Bug fortran/114859] [14/15 Regression] Seeing new segmentation fault in same_type_as since r14-9752

[pault at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114859

--- Comment #16 from Paul Thomas <pault at gcc dot gnu.org> ---
Hi Jakub,

It's good news that the patch does indeed fix the full problem.

I committed to 15-branch with corrections to the ChangeLogs, as requested by
Mikael. What both of us missed was that I screwed up in the commit message by
using the wrong PR number; 114959 instead of 114859. The testcase also has the
wrong number, all of which came about because I initially named the working
directory incorrectly. I am trying to things in too much of a hurry late at
night!

I do apologise for giving you a bit of extra work in backporting to the RC.
I'll fix up 15-branch tomorrow morning.

Regards

Paul

[Bug fortran/114859] [14/15 Regression] Seeing new segmentation fault in same_type_as since r14-9752

[anlauf at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114859

anlauf at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
           Keywords|                            |wrong-code

--- Comment #17 from anlauf at gcc dot gnu.org ---
For reference: the commit is r15-46-gbca41a8d55e830

commit bca41a8d55e830c882b0f39246afead4fcfae6f7
Author: Paul Thomas <pault@gcc.gnu.org>
Date:   Mon Apr 29 11:52:11 2024 +0100

    Fortran: Fix regression caused by r14-9752 [PR114959]

    2024-04-29  Paul Thomas  <pault@gcc.gnu.org>

    gcc/fortran
            PR fortran/114959
            * trans-expr.cc (gfc_trans_class_init_assign): Return NULL_TREE
            if the default initializer has all NULL fields. Guard this
            by a requirement that the code not be EXEC_INIT_ASSIGN and that
            the object be an INTENT_OUT dummy.
            * trans-stmt.cc (gfc_trans_allocate): Change the initializer
            code for allocate with mold to EXEC_ALLOCATE to allow an
            initializer with all NULL fields.

    gcc/testsuite/
            PR fortran/114959
            * gfortran.dg/pr114959.f90: New test.

[Bug fortran/114859] [14/15 Regression] Seeing new segmentation fault in same_type_as since r14-9752

[jakub at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114859

Jakub Jelinek <jakub at gcc dot gnu.org> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|NEW                         |RESOLVED
         Resolution|---                         |FIXED

--- Comment #18 from Jakub Jelinek <jakub at gcc dot gnu.org> ---
And now cherry-picked to 14.1 as well:
commit r14-10153-ge976bef1579086e6e83c6a47f6c5f8f996208f99                      
Author: Paul Thomas <pault@gcc.gnu.org>                                         
Date:   Mon Apr 29 11:52:11 2024 +0100                                          

    Fortran: Fix regression caused by r14-9752 [PR114959]                       

    2024-04-29  Paul Thomas  <pault@gcc.gnu.org>                                

    gcc/fortran                                                                 
            PR fortran/114959                                                   
            * trans-expr.cc (gfc_trans_class_init_assign): Return NULL_TREE     
            if the default initializer has all NULL fields. Guard this          
            by a requirement that the code not be EXEC_INIT_ASSIGN and that     
            the object be an INTENT_OUT dummy.                                  
            * trans-stmt.cc (gfc_trans_allocate): Change the initializer        
            code for allocate with mold to EXEC_ALLOCATE to allow an            
            initializer with all NULL fields.                                   

    gcc/testsuite/                                                              
            PR fortran/114959                                                   
            * gfortran.dg/pr114959.f90: New test.                               

    (cherry picked from commit bca41a8d55e830c882b0f39246afead4fcfae6f7)