Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/gfortran.dg/dtio_35.f90 @ 152:2b5abeee2509

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
update gcc11
author anatofuz
date Mon, 25 May 2020 07:50:57 +0900
parents
children
comparison
equal deleted inserted replaced
145:1830386684a0 152:2b5abeee2509
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