|
152
|
1 ! { dg-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
|
