This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: PR fortran/15326: returning strings with non-constant lengths


Paul Brook <paul@codesourcery.com> writes:
> On Friday 02 September 2005 09:57, Richard Sandiford wrote:
>> There are some things I know don't work for unrelated reasons.
>
> Do you know if there are PRs for these things? If not then it's probably
> worth creating, unless you're already planning on fixing them soon.

I tried to fix the first bug in a later patch.  The second seems to
be the same as 18899.

> Ok.

Thanks.

>> gcc/testsuite/
>> 	PR fortran/15326
>> 	* gfortran.fortran-torture/execute/pr15326-1.f90,
>> 	* gfortran.fortran-torture/execute/pr15326-2.f90,
>> 	* gfortran.fortran-torture/execute/pr15326-3.f90,
>> 	* gfortran.fortran-torture/execute/pr15326-4.f90,
>> 	* gfortran.fortran-torture/execute/pr15326-5.f90,
>> 	* gfortran.fortran-torture/execute/pr15326-6.f90,
>> 	* gfortran.fortran-torture/execute/pr15326-7.f90
>> 	* gfortran.fortran-torture/execute/pr15326-8.f90: New tests.
>
> Previous comments about testcases apply. Preferred naming is eg.
> character_result_1.f90, and mention the PR in a comment.

OK.  For the record, here's what I committed.  I used "char_result_*.f90"
for consistency with existing char_*.f90 tests.

Richard


gcc/testsuite/
	PR fortran/15326
	* gfortran.dg/char_result_1.f90,
	* gfortran.dg/char_result_2.f90,
	* gfortran.dg/char_result_3.f90,
	* gfortran.dg/char_result_4.f90,
	* gfortran.dg/char_result_5.f90,
	* gfortran.dg/char_result_6.f90,
	* gfortran.dg/char_result_7.f90,
	* gfortran.dg/char_result_8.f90: New tests.

