gcc/testsuite/gfortran.dg/pr112407b.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-std=f2008" }
   3 ! Test of an issue found in the investigation of PR112407. The dg-option is
   4 ! set to avoid regression once the F2018 RECURSIVE by default in implemented.
   5 ! Contributed by Tomas Trnka  <trnka@scm.com>
   6 !
   7 module m
   8   private new_t
   9
  10   type s
  11     procedure(),pointer,nopass :: op
  12   end type
  13
  14   type :: t
  15     integer :: i
  16     type (s) :: s
  17   contains
  18     procedure :: new_t
  19     procedure :: bar
  20     procedure :: add_t
  21     generic :: new => new_t, bar
  22     generic, public :: assignment(=) => add_t
  23     final :: final_t
  24   end type
  25
  26   integer :: i = 0, finals = 0
  27
  28 contains
  29   subroutine new_t (arg1, arg2)            ! gfortran didn't detect the recursion
  30     class(t), intent(out) :: arg1
  31     type(t), intent(in)  :: arg2
  32     i = i + 1
  33
  34     print *, "new_t", arg1%i, arg2%i
  35     if (i .ge. 10) return
  36
  37     if (arg1%i .ne. arg2%i) then
  38       arg1%i = arg2%i
  39       call arg1%new(arg2)  ! { dg-warning "possibly calling itself recursively" }
  40     endif
  41   end
  42
  43   subroutine bar(arg)
  44     class(t), intent(out) :: arg
  45     call arg%new(t(42, s(new_t)))
  46   end
  47
  48   subroutine add_t (arg1, arg2)
  49     class(t), intent(out) :: arg1
  50     type(t), intent(in)  :: arg2
  51     call arg1%new (arg2)
  52   end
  53
  54   impure elemental subroutine final_t (arg1)
  55     type(t), intent(in) :: arg1
  56     finals = finals + 1
  57   end
  58 end