1 files changed, 84 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_29.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_29.f90
new file mode 100644
index 00000000000..d4ad39cda1e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_29.f90
@@ -0,0 +1,84 @@
+! { dg-do run }
+!
+! Test the fix for PR84546 in which the failing cases would
+! have x%vec = ['foo','b   '].
+!
+! Contributed by Neil Carlson  <neil.n.carlson@gmail.com>
+!
+module any_vector_type
+
+  type :: any_vector
+    class(*), allocatable :: vec(:)
+  end type
+
+  interface any_vector
+    procedure any_vector1
+  end interface
+
+contains
+
+  function any_vector1(vec) result(this)
+    class(*), intent(in) :: vec(:)
+    type(any_vector) :: this
+    allocate(this%vec, source=vec)
+  end function
+
+end module
+
+program main
+
+  use any_vector_type
+  implicit none
+
+  class(*), allocatable :: x
+  character(*), parameter :: vec(2) = ['foo','bar']
+  integer :: vec1(3) = [7,8,9]
+
+  call foo1
+  call foo2
+  call foo3
+  call foo4
+
+contains
+
+  subroutine foo1 ! This always worked
+    allocate (any_vector :: x)
+    select type (x)
+      type is (any_vector)
+        x = any_vector(vec)
+    end select
+    call bar(1)
+    deallocate (x)
+  end
+
+  subroutine foo2 ! Failure found during diagnosis
+    x = any_vector (vec)
+    call bar(2)
+    deallocate (x)
+  end
+
+  subroutine foo3 ! Original failure
+    allocate (x, source = any_vector (vec))
+    call bar(3)
+    deallocate (x)
+  end
+
+  subroutine foo4 ! This always worked
+    allocate (x, source = any_vector (vec1))
+    call bar(4)
+    deallocate (x)
+  end
+
+  subroutine bar (stop_flag)
+    integer :: stop_flag
+    select type (x)
+      type is (any_vector)
+        select type (xvec => x%vec)
+          type is (character(*))
+            if (any(xvec /= vec)) stop stop_flag
+          type is (integer)
+            if (any(xvec /= (vec1))) stop stop_flag
+        end select
+    end select
+  end
+end program