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

6 files changed, 214 insertions, 5 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a1aec25..38781ee 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+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
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index c55b142..11bf277 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1,6 +1,6 @@
 /* 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;
+        }
+}
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index e160e00..2f1ddf1 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1,6 +1,6 @@
 /* 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;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index d0b7ab9..2e870bb 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1,5 +1,6 @@
 /* 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);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6ec417f..b1b97b4 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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
diff --git a/gcc/testsuite/gfortran.dg/char_result_11.f90 b/gcc/testsuite/gfortran.dg/char_result_11.f90
new file mode 100644
index 0000000..ff10b1a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_11.f90
@@ -0,0 +1,113 @@
+! { 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