[Bug fortran/112407] [13/14 Regression] Fix for PR37336 triggers an ICE in gfc_format_decoder while constructing a vtab

["pault at gcc dot gnu.org" <gcc-bugzilla@gcc.gnu.org>]

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

--- Comment #6 from Paul Thomas <pault at gcc dot gnu.org> ---
(In reply to Tomáš Trnka from comment #5)

> I'm looking forward to any more information on the root cause.

I have failed to produce a compact reproducer that resembles your bug. In fact,
you will note the first comment in the reproducer below, which is a bit ironic
:-).

You will note the commented out assignment and select type block. These
generate the exact error. ie. Whenever 'new_t' appears in a variable expression
the error is triggered.

I am deeply puzzled and will have another go at achieving some enlightenment
tomorrow.

Paul

module m
  private new_t

  type s
    procedure(),pointer,nopass :: op
  end type

  type :: t
    integer :: i
    type (s) :: s
  contains
    procedure :: new_t
    procedure :: bar
    procedure :: add_t
    generic :: new => new_t, bar
    generic, public :: assignment(=) => add_t
    final :: final_t
  end type

  integer :: i = 0, finals = 0

contains
!  recursive subroutine new_t (arg1, arg2) ! gfortran doesn't detect the
recursion
  subroutine new_t (arg1, arg2)            ! in 'new_t'! Other brands do.
    class(t), intent(out) :: arg1
    type(t), intent(in)  :: arg2
    i = i + 1
!    arg1%s%op => new_t          ! This generates the error

!    select type (arg1)          ! As does this
!      type is (t)
!        arg1 = t(arg1%i,s(new_t))
!    end select

    print *, "new_t"
    if (i .ge. 10) return

!    arg1 = arg2                 ! gfortran does not detect the recursion

    if (arg1%i .ne. arg2%i) then ! According to F2018(8.5.10), arg1 should be
      arg1%i = arg2%i            ! undefined on invocation, unless any
sub-components
      call arg1%new(arg2)        ! are default initialised. gfortran sets
arg1%i = 0
    endif                        ! gfortran misses this recursion
  end

  subroutine bar(arg)
    class(t), intent(out) :: arg
    call arg%new(t(42, s(new_t)))
  end

  subroutine add_t (arg1, arg2)
    class(t), intent(out) :: arg1
    type(t), intent(in)  :: arg2
    call arg1%new (arg2)
  end

  impure elemental subroutine final_t (arg1)
    type(t), intent(in) :: arg1
    finals = finals + 1
  end
end

  use m
  class(t), allocatable :: x
  allocate(x)
  call x%new()                   ! gfortran ouputs 10*'new_t'
  print *, x%i, i, finals        !        -||-     0 10 11
!
! The other brands output 2*'new_t' + 42 2 3
end