diff options
author | Paul Thomas <pault@gcc.gnu.org> | 2006-10-31 06:03:24 +0000 |
---|---|---|
committer | Paul Thomas <pault@gcc.gnu.org> | 2006-10-31 06:03:24 +0000 |
commit | dd5797cc36028b51596c88d0b5ecc1f0a2902488 (patch) | |
tree | a2f3d9751ac9c0b7ae6f8b76727cb0d066e270f5 /gcc/fortran | |
parent | e5c18c3c298de538f6a9acec3120b63d830dc307 (diff) | |
download | gcc-dd5797cc36028b51596c88d0b5ecc1f0a2902488.zip gcc-dd5797cc36028b51596c88d0b5ecc1f0a2902488.tar.gz gcc-dd5797cc36028b51596c88d0b5ecc1f0a2902488.tar.bz2 |
re PR fortran/29387 (ICE on character array function of variable length)
2006-10-31 Paul Thomas <pault@gcc.gnu.org>
PR fortran/29387
* trans-intrinsic.c (gfc_conv_intrinsic_len): Rearrange to have
a specific case for EXPR_VARIABLE and, in default, build an ss
to call gfc_conv_expr_descriptor for array expressions..
PR fortran/29490
* trans-expr.c (gfc_set_interface_mapping_bounds): In the case
that GFC_TYPE_ARRAY_LBOUND is not available, use descriptor
values for it and GFC_TYPE_ARRAY_UBOUND.
PR fortran/29641
* trans-types.c (gfc_get_derived_type): If the derived type
namespace has neither a parent nor a proc_name, set NULL for
the search namespace.
2006-10-31 Paul Thomas <pault@gcc.gnu.org>
PR fortran/29387
* gfortran.dg/intrinsic_actual_2.f90: New test.
PR fortran/29490
* gfortran.dg/actual_array_interface_1.f90: New test.
PR fortran/29641
* gfortran.dg/used_types_11.f90: New test.
From-SVN: r118220
Diffstat (limited to 'gcc/fortran')
-rw-r--r-- | gcc/fortran/ChangeLog | 17 | ||||
-rw-r--r-- | gcc/fortran/trans-expr.c | 11 | ||||
-rw-r--r-- | gcc/fortran/trans-intrinsic.c | 57 | ||||
-rw-r--r-- | gcc/fortran/trans-types.c | 14 |
4 files changed, 66 insertions, 33 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f6ea479..3fd834c7 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,20 @@ +2006-10-31 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/29387 + * trans-intrinsic.c (gfc_conv_intrinsic_len): Rearrange to have + a specific case for EXPR_VARIABLE and, in default, build an ss + to call gfc_conv_expr_descriptor for array expressions.. + + PR fortran/29490 + * trans-expr.c (gfc_set_interface_mapping_bounds): In the case + that GFC_TYPE_ARRAY_LBOUND is not available, use descriptor + values for it and GFC_TYPE_ARRAY_UBOUND. + + PR fortran/29641 + * trans-types.c (gfc_get_derived_type): If the derived type + namespace has neither a parent nor a proc_name, set NULL for + the search namespace. + 2006-10-30 Tobias Burnus <burnus@net-b.de> PR fortran/29452 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index e5c9f24..f4fcea5 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1296,10 +1296,17 @@ gfc_set_interface_mapping_bounds (stmtblock_t * block, tree type, tree desc) offset = gfc_index_zero_node; for (n = 0; n < GFC_TYPE_ARRAY_RANK (type); n++) { + dim = gfc_rank_cst[n]; GFC_TYPE_ARRAY_STRIDE (type, n) = gfc_conv_array_stride (desc, n); - if (GFC_TYPE_ARRAY_UBOUND (type, n) == NULL_TREE) + if (GFC_TYPE_ARRAY_LBOUND (type, n) == NULL_TREE) + { + GFC_TYPE_ARRAY_LBOUND (type, n) + = gfc_conv_descriptor_lbound (desc, dim); + GFC_TYPE_ARRAY_UBOUND (type, n) + = gfc_conv_descriptor_ubound (desc, dim); + } + else if (GFC_TYPE_ARRAY_UBOUND (type, n) == NULL_TREE) { - dim = gfc_rank_cst[n]; tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, gfc_conv_descriptor_ubound (desc, dim), gfc_conv_descriptor_lbound (desc, dim)); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 44d439d..d031878 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -2429,6 +2429,7 @@ gfc_conv_intrinsic_len (gfc_se * se, gfc_expr * expr) gfc_symbol *sym; gfc_se argse; gfc_expr *arg; + gfc_ss *ss; gcc_assert (!se->ss); @@ -2448,32 +2449,37 @@ gfc_conv_intrinsic_len (gfc_se * se, gfc_expr * expr) get_array_ctor_strlen (arg->value.constructor, &len); break; - default: - if (arg->expr_type == EXPR_VARIABLE - && (arg->ref == NULL || (arg->ref->next == NULL - && arg->ref->type == REF_ARRAY))) - { - /* This doesn't catch all cases. - See http://gcc.gnu.org/ml/fortran/2004-06/msg00165.html - and the surrounding thread. */ - sym = arg->symtree->n.sym; - decl = gfc_get_symbol_decl (sym); - if (decl == current_function_decl && sym->attr.function + case EXPR_VARIABLE: + if (arg->ref == NULL + || (arg->ref->next == NULL && arg->ref->type == REF_ARRAY)) + { + /* This doesn't catch all cases. + See http://gcc.gnu.org/ml/fortran/2004-06/msg00165.html + and the surrounding thread. */ + sym = arg->symtree->n.sym; + decl = gfc_get_symbol_decl (sym); + if (decl == current_function_decl && sym->attr.function && (sym->result == sym)) - decl = gfc_get_fake_result_decl (sym, 0); - - len = sym->ts.cl->backend_decl; - gcc_assert (len); - } - else - { - /* Anybody stupid enough to do this deserves inefficient code. */ - gfc_init_se (&argse, se); - gfc_conv_expr (&argse, arg); - gfc_add_block_to_block (&se->pre, &argse.pre); - gfc_add_block_to_block (&se->post, &argse.post); - len = argse.string_length; + decl = gfc_get_fake_result_decl (sym, 0); + + len = sym->ts.cl->backend_decl; + gcc_assert (len); + break; } + + /* Otherwise fall through. */ + + default: + /* Anybody stupid enough to do this deserves inefficient code. */ + ss = gfc_walk_expr (arg); + gfc_init_se (&argse, se); + if (ss == gfc_ss_terminator) + gfc_conv_expr (&argse, arg); + else + gfc_conv_expr_descriptor (&argse, arg, ss); + gfc_add_block_to_block (&se->pre, &argse.pre); + gfc_add_block_to_block (&se->post, &argse.post); + len = argse.string_length; break; } se->expr = convert (type, len); @@ -3020,8 +3026,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) else { /* A pointer to an array. */ - arg1se.descriptor_only = 1; - gfc_conv_expr_lhs (&arg1se, arg1->expr); + gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1); tmp2 = gfc_conv_descriptor_data_get (arg1se.expr); } gfc_add_block_to_block (&se->pre, &arg1se.pre); diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index bff025c..ecae593 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1482,11 +1482,15 @@ gfc_get_derived_type (gfc_symbol * derived) building anew so that potential dummy and actual arguments use the same TREE_TYPE. If an equal type is found without a backend_decl, build the parent version and use it in the current namespace. */ - - /* Derived types in an interface body obtain their parent reference - through the proc_name symbol. */ - ns = derived->ns->parent ? derived->ns->parent - : derived->ns->proc_name->ns; + if (derived->ns->parent) + ns = derived->ns->parent; + else if (derived->ns->proc_name) + /* Derived types in an interface body obtain their parent reference + through the proc_name symbol. */ + ns = derived->ns->proc_name->ns; + else + /* Sometimes there isn't a parent reference! */ + ns = NULL; for (; ns; ns = ns->parent) { |