Dear all,
the following patch is based on Thomas' comment 5 in PR55852. He
independently created a patch for the PR; his version is in comment 6:
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=55852#c6
The problem with the current trunk's version of gfc_build_intrinsic_call
is that it assumes that gfc_find_symtree will return the intrinsic
function (size in this case); if the user has a different symbol named
size or hasn't used size, the code doesn't work.
My version is attached.
In my version, the gfc_build_intrinsic_call takes gfc_isym_id as
identifier for the intrinsic - the passed string is mangled via
GFC_PREFIX to avoid issues with symbol declarations of the user.
I do set rather bluntly n.sym... = , assuming that under mangled name
one always finds this intrinsic function.
Besides fixing the ICE, I used the opportunity to cleanup class.c, where
I now use gfc_build_intrinsic_call, which is a nice cleanup: 4 files
changed, 65 insertions(+), 143 deletions(-)
Build and regtested on x86-64-gnu-linux.
OK for the trunk?
Tobias
2013-01-07 Tobias Burnus bur...@net-b.de
Thomas Koenig tkoe...@gcc.gnu.org
PR fortran/55852
* expr.c (gfc_build_intrinsic_call): Avoid clashes
with user's procedures.
* gfortran.h (gfc_build_intrinsic_call): Update prototype.
* simplify.c (gfc_simplify_size): Update call.
* class.c (finalization_scalarizer, finalization_get_offset,
finalizer_insert_packed_call, generate_finalization_wrapper):
Clean up by using gfc_build_intrinsic_call.
2013-01-07 Tobias Burnus bur...@net-b.de
PR fortran/55852
* gfortran.dg/intrinsic_size_3.f90: New.
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 0d34e78..5fdf0a3 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -969,31 +969,6 @@ finalization_scalarizer (gfc_symbol *array, gfc_symbol *ptr,
/* The addr part: TRANSFER (C_LOC (array), c_intptr_t). */
- /* TRANSFER. */
- expr2 = gfc_get_expr ();
- expr2-expr_type = EXPR_FUNCTION;
- expr2-value.function.name = __transfer0;
- expr2-value.function.isym
- = gfc_intrinsic_function_by_id (GFC_ISYM_TRANSFER);
- /* Set symtree for -fdump-parse-tree. */
- gfc_get_sym_tree (transfer, sub_ns, expr2-symtree, false);
- expr2-symtree-n.sym-intmod_sym_id = GFC_ISYM_TRANSFER;
- expr2-symtree-n.sym-attr.flavor = FL_PROCEDURE;
- expr2-symtree-n.sym-attr.intrinsic = 1;
- gfc_commit_symbol (expr2-symtree-n.sym);
- expr2-value.function.actual = gfc_get_actual_arglist ();
- expr2-value.function.actual-expr
- = gfc_lval_expr_from_sym (array);
- expr2-ts.type = BT_INTEGER;
- expr2-ts.kind = gfc_index_integer_kind;
-
- /* TRANSFER's second argument: 0_c_intptr_t. */
- expr2-value.function.actual = gfc_get_actual_arglist ();
- expr2-value.function.actual-next = gfc_get_actual_arglist ();
- expr2-value.function.actual-next-expr
- = gfc_get_int_expr (gfc_index_integer_kind, NULL, 0);
- expr2-value.function.actual-next-next = gfc_get_actual_arglist ();
-
/* TRANSFER's first argument: C_LOC (array). */
expr = gfc_get_expr ();
expr-expr_type = EXPR_FUNCTION;
@@ -1010,7 +985,14 @@ finalization_scalarizer (gfc_symbol *array, gfc_symbol *ptr,
gfc_commit_symbol (expr-symtree-n.sym);
expr-ts.type = BT_INTEGER;
expr-ts.kind = gfc_index_integer_kind;
- expr2-value.function.actual-expr = expr;
+
+ /* TRANSFER. */
+ expr2 = gfc_build_intrinsic_call (sub_ns, GFC_ISYM_TRANSFER, transfer,
+gfc_current_locus, 2, expr,
+gfc_get_int_expr (gfc_index_integer_kind,
+ NULL, 0));
+ expr2-ts.type = BT_INTEGER;
+ expr2-ts.kind = gfc_index_integer_kind;
/* array addr + offset. */
block-ext.actual-expr = gfc_get_expr ();
@@ -1072,27 +1054,18 @@ finalization_get_offset (gfc_symbol *idx, gfc_symbol *idx2, gfc_symbol *offset,
* strides(idx2). */
/* mod (idx, sizes(idx2)). */
- expr = gfc_get_expr ();
- expr-expr_type = EXPR_FUNCTION;
- expr-value.function.isym = gfc_intrinsic_function_by_id (GFC_ISYM_MOD);
- gfc_get_sym_tree (mod, sub_ns, expr-symtree, false);
- expr-symtree-n.sym-intmod_sym_id = GFC_ISYM_MOD;
- expr-symtree-n.sym-attr.flavor = FL_PROCEDURE;
- expr-symtree-n.sym-attr.intrinsic = 1;
- gfc_commit_symbol (expr-symtree-n.sym);
- expr-value.function.actual = gfc_get_actual_arglist ();
- expr-value.function.actual-expr = gfc_lval_expr_from_sym (idx);
- expr-value.function.actual-next = gfc_get_actual_arglist ();
- expr-value.function.actual-next-expr = gfc_lval_expr_from_sym (sizes);
- expr-value.function.actual-next-expr-ref = gfc_get_ref ();
- expr-value.function.actual-next-expr-ref-type = REF_ARRAY;
- expr-value.function.actual-next-expr-ref-u.ar.as = sizes-as;
- expr-value.function.actual-next-expr-ref-u.ar.type = AR_ELEMENT;
- expr-value.function.actual-next-expr-ref-u.ar.dimen = 1;
- expr-value.function.actual-next-expr-ref-u.ar.dimen_type[0]
- = DIMEN_ELEMENT;
- expr-value.function.actual-next-expr-ref-u.ar.start[0]
- =
