------- Comment #5 from pault at gcc dot gnu dot org 2007-12-03 15:05 -------
(In reply to comment #4)
Just for the record, the following, very crude patch works and produces the
same output as NAG. It needs a lot of cleaning up and I should understand why
the inclusion of LEN works fine, except for char_result_[1-2].f90 It is my
belief that for the latter two the interface DOUBLE screws things up. As
soonas I get on top of this, I'll revamp the whole thing and submit it => a few
days from now.
Cheers
Paul
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c (revision 130333)
--- gcc/fortran/trans-expr.c (working copy)
*************** along with GCC; see the file COPYING3.
*** 34,39 ****
--- 34,40 ----
#include "langhooks.h"
#include "flags.h"
#include "gfortran.h"
+ #include "arith.h"
#include "trans.h"
#include "trans-const.h"
#include "trans-types.h"
*************** gfc_apply_interface_mapping_to_expr (gfc
*** 1731,1736 ****
--- 1732,1818 ----
if (sym->old == expr->symtree->n.sym)
expr->symtree = sym->new;
+ if (expr->expr_type == EXPR_FUNCTION
+ && expr->value.function.esym == NULL
+ && expr->value.function.isym != NULL
+ && expr->value.function.isym->id == GFC_ISYM_SIZE
+ && expr->value.function.actual->expr->expr_type == EXPR_VARIABLE
+ && expr->value.function.actual->expr->symtree->n.sym->as)
+ {
+ gfc_symbol *sym = expr->value.function.actual->expr->symtree->n.sym;
+
+ if (!sym->attr.dummy)
+ {
+ gfc_expr *new_expr = NULL;
+ int d, dup;
+
+ gfc_apply_interface_mapping_to_expr (mapping,
expr->value.function.actua
l->expr);
+ if (expr->value.function.actual->next
+ && expr->value.function.actual->next->expr
+ && expr->value.function.actual->next->expr->expr_type ==
EXPR_CONS
TANT)
+ {
+ dup = mpz_get_si
(expr->value.function.actual->next->expr->value.int
eger);
+ d = dup - 1;
+ }
+ else
+ {
+ dup = sym->as->rank;
+ d = 0;
+ }
+
+ for (; d < dup; d++)
+ {
+ gfc_expr *tmp;
+ gfc_apply_interface_mapping_to_expr (mapping, sym->as->upper[d]);
+ gfc_apply_interface_mapping_to_expr (mapping, sym->as->lower[d]);
+ tmp = gfc_add (gfc_copy_expr (sym->as->upper[d]), gfc_int_expr
(1));
+ tmp = gfc_subtract (tmp, gfc_copy_expr (sym->as->lower[d]));
+ if (new_expr)
+ new_expr = gfc_multiply (new_expr, tmp);
+ else
+ new_expr = tmp;
+ new_expr->where = expr->where;
+ }
+ gfc_replace_expr (expr, new_expr);
+ return 0;
+ }
+ }
+
+ if (expr->expr_type == EXPR_FUNCTION
+ && expr->value.function.esym == NULL
+ && expr->value.function.isym != NULL
+ && (expr->value.function.isym->id == GFC_ISYM_LBOUND
+ || expr->value.function.isym->id == GFC_ISYM_UBOUND)
+ && expr->value.function.actual->expr->expr_type == EXPR_VARIABLE
+ && expr->value.function.actual->expr->symtree->n.sym->as)
+ {
+ gfc_symbol *sym = expr->value.function.actual->expr->symtree->n.sym;
+
+ if (!sym->attr.dummy)
+ {
+ gfc_expr *new_expr = NULL;
+ int d;
+
+ gfc_apply_interface_mapping_to_expr (mapping,
expr->value.function.actua
l->expr);
+ if (expr->value.function.actual->next
+ && expr->value.function.actual->next->expr
+ && expr->value.function.actual->next->expr->expr_type ==
EXPR_CONS
TANT)
+ d = mpz_get_si
(expr->value.function.actual->next->expr->value.integer
) - 1;
+ else
+ d = 0;
+
+ if (expr->value.function.isym->id == GFC_ISYM_LBOUND)
+ new_expr = gfc_copy_expr (sym->as->lower[d]);
+ else
+ new_expr = gfc_copy_expr (sym->as->upper[d]);
+
+ gfc_apply_interface_mapping_to_expr (mapping, new_expr);
+ new_expr->where = expr->where;
+ gfc_replace_expr (expr, new_expr);
+ return 0;
+ }
+ }
+
/* ...and to subexpressions in expr->value. */
switch (expr->expr_type)
{
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=33998
