diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 85 | ||||
| -rw-r--r-- | gcc/fortran/decl.c | 2 | ||||
| -rw-r--r-- | gcc/fortran/frontend-passes.c | 191 | ||||
| -rw-r--r-- | gcc/fortran/match.c | 105 | ||||
| -rw-r--r-- | gcc/fortran/parse.c | 2 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 18 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.c | 13 | ||||
| -rw-r--r-- | gcc/fortran/trans-common.c | 6 | ||||
| -rw-r--r-- | gcc/fortran/trans-decl.c | 77 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 71 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 67 | ||||
| -rw-r--r-- | gcc/fortran/trans-openmp.c | 10 | ||||
| -rw-r--r-- | gcc/fortran/trans-stmt.c | 10 | ||||
| -rw-r--r-- | gcc/fortran/trans-types.c | 17 | ||||
| -rw-r--r-- | gcc/fortran/trans.h | 2 |
15 files changed, 451 insertions, 225 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 74ea42aefec..2aa8d60e1f1 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,88 @@ +2012-11-26 Eric Botcazou <ebotcazou@adacore.com> + + * trans-decl.c (gfc_finish_var_decl): Do not set DECL_RESTRICTED_P. + +2012-11-26 Janus Weil <janus@gcc.gnu.org> + + PR fortran/54997 + * decl.c (match_procedure_decl): Don't set 'referenced' attribute + for PROCEDURE declarations. + * parse.c (gfc_fixup_sibling_symbols,parse_contained): Don't set + 'referenced' attribute for all contained procedures. + * trans-decl.c (gfc_get_symbol_decl): Allow for unreferenced procedures. + (build_function_decl): Set TREE_USED for referenced procedures. + +2012-11-26 Janus Weil <janus@gcc.gnu.org> + + PR fortran/54881 + * match.c (select_derived_set_tmp,select_class_set_tmp): Removed and + unified into ... + (select_type_set_tmp): ... this one. Set POINTER argument according to + selector. + * trans-intrinsic.c (gfc_conv_associated): Use 'gfc_class_data_get' + instead of 'gfc_add_data_component'. + +2012-11-25 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/30146 + * frontend-passes.c (doloop_warn): New function. + (doloop_list): New static variable. + (doloop_size): New static variable. + (doloop_level): New static variable. + (gfc_run_passes): Call doloop_warn. + (doloop_code): New function. + (doloop_function): New function. + (gfc_code_walker): Keep track of DO level. + +2012-11-24 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/55314 + * resolve.c (resolve_allocate_deallocate): Compare all + subscripts when deciding if to reject a (de)allocate + statement. + +2012-11-21 Janus Weil <janus@gcc.gnu.org> + + PR fortran/55352 + * trans-decl.c (generate_local_decl): Don't warn for explicitly imported + but unused module variables which are in a namelist or common block. + +2012-11-20 Diego Novillo <dnovillo@google.com> + Jakub Jelinek <jakub@redhat.com> + + * trans-openmp.c: Replace all vec<T, A>() initializers + with vNULL. + +2012-11-17 Diego Novillo <dnovillo@google.com> + + Adjust for new vec API (http://gcc.gnu.org/wiki/cxx-conversion/cxx-vec) + + * frontend-passes.c: Use new vec API in vec.h. + * trans-array.c: Likewise. + * trans-common.c: Likewise. + * trans-decl.c: Likewise. + * trans-expr.c: Likewise. + * trans-intrinsic.c: Likewise. + * trans-openmp.c: Likewise. + * trans-stmt.c: Likewise. + * trans-types.c: Likewise. + * trans.h: Likewise. + +2012-11-17 Jakub Jelinek <jakub@redhat.com> + + PR fortran/55341 + * trans-intrinsic.c (gfc_conv_intrinsic_transfer): Convert last + argument to memcpy to size_type_node type. + * trans-stmt.c (gfc_conv_elemental_dependencies): Likewise. + * trasn-array.c (duplicate_allocatable): Likewise. + +2012-11-16 Janus Weil <janus@gcc.gnu.org> + + PR fortran/55297 + * resolve.c (resolve_typebound_intrinsic_op): Only add typebound + operators to the operator list in the namespace of the derived type. + + 2012-11-12 Jan Hubicka <jh@suse.cz> * f95-lang.c (ATTR_NOTHROW_LEAF_MALLOC_LIST): New macro. diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 6f609e9a5a7..77ca9930afc 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -4941,8 +4941,6 @@ match_procedure_decl (void) } - gfc_set_sym_referenced (sym); - if (gfc_match_eos () == MATCH_YES) return MATCH_YES; if (gfc_match_char (',') != MATCH_YES) diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 0cba9112a08..6679368994b 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -38,7 +38,8 @@ static bool optimize_comparison (gfc_expr *, gfc_intrinsic_op); static bool optimize_trim (gfc_expr *); static bool optimize_lexical_comparison (gfc_expr *); static void optimize_minmaxloc (gfc_expr **); -static bool empty_string (gfc_expr *e); +static bool is_empty_string (gfc_expr *e); +static void doloop_warn (gfc_namespace *); /* How deep we are inside an argument list. */ @@ -76,12 +77,30 @@ static bool in_omp_workshare; static int iterator_level; -/* Entry point - run all passes for a namespace. So far, only an - optimization pass is run. */ +/* Keep track of DO loop levels. */ + +static gfc_code **doloop_list; +static int doloop_size, doloop_level; + +/* Vector of gfc_expr * to keep track of DO loops. */ + +struct my_struct *evec; + +/* Entry point - run all passes for a namespace. */ void gfc_run_passes (gfc_namespace *ns) { + + /* Warn about dubious DO loops where the index might + change. */ + + doloop_size = 20; + doloop_level = 0; + doloop_list = XNEWVEC(gfc_code *, doloop_size); + doloop_warn (ns); + XDELETEVEC (doloop_list); + if (gfc_option.flag_frontend_optimize) { expr_size = 20; @@ -742,7 +761,7 @@ optimize_assignment (gfc_code * c) remove_trim (rhs); /* Replace a = ' ' by a = '' to optimize away a memcpy. */ - if (empty_string(rhs)) + if (is_empty_string(rhs)) rhs->value.character.length = 0; } @@ -865,7 +884,7 @@ optimize_op (gfc_expr *e) /* Return true if a constant string contains only blanks. */ static bool -empty_string (gfc_expr *e) +is_empty_string (gfc_expr *e) { int i; @@ -967,8 +986,8 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op op) && (op == INTRINSIC_EQ || op == INTRINSIC_NE)) { bool empty_op1, empty_op2; - empty_op1 = empty_string (op1); - empty_op2 = empty_string (op2); + empty_op1 = is_empty_string (op1); + empty_op2 = is_empty_string (op2); if (empty_op1 || empty_op2) { @@ -1225,6 +1244,160 @@ optimize_minmaxloc (gfc_expr **e) mpz_set_ui (a->expr->value.integer, 1); } +/* Callback function for code checking that we do not pass a DO variable to an + INTENT(OUT) or INTENT(INOUT) dummy variable. */ + +static int +doloop_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, + void *data ATTRIBUTE_UNUSED) +{ + gfc_code *co; + int i; + gfc_formal_arglist *f; + gfc_actual_arglist *a; + + co = *c; + + switch (co->op) + { + case EXEC_DO: + + /* Grow the temporary storage if necessary. */ + if (doloop_level >= doloop_size) + { + doloop_size = 2 * doloop_size; + doloop_list = XRESIZEVEC (gfc_code *, doloop_list, doloop_size); + } + + /* Mark the DO loop variable if there is one. */ + if (co->ext.iterator && co->ext.iterator->var) + doloop_list[doloop_level] = co; + else + doloop_list[doloop_level] = NULL; + break; + + case EXEC_CALL: + f = co->symtree->n.sym->formal; + + /* Withot a formal arglist, there is only unknown INTENT, + which we don't check for. */ + if (f == NULL) + break; + + a = co->ext.actual; + + while (a && f) + { + for (i=0; i<doloop_level; i++) + { + gfc_symbol *do_sym; + + if (doloop_list[i] == NULL) + break; + + do_sym = doloop_list[i]->ext.iterator->var->symtree->n.sym; + + if (a->expr && a->expr->symtree + && a->expr->symtree->n.sym == do_sym) + { + if (f->sym->attr.intent == INTENT_OUT) + gfc_error_now("Variable '%s' at %L set to undefined value " + "inside loop beginning at %L as INTENT(OUT) " + "argument to subroutine '%s'", do_sym->name, + &a->expr->where, &doloop_list[i]->loc, + co->symtree->n.sym->name); + else if (f->sym->attr.intent == INTENT_INOUT) + gfc_error_now("Variable '%s' at %L not definable inside loop " + "beginning at %L as INTENT(INOUT) argument to " + "subroutine '%s'", do_sym->name, + &a->expr->where, &doloop_list[i]->loc, + co->symtree->n.sym->name); + } + } + a = a->next; + f = f->next; + } + break; + + default: + break; + } + return 0; +} + +/* Callback function for functions checking that we do not pass a DO variable + to an INTENT(OUT) or INTENT(INOUT) dummy variable. */ + +static int +do_function (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, + void *data ATTRIBUTE_UNUSED) +{ + gfc_formal_arglist *f; + gfc_actual_arglist *a; + gfc_expr *expr; + int i; + + expr = *e; + if (expr->expr_type != EXPR_FUNCTION) + return 0; + + /* Intrinsic functions don't modify their arguments. */ + + if (expr->value.function.isym) + return 0; + + f = expr->symtree->n.sym->formal; + + /* Without a formal arglist, there is only unknown INTENT, + which we don't check for. */ + if (f == NULL) + return 0; + + a = expr->value.function.actual; + + while (a && f) + { + for (i=0; i<doloop_level; i++) + { + gfc_symbol *do_sym; + + + if (doloop_list[i] == NULL) + break; + + do_sym = doloop_list[i]->ext.iterator->var->symtree->n.sym; + + if (a->expr && a->expr->symtree + && a->expr->symtree->n.sym == do_sym) + { + if (f->sym->attr.intent == INTENT_OUT) + gfc_error_now("Variable '%s' at %L set to undefined value " + "inside loop beginning at %L as INTENT(OUT) " + "argument to function '%s'", do_sym->name, + &a->expr->where, &doloop_list[i]->loc, + expr->symtree->n.sym->name); + else if (f->sym->attr.intent == INTENT_INOUT) + gfc_error_now("Variable '%s' at %L not definable inside loop " + "beginning at %L as INTENT(INOUT) argument to " + "function '%s'", do_sym->name, + &a->expr->where, &doloop_list[i]->loc, + expr->symtree->n.sym->name); + } + } + a = a->next; + f = f->next; + } + + return 0; +} + +static void +doloop_warn (gfc_namespace *ns) +{ + gfc_code_walker (&ns->code, doloop_code, do_function, NULL); +} + + #define WALK_SUBEXPR(NODE) \ do \ { \ @@ -1383,6 +1556,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, break; case EXEC_DO: + doloop_level ++; WALK_SUBEXPR (co->ext.iterator->var); WALK_SUBEXPR (co->ext.iterator->start); WALK_SUBEXPR (co->ext.iterator->end); @@ -1601,6 +1775,9 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, if (co->op == EXEC_FORALL) forall_level --; + if (co->op == EXEC_DO) + doloop_level --; + in_omp_workshare = saved_in_omp_workshare; } } diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 06585af94e9..39da62faedf 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -5207,103 +5207,56 @@ select_type_push (gfc_symbol *sel) } -/* Set the temporary for the current derived type SELECT TYPE selector. */ +/* Set up a temporary for the current TYPE IS / CLASS IS branch . */ -static gfc_symtree * -select_derived_set_tmp (gfc_typespec *ts) +static void +select_type_set_tmp (gfc_typespec *ts) { char name[GFC_MAX_SYMBOL_LEN]; gfc_symtree *tmp; - - sprintf (name, "__tmp_type_%s", ts->u.derived->name); - gfc_get_sym_tree (name, gfc_current_ns, &tmp, false); - gfc_add_type (tmp->n.sym, ts, NULL); - /* Copy across the array spec to the selector. */ - if (select_type_stack->selector->ts.type == BT_CLASS - && select_type_stack->selector->attr.class_ok - && (CLASS_DATA (select_type_stack->selector)->attr.dimension - || CLASS_DATA (select_type_stack->selector)->attr.codimension)) + if (!ts) { - tmp->n.sym->attr.dimension - = CLASS_DATA (select_type_stack->selector)->attr.dimension; - tmp->n.sym->attr.codimension - = CLASS_DATA (select_type_stack->selector)->attr.codimension; - tmp->n.sym->as - = gfc_copy_array_spec (CLASS_DATA (select_type_stack->selector)->as); + select_type_stack->tmp = NULL; + return; } - - gfc_set_sym_referenced (tmp->n.sym); - gfc_add_flavor (&tmp->n.sym->attr, FL_VARIABLE, name, NULL); - tmp->n.sym->attr.select_type_temporary = 1; - - return tmp; -} - - -/* Set the temporary for the current class SELECT TYPE selector. */ - -static gfc_symtree * -select_class_set_tmp (gfc_typespec *ts) -{ - char name[GFC_MAX_SYMBOL_LEN]; - gfc_symtree *tmp; - if (select_type_stack->selector->ts.type == BT_CLASS - && !select_type_stack->selector->attr.class_ok) - return NULL; + if (!gfc_type_is_extensible (ts->u.derived)) + return; - sprintf (name, "__tmp_class_%s", ts->u.derived->name); + if (ts->type == BT_CLASS) + sprintf (name, "__tmp_class_%s", ts->u.derived->name); + else + sprintf (name, "__tmp_type_%s", ts->u.derived->name); gfc_get_sym_tree (name, gfc_current_ns, &tmp, false); gfc_add_type (tmp->n.sym, ts, NULL); -/* Copy across the array spec to the selector. */ if (select_type_stack->selector->ts.type == BT_CLASS - && (CLASS_DATA (select_type_stack->selector)->attr.dimension - || CLASS_DATA (select_type_stack->selector)->attr.codimension)) + && select_type_stack->selector->attr.class_ok) { - tmp->n.sym->attr.pointer = 1; - tmp->n.sym->attr.dimension - = CLASS_DATA (select_type_stack->selector)->attr.dimension; - tmp->n.sym->attr.codimension - = CLASS_DATA (select_type_stack->selector)->attr.codimension; - tmp->n.sym->as - = gfc_copy_array_spec (CLASS_DATA (select_type_stack->selector)->as); + tmp->n.sym->attr.pointer + = CLASS_DATA (select_type_stack->selector)->attr.class_pointer; + + /* Copy across the array spec to the selector. */ + if ((CLASS_DATA (select_type_stack->selector)->attr.dimension + || CLASS_DATA (select_type_stack->selector)->attr.codimension)) + { + tmp->n.sym->attr.dimension + = CLASS_DATA (select_type_stack->selector)->attr.dimension; + tmp->n.sym->attr.codimension + = CLASS_DATA (select_type_stack->selector)->attr.codimension; + tmp->n.sym->as + = gfc_copy_array_spec (CLASS_DATA (select_type_stack->selector)->as); + } } gfc_set_sym_referenced (tmp->n.sym); gfc_add_flavor (&tmp->n.sym->attr, FL_VARIABLE, name, NULL); tmp->n.sym->attr.select_type_temporary = 1; - gfc_build_class_symbol (&tmp->n.sym->ts, &tmp->n.sym->attr, - &tmp->n.sym->as, false); - - return tmp; -} - - -static void -select_type_set_tmp (gfc_typespec *ts) -{ - gfc_symtree *tmp; - if (!ts) - { - select_type_stack->tmp = NULL; - return; - } - - if (!gfc_type_is_extensible (ts->u.derived)) - return; - - /* Logic is a LOT clearer with separate functions for class and derived - type temporaries! There are not many more lines of code either. */ if (ts->type == BT_CLASS) - tmp = select_class_set_tmp (ts); - else - tmp = select_derived_set_tmp (ts); - - if (tmp == NULL) - return; + gfc_build_class_symbol (&tmp->n.sym->ts, &tmp->n.sym->attr, + &tmp->n.sym->as, false); /* Add an association for it, so the rest of the parser knows it is an associate-name. The target will be set during resolution. */ diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index f31e30940b8..659e9fcc34f 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -3928,7 +3928,6 @@ gfc_fixup_sibling_symbols (gfc_symbol *sym, gfc_namespace *siblings) gfc_symtree *st; gfc_symbol *old_sym; - sym->attr.referenced = 1; for (ns = siblings; ns; ns = ns->sibling) { st = gfc_find_symtree (ns->sym_root, sym->name); @@ -4050,7 +4049,6 @@ parse_contained (int module) /* Mark this as a contained function, so it isn't replaced by other module functions. */ sym->attr.contained = 1; - sym->attr.referenced = 1; /* Set implicit_pure so that it can be reset if any of the tests for purity fail. This is used for some optimisation diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index e39a137fd4f..f3d3beb8595 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -7622,12 +7622,18 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn) if (pr->next && qr->next) { + int i; gfc_array_ref *par = &(pr->u.ar); gfc_array_ref *qar = &(qr->u.ar); - if ((par->start[0] != NULL || qar->start[0] != NULL) - && gfc_dep_compare_expr (par->start[0], - qar->start[0]) != 0) - break; + + for (i=0; i<par->dimen; i++) + { + if ((par->start[i] != NULL + || qar->start[i] != NULL) + && gfc_dep_compare_expr (par->start[i], + qar->start[i]) != 0) + goto break_label; + } } } else @@ -7639,6 +7645,8 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn) pr = pr->next; qr = qr->next; } + break_label: + ; } } } @@ -11540,7 +11548,7 @@ resolve_typebound_intrinsic_op (gfc_symbol* derived, gfc_intrinsic_op op, /* Add target to non-typebound operator list. */ if (!target->specific->deferred && !derived->attr.use_assoc - && p->access != ACCESS_PRIVATE) + && p->access != ACCESS_PRIVATE && derived->ns == gfc_current_ns) { gfc_interface *head, *intr; if (gfc_check_new_interface (derived->ns->op[op], target_proc, diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 26f0523d20f..24adfdeafbe 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1626,7 +1626,7 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type, else { /* Collect multiple scalar constants into a constructor. */ - VEC(constructor_elt,gc) *v = NULL; + vec<constructor_elt, va_gc> *v = NULL; tree init; tree bound; tree tmptype; @@ -1985,7 +1985,7 @@ gfc_build_constant_array_constructor (gfc_expr * expr, tree type) gfc_array_spec as; gfc_se se; int i; - VEC(constructor_elt,gc) *v = NULL; + vec<constructor_elt, va_gc> *v = NULL; /* First traverse the constructor list, converting the constants to tree to build an initializer. */ @@ -5317,7 +5317,7 @@ gfc_conv_array_initializer (tree type, gfc_expr * expr) HOST_WIDE_INT hi; unsigned HOST_WIDE_INT lo; tree index, range; - VEC(constructor_elt,gc) *v = NULL; + vec<constructor_elt, va_gc> *v = NULL; if (expr->expr_type == EXPR_VARIABLE && expr->symtree->n.sym->attr.flavor == FL_PARAMETER @@ -7341,8 +7341,8 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, } tmp = builtin_decl_explicit (BUILT_IN_MEMCPY); - tmp = build_call_expr_loc (input_location, tmp, 3, - dest, src, size); + tmp = build_call_expr_loc (input_location, tmp, 3, dest, src, + fold_convert (size_type_node, size)); } else { @@ -7367,7 +7367,8 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, tmp = builtin_decl_explicit (BUILT_IN_MEMCPY); tmp = build_call_expr_loc (input_location, tmp, 3, gfc_conv_descriptor_data_get (dest), - gfc_conv_descriptor_data_get (src), size); + gfc_conv_descriptor_data_get (src), + fold_convert (size_type_node, size)); } gfc_add_expr_to_block (&block, tmp); diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c index 86cf0070ed3..474774fe8f6 100644 --- a/gcc/fortran/trans-common.c +++ b/gcc/fortran/trans-common.c @@ -487,7 +487,7 @@ get_init_field (segment_info *head, tree union_type, tree *field_init, tree tmp, field; tree init; unsigned char *data, *chk; - VEC(constructor_elt,gc) *v = NULL; + vec<constructor_elt, va_gc> *v = NULL; tree type = unsigned_char_type_node; int i; @@ -644,7 +644,7 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv) if (is_init) { tree ctor, tmp; - VEC(constructor_elt,gc) *v = NULL; + vec<constructor_elt, va_gc> *v = NULL; if (field != NULL_TREE && field_init != NULL_TREE) CONSTRUCTOR_APPEND_ELT (v, field, field_init); @@ -664,7 +664,7 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv) } } - gcc_assert (!VEC_empty (constructor_elt, v)); + gcc_assert (!v->is_empty ()); ctor = build_constructor (union_type, v); TREE_CONSTANT (ctor) = 1; TREE_STATIC (ctor) = 1; diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 77502170c3c..3bee1781d64 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -611,12 +611,6 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) if (sym->attr.threadprivate && (TREE_STATIC (decl) || DECL_EXTERNAL (decl))) DECL_TLS_MODEL (decl) = decl_default_tls_model (decl); - - if (!sym->attr.target - && !sym->attr.pointer - && !sym->attr.cray_pointee - && !sym->attr.proc_pointer) - DECL_RESTRICTED_P (decl) = 1; } @@ -1195,10 +1189,11 @@ gfc_get_symbol_decl (gfc_symbol * sym) bool intrinsic_array_parameter = false; gcc_assert (sym->attr.referenced - || sym->attr.use_assoc - || sym->ns->proc_name->attr.if_source == IFSRC_IFBODY - || (sym->module && sym->attr.if_source != IFSRC_DECL - && sym->backend_decl)); + || sym->attr.flavor == FL_PROCEDURE + || sym->attr.use_assoc + || sym->ns->proc_name->attr.if_source == IFSRC_IFBODY + || (sym->module && sym->attr.if_source != IFSRC_DECL + && sym->backend_decl)); if (sym->ns && sym->ns->proc_name && sym->ns->proc_name->attr.function) byref = gfc_return_by_reference (sym->ns->proc_name); @@ -1851,6 +1846,9 @@ build_function_decl (gfc_symbol * sym, bool global) || sym->attr.public_used)) TREE_PUBLIC (fndecl) = 1; + if (sym->attr.referenced || sym->attr.entry_master) + TREE_USED (fndecl) = 1; + attributes = add_attributes_to_decl (attr, NULL_TREE); decl_attributes (&fndecl, attributes, 0); @@ -2284,8 +2282,8 @@ build_entry_thunks (gfc_namespace * ns, bool global) gfc_save_backend_locus (&old_loc); for (el = ns->entries; el; el = el->next) { - VEC(tree,gc) *args = NULL; - VEC(tree,gc) *string_args = NULL; + vec<tree, va_gc> *args = NULL; + vec<tree, va_gc> *string_args = NULL; thunk_sym = el->sym; @@ -2300,16 +2298,16 @@ build_entry_thunks (gfc_namespace * ns, bool global) /* Pass extra parameter identifying this entry point. */ tmp = build_int_cst (gfc_array_index_type, el->id); - VEC_safe_push (tree, gc, args, tmp); + vec_safe_push (args, tmp); if (thunk_sym->attr.function) { if (gfc_return_by_reference (ns->proc_name)) { tree ref = DECL_ARGUMENTS (current_function_decl); - VEC_safe_push (tree, gc, args, ref); + vec_safe_push (args, ref); if (ns->proc_name->ts.type == BT_CHARACTER) - VEC_safe_push (tree, gc, args, DECL_CHAIN (ref)); + vec_safe_push (args, DECL_CHAIN (ref)); } } @@ -2333,27 +2331,27 @@ build_entry_thunks (gfc_namespace * ns, bool global) { /* Pass the argument. */ DECL_ARTIFICIAL (thunk_formal->sym->backend_decl) = 1; - VEC_safe_push (tree, gc, args, thunk_formal->sym->backend_decl); + vec_safe_push (args, thunk_formal->sym->backend_decl); if (formal->sym->ts.type == BT_CHARACTER) { tmp = thunk_formal->sym->ts.u.cl->backend_decl; - VEC_safe_push (tree, gc, string_args, tmp); + vec_safe_push (string_args, tmp); } } else { /* Pass NULL for a missing argument. */ - VEC_safe_push (tree, gc, args, null_pointer_node); + vec_safe_push (args, null_pointer_node); if (formal->sym->ts.type == BT_CHARACTER) { tmp = build_int_cst (gfc_charlen_type_node, 0); - VEC_safe_push (tree, gc, string_args, tmp); + vec_safe_push (string_args, tmp); } } } /* Call the master function. */ - VEC_safe_splice (tree, gc, args, string_args); + vec_safe_splice (args, string_args); tmp = ns->proc_name->backend_decl; tmp = build_call_expr_loc_vec (input_location, tmp, args); if (ns->proc_name->attr.mixed_entry_master) @@ -2616,7 +2614,7 @@ static tree build_library_function_decl_1 (tree name, const char *spec, tree rettype, int nargs, va_list p) { - VEC(tree,gc) *arglist; + vec<tree, va_gc> *arglist; tree fntype; tree fndecl; int n; @@ -2625,11 +2623,11 @@ build_library_function_decl_1 (tree name, const char *spec, gcc_assert (current_function_decl == NULL_TREE); /* Create a list of the argument types. */ - arglist = VEC_alloc (tree, gc, abs (nargs)); + vec_alloc (arglist, abs (nargs)); for (n = abs (nargs); n > 0; n--) { tree argtype = va_arg (p, tree); - VEC_quick_push (tree, arglist, argtype); + arglist->quick_push (argtype); } /* Build the function type and decl. */ @@ -4589,22 +4587,25 @@ generate_local_decl (gfc_symbol * sym) } /* Warn for unused variables, but not if they're inside a common - block, a namelist, or are use-associated. */ + block or a namelist. */ else if (warn_unused_variable - && !(sym->attr.in_common || sym->attr.use_assoc || sym->mark - || sym->attr.in_namelist)) + && !(sym->attr.in_common || sym->mark || sym->attr.in_namelist)) { - gfc_warning ("Unused variable '%s' declared at %L", sym->name, - &sym->declared_at); - if (sym->backend_decl != NULL_TREE) - TREE_NO_WARNING(sym->backend_decl) = 1; - } - else if (warn_unused_variable && sym->attr.use_only) - { - gfc_warning ("Unused module variable '%s' which has been explicitly " - "imported at %L", sym->name, &sym->declared_at); - if (sym->backend_decl != NULL_TREE) - TREE_NO_WARNING(sym->backend_decl) = 1; + if (sym->attr.use_only) + { + gfc_warning ("Unused module variable '%s' which has been " + "explicitly imported at %L", sym->name, + &sym->declared_at); + if (sym->backend_decl != NULL_TREE) + TREE_NO_WARNING(sym->backend_decl) = 1; + } + else if (!sym->attr.use_assoc) + { + gfc_warning ("Unused variable '%s' declared at %L", + sym->name, &sym->declared_at); + if (sym->backend_decl != NULL_TREE) + TREE_NO_WARNING(sym->backend_decl) = 1; + } } /* For variable length CHARACTER parameters, the PARM_DECL already @@ -5005,7 +5006,7 @@ create_main_function (tree fndecl) language standard parameters. */ { tree array_type, array, var; - VEC(constructor_elt,gc) *v = NULL; + vec<constructor_elt, va_gc> *v = NULL; /* Passing a new option to the library requires four modifications: + add it to the tree_cons list below diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index b0bd7f57004..d6410d3ac49 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -661,7 +661,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems) tree to_data; tree to_ref; tree from_ref; - VEC(tree,gc) *args; + vec<tree, va_gc> *args; tree tmp; tree index; stmtblock_t loopbody; @@ -696,13 +696,13 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems) if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from_data))) { from_ref = gfc_get_class_array_ref (index, from); - VEC_safe_push (tree, gc, args, from_ref); + vec_safe_push (args, from_ref); } else - VEC_safe_push (tree, gc, args, from_data); + vec_safe_push (args, from_data); to_ref = gfc_get_class_array_ref (index, to); - VEC_safe_push (tree, gc, args, to_ref); + vec_safe_push (args, to_ref); tmp = build_call_vec (fcn_type, fcn, args); @@ -724,8 +724,8 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems) else { gcc_assert (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from_data))); - VEC_safe_push (tree, gc, args, from_data); - VEC_safe_push (tree, gc, args, to_data); + vec_safe_push (args, from_data); + vec_safe_push (args, to_data); tmp = build_call_vec (fcn_type, fcn, args); } @@ -3822,11 +3822,11 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym, int gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, gfc_actual_arglist * args, gfc_expr * expr, - VEC(tree,gc) *append_args) + vec<tree, va_gc> *append_args) { gfc_interface_mapping mapping; - VEC(tree,gc) *arglist; - VEC(tree,gc) *retargs; + vec<tree, va_gc> *arglist; + vec<tree, va_gc> *retargs; tree tmp; tree fntype; gfc_se parmse; @@ -3837,7 +3837,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, tree var; tree len; tree base_object; - VEC(tree,gc) *stringargs; + vec<tree, va_gc> *stringargs; tree result = NULL; gfc_formal_arglist *formal; gfc_actual_arglist *arg; @@ -4608,7 +4608,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, /* Character strings are passed as two parameters, a length and a pointer - except for Bind(c) which only passes the pointer. */ if (parmse.string_length != NULL_TREE && !sym->attr.is_bind_c) - VEC_safe_push (tree, gc, stringargs, parmse.string_length); + vec_safe_push (stringargs, parmse.string_length); /* For descriptorless coarrays and assumed-shape coarray dummies, we pass the token and the offset as additional arguments. */ @@ -4618,9 +4618,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, && e == NULL) { /* Token and offset. */ - VEC_safe_push (tree, gc, stringargs, null_pointer_node); - VEC_safe_push (tree, gc, stringargs, - build_int_cst (gfc_array_index_type, 0)); + vec_safe_push (stringargs, null_pointer_node); + vec_safe_push (stringargs, build_int_cst (gfc_array_index_type, 0)); gcc_assert (fsym->attr.optional); } else if (fsym && fsym->attr.codimension @@ -4646,7 +4645,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, tmp = GFC_TYPE_ARRAY_CAF_TOKEN (caf_type); } - VEC_safe_push (tree, gc, stringargs, tmp); + vec_safe_push (stringargs, tmp); if (GFC_DESCRIPTOR_TYPE_P (caf_type) && GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_ALLOCATABLE) @@ -4692,10 +4691,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, offset = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, offset, tmp); - VEC_safe_push (tree, gc, stringargs, offset); + vec_safe_push (stringargs, offset); } - VEC_safe_push (tree, gc, arglist, parmse.expr); + vec_safe_push (arglist, parmse.expr); } gfc_finish_interface_mapping (&mapping, &se->pre, &se->post); @@ -4719,7 +4718,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, if (ts.deferred) cl.backend_decl = gfc_create_var (gfc_charlen_type_node, "slen"); else if (!sym->attr.dummy) - cl.backend_decl = VEC_index (tree, stringargs, 0); + cl.backend_decl = (*stringargs)[0]; else { formal = sym->ns->proc_name->formal; @@ -4796,7 +4795,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, else result = build_fold_indirect_ref_loc (input_location, se->expr); - VEC_safe_push (tree, gc, retargs, se->expr); + vec_safe_push (retargs, se->expr); } else if (comp && comp->attr.dimension) { @@ -4832,7 +4831,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, /* Pass the temporary as the first argument. */ result = info->descriptor; tmp = gfc_build_addr_expr (NULL_TREE, result); - VEC_safe_push (tree, gc, retargs, tmp); + vec_safe_push (retargs, tmp); } else if (!comp && sym->result->attr.dimension) { @@ -4868,7 +4867,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, /* Pass the temporary as the first argument. */ result = info->descriptor; tmp = gfc_build_addr_expr (NULL_TREE, result); - VEC_safe_push (tree, gc, retargs, tmp); + vec_safe_push (retargs, tmp); } else if (ts.type == BT_CHARACTER) { @@ -4899,7 +4898,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, else var = gfc_conv_string_tmp (se, type, len); - VEC_safe_push (tree, gc, retargs, var); + vec_safe_push (retargs, var); } else { @@ -4907,7 +4906,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, type = gfc_get_complex_type (ts.kind); var = gfc_build_addr_expr (NULL_TREE, gfc_create_var (type, "cmplx")); - VEC_safe_push (tree, gc, retargs, var); + vec_safe_push (retargs, var); } /* Add the string length to the argument list. */ @@ -4917,28 +4916,28 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, if (TREE_CODE (tmp) != VAR_DECL) tmp = gfc_evaluate_now (len, &se->pre); tmp = gfc_build_addr_expr (NULL_TREE, tmp); - VEC_safe_push (tree, gc, retargs, tmp); + vec_safe_push (retargs, tmp); } else if (ts.type == BT_CHARACTER) - VEC_safe_push (tree, gc, retargs, len); + vec_safe_push (retargs, len); } gfc_free_interface_mapping (&mapping); /* We need to glom RETARGS + ARGLIST + STRINGARGS + APPEND_ARGS. */ - arglen = (VEC_length (tree, arglist) - + VEC_length (tree, stringargs) + VEC_length (tree, append_args)); - VEC_reserve_exact (tree, gc, retargs, arglen); + arglen = (vec_safe_length (arglist) + vec_safe_length (stringargs) + + vec_safe_length (append_args)); + vec_safe_reserve (retargs, arglen); /* Add the return arguments. */ - VEC_splice (tree, retargs, arglist); + retargs->splice (arglist); /* Add the hidden string length parameters to the arguments. */ - VEC_splice (tree, retargs, stringargs); + retargs->splice (stringargs); /* We may want to append extra arguments here. This is used e.g. for calls to libgfortran_matmul_??, which need extra information. */ - if (!VEC_empty (tree, append_args)) - VEC_splice (tree, retargs, append_args); + if (!vec_safe_is_empty (append_args)) + retargs->splice (append_args); arglist = retargs; /* Generate the actual call. */ @@ -5423,7 +5422,8 @@ gfc_conv_function_expr (gfc_se * se, gfc_expr * expr) if (!sym) sym = expr->symtree->n.sym; - gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr, NULL); + gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr, + NULL); } @@ -5965,7 +5965,7 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init) tree val; tree type; tree tmp; - VEC(constructor_elt,gc) *v = NULL; + vec<constructor_elt, va_gc> *v = NULL; gcc_assert (se->ss == NULL); gcc_assert (expr->expr_type == EXPR_STRUCTURE); @@ -7139,7 +7139,8 @@ gfc_trans_zero_assign (gfc_expr * expr) a = {} instead. */ if (!POINTER_TYPE_P (TREE_TYPE (dest))) return build2_loc (input_location, MODIFY_EXPR, void_type_node, - dest, build_constructor (TREE_TYPE (dest), NULL)); + dest, build_constructor (TREE_TYPE (dest), + NULL)); /* Convert arguments to the correct types. */ dest = fold_convert (pvoid_type_node, dest); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index b101cb46728..e9eb307262f 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -724,7 +724,7 @@ static tree gfc_get_intrinsic_lib_fndecl (gfc_intrinsic_map_t * m, gfc_expr * expr) { tree type; - VEC(tree,gc) *argtypes; + vec<tree, va_gc> *argtypes; tree fndecl; gfc_actual_arglist *actual; tree *pdecl; @@ -809,7 +809,7 @@ gfc_get_intrinsic_lib_fndecl (gfc_intrinsic_map_t * m, gfc_expr * expr) for (actual = expr->value.function.actual; actual; actual = actual->next) { type = gfc_typenode_for_spec (&actual->expr->ts); - VEC_safe_push (tree, gc, argtypes, type); + vec_safe_push (argtypes, type); } type = build_function_type_vec (gfc_typenode_for_spec (ts), argtypes); fndecl = build_decl (input_location, @@ -2341,7 +2341,7 @@ static void gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr) { gfc_symbol *sym; - VEC(tree,gc) *append_args; + vec<tree, va_gc> *append_args; gcc_assert (!se->ss || se->ss->info->expr == expr); @@ -2381,19 +2381,19 @@ gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr) gemm_fndecl = gfor_fndecl_zgemm; } - append_args = VEC_alloc (tree, gc, 3); - VEC_quick_push (tree, append_args, build_int_cst (cint, 1)); - VEC_quick_push (tree, append_args, - build_int_cst (cint, gfc_option.blas_matmul_limit)); - VEC_quick_push (tree, append_args, - gfc_build_addr_expr (NULL_TREE, gemm_fndecl)); + vec_alloc (append_args, 3); + append_args->quick_push (build_int_cst (cint, 1)); + append_args->quick_push (build_int_cst (cint, + gfc_option.blas_matmul_limit)); + append_args->quick_push (gfc_build_addr_expr (NULL_TREE, + gemm_fndecl)); } else { - append_args = VEC_alloc (tree, gc, 3); - VEC_quick_push (tree, append_args, build_int_cst (cint, 0)); - VEC_quick_push (tree, append_args, build_int_cst (cint, 0)); - VEC_quick_push (tree, append_args, null_pointer_node); + vec_alloc (append_args, 3); + append_args->quick_push (build_int_cst (cint, 0)); + append_args->quick_push (build_int_cst (cint, 0)); + append_args->quick_push (null_pointer_node); } } @@ -4486,7 +4486,7 @@ conv_generic_with_optional_char_arg (gfc_se* se, gfc_expr* expr, unsigned cur_pos; gfc_actual_arglist* arg; gfc_symbol* sym; - VEC(tree,gc) *append_args; + vec<tree, va_gc> *append_args; /* Find the two arguments given as position. */ cur_pos = 0; @@ -4516,8 +4516,8 @@ conv_generic_with_optional_char_arg (gfc_se* se, gfc_expr* expr, tree dummy; dummy = build_int_cst (gfc_charlen_type_node, 0); - append_args = VEC_alloc (tree, gc, 1); - VEC_quick_push (tree, append_args, dummy); + vec_alloc (append_args, 1); + append_args->quick_push (dummy); } /* Build the call itself. */ @@ -5600,14 +5600,16 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) tmp = fold_convert (pvoid_type_node, tmp); /* Use memcpy to do the transfer. */ - tmp = build_call_expr_loc (input_location, - builtin_decl_explicit (BUILT_IN_MEMCPY), - 3, - tmp, - fold_convert (pvoid_type_node, source), - fold_build2_loc (input_location, MIN_EXPR, - gfc_array_index_type, - size_bytes, source_bytes)); + tmp + = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_MEMCPY), 3, tmp, + fold_convert (pvoid_type_node, source), + fold_convert (size_type_node, + fold_build2_loc (input_location, + MIN_EXPR, + gfc_array_index_type, + size_bytes, + source_bytes))); gfc_add_expr_to_block (&se->pre, tmp); se->expr = info->descriptor; @@ -5649,7 +5651,7 @@ scalar_transfer: builtin_decl_explicit (BUILT_IN_MEMCPY), 3, fold_convert (pvoid_type_node, tmpdecl), fold_convert (pvoid_type_node, ptr), - extent); + fold_convert (size_type_node, extent)); gfc_add_expr_to_block (&block, tmp); indirect = gfc_finish_block (&block); @@ -5687,7 +5689,7 @@ scalar_transfer: builtin_decl_explicit (BUILT_IN_MEMCPY), 3, fold_convert (pvoid_type_node, tmp), fold_convert (pvoid_type_node, ptr), - extent); + fold_convert (size_type_node, extent)); gfc_add_expr_to_block (&se->pre, tmp); /* For CLASS results, set the _vptr. */ @@ -5775,8 +5777,6 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) gfc_init_se (&arg1se, NULL); gfc_init_se (&arg2se, NULL); arg1 = expr->value.function.actual; - if (arg1->expr->ts.type == BT_CLASS) - gfc_add_data_component (arg1->expr); arg2 = arg1->next; /* Check whether the expression is a scalar or not; we cannot use @@ -5798,7 +5798,10 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) && arg1->expr->symtree->n.sym->attr.dummy) arg1se.expr = build_fold_indirect_ref_loc (input_location, arg1se.expr); - tmp2 = arg1se.expr; + if (arg1->expr->ts.type == BT_CLASS) + tmp2 = gfc_class_data_get (arg1se.expr); + else + tmp2 = arg1se.expr; } else { @@ -5833,6 +5836,8 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) && arg1->expr->symtree->n.sym->attr.dummy) arg1se.expr = build_fold_indirect_ref_loc (input_location, arg1se.expr); + if (arg1->expr->ts.type == BT_CLASS) + arg1se.expr = gfc_class_data_get (arg1se.expr); arg2se.want_pointer = 1; gfc_conv_expr (&arg2se, arg2->expr); @@ -5983,7 +5988,7 @@ gfc_conv_intrinsic_sr_kind (gfc_se *se, gfc_expr *expr) gfc_actual_arglist *actual; tree type; gfc_se argse; - VEC(tree,gc) *args = NULL; + vec<tree, va_gc> *args = NULL; for (actual = expr->value.function.actual; actual; actual = actual->next) { @@ -6009,7 +6014,7 @@ gfc_conv_intrinsic_sr_kind (gfc_se *se, gfc_expr *expr) gfc_add_block_to_block (&se->pre, &argse.pre); gfc_add_block_to_block (&se->post, &argse.post); - VEC_safe_push (tree, gc, args, argse.expr); + vec_safe_push (args, argse.expr); } /* Convert it to the required type. */ diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index e843692e020..8e44338459e 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -1293,8 +1293,6 @@ typedef struct dovar_init_d { tree init; } dovar_init; -DEF_VEC_O(dovar_init); -DEF_VEC_ALLOC_O(dovar_init,heap); static tree gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, @@ -1307,7 +1305,7 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, stmtblock_t body; gfc_omp_clauses *clauses = code->ext.omp_clauses; int i, collapse = clauses->collapse; - VEC(dovar_init,heap) *inits = NULL; + vec<dovar_init> inits = vNULL; dovar_init *di; unsigned ix; @@ -1435,7 +1433,7 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, tmp = fold_build2_loc (input_location, MULT_EXPR, type, count, step); tmp = fold_build2_loc (input_location, PLUS_EXPR, type, from, tmp); dovar_init e = {dovar, tmp}; - VEC_safe_push (dovar_init, heap, inits, e); + inits.safe_push (e); } if (!dovar_found) @@ -1506,9 +1504,9 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, gfc_start_block (&body); - FOR_EACH_VEC_ELT (dovar_init, inits, ix, di) + FOR_EACH_VEC_ELT (inits, ix, di) gfc_add_modify (&body, di->var, di->init); - VEC_free (dovar_init, heap, inits); + inits.release (); /* Cycle statement is implemented with a goto. Exit statement must not be present for this loop. */ diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index b95c8dae758..bdc559b4274 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -337,7 +337,8 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, tmp = gfc_conv_descriptor_data_get (tmp); tmp = build_call_expr_loc (input_location, builtin_decl_explicit (BUILT_IN_MEMCPY), - 3, tmp, data, size); + 3, tmp, data, + fold_convert (size_type_node, size)); } gfc_add_expr_to_block (&se->post, tmp); @@ -488,7 +489,8 @@ gfc_trans_call (gfc_code * code, bool dependency_check, /* Add the subroutine call to the block. */ gfc_conv_procedure_call (&loopse, code->resolved_sym, - code->ext.actual, code->expr1, NULL); + code->ext.actual, code->expr1, + NULL); if (mask && count1) { @@ -2093,7 +2095,7 @@ gfc_trans_character_select (gfc_code *code) gfc_code *c; gfc_se se, expr1se; int n, k; - VEC(constructor_elt,gc) *inits = NULL; + vec<constructor_elt, va_gc> *inits = NULL; tree pchartype = gfc_get_pchar_type (code->expr1->ts.kind); @@ -2321,7 +2323,7 @@ gfc_trans_character_select (gfc_code *code) /* Generate the structure describing the branches */ for (d = cp; d; d = d->right) { - VEC(constructor_elt,gc) *node = NULL; + vec<constructor_elt, va_gc> *node = NULL; gfc_init_se (&se, NULL); diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 81b7fa5ca27..35a39c57859 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -2690,7 +2690,7 @@ tree gfc_get_function_type (gfc_symbol * sym) { tree type; - VEC(tree,gc) *typelist; + vec<tree, va_gc> *typelist; gfc_formal_arglist *f; gfc_symbol *arg; int alternate_return; @@ -2713,7 +2713,7 @@ gfc_get_function_type (gfc_symbol * sym) if (sym->attr.entry_master) /* Additional parameter for selecting an entry point. */ - VEC_safe_push (tree, gc, typelist, gfc_array_index_type); + vec_safe_push (typelist, gfc_array_index_type); if (sym->result) arg = sym->result; @@ -2732,17 +2732,16 @@ gfc_get_function_type (gfc_symbol * sym) || arg->ts.type == BT_CHARACTER) type = build_reference_type (type); - VEC_safe_push (tree, gc, typelist, type); + vec_safe_push (typelist, type); if (arg->ts.type == BT_CHARACTER) { if (!arg->ts.deferred) /* Transfer by value. */ - VEC_safe_push (tree, gc, typelist, gfc_charlen_type_node); + vec_safe_push (typelist, gfc_charlen_type_node); else /* Deferred character lengths are transferred by reference so that the value can be returned. */ - VEC_safe_push (tree, gc, typelist, - build_pointer_type (gfc_charlen_type_node)); + vec_safe_push (typelist, build_pointer_type(gfc_charlen_type_node)); } } @@ -2780,7 +2779,7 @@ gfc_get_function_type (gfc_symbol * sym) used without an explicit interface, and cannot be passed as actual parameters for a dummy procedure. */ - VEC_safe_push (tree, gc, typelist, type); + vec_safe_push (typelist, type); } else { @@ -2803,11 +2802,11 @@ gfc_get_function_type (gfc_symbol * sym) so that the value can be returned. */ type = build_pointer_type (gfc_charlen_type_node); - VEC_safe_push (tree, gc, typelist, type); + vec_safe_push (typelist, type); } } - if (!VEC_empty (tree, typelist) + if (!vec_safe_is_empty (typelist) || sym->attr.is_main_program || sym->attr.if_source != IFSRC_UNKNOWN) is_varargs = false; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 652893ee60c..954dcd3400f 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -427,7 +427,7 @@ int gfc_is_intrinsic_libcall (gfc_expr *); /* Used to call ordinary functions/subroutines and procedure pointer components. */ int gfc_conv_procedure_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *, - gfc_expr *, VEC(tree,gc) *); + gfc_expr *, vec<tree, va_gc> *); void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool); |