[gfortran, patch] PR 23675: Character function of module-variable length
Erik Edelmann
erik.edelmann@iki.fi
Mon Jan 2 02:07:00 GMT 2006
:ADDPATCH fortran:
Here's a patch for PR 23675. The problem is in short this: When
translating the call to the function IntToChar2 in the code
--------------------
module cutils
implicit none
private
integer :: maxStringLength = 25
public :: IntToChar2
contains
function IntToChar2(integerValue)
integer, intent(in) :: integerValue
character(len=maxStringLength) :: IntToChar2
write(IntToChar2, *) integerValue
end function IntToChar2
end module cutils
program test
use cutils
implicit none
character(25) :: str
str = IntToChar2(3)
end program test
-----------------------
we will call gfc_get_symbol_decl() (in trans-decl.c) for the
symbol of maxStringLength. Since maxStringLength hasn't been
(explicitely) referenced in 'program test', it doesn't have
sym->attr.referenced set, which is why we crash at the line
gcc_assert (sym->attr.referenced);
in gfc_get_symbol_decl(). My solution is to, from trans-expr.c
(gfc_conv_function_call), traverse the expression tree of the
length of the function result, and mark all variables we find as
referenced.
Reg.tested on Linux/x86, on mainline and 4.1. Ok to commit?
Erik
2006-01-02 Erik Edelmann <eedelman@gcc.gnu.org>
fortran/PR 23675
* expr.c (gfc_expr_set_symbols_referenced): New function.
* gfortran.h: Add a function prototype for it.
* trans-expr.c (gfc_conv_function_call): Use it.
2006-01-02 Erik Edelmann <eedelman@gcc.gnu.org>
fortran/PR 23675
gfortran.dg/char_result_11.f90: New.
-------------- next part --------------
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (revision 109225)
+++ gcc/fortran/trans-expr.c (working copy)
@@ -1631,6 +1631,7 @@ gfc_conv_function_call (gfc_se * se, gfc
{
/* Calculate the length of the returned string. */
gfc_init_se (&parmse, NULL);
+ gfc_expr_set_symbols_referenced (sym->ts.cl->length);
if (need_interface_mapping)
gfc_apply_interface_mapping (&mapping, &parmse, sym->ts.cl->length);
else
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 109225)
+++ gcc/fortran/gfortran.h (working copy)
@@ -1854,6 +1854,7 @@ try gfc_check_assign_symbol (gfc_symbol
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;
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c (revision 109225)
+++ gcc/fortran/expr.c (working copy)
@@ -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;
+ }
+}
-------------- next part --------------
! { 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
More information about the Gcc-patches
mailing list