1 files changed, 44 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/char_pointer_assign.f90 b/gcc/testsuite/gfortran.dg/char_pointer_assign.f90
new file mode 100644
index 000000000..62fcf0360
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_pointer_assign.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+program char_pointer_assign
+! Test character pointer assignments, required
+! to fix PR18890 and PR21297
+! Provided by Paul Thomas pault@gcc.gnu.org
+  implicit none
+  character*4, target        :: t1
+  character*4, target        :: t2(4) =(/"lmno","lmno","lmno","lmno"/)
+  character*4                :: const
+  character*4, pointer       :: c1, c3
+  character*4, pointer       :: c2(:), c4(:)
+  allocate (c3, c4(4))
+! Scalars first.
+  c3 = "lmno"          ! pointer = constant
+  t1 = c3              ! target = pointer
+  c1 => t1             ! pointer =>target
+  c1(2:3) = "nm"
+  c3 = c1              ! pointer = pointer
+  c3(1:1) = "o"
+  c3(4:4) = "l"
+  c1 => c3             ! pointer => pointer
+  if (t1 /= "lnmo") call abort ()
+  if (c1 /= "onml") call abort ()
+
+! Now arrays.
+  c4 = "lmno"          ! pointer = constant
+  t2 = c4              ! target = pointer
+  c2 => t2             ! pointer =>target
+  const = c2(1)
+  const(2:3) ="nm"     ! c2(:)(2:3) = "nm" is still broken
+  c2 = const
+  c4 = c2              ! pointer = pointer
+  const = c4(1)
+  const(1:1) ="o"      ! c4(:)(1:1) = "o" is still broken
+  const(4:4) ="l"      ! c4(:)(4:4) = "l" is still broken
+  c4 = const
+  c2 => c4             ! pointer => pointer
+  if (any (t2 /= "lnmo")) call abort ()
+  if (any (c2 /= "onml")) call abort ()
+  deallocate (c3, c4)
+end program char_pointer_assign
+