aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/ChangeLog17
-rw-r--r--gcc/fortran/trans-expr.c11
-rw-r--r--gcc/fortran/trans-intrinsic.c57
-rw-r--r--gcc/fortran/trans-types.c14
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)
{
generated by cgit v1.1 at 2025-12-29 13:40:38 +0000