From 20c9dc8aacd8abe8ddcc5d0ba2da84e78c030b50 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Tobias=20Schl=C3=BCter?= Date: Thu, 15 Jul 2004 16:53:28 +0200 Subject: [PATCH] re PR libfortran/15234 (libgfortran doesn't compile on Tru64 UNIX V4.0F) PR fortran/15234 * trans-array.c gfc_trans_g77_array, gfc_trans_dummy_array_bias): Don't call gfc_trans_string_init for assumed length characters. (gfc_conv_expr_descriptor): Set se->string_length if dealing with a character expression. (gfc_cvonv_array_parameter): Pass string length when passing character array according to g77 conventions. From-SVN: r84752 --- gcc/fortran/ChangeLog | 11 +++++++++++ gcc/fortran/trans-array.c | 19 ++++++++++++++++--- 2 files changed, 27 insertions(+), 3 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 083f59f0fdf..687eeab4449 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2004-07-15 Tobias Schlueter + + PR fortran/15234 + * trans-array.c gfc_trans_g77_array, + gfc_trans_dummy_array_bias): Don't call gfc_trans_string_init + for assumed length characters. + (gfc_conv_expr_descriptor): Set se->string_length if dealing + with a character expression. + (gfc_cvonv_array_parameter): Pass string length when passing + character array according to g77 conventions. + 2004-07-12 Paul Brook * expr.c (gfc_check_assign_symbol): Handle pointer assignments. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 88e286544ef..7ba677ea82c 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2947,7 +2947,7 @@ gfc_trans_g77_array (gfc_symbol * sym, tree body) gfc_start_block (&block); if (sym->ts.type == BT_CHARACTER - && !INTEGER_CST_P (sym->ts.cl->backend_decl)) + && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL) gfc_trans_init_string_length (sym->ts.cl, &block); /* Evaluate the bounds of the array. */ @@ -3026,7 +3026,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body) gfc_start_block (&block); if (sym->ts.type == BT_CHARACTER - && !INTEGER_CST_P (sym->ts.cl->backend_decl)) + && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL) gfc_trans_init_string_length (sym->ts.cl, &block); checkparm = (sym->as->type == AS_EXPLICIT && flag_bounds_check); @@ -3359,6 +3359,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) { se->expr = desc; } + if (expr->ts.type == BT_CHARACTER) + se->string_length = expr->symtree->n.sym->ts.cl->backend_decl; return; } } @@ -3390,7 +3392,12 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) loop.temp_ss->type = GFC_SS_TEMP; loop.temp_ss->next = gfc_ss_terminator; loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts); - loop.temp_ss->data.temp.string_length = NULL; + /* Which can hold our string, if present. */ + if (expr->ts.type == BT_CHARACTER) + se->string_length = loop.temp_ss->data.temp.string_length + = TYPE_SIZE_UNIT (loop.temp_ss->data.temp.type); + else + loop.temp_ss->data.temp.string_length = NULL; loop.temp_ss->data.temp.dimen = loop.dimen; gfc_add_ss_to_loop (&loop, loop.temp_ss); } @@ -3451,6 +3458,10 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) tree to; tree base; + /* set the string_length for a character array. */ + if (expr->ts.type == BT_CHARACTER) + se->string_length = expr->symtree->n.sym->ts.cl->backend_decl; + /* Otherwise make a new descriptor and point it at the section we want. The loop variable limits will be the limits of the section. */ @@ -3625,6 +3636,8 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77) { sym = expr->symtree->n.sym; tmp = gfc_get_symbol_decl (sym); + if (sym->ts.type == BT_CHARACTER) + se->string_length = sym->ts.cl->backend_decl; if (!sym->attr.pointer && sym->as->type != AS_ASSUMED_SHAPE && !sym->attr.allocatable) { -- 2.30.2