summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/char_pointer_func.f90
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/testsuite/gfortran.dg/char_pointer_func.f90')
-rw-r--r--gcc/testsuite/gfortran.dg/char_pointer_func.f9044
1 files changed, 44 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/char_pointer_func.f90 b/gcc/testsuite/gfortran.dg/char_pointer_func.f90
new file mode 100644
index 000000000..23f867eeb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_pointer_func.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+program char_pointer_func
+! Test assignments from character pointer functions, required
+! to fix PR17192 and PR17202
+! Provided by Paul Thomas pault@gcc.gnu.org
+ implicit none
+ character*4 :: c0
+ character*4, pointer :: c1
+ character*4, pointer :: c2(:)
+ allocate (c1, c2(1))
+! Check that we have not broken non-pointer characters.
+ c0 = foo ()
+ if (c0 /= "abcd") call abort ()
+! Value assignments
+ c1 = sfoo ()
+ if (c1 /= "abcd") call abort ()
+ c2 = afoo (c0)
+ if (c2(1) /= "abcd") call abort ()
+ deallocate (c1, c2)
+! Pointer assignments
+ c1 => sfoo ()
+ if (c1 /= "abcd") call abort ()
+ c2 => afoo (c0)
+ if (c2(1) /= "abcd") call abort ()
+ deallocate (c1, c2)
+contains
+ function foo () result (cc1)
+ character*4 :: cc1
+ cc1 = "abcd"
+ end function foo
+ function sfoo () result (sc1)
+ character*4, pointer :: sc1
+ allocate (sc1)
+ sc1 = "abcd"
+ end function sfoo
+ function afoo (c0) result (ac1)
+ character*4 :: c0
+ character*4, pointer :: ac1(:)
+ allocate (ac1(1))
+ ac1 = "abcd"
+ end function afoo
+end program char_pointer_func