re PR fortran/49110 (Deferred-length character result triggers (false positive)…

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

gcc/fortran/ChangeLog

+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

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)

gcc/testsuite/ChangeLog

+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.

gcc/testsuite/gfortran.dg/deferred_type_param_5.f90

+! { 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