From 11820978d85394e388558762f628503d826c8e6d Mon Sep 17 00:00:00 2001 From: burnus Date: Sat, 12 May 2012 09:53:53 +0000 Subject: [PATCH] 2012-05-12 Tobias Burnus 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 PR fortran/49110 PR fortran/52843 * gfortran.dg/deferred_type_param_5.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@187427 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 7 +++ gcc/fortran/resolve.c | 2 +- gcc/testsuite/ChangeLog | 6 +++ .../gfortran.dg/deferred_type_param_5.f90 | 51 ++++++++++++++++++++++ 4 files changed, 65 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/deferred_type_param_5.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e761ef51154..faffa290f24 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2012-05-12 Tobias Burnus + + 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 PR fortran/52537 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index b3a23ed73c9..4a072303c49 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 282cfc0e3ec..5f5e6892272 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2012-05-12 Tobias Burnus + + PR fortran/49110 + PR fortran/52843 + * gfortran.dg/deferred_type_param_5.f90: New. + 2012-05-12 Paolo Carlini * g++.dg/parse/error47.C: New. diff --git a/gcc/testsuite/gfortran.dg/deferred_type_param_5.f90 b/gcc/testsuite/gfortran.dg/deferred_type_param_5.f90 new file mode 100644 index 00000000000..8380b9d2d4d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/deferred_type_param_5.f90 @@ -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 -- 2.11.4.GIT