gcc/testsuite/gfortran.dg/dtio_35.f90

   1 ! { dg-do compile }
   2 !
   3 ! Reported by Vladimir Nikishkin
   4 ! at https://stackoverflow.com/questions/60972134/whats-wrong-with-the-following-fortran-code-gfortran-dtio-dummy-argument-at#
   5 !
   6
   7 module scheme
   8
   9   type, abstract :: scheme_object
  10    contains
  11      procedure, pass :: generic_scheme_print => print_scheme_object
  12      generic, public :: write (formatted) => generic_scheme_print
  13   end type scheme_object
  14
  15   abstract interface
  16      subroutine packageable_procedure(  )
  17        import scheme_object
  18      end subroutine packageable_procedure
  19   end interface
  20 contains
  21
  22   subroutine print_scheme_object(this, unit, iotype, v_list, iostat, iomsg)
  23     class(scheme_object), intent(in) :: this
  24     integer, intent(in)         :: unit
  25     character(*), intent(in)    :: iotype
  26     integer, intent(in)         :: v_list (:)
  27     integer, intent(out)        :: iostat
  28     character(*), intent(inout) :: iomsg
  29     iostat = 1
  30   end subroutine print_scheme_object
  31
  32   subroutine packaged_cons( )
  33   end subroutine packaged_cons
  34
  35   function make_primitive_procedure_object( proc1 ) result( retval )
  36     class(scheme_object), pointer :: retval
  37     procedure(packageable_procedure), pointer :: proc1
  38   end function make_primitive_procedure_object
  39
  40   subroutine ll_setup_global_environment()
  41     procedure(packageable_procedure), pointer :: proc1
  42     class(scheme_object), pointer :: proc_obj_to_pack
  43     proc1 => packaged_cons
  44     proc_obj_to_pack => make_primitive_procedure_object( proc1 )
  45   end subroutine ll_setup_global_environment
  46
  47 end module scheme
  48
  49 program main
  50 end program main