re PR fortran/23675 (ICE in gfc_finish_var_decl (string manipulation))

2006-01-05  Erik Edelmann  <eedelman@gcc.gnu.org>

        PR fortran/23675
        * expr.c (gfc_expr_set_symbols_referenced): New function.
        * gfortran.h: Add a function prototype for it.
        * resolve.c (resolve_function): Use it for
        use associated character functions lengths.
        * expr.c, gfortran.h, resolve.c: Updated copyright years.


testsuite/
2006-01-05  Erik Edelmann  <eedelman@gcc.gnu.org>

        PR fortran/23675
        gfortran.dg/char_result_11.f90: New.

From-SVN: r109368

gcc/fortran/ChangeLog

+2006-01-05  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/23675
+	* expr.c (gfc_expr_set_symbols_referenced): New function.
+	* gfortran.h: Add a function prototype for it.
+	* resolve.c (resolve_function): Use it for
+	use associated character functions lengths.
+	* expr.c, gfortran.h, resolve.c: Updated copyright years.
+
 2006-01-03  Steven G. Kargl  <kargls@comcast.net>
 
 	PR fortran/25101

gcc/fortran/expr.c

 /* Routines for manipulation of expression nodes.
-   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation,
-   Inc.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software 
+   Foundation, Inc.
    Contributed by Andy Vaught
 
 This file is part of GCC.
@@ -2110,3 +2110,73 @@ gfc_get_variable_expr (gfc_symtree * var)
   return e;
 }
 
+
+/* Traverse expr, marking all EXPR_VARIABLE symbols referenced.  */
+
+void
+gfc_expr_set_symbols_referenced (gfc_expr * expr)
+{
+  gfc_actual_arglist *arg;
+  gfc_constructor *c;
+  gfc_ref *ref;
+  int i;
+
+  if (!expr) return;
+
+  switch (expr->expr_type)
+    {
+    case EXPR_OP:
+      gfc_expr_set_symbols_referenced (expr->value.op.op1);
+      gfc_expr_set_symbols_referenced (expr->value.op.op2);
+      break;
+
+    case EXPR_FUNCTION:
+      for (arg = expr->value.function.actual; arg; arg = arg->next)
+        gfc_expr_set_symbols_referenced (arg->expr);
+      break;
+
+    case EXPR_VARIABLE:
+      gfc_set_sym_referenced (expr->symtree->n.sym);
+      break;
+
+    case EXPR_CONSTANT:
+    case EXPR_NULL:
+    case EXPR_SUBSTRING:
+      break;
+
+    case EXPR_STRUCTURE:
+    case EXPR_ARRAY:
+      for (c = expr->value.constructor; c; c = c->next)
+        gfc_expr_set_symbols_referenced (c->expr);
+      break;
+
+    default:
+      gcc_unreachable ();
+      break;
+    }
+
+    for (ref = expr->ref; ref; ref = ref->next)
+      switch (ref->type)
+        {
+        case REF_ARRAY:
+          for (i = 0; i < ref->u.ar.dimen; i++)
+            {
+              gfc_expr_set_symbols_referenced (ref->u.ar.start[i]);
+              gfc_expr_set_symbols_referenced (ref->u.ar.end[i]);
+              gfc_expr_set_symbols_referenced (ref->u.ar.stride[i]);
+            }
+          break;
+           
+        case REF_COMPONENT:
+          break;
+           
+        case REF_SUBSTRING:
+          gfc_expr_set_symbols_referenced (ref->u.ss.start);
+          gfc_expr_set_symbols_referenced (ref->u.ss.end);
+          break;
+           
+        default:
+          gcc_unreachable ();
+          break;
+        }
+}

gcc/fortran/gfortran.h

 /* gfortran header file
-   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation,
-   Inc.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software 
+   Foundation, Inc.
    Contributed by Andy Vaught
 
 This file is part of GCC.
@@ -1854,6 +1854,7 @@ try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *);
 gfc_expr *gfc_default_initializer (gfc_typespec *);
 gfc_expr *gfc_get_variable_expr (gfc_symtree *);
 
+void gfc_expr_set_symbols_referenced (gfc_expr * expr);
 
 /* st.c */
 extern gfc_code new_st;

