1 files changed, 55 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03
new file mode 100644
index 0000000..5ed9897
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03
@@ -0,0 +1,55 @@
+! { dg-do run }
+!
+! Check that pointer assignments allowed by F2003:C717
+! work and check null initialization of CLASS(*) pointers.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+program main
+  interface
+    subroutine foo(z)
+      class(*), pointer, intent(in) :: z
+    end subroutine foo
+  end interface
+  type sq
+    sequence
+    integer :: i
+  end type sq
+  type(sq), target :: x
+  class(*), pointer :: y, z
+  x%i = 42
+  y => x
+  z => y ! unlimited => unlimited allowed
+  call foo (z)
+  call bar
+contains
+  subroutine bar
+    type t
+    end type t
+    type(t), pointer :: x
+    class(*), pointer :: ptr1 => null() ! pointer initialization
+    class(*), pointer :: ptr2 => null(x) ! pointer initialization
+    if (same_type_as (ptr1, x) .neqv. .FALSE.) call abort
+    if (same_type_as (ptr2, x) .neqv. .TRUE.) call abort
+  end subroutine bar
+
+end program main
+
+
+subroutine foo(tgt)
+  use iso_c_binding
+  class(*), pointer, intent(in) :: tgt
+  type, bind(c) :: s
+    integer (c_int) :: k
+  end type s
+  type t
+    sequence
+    integer :: k
+  end type t
+  type(s), pointer :: ptr1
+  type(t), pointer :: ptr2
+  ptr1 => tgt ! bind(c) => unlimited allowed
+  if (ptr1%k .ne. 42) call abort
+  ptr2 => tgt ! sequence type => unlimited allowed
+  if (ptr2%k .ne. 42) call abort
+end subroutine foo