mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-21 03:30:26 +08:00
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
This commit is contained in:
parent
a12baf9804
commit
20c9dc8aac
@ -1,3 +1,14 @@
|
||||
2004-07-15 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
|
||||
|
||||
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 <paul@codesourcery.com>
|
||||
|
||||
* expr.c (gfc_check_assign_symbol): Handle pointer assignments.
|
||||
|
@ -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)
|
||||
{
|
||||
|
Loading…
x
Reference in New Issue
Block a user