[Bug fortran/33998] ICE in make_decl_rtl, at varasm.c:1263

[pault at gcc dot gnu dot org]

------- 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