From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001
From: upstream source tree <ports@midipix.org>
Date: Sun, 15 Mar 2015 20:14:05 -0400
Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; 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.
---
 gcc/testsuite/gfortran.dg/select_type_18.f03 | 90 ++++++++++++++++++++++++++++
 1 file changed, 90 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/select_type_18.f03

(limited to 'gcc/testsuite/gfortran.dg/select_type_18.f03')

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" } }
-- 
cgit v1.2.3