Mercurial > hg > CbC > CbC_gcc
diff gcc/testsuite/gfortran.dg/dtio_35.f90 @ 152:2b5abeee2509
update gcc11
author | anatofuz |
---|---|
date | Mon, 25 May 2020 07:50:57 +0900 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/gcc/testsuite/gfortran.dg/dtio_35.f90 Mon May 25 07:50:57 2020 +0900 @@ -0,0 +1,50 @@ +! { dg-compile } +! +! Reported by Vladimir Nikishkin +! at https://stackoverflow.com/questions/60972134/whats-wrong-with-the-following-fortran-code-gfortran-dtio-dummy-argument-at# +! + +module scheme + + type, abstract :: scheme_object + contains + procedure, pass :: generic_scheme_print => print_scheme_object + generic, public :: write (formatted) => generic_scheme_print + end type scheme_object + + abstract interface + subroutine packageable_procedure( ) + import scheme_object + end subroutine packageable_procedure + end interface +contains + + subroutine print_scheme_object(this, unit, iotype, v_list, iostat, iomsg) + class(scheme_object), intent(in) :: this + integer, intent(in) :: unit + character(*), intent(in) :: iotype + integer, intent(in) :: v_list (:) + integer, intent(out) :: iostat + character(*), intent(inout) :: iomsg + iostat = 1 + end subroutine print_scheme_object + + subroutine packaged_cons( ) + end subroutine packaged_cons + + function make_primitive_procedure_object( proc1 ) result( retval ) + class(scheme_object), pointer :: retval + procedure(packageable_procedure), pointer :: proc1 + end function make_primitive_procedure_object + + subroutine ll_setup_global_environment() + procedure(packageable_procedure), pointer :: proc1 + class(scheme_object), pointer :: proc_obj_to_pack + proc1 => packaged_cons + proc_obj_to_pack => make_primitive_procedure_object( proc1 ) + end subroutine ll_setup_global_environment + +end module scheme + +program main +end program main