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/char_result_1.f90 | 114 ++++++++++++++++++++++++++++
 1 file changed, 114 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/char_result_1.f90

(limited to 'gcc/testsuite/gfortran.dg/char_result_1.f90')

diff --git a/gcc/testsuite/gfortran.dg/char_result_1.f90 b/gcc/testsuite/gfortran.dg/char_result_1.f90
new file mode 100644
index 000000000..2e0b4ef14
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_1.f90
@@ -0,0 +1,114 @@
+! Related to PR 15326.  Try calling string functions whose lengths depend
+! on the lengths of other strings.
+! { dg-do run }
+pure function double (string)
+  character (len = *), intent (in) :: string
+  character (len = len (string) * 2) :: double
+  double = string // string
+end function double
+
+function f1 (string)
+  character (len = *) :: string
+  character (len = len (string)) :: f1
+  f1 = ''
+end function f1
+
+function f2 (string1, string2)
+  character (len = *) :: string1
+  character (len = len (string1) - 20) :: string2
+  character (len = len (string1) + len (string2) / 2) :: f2
+  f2 = ''
+end function f2
+
+program main
+  implicit none
+
+  interface
+    pure function double (string)
+      character (len = *), intent (in) :: string
+      character (len = len (string) * 2) :: double
+    end function double
+    function f1 (string)
+      character (len = *) :: string
+      character (len = len (string)) :: f1
+    end function f1
+    function f2 (string1, string2)
+      character (len = *) :: string1
+      character (len = len (string1) - 20) :: string2
+      character (len = len (string1) + len (string2) / 2) :: f2
+    end function f2
+  end interface
+
+  integer :: a
+  character (len = 80)  :: text
+  character (len = 70), target :: textt
+  character (len = 70), pointer :: textp
+
+  a = 42
+  textp => textt
+
+  call test (f1 (text), 80)
+  call test (f2 (text, text), 110)
+  call test (f3 (text), 115)
+  call test (f4 (text), 192)
+  call test (f5 (text), 160)
+  call test (f6 (text), 39)
+
+  call test (f1 (textp), 70)
+  call test (f2 (textp, text), 95)
+  call test (f3 (textp), 105)
+  call test (f4 (textp), 192)
+  call test (f5 (textp), 140)
+  call test (f6 (textp), 29)
+
+  call indirect (textp)
+contains
+  function f3 (string)
+    integer, parameter :: l1 = 30
+    character (len = *) :: string
+    character (len = len (string) + l1 + 5) :: f3
+    f3 = ''
+  end function f3
+
+  function f4 (string)
+    character (len = len (text) - 10) :: string
+    character (len = len (string) + len (text) + a) :: f4
+    f4 = ''
+  end function f4
+
+  function f5 (string)
+    character (len = *) :: string
+    character (len = len (double (string))) :: f5
+    f5 = ''
+  end function f5
+
+  function f6 (string)
+    character (len = *) :: string
+    character (len = len (string (a:))) :: f6
+    f6 = ''
+  end function f6
+
+  subroutine indirect (text2)
+    character (len = *) :: text2
+
+    call test (f1 (text), 80)
+    call test (f2 (text, text), 110)
+    call test (f3 (text), 115)
+    call test (f4 (text), 192)
+    call test (f5 (text), 160)
+    call test (f6 (text), 39)
+
+    call test (f1 (text2), 70)
+    call test (f2 (text2, text2), 95)
+    call test (f3 (text2), 105)
+    call test (f4 (text2), 192)
+    call test (f5 (text2), 140)
+    call test (f6 (text2), 29)
+  end subroutine indirect
+
+  subroutine test (string, length)
+    character (len = *) :: string
+    integer, intent (in) :: length
+    if (len (string) .ne. length) call abort
+  end subroutine test
+end program main
-- 
cgit v1.2.3