summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/select_type_18.f03
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/select_type_18.f03
downloadcbb-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.f0390
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" } }