gcc/fortran/resolve.c

 /* Perform type resolution on the various stuctures.
-   Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+   Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, 
+   Inc.
    Contributed by Andy Vaught
 
 This file is part of GCC.
@@ -1167,6 +1168,16 @@ resolve_function (gfc_expr * expr)
 	}
     }
 
+  /* Character lengths of use associated functions may contains references to
+     symbols not referenced from the current program unit otherwise.  Make sure
+     those symbols are marked as referenced.  */
+
+  if (expr->ts.type == BT_CHARACTER && expr->value.function.esym 
+      && expr->value.function.esym->attr.use_assoc)
+    {
+      gfc_expr_set_symbols_referenced (expr->ts.cl->length);
+    }
+
   if (t == SUCCESS)
     find_noncopying_intrinsics (expr->value.function.esym,
 				expr->value.function.actual);

gcc/testsuite/ChangeLog

+2006-01-05  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/23675
+	gfortran.dg/char_result_11.f90: New.
+
 2006-01-04  Mark Mitchell  <mark@codesourcery.com>
 
 	PR c++/24782

gcc/testsuite/gfortran.dg/char_result_11.f90

+! { dg-do compile }
+! PR 23675: Character function of module variable length
+module cutils
+
+    implicit none
+    private
+   
+    type t
+        integer :: k = 25
+        integer :: kk(3) = (/30, 40, 50 /)
+    end type t
+
+    integer :: m1 = 25, m2 = 25, m3 = 25, m4 = 25, m5 = 25
+    integer :: n1 = 3, n2 = 3, n3 = 3, n4 = 3, n5 = 3, n6 = 3, n7 = 3, n8 = 3, n9 = 3
+    character(10) :: s = "abcdefghij"
+    integer :: x(4) = (/ 30, 40, 50, 60 /)
+    type(t) :: tt1(5), tt2(5)
+
+    public :: IntToChar1, IntToChar2, IntToChar3, IntToChar4, IntToChar5, &
+                IntToChar6, IntToChar7, IntToChar8
+
+contains
+
+    pure integer function get_k(tt)
+        type(t), intent(in) :: tt
+
+        get_k = tt%k
+    end function get_k
+ 
+    function IntToChar1(integerValue) result(a)
+        integer, intent(in) :: integerValue
+        character(len=m1)  :: a
+ 
+        write(a, *) integerValue
+    end function IntToChar1
+ 
+    function IntToChar2(integerValue) result(a)
+        integer, intent(in) :: integerValue
+        character(len=m2+n1)  :: a
+ 
+        write(a, *) integerValue
+    end function IntToChar2
+ 
+    function IntToChar3(integerValue) result(a)
+        integer, intent(in) :: integerValue
+        character(len=iachar(s(n2:n3)))  :: a
+ 
+        write(a, *) integerValue
+    end function IntToChar3
+ 
+    function IntToChar4(integerValue) result(a)
+        integer, intent(in) :: integerValue
+        character(len=tt1(n4)%k)  :: a
+ 
+        write(a, *) integerValue
+    end function IntToChar4
+ 
+    function IntToChar5(integerValue) result(a)
+        integer, intent(in) :: integerValue
+        character(len=maxval((/m3, n5/)))  :: a
+ 
+        write(a, *) integerValue
+    end function IntToChar5
+ 
+    function IntToChar6(integerValue) result(a)
+        integer, intent(in) :: integerValue
+        character(len=x(n6))  :: a
+ 
+        write(a, *) integerValue
+    end function IntToChar6
+ 
+    function IntToChar7(integerValue) result(a)
+        integer, intent(in) :: integerValue
+        character(len=tt2(min(m4, n7, 2))%kk(n8))  :: a
+     
+        write(a, *) integerValue
+    end function IntToChar7
+ 
+    function IntToChar8(integerValue) result(a)
+        integer, intent(in) :: integerValue
+        character(len=get_k(t(m5, (/31, n9, 53/))))  :: a
+ 
+        write(a, *) integerValue
+    end function IntToChar8
+
+end module cutils
+
+
+program test
+
+    use cutils
+
+    implicit none
+    character(25) :: str
+    
+    str = IntToChar1(3)
+    print *, str
+    str = IntToChar2(3)
+    print *, str
+    str = IntToChar3(3)
+    print *, str
+    str = IntToChar4(3)
+    print *, str
+    str = IntToChar5(3)
+    print *, str
+    str = IntToChar6(3)
+    print *, str
+    str = IntToChar7(3)
+    print *, str
+    str = IntToChar8(3)
+    print *, str
+
+end program test