diff options
author | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
---|---|---|
committer | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
commit | 554fd8c5195424bdbcabf5de30fdc183aba391bd (patch) | |
tree | 976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/select_type_18.f03 | |
download | cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2 cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.xz |
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.
downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.
if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.
Diffstat (limited to 'gcc/testsuite/gfortran.dg/select_type_18.f03')
-rw-r--r-- | gcc/testsuite/gfortran.dg/select_type_18.f03 | 90 |
1 files changed, 90 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/select_type_18.f03 b/gcc/testsuite/gfortran.dg/select_type_18.f03 new file mode 100644 index 000000000..e4bacd377 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/select_type_18.f03 @@ -0,0 +1,90 @@ +! { dg-do compile } + +! PR fortran/45783 +! PR fortran/45795 +! This used to fail because of incorrect compile-time typespec on the +! SELECT TYPE selector. + +! This is the test-case from PR 45795. +! Contributed by Salvatore Filippone, sfilippone@uniroma2.it. + +module base_mod + + type :: base + integer :: m, n + end type base + +end module base_mod + +module s_base_mod + + use base_mod + + type, extends(base) :: s_base + contains + procedure, pass(a) :: cp_to_foo => s_base_cp_to_foo + + end type s_base + + + type, extends(s_base) :: s_foo + + integer :: nnz + integer, allocatable :: ia(:), ja(:) + real, allocatable :: val(:) + + contains + + procedure, pass(a) :: cp_to_foo => s_cp_foo_to_foo + + end type s_foo + + + interface + subroutine s_base_cp_to_foo(a,b,info) + import :: s_base, s_foo + class(s_base), intent(in) :: a + class(s_foo), intent(inout) :: b + integer, intent(out) :: info + end subroutine s_base_cp_to_foo + end interface + + interface + subroutine s_cp_foo_to_foo(a,b,info) + import :: s_foo + class(s_foo), intent(in) :: a + class(s_foo), intent(inout) :: b + integer, intent(out) :: info + end subroutine s_cp_foo_to_foo + end interface + +end module s_base_mod + + +subroutine trans2(a,b) + use s_base_mod + implicit none + + class(s_base), intent(out) :: a + class(base), intent(in) :: b + + type(s_foo) :: tmp + integer err_act, info + + + info = 0 + select type(b) + class is (s_base) + call b%cp_to_foo(tmp,info) + class default + info = -1 + write(*,*) 'Invalid dynamic type' + end select + + if (info /= 0) write(*,*) 'Error code ',info + + return + +end subroutine trans2 + +! { dg-final { cleanup-modules "base_mod s_base_mod" } } |