diff options
30 files changed, 343 insertions, 306 deletions
diff --git a/gcc/fortran/data.cc b/gcc/fortran/data.cc index d80ba66..c0974be 100644 --- a/gcc/fortran/data.cc +++ b/gcc/fortran/data.cc @@ -384,9 +384,10 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index, declarations. Therefore, check which is the most recent. */ gfc_expr *exprd; - exprd = (LOCATION_LINE (con->expr->where.lb->location) - > LOCATION_LINE (rvalue->where.lb->location)) - ? con->expr : rvalue; + exprd = (linemap_location_before_p (line_table, + gfc_get_location (&con->expr->where), + gfc_get_location (&rvalue->where)) + ? rvalue : con->expr); if (gfc_notify_std (GFC_STD_GNU, "re-initialization of %qs at %L", symbol->name, &exprd->where) == false) @@ -605,14 +606,17 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index, /* Overwriting an existing initializer is non-standard but usually only provokes a warning from other compilers. */ - if (init != NULL && init->where.lb && rvalue->where.lb) + if (init != NULL + && GFC_LOCUS_IS_SET (init->where) + && GFC_LOCUS_IS_SET (rvalue->where)) { /* Order in which the expressions arrive here depends on whether they are from data statements or F95 style declarations. Therefore, check which is the most recent. */ - expr = (LOCATION_LINE (init->where.lb->location) - > LOCATION_LINE (rvalue->where.lb->location)) - ? init : rvalue; + expr = (linemap_location_before_p (line_table, + gfc_get_location (&init->where), + gfc_get_location (&rvalue->where)) + ? rvalue : init); if (gfc_notify_std (GFC_STD_GNU, "re-initialization of %qs at %L", symbol->name, &expr->where) == false) return false; diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index 81e5e62..1515789 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -1573,11 +1573,11 @@ gfc_verify_c_interop_param (gfc_symbol *sym) && sym->ts.type == BT_DERIVED && gfc_has_default_initializer (sym->ts.u.derived)) { - gfc_error ("Default-initialized %s dummy argument %qs " - "at %L is not permitted in BIND(C) procedure %qs", - (sym->attr.pointer ? "pointer" : "allocatable"), - sym->name, &sym->declared_at, - sym->ns->proc_name->name); + gfc_error ("Default-initialized dummy argument %qs with %s " + "attribute at %L is not permitted in BIND(C) " + "procedure %qs", sym->name, + (sym->attr.pointer ? "POINTER" : "ALLOCATABLE"), + &sym->declared_at, sym->ns->proc_name->name); retval = false; } @@ -1733,15 +1733,14 @@ build_sym (const char *name, int elem, gfc_charlen *cl, bool cl_deferred, { gfc_symtree *s = gfc_get_unique_symtree (gfc_current_ns); s->n.sym = st->n.sym; - sym = gfc_new_symbol (name, gfc_current_ns); - + sym = gfc_new_symbol (name, gfc_current_ns, var_locus); st->n.sym = sym; sym->refs++; gfc_set_sym_referenced (sym); } /* ...Otherwise generate a new symtree and new symbol. */ - else if (gfc_get_symbol (name, NULL, &sym)) + else if (gfc_get_symbol (name, NULL, &sym, var_locus)) return false; /* Check if the name has already been defined as a type. The @@ -2633,6 +2632,7 @@ variable_decl (int elem) name to be '%FILL' which gives it an anonymous (inaccessible) name. */ m = MATCH_NO; gfc_gobble_whitespace (); + var_locus = gfc_current_locus; c = gfc_peek_ascii_char (); if (c == '%') { @@ -2674,8 +2674,6 @@ variable_decl (int elem) goto cleanup; } - var_locus = gfc_current_locus; - /* Now we could see the optional array spec. or character length. */ m = gfc_match_array_spec (&as, true, true); if (m == MATCH_ERROR) @@ -2690,6 +2688,8 @@ variable_decl (int elem) goto cleanup; } + var_locus = gfc_get_location_range (NULL, 0, &var_locus, 1, + &gfc_current_locus); if (flag_cray_pointer) cp_as = gfc_copy_array_spec (as); @@ -2881,9 +2881,9 @@ variable_decl (int elem) if (sym != NULL && (sym->attr.dummy || sym->attr.result)) { m = MATCH_ERROR; - gfc_error ("%qs at %C is a redefinition of the declaration " + gfc_error ("%qs at %L is a redefinition of the declaration " "in the corresponding interface for MODULE " - "PROCEDURE %qs", sym->name, + "PROCEDURE %qs", sym->name, &var_locus, gfc_current_ns->proc_name->name); goto cleanup; } @@ -2892,7 +2892,8 @@ variable_decl (int elem) /* %FILL components may not have initializers. */ if (startswith (name, "%FILL") && gfc_match_eos () != MATCH_YES) { - gfc_error ("%qs entity cannot have an initializer at %C", "%FILL"); + gfc_error ("%qs entity cannot have an initializer at %L", "%FILL", + &var_locus); m = MATCH_ERROR; goto cleanup; } @@ -2917,7 +2918,7 @@ variable_decl (int elem) { if (sym->as != NULL) { - gfc_error ("Duplicate array spec for Cray pointee at %C"); + gfc_error ("Duplicate array spec for Cray pointee at %L", &var_locus); gfc_free_array_spec (cp_as); m = MATCH_ERROR; goto cleanup; @@ -6696,6 +6697,7 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag, for (;;) { + gfc_gobble_whitespace (); if (gfc_match_char ('*') == MATCH_YES) { sym = NULL; @@ -6710,6 +6712,7 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag, } else { + locus loc = gfc_current_locus; m = gfc_match_name (name); if (m != MATCH_YES) { @@ -6717,11 +6720,12 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag, gfc_error_now ("A parameter name is required at %C"); goto cleanup; } + loc = gfc_get_location_range (NULL, 0, &loc, 1, &gfc_current_locus); - if (!typeparam && gfc_get_symbol (name, NULL, &sym)) + if (!typeparam && gfc_get_symbol (name, NULL, &sym, &loc)) goto cleanup; else if (typeparam - && gfc_get_symbol (name, progname->f2k_derived, &sym)) + && gfc_get_symbol (name, progname->f2k_derived, &sym, &loc)) goto cleanup; } @@ -8037,6 +8041,7 @@ gfc_match_subroutine (void) if (m != MATCH_YES) return m; + loc = gfc_current_locus; m = gfc_match ("subroutine% %n", name); if (m != MATCH_YES) return m; @@ -8046,7 +8051,8 @@ gfc_match_subroutine (void) /* Set declared_at as it might point to, e.g., a PUBLIC statement, if the symbol existed before. */ - sym->declared_at = gfc_current_locus; + sym->declared_at = gfc_get_location_range (NULL, 0, &loc, 1, + &gfc_current_locus); if (current_attr.module_procedure) sym->attr.module_procedure = 1; diff --git a/gcc/fortran/error.cc b/gcc/fortran/error.cc index afe2e49..4e60b14 100644 --- a/gcc/fortran/error.cc +++ b/gcc/fortran/error.cc @@ -52,19 +52,45 @@ static int warningcount_buffered, werrorcount_buffered; /* Return a location_t suitable for 'tree' for a gfortran locus. During - parsing in gfortran, loc->lb->location contains only the line number + parsing in gfortran, loc->u.lb->location contains only the line number and LOCATION_COLUMN is 0; hence, the column has to be added when generating - locations for 'tree'. */ + locations for 'tree'. If available, return location_t directly, which + might be a range. */ location_t gfc_get_location_with_offset (locus *loc, unsigned offset) { - gcc_checking_assert (loc->nextc >= loc->lb->line); - return linemap_position_for_loc_and_offset (line_table, loc->lb->location, - loc->nextc - loc->lb->line + if (loc->nextc == (gfc_char_t *) -1) + { + gcc_checking_assert (offset == 0); + return loc->u.location; + } + gcc_checking_assert (loc->nextc >= loc->u.lb->line); + return linemap_position_for_loc_and_offset (line_table, loc->u.lb->location, + loc->nextc - loc->u.lb->line + offset); } +/* Convert a locus to a range. */ + +locus +gfc_get_location_range (locus *caret_loc, unsigned caret_offset, + locus *start_loc, unsigned start_offset, + locus *end_loc) +{ + location_t caret; + location_t start = gfc_get_location_with_offset (start_loc, start_offset); + location_t end = gfc_get_location_with_offset (end_loc, 0); + + if (caret_loc) + caret = gfc_get_location_with_offset (caret_loc, caret_offset); + + locus range; + range.nextc = (gfc_char_t *) -1; + range.u.location = make_location (caret_loc ? caret : start, start, end); + return range; +} + /* Return buffered_p. */ bool gfc_buffered_p (void) diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index 36baa9b..65bb9f1 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -3912,7 +3912,8 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform, if (lvalue->ts.type == BT_LOGICAL && rvalue->ts.type == BT_LOGICAL) return true; - where = lvalue->where.lb ? &lvalue->where : &rvalue->where; + where = (GFC_LOCUS_IS_SET (lvalue->where) + ? &lvalue->where : &rvalue->where); gfc_error ("Incompatible types in DATA statement at %L; attempted " "conversion of %s to %s", where, gfc_typename (rvalue), gfc_typename (lvalue)); diff --git a/gcc/fortran/frontend-passes.cc b/gcc/fortran/frontend-passes.cc index c7cb9d2..405074e 100644 --- a/gcc/fortran/frontend-passes.cc +++ b/gcc/fortran/frontend-passes.cc @@ -190,7 +190,14 @@ check_locus_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, void *data ATTRIBUTE_UNUSED) { current_code = c; - if (c && *c && (((*c)->loc.nextc == NULL) || ((*c)->loc.lb == NULL))) + if (c + && *c + && (((*c)->loc.nextc == NULL) + || ((*c)->loc.nextc == (gfc_char_t *) -1 + && (*c)->loc.u.location == UNKNOWN_LOCATION) + || ((*c)->loc.nextc != (gfc_char_t *) -1 + && ((*c)->loc.u.lb == NULL)))) + gfc_warning_internal (0, "Inconsistent internal state: " "No location in statement"); @@ -206,7 +213,13 @@ check_locus_expr (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, void *data ATTRIBUTE_UNUSED) { - if (e && *e && (((*e)->where.nextc == NULL || (*e)->where.lb == NULL))) + if (e + && *e + && (((*e)->where.nextc == NULL) + || ((*e)->where.nextc == (gfc_char_t *) -1 + && (*e)->where.u.location == UNKNOWN_LOCATION) + || ((*e)->where.nextc != (gfc_char_t *) -1 + && ((*e)->where.u.lb == NULL)))) gfc_warning_internal (0, "Inconsistent internal state: " "No location in expression near %L", &((*current_code)->loc)); @@ -3352,7 +3365,7 @@ runtime_error_ne (gfc_expr *e1, gfc_expr *e2, const char *msg) gfc_code *c; gfc_actual_arglist *a1, *a2, *a3; - gcc_assert (e1->where.lb); + gcc_assert (GFC_LOCUS_IS_SET (e1->where)); /* Build the call to runtime_error. */ c = XCNEW (gfc_code); c->op = EXEC_CALL; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 7aa9b13..9e81a81 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1087,12 +1087,20 @@ typedef struct gfc_linebuf #define gfc_linebuf_linenum(LBUF) (LOCATION_LINE ((LBUF)->location)) +/* If nextc = (gfc_char_t*) -1, 'location' is used. */ typedef struct { gfc_char_t *nextc; - gfc_linebuf *lb; + union + { + gfc_linebuf *lb; + location_t location; + } u; } locus; +#define GFC_LOCUS_IS_SET(loc) \ + ((loc).nextc == (gfc_char_t *) -1 || (loc).u.lb != NULL) + /* In order for the "gfc" format checking to work correctly, you must have declared a typedef locus first. */ #if GCC_VERSION >= 4001 @@ -3439,6 +3447,7 @@ const char * gfc_get_string (const char *, ...) ATTRIBUTE_PRINTF_1; bool gfc_find_sym_in_expr (gfc_symbol *, gfc_expr *); /* error.cc */ +locus gfc_get_location_range (locus *, unsigned, locus *, unsigned, locus *); location_t gfc_get_location_with_offset (locus *, unsigned); inline location_t gfc_get_location (locus *loc) @@ -3628,11 +3637,12 @@ gfc_user_op *gfc_get_uop (const char *); gfc_user_op *gfc_find_uop (const char *, gfc_namespace *); void gfc_free_symbol (gfc_symbol *&); bool gfc_release_symbol (gfc_symbol *&); -gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *); +gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *, locus * = NULL); gfc_symtree* gfc_find_symtree_in_proc (const char *, gfc_namespace *); int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **); bool gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **); -int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **); +int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **, + locus * = NULL); bool gfc_verify_c_interop (gfc_typespec *); bool gfc_verify_c_interop_param (gfc_symbol *); bool verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *); @@ -3641,9 +3651,10 @@ bool verify_com_block_vars_c_interop (gfc_common_head *); gfc_symtree *generate_isocbinding_symbol (const char *, iso_c_binding_symbol, const char *, gfc_symtree *, bool); void gfc_save_symbol_data (gfc_symbol *); -int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **, bool); -int gfc_get_ha_symbol (const char *, gfc_symbol **); -int gfc_get_ha_sym_tree (const char *, gfc_symtree **); +int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **, bool, + locus * = NULL); +int gfc_get_ha_symbol (const char *, gfc_symbol **, locus * = NULL); +int gfc_get_ha_sym_tree (const char *, gfc_symtree **, locus * = NULL); void gfc_drop_last_undo_checkpoint (void); void gfc_restore_last_undo_checkpoint (void); diff --git a/gcc/fortran/io.cc b/gcc/fortran/io.cc index 6fd69f7..ac4e5c5 100644 --- a/gcc/fortran/io.cc +++ b/gcc/fortran/io.cc @@ -3761,11 +3761,11 @@ static bool check_io_constraints (io_kind k, gfc_dt *dt, gfc_code *io_code, locus *spec_end) { -#define io_constraint(condition, msg, arg)\ +#define io_constraint(condition, msg, where)\ if (condition) \ {\ - if ((arg)->lb != NULL)\ - gfc_error ((msg), (arg));\ + if (GFC_LOCUS_IS_SET (*where))\ + gfc_error ((msg), (where));\ else\ gfc_error ((msg), spec_end);\ return false;\ diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc index 0cd78a5..3a993ed 100644 --- a/gcc/fortran/match.cc +++ b/gcc/fortran/match.cc @@ -675,16 +675,21 @@ gfc_match_sym_tree (gfc_symtree **matched_symbol, int host_assoc) { char buffer[GFC_MAX_SYMBOL_LEN + 1]; match m; + int ret; + locus loc = gfc_current_locus; m = gfc_match_name (buffer); if (m != MATCH_YES) return m; - + loc = gfc_get_location_range (NULL, 0, &loc, 1, &gfc_current_locus); if (host_assoc) - return (gfc_get_ha_sym_tree (buffer, matched_symbol)) - ? MATCH_ERROR : MATCH_YES; + { + ret = gfc_get_ha_sym_tree (buffer, matched_symbol, &loc); + return ret ? MATCH_ERROR : MATCH_YES; + } - if (gfc_get_sym_tree (buffer, NULL, matched_symbol, false)) + ret = gfc_get_sym_tree (buffer, NULL, matched_symbol, false, &loc); + if (ret) return MATCH_ERROR; return MATCH_YES; diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 2c12f5e..7aa0d59 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -424,15 +424,18 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list, for (;;) { + gfc_gobble_whitespace (); cur_loc = gfc_current_locus; m = gfc_match_name (n); if (m == MATCH_YES && strcmp (n, "omp_all_memory") == 0) { + locus loc = gfc_get_location_range (NULL, 0, &cur_loc, 1, + &gfc_current_locus); if (!has_all_memory) { - gfc_error ("%<omp_all_memory%> at %C not permitted in this " - "clause"); + gfc_error ("%<omp_all_memory%> at %L not permitted in this " + "clause", &loc); goto cleanup; } *has_all_memory = true; @@ -444,7 +447,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list, tail->next = p; tail = tail->next; } - tail->where = cur_loc; + tail->where = loc; goto next_item; } if (m == MATCH_YES) @@ -476,7 +479,8 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list, } if (gfc_is_coindexed (expr)) { - gfc_error ("List item shall not be coindexed at %C"); + gfc_error ("List item shall not be coindexed at %L", + &expr->where); goto cleanup; } } @@ -491,7 +495,8 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list, } tail->sym = sym; tail->expr = expr; - tail->where = cur_loc; + tail->where = gfc_get_location_range (NULL, 0, &cur_loc, 1, + &gfc_current_locus); if (reject_common_vars && sym->attr.in_common) { gcc_assert (allow_common); @@ -511,16 +516,18 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list, if (!allow_common) goto syntax; - m = gfc_match (" / %n /", n); + m = gfc_match ("/ %n /", n); if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_NO) goto syntax; + cur_loc = gfc_get_location_range (NULL, 0, &cur_loc, 1, + &gfc_current_locus); st = gfc_find_symtree (gfc_current_ns->common_root, n); if (st == NULL) { - gfc_error ("COMMON block /%s/ not found at %C", n); + gfc_error ("COMMON block %</%s/%> not found at %L", n, &cur_loc); goto cleanup; } for (sym = st->n.common->head; sym; sym = sym->common_next) @@ -699,14 +706,17 @@ gfc_match_omp_doacross_sink (gfc_omp_namelist **list, bool depend) for (;;) { + gfc_gobble_whitespace (); cur_loc = gfc_current_locus; if (gfc_match_name (n) != MATCH_YES) goto syntax; + locus loc = gfc_get_location_range (NULL, 0, &cur_loc, 1, + &gfc_current_locus); if (UNLIKELY (strcmp (n, "omp_all_memory") == 0)) { gfc_error ("%<omp_all_memory%> used with dependence-type " - "other than OUT or INOUT at %C"); + "other than OUT or INOUT at %L", &loc); goto cleanup; } sym = NULL; @@ -733,7 +743,7 @@ gfc_match_omp_doacross_sink (gfc_omp_namelist **list, bool depend) } tail->sym = sym; tail->expr = NULL; - tail->where = cur_loc; + tail->where = loc; if (gfc_match_char ('+') == MATCH_YES) { if (gfc_match_literal_constant (&tail->expr, 0) != MATCH_YES) diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index 9e06dbf..1821871 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -1799,7 +1799,7 @@ blank_line: if (digit_flag) gfc_error_now ("Statement label without statement at %L", &label_locus); - gfc_current_locus.lb->truncated = 0; + gfc_current_locus.u.lb->truncated = 0; gfc_advance_line (); return ST_NONE; } diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index e114bf1..b93ee56 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -2669,7 +2669,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, if (tmp && tmp->type == REF_INQUIRY) { - if (!primary->where.lb || !primary->where.nextc) + if (!primary->where.u.lb || !primary->where.nextc) primary->where = gfc_current_locus; gfc_simplify_expr (primary, 0); @@ -4444,7 +4444,6 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag) expr->expr_type = EXPR_VARIABLE; expr->symtree = st; expr->ts = sym->ts; - expr->where = where; /* Now see if we have to do more. */ m = gfc_match_varspec (expr, equiv_flag, false, false); @@ -4454,6 +4453,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag) return m; } + expr->where = gfc_get_location_range (NULL, 0, &where, 1, &gfc_current_locus); *result = expr; return MATCH_YES; } diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index ebe449e..0ff63be 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -5196,7 +5196,8 @@ find_array_spec (gfc_expr *e) case REF_ARRAY: if (as == NULL) { - locus loc = ref->u.ar.where.lb ? ref->u.ar.where : e->where; + locus loc = (GFC_LOCUS_IS_SET (ref->u.ar.where) + ? ref->u.ar.where : e->where); gfc_error ("Invalid array reference of a non-array entity at %L", &loc); return false; diff --git a/gcc/fortran/scanner.cc b/gcc/fortran/scanner.cc index 0631e7b..3d853ac 100644 --- a/gcc/fortran/scanner.cc +++ b/gcc/fortran/scanner.cc @@ -536,7 +536,7 @@ gfc_at_eof (void) if (line_head == NULL) return 1; /* Null file */ - if (gfc_current_locus.lb == NULL) + if (gfc_current_locus.u.lb == NULL) return 1; return 0; @@ -551,7 +551,7 @@ gfc_at_bol (void) if (gfc_at_eof ()) return 1; - return (gfc_current_locus.nextc == gfc_current_locus.lb->line); + return (gfc_current_locus.nextc == gfc_current_locus.u.lb->line); } @@ -609,7 +609,7 @@ gfc_start_source_files (void) (*debug_hooks->start_source_file) (0, gfc_source_file); file_changes_cur = 0; - report_file_change (gfc_current_locus.lb); + report_file_change (gfc_current_locus.u.lb); } void @@ -629,23 +629,23 @@ gfc_advance_line (void) if (gfc_at_end ()) return; - if (gfc_current_locus.lb == NULL) + if (gfc_current_locus.u.lb == NULL) { end_flag = 1; return; } - if (gfc_current_locus.lb->next - && !gfc_current_locus.lb->next->dbg_emitted) + if (gfc_current_locus.u.lb->next + && !gfc_current_locus.u.lb->next->dbg_emitted) { - report_file_change (gfc_current_locus.lb->next); - gfc_current_locus.lb->next->dbg_emitted = true; + report_file_change (gfc_current_locus.u.lb->next); + gfc_current_locus.u.lb->next->dbg_emitted = true; } - gfc_current_locus.lb = gfc_current_locus.lb->next; + gfc_current_locus.u.lb = gfc_current_locus.u.lb->next; - if (gfc_current_locus.lb != NULL) - gfc_current_locus.nextc = gfc_current_locus.lb->line; + if (gfc_current_locus.u.lb != NULL) + gfc_current_locus.nextc = gfc_current_locus.u.lb->line; else { gfc_current_locus.nextc = NULL; @@ -714,7 +714,7 @@ gfc_define_undef_line (void) if (wide_strncmp (gfc_current_locus.nextc, "#define ", 8) == 0) { tmp = gfc_widechar_to_char (&gfc_current_locus.nextc[8], -1); - (*debug_hooks->define) (gfc_linebuf_linenum (gfc_current_locus.lb), + (*debug_hooks->define) (gfc_linebuf_linenum (gfc_current_locus.u.lb), tmp); free (tmp); } @@ -722,7 +722,7 @@ gfc_define_undef_line (void) if (wide_strncmp (gfc_current_locus.nextc, "#undef ", 7) == 0) { tmp = gfc_widechar_to_char (&gfc_current_locus.nextc[7], -1); - (*debug_hooks->undef) (gfc_linebuf_linenum (gfc_current_locus.lb), + (*debug_hooks->undef) (gfc_linebuf_linenum (gfc_current_locus.u.lb), tmp); free (tmp); } @@ -1099,9 +1099,9 @@ skip_fixed_comments (void) return; } - if (gfc_current_locus.lb != NULL - && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)) - continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); + if (gfc_current_locus.u.lb != NULL + && continue_line < gfc_linebuf_linenum (gfc_current_locus.u.lb)) + continue_line = gfc_linebuf_linenum (gfc_current_locus.u.lb); /* If -fopenmp/-fopenacc, we need to handle here 2 things: 1) don't treat !$omp/!$acc|c$omp/c$acc|*$omp / *$acc as comments, @@ -1221,9 +1221,9 @@ check_for_digits: if (col != 6 && c == '!') { - if (gfc_current_locus.lb != NULL - && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)) - continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); + if (gfc_current_locus.u.lb != NULL + && continue_line < gfc_linebuf_linenum (gfc_current_locus.u.lb)) + continue_line = gfc_linebuf_linenum (gfc_current_locus.u.lb); skip_comment_line (); continue; } @@ -1305,20 +1305,20 @@ restart: while (c != '\n'); /* Avoid truncation warnings for comment ending lines. */ - gfc_current_locus.lb->truncated = 0; + gfc_current_locus.u.lb->truncated = 0; goto done; } /* Check to see if the continuation line was truncated. */ - if (warn_line_truncation && gfc_current_locus.lb != NULL - && gfc_current_locus.lb->truncated) + if (warn_line_truncation && gfc_current_locus.u.lb != NULL + && gfc_current_locus.u.lb->truncated) { int maxlen = flag_free_line_length; gfc_char_t *current_nextc = gfc_current_locus.nextc; - gfc_current_locus.lb->truncated = 0; - gfc_current_locus.nextc = gfc_current_locus.lb->line + maxlen; + gfc_current_locus.u.lb->truncated = 0; + gfc_current_locus.nextc = gfc_current_locus.u.lb->line + maxlen; gfc_warning_now (OPT_Wline_truncation, "Line truncated at %L", &gfc_current_locus); gfc_current_locus.nextc = current_nextc; @@ -1363,9 +1363,9 @@ restart: without getting reset (e.g. via input_stmt). It also happens when pre-including files via -fpre-include=. */ if (continue_count == 0 - && gfc_current_locus.lb - && continue_line > gfc_linebuf_linenum (gfc_current_locus.lb) + 1) - continue_line = gfc_linebuf_linenum (gfc_current_locus.lb) + 1; + && gfc_current_locus.u.lb + && continue_line > gfc_linebuf_linenum (gfc_current_locus.u.lb) + 1) + continue_line = gfc_linebuf_linenum (gfc_current_locus.u.lb) + 1; continue_flag = 1; if (c == '!') @@ -1379,7 +1379,7 @@ restart: /* We've got a continuation line. If we are on the very next line after the last continuation, increment the continuation line count and check whether the limit has been exceeded. */ - if (gfc_linebuf_linenum (gfc_current_locus.lb) == continue_line + 1) + if (gfc_linebuf_linenum (gfc_current_locus.u.lb) == continue_line + 1) { if (++continue_count == gfc_option.max_continue_free) { @@ -1392,9 +1392,9 @@ restart: /* Now find where it continues. First eat any comment lines. */ openmp_cond_flag = skip_free_comments (); - if (gfc_current_locus.lb != NULL - && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)) - continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); + if (gfc_current_locus.u.lb != NULL + && continue_line < gfc_linebuf_linenum (gfc_current_locus.u.lb)) + continue_line = gfc_linebuf_linenum (gfc_current_locus.u.lb); if (flag_openmp) if (prev_openmp_flag != openmp_flag && !openacc_flag) @@ -1461,7 +1461,7 @@ restart: is_openmp = 1; } if (omp_acc_err_loc.nextc != gfc_current_locus.nextc - || omp_acc_err_loc.lb != gfc_current_locus.lb) + || omp_acc_err_loc.u.lb != gfc_current_locus.u.lb) gfc_error_now (is_openmp ? G_("Wrong OpenACC continuation at %C: " "expected !$ACC, got !$OMP") @@ -1511,17 +1511,17 @@ restart: while (c != '\n'); /* Avoid truncation warnings for comment ending lines. */ - gfc_current_locus.lb->truncated = 0; + gfc_current_locus.u.lb->truncated = 0; } if (c != '\n') goto done; /* Check to see if the continuation line was truncated. */ - if (warn_line_truncation && gfc_current_locus.lb != NULL - && gfc_current_locus.lb->truncated) + if (warn_line_truncation && gfc_current_locus.u.lb != NULL + && gfc_current_locus.u.lb->truncated) { - gfc_current_locus.lb->truncated = 0; + gfc_current_locus.u.lb->truncated = 0; gfc_warning_now (OPT_Wline_truncation, "Line truncated at %L", &gfc_current_locus); } @@ -1535,9 +1535,9 @@ restart: without getting reset (e.g. via input_stmt). It also happens when pre-including files via -fpre-include=. */ if (continue_count == 0 - && gfc_current_locus.lb - && continue_line > gfc_linebuf_linenum (gfc_current_locus.lb) + 1) - continue_line = gfc_linebuf_linenum (gfc_current_locus.lb) + 1; + && gfc_current_locus.u.lb + && continue_line > gfc_linebuf_linenum (gfc_current_locus.u.lb) + 1) + continue_line = gfc_linebuf_linenum (gfc_current_locus.u.lb) + 1; continue_flag = 1; old_loc = gfc_current_locus; @@ -1570,7 +1570,7 @@ restart: is_openmp = 1; } if (omp_acc_err_loc.nextc != gfc_current_locus.nextc - || omp_acc_err_loc.lb != gfc_current_locus.lb) + || omp_acc_err_loc.u.lb != gfc_current_locus.u.lb) gfc_error_now (is_openmp ? G_("Wrong OpenACC continuation at %C: " "expected !$ACC, got !$OMP") @@ -1608,7 +1608,7 @@ restart: /* We've got a continuation line. If we are on the very next line after the last continuation, increment the continuation line count and check whether the limit has been exceeded. */ - if (gfc_linebuf_linenum (gfc_current_locus.lb) == continue_line + 1) + if (gfc_linebuf_linenum (gfc_current_locus.u.lb) == continue_line + 1) { if (++continue_count == gfc_option.max_continue_fixed) { @@ -1619,9 +1619,9 @@ restart: } } - if (gfc_current_locus.lb != NULL - && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)) - continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); + if (gfc_current_locus.u.lb != NULL + && continue_line < gfc_linebuf_linenum (gfc_current_locus.u.lb)) + continue_line = gfc_linebuf_linenum (gfc_current_locus.u.lb); } /* Ready to read first character of continuation line, which might @@ -1760,7 +1760,7 @@ gfc_gobble_whitespace (void) line will be scanned multiple times. */ if (warn_tabs && c == '\t') { - int cur_linenum = LOCATION_LINE (gfc_current_locus.lb->location); + int cur_linenum = LOCATION_LINE (gfc_current_locus.u.lb->location); if (cur_linenum != linenum) { linenum = cur_linenum; @@ -2424,7 +2424,7 @@ include_stmt (gfc_linebuf *b) openacc_flag = 0; continue_count = 0; continue_line = 0; - gfc_current_locus.lb = b; + gfc_current_locus.u.lb = b; gfc_current_locus.nextc = b->line; gfc_skip_comments (); @@ -2782,7 +2782,7 @@ gfc_new_file (void) else load_file (gfc_source_file, NULL, true); - gfc_current_locus.lb = line_head; + gfc_current_locus.u.lb = line_head; gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line; #if 0 /* Debugging aid. */ diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc index 557bd3b..e803cdd 100644 --- a/gcc/fortran/symbol.cc +++ b/gcc/fortran/symbol.cc @@ -3254,7 +3254,7 @@ gfc_release_symbol (gfc_symbol *&sym) /* Allocate and initialize a new symbol node. */ gfc_symbol * -gfc_new_symbol (const char *name, gfc_namespace *ns) +gfc_new_symbol (const char *name, gfc_namespace *ns, locus *where) { gfc_symbol *p; @@ -3263,7 +3263,7 @@ gfc_new_symbol (const char *name, gfc_namespace *ns) gfc_clear_ts (&p->ts); gfc_clear_attr (&p->attr); p->ns = ns; - p->declared_at = gfc_current_locus; + p->declared_at = where ? *where : gfc_current_locus; p->name = gfc_get_string ("%s", name); return p; @@ -3477,7 +3477,7 @@ gfc_save_symbol_data (gfc_symbol *sym) int gfc_get_sym_tree (const char *name, gfc_namespace *ns, gfc_symtree **result, - bool allow_subroutine) + bool allow_subroutine, locus *where) { gfc_symtree *st; gfc_symbol *p; @@ -3498,7 +3498,7 @@ gfc_get_sym_tree (const char *name, gfc_namespace *ns, gfc_symtree **result, if (st == NULL) { /* If not there, create a new symbol. */ - p = gfc_new_symbol (name, ns); + p = gfc_new_symbol (name, ns, where); /* Add to the list of tentative symbols. */ p->old_symbol = NULL; @@ -3546,12 +3546,13 @@ gfc_get_sym_tree (const char *name, gfc_namespace *ns, gfc_symtree **result, int -gfc_get_symbol (const char *name, gfc_namespace *ns, gfc_symbol **result) +gfc_get_symbol (const char *name, gfc_namespace *ns, gfc_symbol **result, + locus *where) { gfc_symtree *st; int i; - i = gfc_get_sym_tree (name, ns, &st, false); + i = gfc_get_sym_tree (name, ns, &st, false, where); if (i != 0) return i; @@ -3567,7 +3568,7 @@ gfc_get_symbol (const char *name, gfc_namespace *ns, gfc_symbol **result) exist, but tries to host-associate the symbol if possible. */ int -gfc_get_ha_sym_tree (const char *name, gfc_symtree **result) +gfc_get_ha_sym_tree (const char *name, gfc_symtree **result, locus *where) { gfc_symtree *st; int i; @@ -3591,17 +3592,17 @@ gfc_get_ha_sym_tree (const char *name, gfc_symtree **result) return 0; } - return gfc_get_sym_tree (name, gfc_current_ns, result, false); + return gfc_get_sym_tree (name, gfc_current_ns, result, false, where); } int -gfc_get_ha_symbol (const char *name, gfc_symbol **result) +gfc_get_ha_symbol (const char *name, gfc_symbol **result, locus *where) { int i; gfc_symtree *st = NULL; - i = gfc_get_ha_sym_tree (name, &st); + i = gfc_get_ha_sym_tree (name, &st, where); if (st) *result = st->n.sym; diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 160a543..dbf7bc8 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -2349,10 +2349,12 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, { symbol_attribute attr; gfc_se fse; - gfc_warning (0, "The structure constructor at %C has been" + locus loc; + gfc_locus_from_location (&loc, input_location); + gfc_warning (0, "The structure constructor at %L has been" " finalized. This feature was removed by f08/0011." " Use -std=f2018 or -std=gnu to eliminate the" - " finalization."); + " finalization.", &loc); attr.pointer = attr.allocatable = 0; gfc_init_se (&fse, NULL); fse.expr = desc; @@ -7099,14 +7101,13 @@ gfc_trans_g77_array (gfc_symbol * sym, gfc_wrapped_block * block) { tree parm; tree type; - locus loc; tree offset; tree tmp; tree stmt; stmtblock_t init; - gfc_save_backend_locus (&loc); - gfc_set_backend_locus (&sym->declared_at); + location_t loc = input_location; + input_location = gfc_get_location (&sym->declared_at); /* Descriptor type. */ parm = sym->backend_decl; @@ -7141,7 +7142,7 @@ gfc_trans_g77_array (gfc_symbol * sym, gfc_wrapped_block * block) } stmt = gfc_finish_block (&init); - gfc_restore_backend_locus (&loc); + input_location = loc; /* Add the initialization code to the start of the function. */ @@ -7181,7 +7182,6 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree size; tree type; tree offset; - locus loc; stmtblock_t init; tree stmtInit, stmtCleanup; tree lbound; @@ -7217,13 +7217,8 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, return; } - loc.nextc = NULL; - gfc_save_backend_locus (&loc); - /* loc.nextc is not set by save_backend_locus but the location routines - depend on it. */ - if (loc.nextc == NULL) - loc.nextc = loc.lb->line; - gfc_set_backend_locus (&sym->declared_at); + location_t loc = input_location; + input_location = gfc_get_location (&sym->declared_at); /* Descriptor type. */ type = TREE_TYPE (tmpdesc); @@ -7293,8 +7288,12 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, stride = gfc_index_one_node; if (warn_array_temporaries) - gfc_warning (OPT_Warray_temporaries, - "Creating array temporary at %L", &loc); + { + locus where; + gfc_locus_from_location (&where, loc); + gfc_warning (OPT_Warray_temporaries, + "Creating array temporary at %L", &where); + } } /* This is for the case where the array data is used directly without @@ -7363,7 +7362,9 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, /* Check (ubound(a) - lbound(a) == ubound(b) - lbound(b)). */ char * msg; tree temp; + locus where; + gfc_locus_from_location (&where, loc); temp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, ubound, lbound); temp = fold_build2_loc (input_location, PLUS_EXPR, @@ -7380,7 +7381,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, msg = xasprintf ("Dimension %d of array '%s' has extent " "%%ld instead of %%ld", n+1, sym->name); - gfc_trans_runtime_check (true, false, tmp, &init, &loc, msg, + gfc_trans_runtime_check (true, false, tmp, &init, &where, msg, fold_convert (long_integer_type_node, temp), fold_convert (long_integer_type_node, stride2)); @@ -7532,7 +7533,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, be freed at the end of the function by pop_context. */ gfc_add_init_cleanup (block, stmtInit, stmtCleanup); - gfc_restore_backend_locus (&loc); + input_location = loc; } @@ -11839,7 +11840,6 @@ gfc_trans_class_array (gfc_symbol * sym, gfc_wrapped_block * block) tree tmp; tree descriptor; stmtblock_t init; - locus loc; int rank; /* Make sure the frontend gets these right. */ @@ -11859,8 +11859,8 @@ gfc_trans_class_array (gfc_symbol * sym, gfc_wrapped_block * block) if (type == NULL || !GFC_DESCRIPTOR_TYPE_P (type)) return; - gfc_save_backend_locus (&loc); - gfc_set_backend_locus (&sym->declared_at); + location_t loc = input_location; + input_location = gfc_get_location (&sym->declared_at); gfc_init_block (&init); rank = CLASS_DATA (sym)->as ? (CLASS_DATA (sym)->as->rank) : (0); @@ -11872,7 +11872,7 @@ gfc_trans_class_array (gfc_symbol * sym, gfc_wrapped_block * block) gfc_add_expr_to_block (&init, tmp); gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE); - gfc_restore_backend_locus (&loc); + input_location = loc; } @@ -11889,7 +11889,6 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block) tree descriptor; stmtblock_t init; stmtblock_t cleanup; - locus loc; int rank; bool sym_has_alloc_comp, has_finalizer; @@ -11903,8 +11902,8 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block) || has_finalizer || (sym->as->type == AS_ASSUMED_RANK && sym->attr.dummy)); - gfc_save_backend_locus (&loc); - gfc_set_backend_locus (&sym->declared_at); + location_t loc = input_location; + input_location = gfc_get_location (&sym->declared_at); gfc_init_block (&init); gcc_assert (VAR_P (sym->backend_decl) @@ -11933,7 +11932,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block) if (sym->attr.dummy || sym->attr.use_assoc || sym->attr.result) { gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE); - gfc_restore_backend_locus (&loc); + input_location = loc; return; } @@ -11948,7 +11947,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block) gfc_trans_static_array_pointer (sym); gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE); - gfc_restore_backend_locus (&loc); + input_location = loc; return; } @@ -12013,7 +12012,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block) gfc_get_dtype_rank_type (sym->as->rank, etype)); gfc_add_expr_to_block (&init, tmp); } - gfc_restore_backend_locus (&loc); + input_location = loc; gfc_init_block (&cleanup); /* Allocatable arrays need to be freed when they go out of scope. diff --git a/gcc/fortran/trans-common.cc b/gcc/fortran/trans-common.cc index 481d468..49b0c3d 100644 --- a/gcc/fortran/trans-common.cc +++ b/gcc/fortran/trans-common.cc @@ -382,7 +382,7 @@ build_equiv_decl (tree union_type, bool is_init, bool is_saved, bool is_auto) /* The source location has been lost, and doesn't really matter. We need to set it to something though. */ - gfc_set_decl_location (decl, &gfc_current_locus); + DECL_SOURCE_LOCATION (decl) = input_location; gfc_add_decl_to_function (decl); @@ -611,8 +611,7 @@ get_init_field (segment_info *head, tree union_type, tree *field_init, tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp); tmp = build_array_type (type, tmp); - field = build_decl (gfc_get_location (&gfc_current_locus), - FIELD_DECL, NULL_TREE, tmp); + field = build_decl (input_location, FIELD_DECL, NULL_TREE, tmp); known_align = BIGGEST_ALIGNMENT; diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index 9cced7c..a62fe3f 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -2278,15 +2278,13 @@ gfc_get_extern_function_decl (gfc_symbol * sym, gfc_actual_arglist *actual_args, { /* By construction, the external function cannot be a contained procedure. */ - locus old_loc; - - gfc_save_backend_locus (&old_loc); + location_t old_loc = input_location; push_cfun (NULL); gfc_create_function_decl (gsym->ns, true); pop_cfun (); - gfc_restore_backend_locus (&old_loc); + input_location = old_loc; } /* If the namespace has entries, the proc_name is the @@ -2491,7 +2489,7 @@ build_function_decl (gfc_symbol * sym, bool global) /* Set the line and filename. sym->declared_at seems to point to the last statement for subroutines, but it'll do for now. */ - gfc_set_backend_locus (&sym->declared_at); + input_location = gfc_get_location (&sym->declared_at); /* Allow only one nesting level. Allow public declarations. */ gcc_assert (current_function_decl == NULL_TREE @@ -3049,12 +3047,12 @@ build_entry_thunks (gfc_namespace * ns, bool global) stmtblock_t body; tree thunk_fndecl; tree tmp; - locus old_loc; + location_t old_loc; /* This should always be a toplevel function. */ gcc_assert (current_function_decl == NULL_TREE); - gfc_save_backend_locus (&old_loc); + old_loc = input_location; for (el = ns->entries; el; el = el->next) { vec<tree, va_gc> *args = NULL; @@ -3221,7 +3219,7 @@ build_entry_thunks (gfc_namespace * ns, bool global) } } - gfc_restore_backend_locus (&old_loc); + input_location = old_loc; } @@ -4559,7 +4557,7 @@ init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block) static tree gfc_null_and_pass_deferred_len (gfc_symbol *sym, stmtblock_t *init, - locus *loc) + location_t loc) { tree tmp; @@ -4589,7 +4587,7 @@ gfc_null_and_pass_deferred_len (gfc_symbol *sym, stmtblock_t *init, gfc_add_expr_to_block (init, tmp2); } - gfc_restore_backend_locus (loc); + input_location = loc; /* Pass the final character length back. */ if (sym->attr.intent != INTENT_IN) @@ -4641,7 +4639,7 @@ get_proc_result (gfc_symbol* sym) void gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) { - locus loc; + location_t loc; gfc_symbol *sym; gfc_formal_arglist *f; stmtblock_t tmpblock; @@ -4674,8 +4672,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) else if (proc_sym->as) { tree result = TREE_VALUE (current_fake_result_decl); - gfc_save_backend_locus (&loc); - gfc_set_backend_locus (&proc_sym->declared_at); + loc = input_location; + input_location = gfc_get_location (&proc_sym->declared_at); gfc_trans_dummy_array_bias (proc_sym, result, block); /* An automatic character length, pointer array result. */ @@ -4686,7 +4684,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) if (proc_sym->ts.deferred) { gfc_start_block (&init); - tmp = gfc_null_and_pass_deferred_len (proc_sym, &init, &loc); + tmp = gfc_null_and_pass_deferred_len (proc_sym, &init, loc); gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp); } else @@ -4698,8 +4696,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) if (proc_sym->ts.deferred) { tmp = NULL; - gfc_save_backend_locus (&loc); - gfc_set_backend_locus (&proc_sym->declared_at); + loc = input_location; + input_location = gfc_get_location (&proc_sym->declared_at); gfc_start_block (&init); /* Zero the string length on entry. */ gfc_add_modify (&init, proc_sym->ts.u.cl->backend_decl, @@ -4714,7 +4712,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) gfc_add_modify (&init, tmp, fold_convert (TREE_TYPE (se.expr), null_pointer_node)); - gfc_restore_backend_locus (&loc); + input_location = loc; /* Pass back the string length on exit. */ tmp = proc_sym->ts.u.cl->backend_decl; @@ -4759,10 +4757,10 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) /* Initialize the INTENT(OUT) derived type dummy arguments. This should be done here so that the offsets and lbounds of arrays are available. */ - gfc_save_backend_locus (&loc); - gfc_set_backend_locus (&proc_sym->declared_at); + loc = input_location; + input_location = gfc_get_location (&proc_sym->declared_at); init_intent_out_dt (proc_sym, block); - gfc_restore_backend_locus (&loc); + input_location = loc; /* For some reasons, internal procedures point to the parent's namespace. Top-level procedure and variables inside BLOCK are fine. */ @@ -4967,10 +4965,10 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) { if (TREE_STATIC (sym->backend_decl)) { - gfc_save_backend_locus (&loc); - gfc_set_backend_locus (&sym->declared_at); + loc = input_location; + input_location = gfc_get_location (&sym->declared_at); gfc_trans_static_array_pointer (sym); - gfc_restore_backend_locus (&loc); + input_location = loc; } else { @@ -4990,8 +4988,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) } else { - gfc_save_backend_locus (&loc); - gfc_set_backend_locus (&sym->declared_at); + loc = input_location; + input_location = gfc_get_location (&sym->declared_at); if (alloc_comp_or_fini) { @@ -5012,7 +5010,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) gfc_trans_auto_array_allocation (sym->backend_decl, sym, block); - gfc_restore_backend_locus (&loc); + input_location = loc; } break; @@ -5040,9 +5038,9 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) && sym->attr.result) { gfc_start_block (&init); - gfc_save_backend_locus (&loc); - gfc_set_backend_locus (&sym->declared_at); - tmp = gfc_null_and_pass_deferred_len (sym, &init, &loc); + loc = input_location; + input_location = gfc_get_location (&sym->declared_at); + tmp = gfc_null_and_pass_deferred_len (sym, &init, loc); gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp); } break; @@ -5067,8 +5065,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) { tree descriptor = NULL_TREE; - gfc_save_backend_locus (&loc); - gfc_set_backend_locus (&sym->declared_at); + loc = input_location; + input_location = gfc_get_location (&sym->declared_at); gfc_start_block (&init); if (sym->ts.type == BT_CHARACTER @@ -5133,10 +5131,10 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) && sym->ts.type == BT_CHARACTER && sym->ts.deferred && sym->ts.u.cl->passed_length) - tmp = gfc_null_and_pass_deferred_len (sym, &init, &loc); + tmp = gfc_null_and_pass_deferred_len (sym, &init, loc); else { - gfc_restore_backend_locus (&loc); + input_location = loc; tmp = NULL_TREE; } @@ -5170,12 +5168,13 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) if (sym->ts.type == BT_CLASS) { /* Initialize _vptr to declared type. */ - gfc_save_backend_locus (&loc); - gfc_set_backend_locus (&sym->declared_at); + loc = input_location; + input_location = gfc_get_location (&sym->declared_at); + e = gfc_lval_expr_from_sym (sym); gfc_reset_vptr (&init, e); gfc_free_expr (e); - gfc_restore_backend_locus (&loc); + input_location = loc; } gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp); @@ -5192,9 +5191,9 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) if (sym->attr.dummy) { gfc_start_block (&init); - gfc_save_backend_locus (&loc); - gfc_set_backend_locus (&sym->declared_at); - tmp = gfc_null_and_pass_deferred_len (sym, &init, &loc); + loc = input_location; + input_location = gfc_get_location (&sym->declared_at); + tmp = gfc_null_and_pass_deferred_len (sym, &init, loc); gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp); } } @@ -5204,20 +5203,20 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) gfc_trans_deferred_array (sym, block); else if (sym->ts.type == BT_CHARACTER) { - gfc_save_backend_locus (&loc); - gfc_set_backend_locus (&sym->declared_at); + loc = input_location; + input_location = gfc_get_location (&sym->declared_at); if (sym->attr.dummy || sym->attr.result) gfc_trans_dummy_character (sym, sym->ts.u.cl, block); else gfc_trans_auto_character_variable (sym, block); - gfc_restore_backend_locus (&loc); + input_location = loc; } else if (sym->attr.assign) { - gfc_save_backend_locus (&loc); - gfc_set_backend_locus (&sym->declared_at); + loc = input_location; + input_location = gfc_get_location (&sym->declared_at); gfc_trans_assign_aux_var (sym, block); - gfc_restore_backend_locus (&loc); + input_location = loc; } else if (sym->ts.type == BT_DERIVED && sym->value @@ -5582,7 +5581,7 @@ gfc_trans_use_stmts (gfc_namespace * ns) void_type_node); DECL_EXTERNAL (entry->namespace_decl) = 1; } - gfc_set_backend_locus (&use_stmt->where); + input_location = gfc_get_location (&use_stmt->where); if (!use_stmt->only_flag) (*debug_hooks->imported_module_or_decl) (entry->namespace_decl, NULL_TREE, @@ -5665,7 +5664,7 @@ gfc_trans_use_stmts (gfc_namespace * ns) local_name = get_identifier (rent->local_name); else local_name = NULL_TREE; - gfc_set_backend_locus (&rent->where); + input_location = gfc_get_location (&rent->where); (*debug_hooks->imported_module_or_decl) (decl, local_name, ns->proc_name->backend_decl, !use_stmt->only_flag, @@ -6870,11 +6869,12 @@ finish_oacc_declare (gfc_namespace *ns, gfc_symbol *sym, bool block) { gfc_code *code; gfc_oacc_declare *oc; - locus where = gfc_current_locus; + locus where; gfc_omp_clauses *omp_clauses = NULL; gfc_omp_namelist *n, *p; - module_oacc_clauses = NULL; + + gfc_locus_from_location (&where, input_location); gfc_traverse_ns (ns, find_module_oacc_declare_clauses); if (module_oacc_clauses && sym->attr.flavor == FL_PROGRAM) @@ -8209,9 +8209,9 @@ gfc_generate_block_data (gfc_namespace * ns) /* Tell the backend the source location of the block data. */ if (ns->proc_name) - gfc_set_backend_locus (&ns->proc_name->declared_at); + input_location = gfc_get_location (&ns->proc_name->declared_at); else - gfc_set_backend_locus (&gfc_current_locus); + input_location = gfc_get_location (&gfc_current_locus); /* Process the DATA statements. */ gfc_trans_common (ns); diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 569b92a..735ab3a 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -1641,8 +1641,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited) cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, from_len, to_len); gfc_trans_runtime_check (true, false, cond, &body, - &gfc_current_locus, msg, - to_len, from_len); + NULL, msg, to_len, from_len); free (msg); } } @@ -10023,10 +10022,12 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr) && expr->must_finalize && gfc_may_be_finalized (expr->ts)) { - gfc_warning (0, "The structure constructor at %C has been" + locus loc; + gfc_locus_from_location (&loc, input_location); + gfc_warning (0, "The structure constructor at %L has been" " finalized. This feature was removed by f08/0011." " Use -std=f2018 or -std=gnu to eliminate the" - " finalization."); + " finalization.", &loc); symbol_attribute attr; attr.allocatable = attr.pointer = 0; gfc_finalize_tree_expr (se, expr->ts.u.derived, attr, 0); diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc index f3580ce..961a711 100644 --- a/gcc/fortran/trans-io.cc +++ b/gcc/fortran/trans-io.cc @@ -1050,9 +1050,7 @@ io_result (stmtblock_t * block, tree var, gfc_st_label * err_label, static void set_error_locus (stmtblock_t * block, tree var, locus * where) { - gfc_file *f; tree str, locus_file; - int line; gfc_st_parameter_field *p = &st_parameter_field[IOPARM_common_filename]; locus_file = fold_build3_loc (input_location, COMPONENT_REF, @@ -1061,14 +1059,12 @@ set_error_locus (stmtblock_t * block, tree var, locus * where) locus_file = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field), locus_file, p->field, NULL_TREE); - f = where->lb->file; - str = gfc_build_cstring_const (f->filename); - + location_t loc = gfc_get_location (where); + str = gfc_build_cstring_const (LOCATION_FILE (loc)); str = gfc_build_addr_expr (pchar_type_node, str); gfc_add_modify (block, locus_file, str); - line = LOCATION_LINE (where->lb->location); - set_parameter_const (block, var, IOPARM_common_line, line); + set_parameter_const (block, var, IOPARM_common_line, LOCATION_LINE (loc)); } diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index f4c9314..153efd8 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -8119,7 +8119,7 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses) gfc_internal_error ("gfc_trans_omp_workshare(): Bad statement code"); } - gfc_set_backend_locus (&code->loc); + input_location = gfc_get_location (&code->loc); if (res != NULL_TREE && ! IS_EMPTY_STMT (res)) { diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc index 86c5497..81d9740 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -1464,8 +1464,7 @@ gfc_trans_if_1 (gfc_code * code) { gfc_se if_se; tree stmt, elsestmt; - locus saved_loc; - location_t loc; + location_t loc, saved_loc = UNKNOWN_LOCATION; /* Check for an unconditional ELSE clause. */ if (!code->expr1) @@ -1476,16 +1475,16 @@ gfc_trans_if_1 (gfc_code * code) gfc_start_block (&if_se.pre); /* Calculate the IF condition expression. */ - if (code->expr1->where.lb) + if (GFC_LOCUS_IS_SET (code->expr1->where)) { - gfc_save_backend_locus (&saved_loc); - gfc_set_backend_locus (&code->expr1->where); + saved_loc = input_location; + input_location = gfc_get_location (&code->expr1->where); } gfc_conv_expr_val (&if_se, code->expr1); - if (code->expr1->where.lb) - gfc_restore_backend_locus (&saved_loc); + if (saved_loc != UNKNOWN_LOCATION) + input_location = saved_loc; /* Translate the THEN clause. */ stmt = gfc_trans_code (code->next); @@ -1497,8 +1496,8 @@ gfc_trans_if_1 (gfc_code * code) elsestmt = build_empty_stmt (input_location); /* Build the condition expression and add it to the condition block. */ - loc = code->expr1->where.lb ? gfc_get_location (&code->expr1->where) - : input_location; + loc = (GFC_LOCUS_IS_SET (code->expr1->where) + ? gfc_get_location (&code->expr1->where) : input_location); stmt = fold_build3_loc (loc, COND_EXPR, void_type_node, if_se.expr, stmt, elsestmt); diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc index d59c0cc..e596a36 100644 --- a/gcc/fortran/trans-types.cc +++ b/gcc/fortran/trans-types.cc @@ -2736,10 +2736,10 @@ gfc_get_union_type (gfc_symbol *un) /* The map field's declaration. */ map_field = gfc_add_field_to_struct(typenode, get_identifier(map->name), map_type, &chain); - if (map->loc.lb) - gfc_set_decl_location (map_field, &map->loc); - else if (un->declared_at.lb) - gfc_set_decl_location (map_field, &un->declared_at); + if (GFC_LOCUS_IS_SET (map->loc)) + gfc_set_decl_location (map_field, &map->loc); + else if (GFC_LOCUS_IS_SET (un->declared_at)) + gfc_set_decl_location (map_field, &un->declared_at); DECL_PACKED (map_field) |= TYPE_PACKED (typenode); DECL_NAMELESS(map_field) = true; @@ -3115,9 +3115,9 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen) field = gfc_add_field_to_struct (typenode, get_identifier (c->name), field_type, &chain); - if (c->loc.lb) + if (GFC_LOCUS_IS_SET (c->loc)) gfc_set_decl_location (field, &c->loc); - else if (derived->declared_at.lb) + else if (GFC_LOCUS_IS_SET (derived->declared_at)) gfc_set_decl_location (field, &derived->declared_at); gfc_finish_decl_attrs (field, &c->attr); diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc index 2c5133a..7182fa0 100644 --- a/gcc/fortran/trans.cc +++ b/gcc/fortran/trans.cc @@ -42,8 +42,6 @@ along with GCC; see the file COPYING3. If not see gfc_get_* get a backend tree representation of a decl or type */ -static gfc_file *gfc_current_backend_file; - const char gfc_msg_fault[] = N_("Array reference out of bounds"); @@ -60,6 +58,14 @@ gfc_advance_chain (tree t, int n) return t; } +void +gfc_locus_from_location (locus *where, location_t loc) +{ + where->nextc = (gfc_char_t *) -1; + where->u.location = loc; +} + + static int num_var; #define MAX_PREFIX_LEN 20 @@ -568,7 +574,7 @@ trans_runtime_error_vararg (tree errorfunc, locus* where, const char* msgid, tree fntype; char *message; const char *p; - int line, nargs, i; + int nargs, i; location_t loc; /* Compute the number of extra arguments from the format string. */ @@ -585,13 +591,13 @@ trans_runtime_error_vararg (tree errorfunc, locus* where, const char* msgid, if (where) { - line = LOCATION_LINE (where->lb->location); - message = xasprintf ("At line %d of file %s", line, - where->lb->file->filename); + location_t loc = gfc_get_location (where); + message = xasprintf ("At line %d of file %s", LOCATION_LINE (loc), + LOCATION_FILE (loc)); } else message = xasprintf ("In file '%s', around line %d", - gfc_source_file, LOCATION_LINE (input_location) + 1); + gfc_source_file, LOCATION_LINE (input_location)); arg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const (message)); @@ -692,14 +698,13 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock, } else { + location_t loc = where ? gfc_get_location (where) : input_location; if (once) - cond = fold_build2_loc (gfc_get_location (where), TRUTH_AND_EXPR, - boolean_type_node, tmpvar, + cond = fold_build2_loc (loc, TRUTH_AND_EXPR, boolean_type_node, tmpvar, fold_convert (boolean_type_node, cond)); - tmp = fold_build3_loc (gfc_get_location (where), COND_EXPR, void_type_node, - cond, body, - build_empty_stmt (gfc_get_location (where))); + tmp = fold_build3_loc (loc, COND_EXPR, void_type_node, cond, body, + build_empty_stmt (loc)); gfc_add_expr_to_block (pblock, tmp); } } @@ -2278,42 +2283,6 @@ gfc_add_block_to_block (stmtblock_t * block, stmtblock_t * append) } -/* Save the current locus. The structure may not be complete, and should - only be used with gfc_restore_backend_locus. */ - -void -gfc_save_backend_locus (locus * loc) -{ - loc->lb = XCNEW (gfc_linebuf); - loc->lb->location = input_location; - loc->lb->file = gfc_current_backend_file; -} - - -/* Set the current locus. */ - -void -gfc_set_backend_locus (locus * loc) -{ - gfc_current_backend_file = loc->lb->file; - input_location = gfc_get_location (loc); -} - - -/* Restore the saved locus. Only used in conjunction with - gfc_save_backend_locus, to free the memory when we are done. */ - -void -gfc_restore_backend_locus (locus * loc) -{ - /* This only restores the information captured by gfc_save_backend_locus, - intentionally does not use gfc_get_location. */ - input_location = loc->lb->location; - gfc_current_backend_file = loc->lb->file; - free (loc->lb); -} - - /* Translate an executable statement. The tree cond is used by gfc_trans_do. This static function is wrapped by gfc_trans_code_cond and gfc_trans_code. */ @@ -2339,8 +2308,7 @@ trans_code (gfc_code * code, tree cond) gfc_add_expr_to_block (&block, res); } - gfc_current_locus = code->loc; - gfc_set_backend_locus (&code->loc); + input_location = gfc_get_location (&code->loc); switch (code->op) { @@ -2678,7 +2646,7 @@ trans_code (gfc_code * code, tree cond) gfc_internal_error ("gfc_trans_code(): Bad statement code"); } - gfc_set_backend_locus (&code->loc); + input_location = gfc_get_location (&code->loc); if (res != NULL_TREE && ! IS_EMPTY_STMT (res)) { diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index ed0a6f0..4679ea0 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -720,10 +720,7 @@ struct GTY((for_user)) module_htab_entry { struct module_htab_entry *gfc_find_module (const char *); void gfc_module_add_decl (struct module_htab_entry *, tree); -/* Get and set the current location. */ -void gfc_save_backend_locus (locus *); -void gfc_set_backend_locus (locus *); -void gfc_restore_backend_locus (locus *); +void gfc_locus_from_location (locus *, location_t); /* Handle static constructor functions. */ extern GTY(()) tree gfc_static_ctors; diff --git a/gcc/testsuite/gfortran.dg/bounds_check_25.f90 b/gcc/testsuite/gfortran.dg/bounds_check_25.f90 index cc22475..c55a102 100644 --- a/gcc/testsuite/gfortran.dg/bounds_check_25.f90 +++ b/gcc/testsuite/gfortran.dg/bounds_check_25.f90 @@ -25,8 +25,8 @@ contains end subroutine bla end -! { dg-final { scan-tree-dump-times "line 15 .* bound mismatch for dimension 1 of array .'.*.'" 1 "original" } } -! { dg-final { scan-tree-dump-times "line 15 .* bound mismatch for dimension 2 of array .'.*.'" 1 "original" } } +! { dg-final { scan-tree-dump-times "around line 15.* bound mismatch for dimension 1 of array .'.*.'" 1 "original" } } +! { dg-final { scan-tree-dump-times "around line 15.* bound mismatch for dimension 2 of array .'.*.'" 1 "original" } } -! { dg-final { scan-tree-dump-times "line 24 .* bound mismatch for dimension 1 of array .'d%%m.'" 1 "original" } } -! { dg-final { scan-tree-dump-times "line 24 .* bound mismatch for dimension 2 of array .'d%%m.'" 1 "original" } } +! { dg-final { scan-tree-dump-times "At line 24 .* bound mismatch for dimension 1 of array .'d%%m.'" 1 "original" } } +! { dg-final { scan-tree-dump-times "At line 24 .* bound mismatch for dimension 2 of array .'d%%m.'" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 index 422131b..7a33d7f 100644 --- a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 +++ b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 @@ -21,8 +21,8 @@ subroutine check () !$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:22\\\] #pragma acc loop" 1 "original" } } !$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:22\\\] #pragma acc loop" 1 "gimple" } } !$acc& reduction ( + : sum ) & ! { dg-line sum1 } - !$acc && ! Fortran location information points to the ':' in 'reduction(+:sum)'. - !$acc & & ! { dg-message "36: location of the previous reduction for 'sum'" "" { target *-*-* } sum1 } + !$acc && ! Fortran location information points to the 's' in 'reduction(+:sum)'. + !$acc & & ! { dg-message "38: location of the previous reduction for 'sum'" "" { target *-*-* } sum1 } !$acc& independent do i = 1, 10 !$acc loop & @@ -32,7 +32,7 @@ subroutine check () !$acc & reduction(-: diff ) & !$acc&reduction(- : sum) & ! { dg-line sum2 } !$acc & & ! Fortran location information points to the ':' in 'reduction(-:sum)'. - !$acc& & ! { dg-warning "32: conflicting reduction operations for 'sum'" "" { target *-*-* } sum2 } + !$acc& & ! { dg-warning "37: conflicting reduction operations for 'sum'" "" { target *-*-* } sum2 } !$acc &independent do j = 1, 10 sum & @@ -107,7 +107,7 @@ subroutine gwv_s_l () !$acc end serial end subroutine gwv_s_l -subroutine gwv_r () ! { dg-message "16: enclosing routine" } +subroutine gwv_r () ! { dg-message "1: enclosing routine" } implicit none (type, external) integer :: i, j, k diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90 index 4fed192..4db950f 100644 --- a/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90 @@ -32,10 +32,10 @@ subroutine coarrays(x) !$omp allocate(x) ! { dg-error "Unexpected dummy argument 'x' as argument at .1. to declarative !.OMP ALLOCATE" } - !$omp allocators allocate(y) ! { dg-error "28:Unexpected coarray 'y' in 'allocate' at .1." } + !$omp allocators allocate(y) ! { dg-error "29:Unexpected coarray 'y' in 'allocate' at .1." } allocate(y[*]) - !$omp allocate(z) ! { dg-error "17:Unexpected coarray 'z' in 'allocate' at .1." } + !$omp allocate(z) ! { dg-error "18:Unexpected coarray 'z' in 'allocate' at .1." } allocate(z(5)[*]) x = 5 end diff --git a/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping.f90 b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping.f90 index dc3eb9e..dd7eb31 100644 --- a/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping.f90 @@ -11,17 +11,17 @@ pa => ca ! 11111111112222222222333333333344 !2345678901234567890123456789012345678901 !$omp target enter data map(c, ca, p, pa) -! { dg-warning "28:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 } -! { dg-warning "30:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-2 } -! { dg-warning "34:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-3 } -! { dg-warning "37:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-4 } +! { dg-warning "29:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 } +! { dg-warning "32:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-2 } +! { dg-warning "36:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-3 } +! { dg-warning "39:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-4 } ! 11111111112222222222333333333344 !2345678901234567890123456789012345678901 -!$omp target firstprivate(ca) ! { dg-warning "26:FIRSTPRIVATE with polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" } +!$omp target firstprivate(ca) ! { dg-warning "27:FIRSTPRIVATE with polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" } !$omp end target -!$omp target parallel do firstprivate(ca) ! { dg-warning "38:FIRSTPRIVATE with polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" } +!$omp target parallel do firstprivate(ca) ! { dg-warning "39:FIRSTPRIVATE with polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" } do x = 0, 5 end do @@ -36,14 +36,14 @@ end block ! 11111111112222222222333333333344 !2345678901234567890123456789012345678901 !$omp target update from(c,ca), to(p,pa) -! { dg-warning "25:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 } -! { dg-warning "27:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-2 } -! { dg-warning "35:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-3 } -! { dg-warning "37:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-4 } +! { dg-warning "26:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 } +! { dg-warning "28:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-2 } +! { dg-warning "36:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-3 } +! { dg-warning "38:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-4 } ! ------------------------- -!$omp target parallel map(release: x) ! { dg-error "35:TARGET with map-type other than TO, FROM, TOFROM, or ALLOC on MAP clause" } +!$omp target parallel map(release: x) ! { dg-error "36:TARGET with map-type other than TO, FROM, TOFROM, or ALLOC on MAP clause" } block end block diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction5.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction5.f90 index 85491f0..b4b1c46 100644 --- a/gcc/testsuite/gfortran.dg/gomp/reduction5.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/reduction5.f90 @@ -21,13 +21,13 @@ end do !$omp end task ! { dg-error "Unexpected !.OMP END TASK statement" } !$omp taskloop reduction(inscan,+:a) in_reduction(+:b) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } - ! { dg-error "34: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured block sequences" "" { target *-*-* } .-1 } + ! { dg-error "35: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured block sequences" "" { target *-*-* } .-1 } ! { dg-error "'inscan' and non-'inscan' 'reduction' clauses on the same construct" "" { target *-*-* } .-2 } do i=1,10 a = a + 1 end do -!$omp taskloop reduction(task,+:a) in_reduction(+:b) ! { dg-error "32: Only DEFAULT permitted as reduction-modifier in REDUCTION clause" } +!$omp taskloop reduction(task,+:a) in_reduction(+:b) ! { dg-error "33: Only DEFAULT permitted as reduction-modifier in REDUCTION clause" } do i=1,10 a = a + 1 end do @@ -36,7 +36,7 @@ end do a = a + 1 !$omp end teams -!$omp teams reduction(task, +:b) ! { dg-error "30: Only DEFAULT permitted as reduction-modifier in REDUCTION clause" } +!$omp teams reduction(task, +:b) ! { dg-error "31: Only DEFAULT permitted as reduction-modifier in REDUCTION clause" } a = a + 1 !$omp end teams diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction6.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction6.f90 index 321f096..f6d95af 100644 --- a/gcc/testsuite/gfortran.dg/gomp/reduction6.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/reduction6.f90 @@ -4,13 +4,13 @@ implicit none integer :: a, b, i a = 0 -!$omp simd reduction(inscan,+:a) ! { dg-error "30: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured block sequences" } +!$omp simd reduction(inscan,+:a) ! { dg-error "31: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured block sequences" } do i=1,10 a = a + 1 end do !$omp parallel -!$omp do reduction(inscan,+:a) ! { dg-error "28: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured block sequences" } +!$omp do reduction(inscan,+:a) ! { dg-error "29: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured block sequences" } do i=1,10 a = a + 1 end do |