diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a1aec2588dff5d10a1df2d9c3b03426b90178368..38781ee1172fcbb2ab46d3091ba3021c027f7e6b 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 c55b142d0382a4ce43d741ab1ed0769a7dbc0c99..11bf277ae58513d21c03ab2393d5f8f43eb1db03 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 e160e00d09f234a0d5d987e61b254a8f70e422b4..2f1ddf14f196af1fd8d8c7454bdac9dcbe04a2fc 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 d0b7ab97acaf5d478d6e73bdbe384434096188b7..2e870bbc9687828f2ed6e00136b849b825fca19e 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 6ec417fb7df4f0468e5b16c61215c97b98b294b7..b1b97b4ca83f925980b93a0edf82f3c2908e19c1 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 0000000000000000000000000000000000000000..ff10b1afdc7902df5d54223b55c0845cbabf1b16
--- /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