diff -c /dev/null gcc/testsuite/gfortran.dg/char_result_1.f90
*** /dev/null	2005-06-16 22:49:09.000000000 +0100
--- gcc/testsuite/gfortran.dg/char_result_1.f90	2005-09-08 19:26:18.000000000 +0100
***************
*** 0 ****
--- 1,113 ----
+ ! 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), target :: text
+   character (len = 70), pointer :: textp
+ 
+   a = 42
+   textp => text
+ 
+   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
diff -c /dev/null gcc/testsuite/gfortran.dg/char_result_2.f90
*** /dev/null	2005-06-16 22:49:09.000000000 +0100
--- gcc/testsuite/gfortran.dg/char_result_2.f90	2005-09-08 19:34:10.000000000 +0100
***************
*** 0 ****
--- 1,105 ----
+ ! Like char_result_1.f90, but the string arguments are pointers.
+ ! { 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 = *), pointer :: string
+   character (len = len (string)) :: f1
+   f1 = ''
+ end function f1
+ 
+ function f2 (string1, string2)
+   character (len = *), pointer :: string1
+   character (len = len (string1) - 20), pointer :: 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 = *), pointer :: string
+       character (len = len (string)) :: f1
+     end function f1
+     function f2 (string1, string2)
+       character (len = *), pointer :: string1
+       character (len = len (string1) - 20), pointer :: string2
+       character (len = len (string1) + len (string2) / 2) :: f2
+     end function f2
+   end interface
+ 
+   integer :: a
+   character (len = 80), target :: text
+   character (len = 70), pointer :: textp
+ 
+   a = 42
+   textp => text
+ 
+   call test (f1 (textp), 70)
+   call test (f2 (textp, textp), 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 = *), pointer :: string
+     character (len = len (string) + l1 + 5) :: f3
+     f3 = ''
+   end function f3
+ 
+   function f4 (string)
+     character (len = len (text) - 10), pointer :: string
+     character (len = len (string) + len (text) + a) :: f4
+     f4 = ''
+   end function f4
+ 
+   function f5 (string)
+     character (len = *), pointer :: string
+     character (len = len (double (string))) :: f5
+     f5 = ''
+   end function f5
+ 
+   function f6 (string)
+     character (len = *), pointer :: string
+     character (len = len (string (a:))) :: f6
+     f6 = ''
+   end function f6
+ 
+   subroutine indirect (textp2)
+     character (len = 50), pointer :: textp2
+ 
+     call test (f1 (textp), 70)
+     call test (f2 (textp, textp), 95)
+     call test (f3 (textp), 105)
+     call test (f4 (textp), 192)
+     call test (f5 (textp), 140)
+     call test (f6 (textp), 29)
+ 
+     call test (f1 (textp2), 50)
+     call test (f2 (textp2, textp), 65)
+     call test (f3 (textp2), 85)
+     call test (f4 (textp2), 192)
+     call test (f5 (textp2), 100)
+     call test (f6 (textp2), 9)
+   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
diff -c /dev/null gcc/testsuite/gfortran.dg/char_result_3.f90
*** /dev/null	2005-06-16 22:49:09.000000000 +0100
--- gcc/testsuite/gfortran.dg/char_result_3.f90	2005-09-08 19:37:01.000000000 +0100
***************
*** 0 ****
--- 1,78 ----
+ ! Related to PR 15326.  Try calling string functions whose lengths involve
+ ! some sort of array calculation.
+ ! { dg-do run }
+ pure elemental function double (x)
+   integer, intent (in) :: x
+   integer :: double
+   double = x * 2
+ end function double
+ 
+ program main
+   implicit none
+ 
+   interface
+     pure elemental function double (x)
+       integer, intent (in) :: x
+       integer :: double
+     end function double
+   end interface
+ 
+   integer, dimension (100:104), target :: a
+   integer, dimension (:), pointer :: ap
+   integer :: i, lower
+ 
+   a = (/ (i + 5, i = 0, 4) /)
+   ap => a
+   lower = 11
+ 
+   call test (f1 (a), 35)
+   call test (f1 (ap), 35)
+   call test (f1 ((/ 5, 10, 50 /)), 65)
+   call test (f1 (a (101:103)), 21)
+ 
+   call test (f2 (a), 115)
+   call test (f2 (ap), 115)
+   call test (f2 ((/ 5, 10, 50 /)), 119)
+   call test (f2 (a (101:103)), 116)
+ 
+   call test (f3 (a), 60)
+   call test (f3 (ap), 60)
+   call test (f3 ((/ 5, 10, 50 /)), 120)
+   call test (f3 (a (101:103)), 30)
+ 
+   call test (f4 (a, 13, 1), 21)
+   call test (f4 (ap, 13, 2), 14)
+   call test (f4 ((/ 5, 10, 50 /), 12, 1), 60)
+   call test (f4 (a (101:103), 12, 1), 15)
+ contains
+   function f1 (array)
+     integer, dimension (10:) :: array
+     character (len = sum (array)) :: f1
+     f1 = ''
+   end function f1
+ 
+   function f2 (array)
+     integer, dimension (10:) :: array
+     character (len = array (11) + a (104) + 100) :: f2
+     f2 = ''
+   end function f2
+ 
+   function f3 (array)
+     integer, dimension (:) :: array
+     character (len = sum (double (array (2:)))) :: f3
+     f3 = ''
+   end function f3
+ 
+   function f4 (array, upper, stride)
+     integer, dimension (10:) :: array
+     integer :: upper, stride
+     character (len = sum (array (lower:upper:stride))) :: f4
+     f4 = ''
+   end function f4
+ 
+   subroutine test (string, length)
+     character (len = *) :: string
+     integer, intent (in) :: length
+     if (len (string) .ne. length) call abort
+   end subroutine test
+ end program main
diff -c /dev/null gcc/testsuite/gfortran.dg/char_result_4.f90
*** /dev/null	2005-06-16 22:49:09.000000000 +0100
--- gcc/testsuite/gfortran.dg/char_result_4.f90	2005-09-08 19:33:57.000000000 +0100
***************
*** 0 ****
--- 1,62 ----
+ ! Like char_result_3.f90, but the array arguments are pointers.
+ ! { dg-do run }
+ pure elemental function double (x)
+   integer, intent (in) :: x
+   integer :: double
+   double = x * 2
+ end function double
+ 
+ program main
+   implicit none
+ 
+   interface
+     pure elemental function double (x)
+       integer, intent (in) :: x
+       integer :: double
+     end function double
+   end interface
+ 
+   integer, dimension (100:104), target :: a
+   integer, dimension (:), pointer :: ap
+   integer :: i, lower
+ 
+   a = (/ (i + 5, i = 0, 4) /)
+   ap => a
+   lower = 1
+ 
+   call test (f1 (ap), 35)
+   call test (f2 (ap), 115)
+   call test (f3 (ap), 60)
+   call test (f4 (ap, 5, 2), 21)
+ contains
+   function f1 (array)
+     integer, dimension (:), pointer :: array
+     character (len = sum (array)) :: f1
+     f1 = ''
+   end function f1
+ 
+   function f2 (array)
+     integer, dimension (:), pointer :: array
+     character (len = array (2) + a (104) + 100) :: f2
+     f2 = ''
+   end function f2
+ 
+   function f3 (array)
+     integer, dimension (:), pointer :: array
+     character (len = sum (double (array (2:)))) :: f3
+     f3 = ''
+   end function f3
+ 
+   function f4 (array, upper, stride)
+     integer, dimension (:), pointer :: array
+     integer :: upper, stride
+     character (len = sum (array (lower:upper:stride))) :: f4
+     f4 = ''
+   end function f4
+ 
+   subroutine test (string, length)
+     character (len = *) :: string
+     integer, intent (in) :: length
+     if (len (string) .ne. length) call abort
+   end subroutine test
+ end program main
diff -c /dev/null gcc/testsuite/gfortran.dg/char_result_5.f90
*** /dev/null	2005-06-16 22:49:09.000000000 +0100
--- gcc/testsuite/gfortran.dg/char_result_5.f90	2005-09-08 19:42:25.000000000 +0100
***************
*** 0 ****
--- 1,137 ----
+ ! Related to PR 15326.  Test calls to string functions whose lengths
+ ! depend on various types of scalar value.
+ ! { dg-do run }
+ pure function select (selector, iftrue, iffalse)
+   logical, intent (in) :: selector
+   integer, intent (in) :: iftrue, iffalse
+   integer :: select
+ 
+   if (selector) then
+     select = iftrue
+   else
+     select = iffalse
+   end if
+ end function select
+ 
+ program main
+   implicit none
+ 
+   interface
+     pure function select (selector, iftrue, iffalse)
+       logical, intent (in) :: selector
+       integer, intent (in) :: iftrue, iffalse
+       integer :: select
+     end function select
+   end interface
+ 
+   type pair
+     integer :: left, right
+   end type pair
+ 
+   integer, target :: i
+   integer, pointer :: ip
+   real, target :: r
+   real, pointer :: rp
+   logical, target :: l
+   logical, pointer :: lp
+   complex, target :: c
+   complex, pointer :: cp
+   character, target :: ch
+   character, pointer :: chp
+   type (pair), target :: p
+   type (pair), pointer :: pp
+ 
+   character (len = 10) :: dig
+ 
+   i = 100
+   r = 50.5
+   l = .true.
+   c = (10.9, 11.2)
+   ch = '1'
+   p%left = 40
+   p%right = 50
+ 
+   ip => i
+   rp => r
+   lp => l
+   cp => c
+   chp => ch
+   pp => p
+ 
+   dig = '1234567890'
+ 
+   call test (f1 (i), 200)
+   call test (f1 (ip), 200)
+   call test (f1 (-30), 60)
+   call test (f1 (i / (-4)), 50)
+ 
+   call test (f2 (r), 100)
+   call test (f2 (rp), 100)
+   call test (f2 (70.1), 140)
+   call test (f2 (r / 4), 24)
+   call test (f2 (real (i)), 200)
+ 
+   call test (f3 (l), 50)
+   call test (f3 (lp), 50)
+   call test (f3 (.false.), 55)
+   call test (f3 (i < 30), 55)
+ 
+   call test (f4 (c), 10)
+   call test (f4 (cp), 10)
+   call test (f4 (cmplx (60.0, r)), 60)
+   call test (f4 (cmplx (r, 1.0)), 50)
+ 
+   call test (f5 (ch), 11)
+   call test (f5 (chp), 11)
+   call test (f5 ('23'), 12)
+   call test (f5 (dig (3:)), 13)
+   call test (f5 (dig (10:)), 10)
+ 
+   call test (f6 (p), 145)
+   call test (f6 (pp), 145)
+   call test (f6 (pair (20, 10)), 85)
+   call test (f6 (pair (i / 2, 1)), 106)
+ contains
+   function f1 (i)
+     integer :: i
+     character (len = abs (i) * 2) :: f1
+     f1 = ''
+   end function f1
+ 
+   function f2 (r)
+     real :: r
+     character (len = floor (r) * 2) :: f2
+     f2 = ''
+   end function f2
+ 
+   function f3 (l)
+     logical :: l
+     character (len = select (l, 50, 55)) :: f3
+     f3 = ''
+   end function f3
+ 
+   function f4 (c)
+     complex :: c
+     character (len = int (c)) :: f4
+     f4 = ''
+   end function f4
+ 
+   function f5 (c)
+     character :: c
+     character (len = scan ('123456789', c) + 10) :: f5
+     f5 = ''
+   end function f5
+ 
+   function f6 (p)
+     type (pair) :: p
+     integer :: i
+     character (len = sum ((/ p%left, p%right, (i, i = 1, 10) /))) :: f6
+     f6 = ''
+   end function f6
+ 
+   subroutine test (string, length)
+     character (len = *) :: string
+     integer, intent (in) :: length
+     if (len (string) .ne. length) call abort
+   end subroutine test
+ end program main
diff -c /dev/null gcc/testsuite/gfortran.dg/char_result_6.f90
*** /dev/null	2005-06-16 22:49:09.000000000 +0100
--- gcc/testsuite/gfortran.dg/char_result_6.f90	2005-09-08 19:33:42.000000000 +0100
***************
*** 0 ****
--- 1,107 ----
+ ! Like char_result_5.f90, but the function arguments are pointers to scalars.
+ ! { dg-do run }
+ pure function select (selector, iftrue, iffalse)
+   logical, intent (in) :: selector
+   integer, intent (in) :: iftrue, iffalse
+   integer :: select
+ 
+   if (selector) then
+     select = iftrue
+   else
+     select = iffalse
+   end if
+ end function select
+ 
+ program main
+   implicit none
+ 
+   interface
+     pure function select (selector, iftrue, iffalse)
+       logical, intent (in) :: selector
+       integer, intent (in) :: iftrue, iffalse
+       integer :: select
+     end function select
+   end interface
+ 
+   type pair
+     integer :: left, right
+   end type pair
+ 
+   integer, target :: i
+   integer, pointer :: ip
+   real, target :: r
+   real, pointer :: rp
+   logical, target :: l
+   logical, pointer :: lp
+   complex, target :: c
+   complex, pointer :: cp
+   character, target :: ch
+   character, pointer :: chp
+   type (pair), target :: p
+   type (pair), pointer :: pp
+ 
+   i = 100
+   r = 50.5
+   l = .true.
+   c = (10.9, 11.2)
+   ch = '1'
+   p%left = 40
+   p%right = 50
+ 
+   ip => i
+   rp => r
+   lp => l
+   cp => c
+   chp => ch
+   pp => p
+ 
+   call test (f1 (ip), 200)
+   call test (f2 (rp), 100)
+   call test (f3 (lp), 50)
+   call test (f4 (cp), 10)
+   call test (f5 (chp), 11)
+   call test (f6 (pp), 145)
+ contains
+   function f1 (i)
+     integer, pointer :: i
+     character (len = abs (i) * 2) :: f1
+     f1 = ''
+   end function f1
+ 
+   function f2 (r)
+     real, pointer :: r
+     character (len = floor (r) * 2) :: f2
+     f2 = ''
+   end function f2
+ 
+   function f3 (l)
+     logical, pointer :: l
+     character (len = select (l, 50, 55)) :: f3
+     f3 = ''
+   end function f3
+ 
+   function f4 (c)
+     complex, pointer :: c
+     character (len = int (c)) :: f4
+     f4 = ''
+   end function f4
+ 
+   function f5 (c)
+     character, pointer :: c
+     character (len = scan ('123456789', c) + 10) :: f5
+     f5 = ''
+   end function f5
+ 
+   function f6 (p)
+     type (pair), pointer :: p
+     integer :: i
+     character (len = sum ((/ p%left, p%right, (i, i = 1, 10) /))) :: f6
+     f6 = ''
+   end function f6
+ 
+   subroutine test (string, length)
+     character (len = *) :: string
+     integer, intent (in) :: length
+     if (len (string) .ne. length) call abort
+   end subroutine test
+ end program main
diff -c /dev/null gcc/testsuite/gfortran.dg/char_result_7.f90
*** /dev/null	2005-06-16 22:49:09.000000000 +0100
--- gcc/testsuite/gfortran.dg/char_result_7.f90	2005-09-08 19:33:27.000000000 +0100
***************
*** 0 ****
--- 1,55 ----
+ ! Related to PR 15326.  Try calling string functions whose lengths depend
+ ! on a dummy procedure.
+ ! { dg-do run }
+ integer pure function double (x)
+   integer, intent (in) :: x
+   double = x * 2
+ end function double
+ 
+ program main
+   implicit none
+ 
+   interface
+     integer pure function double (x)
+       integer, intent (in) :: x
+     end function double
+   end interface
+ 
+   call test (f1 (double, 100), 200)
+   call test (f2 (double, 70), 140)
+ 
+   call indirect (double)
+ contains
+   function f1 (fn, i)
+     integer :: i
+     interface
+       integer pure function fn (x)
+         integer, intent (in) :: x
+       end function fn
+     end interface
+     character (len = fn (i)) :: f1
+     f1 = ''
+   end function f1
+ 
+   function f2 (fn, i)
+     integer :: i, fn
+     character (len = fn (i)) :: f2
+     f2 = ''
+   end function f2
+ 
+   subroutine indirect (fn)
+     interface
+       integer pure function fn (x)
+         integer, intent (in) :: x
+       end function fn
+     end interface
+     call test (f1 (fn, 100), 200)
+     call test (f2 (fn, 70), 140)
+   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
diff -c /dev/null gcc/testsuite/gfortran.dg/char_result_8.f90
*** /dev/null	2005-06-16 22:49:09.000000000 +0100
--- gcc/testsuite/gfortran.dg/char_result_8.f90	2005-09-08 19:33:35.000000000 +0100
***************
*** 0 ****
--- 1,51 ----
+ ! Related to PR 15326.  Compare functions that return string pointers with
+ ! functions that return strings.
+ ! { dg-do run }
+ program main
+   implicit none
+ 
+   character (len = 100), target :: string
+ 
+   call test (f1 (), 30)
+   call test (f2 (50), 50)
+   call test (f3 (), 30)
+   call test (f4 (70), 70)
+ 
+   call indirect (100)
+ contains
+   function f1
+     character (len = 30) :: f1
+     f1 = ''
+   end function f1
+ 
+   function f2 (i)
+     integer :: i
+     character (len = i) :: f2
+     f2 = ''
+   end function f2
+ 
+   function f3
+     character (len = 30), pointer :: f3
+     f3 => string
+   end function f3
+ 
+   function f4 (i)
+     integer :: i
+     character (len = i), pointer :: f4
+     f4 => string
+   end function f4
+ 
+   subroutine indirect (i)
+     integer :: i
+     call test (f1 (), 30)
+     call test (f2 (i), i)
+     call test (f3 (), 30)
+     call test (f4 (i), i)
+   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


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]