git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/49110 (Deferred-length character result triggers (false positive) error for pure procedures) 

2012-05-12  Tobias Burnus  <burnus@net-b.de>

        PR fortran/49110
        PR fortran/52843
        * resolve.c (resolve_fl_procedure): Don't regard
        character(len=:) as character(*) in the diagnostic.

2012-05-12  Tobias Burnus  <burnus@net-b.de>

        PR fortran/49110
        PR fortran/52843
        * gfortran.dg/deferred_type_param_5.f90: New.

From-SVN: r187427
This commit is contained in:
Tobias Burnus 2012-05-12 11:53:53 +02:00 committed by Tobias Burnus
parent 3906795848
commit dd9123310d
4 changed files with 65 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View File

@ -1,3 +1,10 @@
2012-05-12 Tobias Burnus <burnus@net-b.de>
PR fortran/49110
PR fortran/52843
* resolve.c (resolve_fl_procedure): Don't regard
character(len=:) as character(*) in the diagnostic.
2012-05-11 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/52537

2
gcc/fortran/resolve.c
View File

@ -10726,7 +10726,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
actual length; (ii) To declare a named constant; or (iii) External
function - but length must be declared in calling scoping unit. */
if (sym->attr.function
&& sym->ts.type == BT_CHARACTER
&& sym->ts.type == BT_CHARACTER && !sym->ts.deferred
&& sym->ts.u.cl && sym->ts.u.cl->length == NULL)
{
if ((sym->as && sym->as->rank) || (sym->attr.pointer)

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2012-05-12 Tobias Burnus <burnus@net-b.de>
PR fortran/49110
PR fortran/52843
* gfortran.dg/deferred_type_param_5.f90: New.
2012-05-12 Paolo Carlini <paolo.carlini@oracle.com>
* g++.dg/parse/error47.C: New.

51
gcc/testsuite/gfortran.dg/deferred_type_param_5.f90 Normal file
View File

@ -0,0 +1,51 @@
! { dg-do compile }
!
! PR fortran/49110
! PR fortran/52843
!
! Based on a contributed code by jwmwalrus@gmail.com
!
! Before, character(len=:) result variable were rejected in PURE functions.
!
module mod1
use iso_c_binding
implicit none
contains
pure function c_strlen(str)
character(KIND = C_CHAR), intent(IN) :: str(*)
integer :: c_strlen,i
i = 1
do
if (i < 1) then
c_strlen = 0
return
end if
if (str(i) == c_null_char) exit
i = i + 1
end do
c_strlen = i - 1
end function c_strlen
pure function c2fstring(cbuffer) result(string)
character(:), allocatable :: string
character(KIND = C_CHAR), intent(IN) :: cbuffer(*)
integer :: i
continue
string = REPEAT(' ', c_strlen(cbuffer))
do i = 1, c_strlen(cbuffer)
if (cbuffer(i) == C_NULL_CHAR) exit
string(i:i) = cbuffer(i)
enddo
string = TRIM(string)
end function
end module mod1
use mod1
character(len=:), allocatable :: str
str = c2fstring("ABCDEF"//c_null_char//"GHI")
if (len(str) /= 6 .or. str /= "ABCDEF") call abort()
end