+2012-07-17 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/51081
+ * error.c (gfc_notify_std): Automatically print the relevant Fortran
+ standard version.
+ * arith.c (arith_power): Remove explicit standard reference string.
+ * array.c (gfc_match_array_spec, gfc_match_array_constructor): Ditto.
+ * check.c (gfc_check_a_p, gfc_check_besn, gfc_check_count,
+ gfc_check_float, gfc_check_fn_rc2008, gfc_check_iand,
+ gfc_check_ichar_iachar, gfc_check_ieor, gfc_check_index, gfc_check_ior,
+ gfc_check_lbound, gfc_check_len_lentrim, check_rest, gfc_check_min_max,
+ gfc_check_null, gfc_check_scan, gfc_check_selected_real_kind,
+ gfc_check_shape, gfc_check_size, gfc_check_sngl, gfc_check_ubound,
+ gfc_check_verify): Ditto.
+ * data.c (gfc_assign_data_value): Ditto.
+ * decl.c (var_element, char_len_param_value, match_char_length,
+ gfc_verify_c_interop_param, match_pointer_init, variable_decl,
+ gfc_match_decl_type_spec, gfc_match_import, match_attr_spec,
+ gfc_match_prefix, gfc_match_suffix, match_ppc_decl,
+ match_procedure_in_interface, gfc_match_procedure,gfc_match_entry,
+ gfc_match_subroutine, gfc_match_end, gfc_match_codimension,
+ gfc_match_protected, gfc_match_value, gfc_match_volatile,
+ gfc_match_asynchronous, gfc_match_modproc, gfc_get_type_attr_spec,
+ gfc_match_enum, match_procedure_in_type): Ditto.
+ * expr.c (check_elemental, gfc_check_assign, gfc_check_pointer_assign):
+ Ditto.
+ * interface.c (gfc_match_abstract_interface, check_interface0): Ditto.
+ * intrinsic.c (gfc_intrinsic_func_interface): Ditto.
+ * io.c (format_lex, resolve_tag_format, resolve_tag,
+ compare_to_allowed_values, gfc_match_open, gfc_match_rewind,
+ gfc_resolve_dt, gfc_match_wait): Ditto.
+ * match.c (match_arithmetic_if, gfc_match_if, gfc_match_critical,
+ gfc_match_do, match_exit_cycle, gfc_match_pause, gfc_match_stop,
+ gfc_match_lock, sync_statement, gfc_match_assign, gfc_match_goto,
+ gfc_match_allocate, gfc_match_return, gfc_match_st_function): Ditto.
+ * module.c (gfc_match_use, gfc_use_module): Ditto.
+ * parse.c (parse_derived_contains, parse_block_construct,
+ parse_associate, parse_contained): Ditto.
+ * primary.c (match_hollerith_constant, match_boz_constant,
+ match_real_constant, match_sym_complex_part, match_arg_list_function,
+ build_actual_constructor, gfc_convert_to_structure_constructor): Ditto.
+ * resolve.c (resolve_formal_arglist, resolve_entries,
+ resolve_common_blocks, resolve_actual_arglist, gfc_resolve_index_1,
+ gfc_resolve_iterator_expr, resolve_ordinary_assign,
+ resolve_fl_var_and_proc, resolve_fl_variable_derived,
+ resolve_fl_procedure, resolve_fl_derived0, resolve_fl_derived,
+ resolve_fl_namelist, resolve_symbol, resolve_fntype): Ditto.
+ * symbol.c (check_conflict, conflict, gfc_add_is_bind_c,
+ gfc_add_extension, gfc_check_symbol_typed): Ditto.
+
2012-07-17 Tobias Burnus <burnus@net-b.de>
PR fortran/53985
if (gfc_init_expr_flag)
{
- if (gfc_notify_std (GFC_STD_F2003,"Fortran 2003: Noninteger "
+ if (gfc_notify_std (GFC_STD_F2003, "Noninteger "
"exponent in an initialization "
"expression at %L", &op2->where) == FAILURE)
return ARITH_PROHIBIT;
{
if (gfc_init_expr_flag)
{
- if (gfc_notify_std (GFC_STD_F2003,"Fortran 2003: Noninteger "
+ if (gfc_notify_std (GFC_STD_F2003, "Noninteger "
"exponent in an initialization "
"expression at %L", &op2->where) == FAILURE)
return ARITH_PROHIBIT;
}
if (as->corank + as->rank >= 7
- && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Array "
+ && gfc_notify_std (GFC_STD_F2008, "Array "
"specification at %C with more than 7 dimensions")
== FAILURE)
goto cleanup;
if (gfc_match_char ('[') != MATCH_YES)
goto done;
- if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Coarray declaration at %C")
+ if (gfc_notify_std (GFC_STD_F2008, "Coarray declaration at %C")
== FAILURE)
goto cleanup;
return MATCH_NO;
else
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: [...] "
+ if (gfc_notify_std (GFC_STD_F2003, "[...] "
"style array constructors at %C") == FAILURE)
return MATCH_ERROR;
end_delim = " ]";
if (seen_ts)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Array constructor "
+ if (gfc_notify_std (GFC_STD_F2003, "Array constructor "
"including type specification at %C") == FAILURE)
goto cleanup;
if (a->ts.kind != p->ts.kind)
{
- if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type kinds at %L",
+ if (gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L",
&p->where) == FAILURE)
return FAILURE;
}
{
int i;
gfc_extract_int (n, &i);
- if (i < 0 && gfc_notify_std (GFC_STD_GNU, "Extension: Negative argument "
+ if (i < 0 && gfc_notify_std (GFC_STD_GNU, "Negative argument "
"N at %L", &n->where) == FAILURE)
return FAILURE;
}
return FAILURE;
if (kind_check (kind, 2, BT_INTEGER) == FAILURE)
return FAILURE;
- if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+ if (kind && gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
"with KIND argument at %L",
gfc_current_intrinsic, &kind->where) == FAILURE)
return FAILURE;
return FAILURE;
if ((a->ts.kind != gfc_default_integer_kind)
- && gfc_notify_std (GFC_STD_GNU, "GNU extension: non-default INTEGER "
+ && gfc_notify_std (GFC_STD_GNU, "non-default INTEGER "
"kind argument to %s intrinsic at %L",
gfc_current_intrinsic, &a->where) == FAILURE )
return FAILURE;
return FAILURE;
if (a->ts.type == BT_COMPLEX
- && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: COMPLEX argument '%s' "
+ && gfc_notify_std (GFC_STD_F2008, "COMPLEX argument '%s' "
"argument of '%s' intrinsic at %L",
gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &a->where) == FAILURE)
if (i->ts.kind != j->ts.kind)
{
- if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type kinds at %L",
+ if (gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L",
&i->where) == FAILURE)
return FAILURE;
}
if (kind_check (kind, 1, BT_INTEGER) == FAILURE)
return FAILURE;
- if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+ if (kind && gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
"with KIND argument at %L",
gfc_current_intrinsic, &kind->where) == FAILURE)
return FAILURE;
if (i->ts.kind != j->ts.kind)
{
- if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type kinds at %L",
+ if (gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L",
&i->where) == FAILURE)
return FAILURE;
}
if (kind_check (kind, 3, BT_INTEGER) == FAILURE)
return FAILURE;
- if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+ if (kind && gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
"with KIND argument at %L",
gfc_current_intrinsic, &kind->where) == FAILURE)
return FAILURE;
if (i->ts.kind != j->ts.kind)
{
- if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type kinds at %L",
+ if (gfc_notify_std (GFC_STD_GNU, "Different type kinds at %L",
&i->where) == FAILURE)
return FAILURE;
}
if (kind_check (kind, 2, BT_INTEGER) == FAILURE)
return FAILURE;
- if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+ if (kind && gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
"with KIND argument at %L",
gfc_current_intrinsic, &kind->where) == FAILURE)
return FAILURE;
if (kind_check (kind, 1, BT_INTEGER) == FAILURE)
return FAILURE;
- if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+ if (kind && gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
"with KIND argument at %L",
gfc_current_intrinsic, &kind->where) == FAILURE)
return FAILURE;
{
if (x->ts.type == type)
{
- if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type "
+ if (gfc_notify_std (GFC_STD_GNU, "Different type "
"kinds at %L", &x->where) == FAILURE)
return FAILURE;
}
if (x->ts.type == BT_CHARACTER)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+ if (gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
"with CHARACTER argument at %L",
gfc_current_intrinsic, &x->where) == FAILURE)
return FAILURE;
}
if (attr.allocatable
- && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: NULL intrinsic with "
+ && gfc_notify_std (GFC_STD_F2003, "NULL intrinsic with "
"allocatable MOLD at %L", &mold->where) == FAILURE)
return FAILURE;
if (kind_check (kind, 3, BT_INTEGER) == FAILURE)
return FAILURE;
- if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+ if (kind && gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
"with KIND argument at %L",
gfc_current_intrinsic, &kind->where) == FAILURE)
return FAILURE;
gfc_check_selected_real_kind (gfc_expr *p, gfc_expr *r, gfc_expr *radix)
{
if (p == NULL && r == NULL
- && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: SELECTED_REAL_KIND with"
+ && gfc_notify_std (GFC_STD_F2008, "SELECTED_REAL_KIND with"
" neither 'P' nor 'R' argument at %L",
gfc_current_intrinsic_where) == FAILURE)
return FAILURE;
if (scalar_check (radix, 1) == FAILURE)
return FAILURE;
- if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: '%s' intrinsic with "
+ if (gfc_notify_std (GFC_STD_F2008, "'%s' intrinsic with "
"RADIX argument at %L", gfc_current_intrinsic,
&radix->where) == FAILURE)
return FAILURE;
if (kind_check (kind, 1, BT_INTEGER) == FAILURE)
return FAILURE;
- if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+ if (kind && gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
"with KIND argument at %L",
gfc_current_intrinsic, &kind->where) == FAILURE)
return FAILURE;
if (kind_check (kind, 2, BT_INTEGER) == FAILURE)
return FAILURE;
- if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+ if (kind && gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
"with KIND argument at %L",
gfc_current_intrinsic, &kind->where) == FAILURE)
return FAILURE;
return FAILURE;
if ((a->ts.kind != gfc_default_double_kind)
- && gfc_notify_std (GFC_STD_GNU, "GNU extension: non double precision "
+ && gfc_notify_std (GFC_STD_GNU, "non double precision "
"REAL argument to %s intrinsic at %L",
gfc_current_intrinsic, &a->where) == FAILURE)
return FAILURE;
if (kind_check (kind, 2, BT_INTEGER) == FAILURE)
return FAILURE;
- if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+ if (kind && gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
"with KIND argument at %L",
gfc_current_intrinsic, &kind->where) == FAILURE)
return FAILURE;
if (kind_check (kind, 3, BT_INTEGER) == FAILURE)
return FAILURE;
- if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+ if (kind && gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
"with KIND argument at %L",
gfc_current_intrinsic, &kind->where) == FAILURE)
return FAILURE;
exprd = (LOCATION_LINE (con->expr->where.lb->location)
> LOCATION_LINE (rvalue->where.lb->location))
? con->expr : rvalue;
- if (gfc_notify_std (GFC_STD_GNU,"Extension: "
+ if (gfc_notify_std (GFC_STD_GNU,
"re-initialization of '%s' at %L",
symbol->name, &exprd->where) == FAILURE)
return FAILURE;
expr = (LOCATION_LINE (init->where.lb->location)
> LOCATION_LINE (rvalue->where.lb->location))
? init : rvalue;
- if (gfc_notify_std (GFC_STD_GNU,"Extension: "
+ if (gfc_notify_std (GFC_STD_GNU,
"re-initialization of '%s' at %L",
symbol->name, &expr->where) == FAILURE)
return FAILURE;
if (gfc_current_state () != COMP_BLOCK_DATA
&& sym->attr.in_common
- && gfc_notify_std (GFC_STD_GNU, "Extension: initialization of "
+ && gfc_notify_std (GFC_STD_GNU, "initialization of "
"common block variable '%s' in DATA statement at %C",
sym->name) == FAILURE)
return MATCH_ERROR;
if (gfc_match_char (':') == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: deferred type "
+ if (gfc_notify_std (GFC_STD_F2003, "deferred type "
"parameter at %C") == FAILURE)
return MATCH_ERROR;
if (m == MATCH_YES)
{
if (obsolenscent_check
- && gfc_notify_std (GFC_STD_F95_OBS, "Obsolescent feature: "
+ && gfc_notify_std (GFC_STD_F95_OBS,
"Old-style character length at %C") == FAILURE)
return MATCH_ERROR;
*expr = gfc_get_int_expr (gfc_default_integer_kind, NULL, length);
retval = FAILURE;
}
else if (sym->attr.optional == 1
- && gfc_notify_std (GFC_STD_F2008_TS, "TS29113: Variable '%s' "
+ && gfc_notify_std (GFC_STD_F2008_TS, "Variable '%s' "
"at %L with OPTIONAL attribute in "
"procedure '%s' which is BIND(C)",
sym->name, &(sym->declared_at),
if (!procptr)
gfc_resolve_expr (*init);
- if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: non-NULL pointer "
+ if (gfc_notify_std (GFC_STD_F2008, "non-NULL pointer "
"initialization at %C") == FAILURE)
return MATCH_ERROR;
if (as->type == AS_IMPLIED_SHAPE
&& gfc_notify_std (GFC_STD_F2008,
- "Fortran 2008: Implied-shape array at %L",
+ "Implied-shape array at %L",
&var_locus) == FAILURE)
{
m = MATCH_ERROR;
if (!colon_seen && gfc_match (" /") == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_GNU, "Extension: Old-style "
+ if (gfc_notify_std (GFC_STD_GNU, "Old-style "
"initialization at %C") == FAILURE)
return MATCH_ERROR;
if (gfc_match (" byte") == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_GNU, "Extension: BYTE type at %C")
+ if (gfc_notify_std (GFC_STD_GNU, "BYTE type at %C")
== FAILURE)
return MATCH_ERROR;
gfc_error ("Assumed type at %C is not allowed for components");
return MATCH_ERROR;
}
- if (gfc_notify_std (GFC_STD_F2008_TS, "TS 29113: Assumed type "
+ if (gfc_notify_std (GFC_STD_F2008_TS, "Assumed type "
"at %C") == FAILURE)
return MATCH_ERROR;
ts->type = BT_ASSUMED;
|| (!matched_type && gfc_match (" character") == MATCH_YES))
{
if (matched_type
- && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: TYPE with "
+ && gfc_notify_std (GFC_STD_F2008, "TYPE with "
"intrinsic-type-spec at %C") == FAILURE)
return MATCH_ERROR;
|| (!matched_type && gfc_match (" double precision") == MATCH_YES))
{
if (matched_type
- && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: TYPE with "
+ && gfc_notify_std (GFC_STD_F2008, "TYPE with "
"intrinsic-type-spec at %C") == FAILURE)
return MATCH_ERROR;
if (matched_type && gfc_match_char (')') != MATCH_YES)
&& gfc_match (" complex") == MATCH_YES)))
|| (!matched_type && gfc_match (" double complex") == MATCH_YES))
{
- if (gfc_notify_std (GFC_STD_GNU, "Extension: DOUBLE COMPLEX at %C")
+ if (gfc_notify_std (GFC_STD_GNU, "DOUBLE COMPLEX at %C")
== FAILURE)
return MATCH_ERROR;
if (matched_type
- && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: TYPE with "
+ && gfc_notify_std (GFC_STD_F2008, "TYPE with "
"intrinsic-type-spec at %C") == FAILURE)
return MATCH_ERROR;
return m;
ts->type = BT_CLASS;
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: CLASS statement at %C")
+ if (gfc_notify_std (GFC_STD_F2003, "CLASS statement at %C")
== FAILURE)
return MATCH_ERROR;
}
get_kind:
if (matched_type
- && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: TYPE with "
+ && gfc_notify_std (GFC_STD_F2008, "TYPE with "
"intrinsic-type-spec at %C") == FAILURE)
return MATCH_ERROR;
return MATCH_ERROR;
}
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: IMPORT statement at %C")
+ if (gfc_notify_std (GFC_STD_F2003, "IMPORT statement at %C")
== FAILURE)
return MATCH_ERROR;
{
if (d == DECL_ALLOCATABLE)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ALLOCATABLE "
+ if (gfc_notify_std (GFC_STD_F2003, "ALLOCATABLE "
"attribute at %C in a TYPE definition")
== FAILURE)
{
&& gfc_state_stack->previous
&& gfc_state_stack->previous->state == COMP_MODULE)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Attribute %s "
+ if (gfc_notify_std (GFC_STD_F2003, "Attribute %s "
"at %L in a TYPE definition", attr,
&seen_at[d])
== FAILURE)
case DECL_ASYNCHRONOUS:
if (gfc_notify_std (GFC_STD_F2003,
- "Fortran 2003: ASYNCHRONOUS attribute at %C")
+ "ASYNCHRONOUS attribute at %C")
== FAILURE)
t = FAILURE;
else
case DECL_CONTIGUOUS:
if (gfc_notify_std (GFC_STD_F2008,
- "Fortran 2008: CONTIGUOUS attribute at %C")
+ "CONTIGUOUS attribute at %C")
== FAILURE)
t = FAILURE;
else
break;
}
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PROTECTED "
+ if (gfc_notify_std (GFC_STD_F2003, "PROTECTED "
"attribute at %C")
== FAILURE)
t = FAILURE;
break;
case DECL_VALUE:
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: VALUE attribute "
+ if (gfc_notify_std (GFC_STD_F2003, "VALUE attribute "
"at %C")
== FAILURE)
t = FAILURE;
case DECL_VOLATILE:
if (gfc_notify_std (GFC_STD_F2003,
- "Fortran 2003: VOLATILE attribute at %C")
+ "VOLATILE attribute at %C")
== FAILURE)
t = FAILURE;
else
if (gfc_match ("impure% ") == MATCH_YES)
{
if (gfc_notify_std (GFC_STD_F2008,
- "Fortran 2008: IMPURE procedure at %C")
+ "IMPURE procedure at %C")
== FAILURE)
goto error;
/* Fortran 2008 draft allows BIND(C) for internal procedures. */
if (gfc_current_state () == COMP_CONTAINS
&& sym->ns->proc_name->attr.flavor != FL_MODULE
- && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: BIND(C) attribute "
+ && gfc_notify_std (GFC_STD_F2008, "BIND(C) attribute "
"at %L may not be specified for an internal "
"procedure", &gfc_current_locus)
== FAILURE)
return MATCH_ERROR;
}
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Procedure pointer "
+ if (gfc_notify_std (GFC_STD_F2003, "Procedure pointer "
"component at %C") == FAILURE)
return MATCH_ERROR;
old_locus = gfc_current_locus;
if (gfc_match ("::") == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: double colon in "
+ if (gfc_notify_std (GFC_STD_F2008, "double colon in "
"MODULE PROCEDURE statement at %L", &old_locus)
== FAILURE)
return MATCH_ERROR;
if (m != MATCH_YES)
return m;
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PROCEDURE statement at %C")
+ if (gfc_notify_std (GFC_STD_F2003, "PROCEDURE statement at %C")
== FAILURE)
return MATCH_ERROR;
if (m != MATCH_YES)
return m;
- if (gfc_notify_std (GFC_STD_F2008_OBS, "Fortran 2008 obsolescent feature: "
+ if (gfc_notify_std (GFC_STD_F2008_OBS,
"ENTRY statement at %C") == FAILURE)
return MATCH_ERROR;
/* The following is allowed in the Fortran 2008 draft. */
if (gfc_current_state () == COMP_CONTAINS
&& sym->ns->proc_name->attr.flavor != FL_MODULE
- && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: BIND(C) attribute "
+ && gfc_notify_std (GFC_STD_F2008, "BIND(C) attribute "
"at %L may not be specified for an internal "
"procedure", &gfc_current_locus)
== FAILURE)
{
if (!eos_ok && (*st == ST_END_SUBROUTINE || *st == ST_END_FUNCTION))
{
- if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: END statement "
+ if (gfc_notify_std (GFC_STD_F2008, "END statement "
"instead of %s statement at %L",
gfc_ascii_statement (*st), &old_loc) == FAILURE)
goto cleanup;
match
gfc_match_contiguous (void)
{
- if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: CONTIGUOUS statement at %C")
+ if (gfc_notify_std (GFC_STD_F2008, "CONTIGUOUS statement at %C")
== FAILURE)
return MATCH_ERROR;
}
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PROTECTED statement at %C")
+ if (gfc_notify_std (GFC_STD_F2003, "PROTECTED statement at %C")
== FAILURE)
return MATCH_ERROR;
return MATCH_ERROR;
}
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: VALUE statement at %C")
+ if (gfc_notify_std (GFC_STD_F2003, "VALUE statement at %C")
== FAILURE)
return MATCH_ERROR;
gfc_symbol *sym;
match m;
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: VOLATILE statement at %C")
+ if (gfc_notify_std (GFC_STD_F2003, "VOLATILE statement at %C")
== FAILURE)
return MATCH_ERROR;
gfc_symbol *sym;
match m;
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ASYNCHRONOUS statement at %C")
+ if (gfc_notify_std (GFC_STD_F2003, "ASYNCHRONOUS statement at %C")
== FAILURE)
return MATCH_ERROR;
old_locus = gfc_current_locus;
if (gfc_match ("::") == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: double colon in "
+ if (gfc_notify_std (GFC_STD_F2008, "double colon in "
"MODULE PROCEDURE statement at %L", &old_locus)
== FAILURE)
return MATCH_ERROR;
}
else if (gfc_match (" , abstract") == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ABSTRACT type at %C")
+ if (gfc_notify_std (GFC_STD_F2003, "ABSTRACT type at %C")
== FAILURE)
return MATCH_ERROR;
if (m != MATCH_YES)
return m;
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ENUM and ENUMERATOR at %C")
+ if (gfc_notify_std (GFC_STD_F2003, "ENUM and ENUMERATOR at %C")
== FAILURE)
return MATCH_ERROR;
return MATCH_ERROR;
}
- if (num>1 && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: PROCEDURE list"
+ if (num>1 && gfc_notify_std (GFC_STD_F2008, "PROCEDURE list"
" at %C") == FAILURE)
return MATCH_ERROR;
{
va_list argp;
bool warning;
+ const char *msg1, *msg2;
+ char *buffer;
warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
if ((gfc_option.allow_std & std) != 0 && !warning)
cur_error_buffer->flag = 1;
cur_error_buffer->index = 0;
- va_start (argp, gmsgid);
if (warning)
- error_print (_("Warning:"), _(gmsgid), argp);
+ msg1 = _("Warning:");
else
- error_print (_("Error:"), _(gmsgid), argp);
+ msg1 = _("Error:");
+
+ switch (std)
+ {
+ case GFC_STD_F2008_TS:
+ msg2 = "TS 29113:";
+ break;
+ case GFC_STD_F2008_OBS:
+ msg2 = _("Fortran 2008 obsolescent feature:");
+ break;
+ case GFC_STD_F2008:
+ msg2 = "Fortran 2008:";
+ break;
+ case GFC_STD_F2003:
+ msg2 = "Fortran 2003:";
+ break;
+ case GFC_STD_GNU:
+ msg2 = _("GNU Extension:");
+ break;
+ case GFC_STD_LEGACY:
+ msg2 = _("Legacy Extension:");
+ break;
+ case GFC_STD_F95_OBS:
+ msg2 = _("Obsolescent feature:");
+ break;
+ case GFC_STD_F95_DEL:
+ msg2 = _("Deleted feature:");
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ buffer = (char *) alloca (strlen (msg1) + strlen (msg2) + 2);
+ strcpy (buffer, msg1);
+ strcat (buffer, " ");
+ strcat (buffer, msg2);
+
+ va_start (argp, gmsgid);
+ error_print (buffer, _(gmsgid), argp);
va_end (argp);
error_char ('\0');
if (e->ts.type != BT_INTEGER
&& e->ts.type != BT_CHARACTER
- && gfc_notify_std (GFC_STD_F2003, "Extension: Evaluation of "
+ && gfc_notify_std (GFC_STD_F2003, "Evaluation of "
"nonstandard initialization expression at %L",
&e->where) == FAILURE)
return MATCH_ERROR;
if (rvalue->is_boz && lvalue->ts.type != BT_INTEGER
&& lvalue->symtree->n.sym->attr.data
- && gfc_notify_std (GFC_STD_GNU, "Extension: BOZ literal at %L used to "
+ && gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L used to "
"initialize non-integer variable '%s'",
&rvalue->where, lvalue->symtree->n.sym->name)
== FAILURE)
return FAILURE;
else if (rvalue->is_boz && !lvalue->symtree->n.sym->attr.data
- && gfc_notify_std (GFC_STD_GNU, "Extension: BOZ literal at %L outside "
+ && gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L outside "
"a DATA statement and outside INT/REAL/DBLE/CMPLX",
&rvalue->where) == FAILURE)
return FAILURE;
return FAILURE;
}
- if (gfc_notify_std (GFC_STD_F2003,"Fortran 2003: Bounds "
+ if (gfc_notify_std (GFC_STD_F2003,"Bounds "
"specification for '%s' in pointer assignment "
"at %L", lvalue->symtree->n.sym->name,
&lvalue->where) == FAILURE)
return FAILURE;
}
if (attr.proc == PROC_INTERNAL &&
- gfc_notify_std (GFC_STD_F2008, "Internal procedure '%s' is "
- "invalid in procedure pointer assignment at %L",
- rvalue->symtree->name, &rvalue->where) == FAILURE)
+ gfc_notify_std (GFC_STD_F2008, "Internal procedure "
+ "'%s' is invalid in procedure pointer assignment "
+ "at %L", rvalue->symtree->name, &rvalue->where)
+ == FAILURE)
return FAILURE;
}
/* Check for F08:C730. */
" simply contiguous at %L", &rvalue->where);
return FAILURE;
}
- if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Rank remapping"
+ if (gfc_notify_std (GFC_STD_F2008, "Rank remapping"
" target is not rank 1 at %L", &rvalue->where)
== FAILURE)
return FAILURE;
{
match m;
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ABSTRACT INTERFACE at %C")
+ if (gfc_notify_std (GFC_STD_F2003, "ABSTRACT INTERFACE at %C")
== FAILURE)
return MATCH_ERROR;
/* F2003, C1207. F2008, C1207. */
if (p->sym->attr.proc == PROC_INTERNAL
- && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Internal procedure "
+ && gfc_notify_std (GFC_STD_F2008, "Internal procedure "
"'%s' in %s at %L", p->sym->name, interface_name,
&p->sym->declared_at) == FAILURE)
return 1;
if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
|| isym->id == GFC_ISYM_CMPLX)
&& gfc_init_expr_flag
- && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' "
+ && gfc_notify_std (GFC_STD_F2003, "Function '%s' "
"as initialization expression at %L", name,
&expr->where) == FAILURE)
{
where each argument is an initialization expression */
if (gfc_init_expr_flag && isym->elemental && flag
- && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Elemental function "
+ && gfc_notify_std (GFC_STD_F2003, "Elemental function "
"as initialization expression with non-integer/non-"
"character arguments at %L", &expr->where) == FAILURE)
return MATCH_ERROR;
c = next_char_not_space (&error);
if (c == 'P')
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: DP format "
+ if (gfc_notify_std (GFC_STD_F2003, "DP format "
"specifier not allowed at %C") == FAILURE)
return FMT_ERROR;
token = FMT_DP;
}
else if (c == 'C')
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: DC format "
+ if (gfc_notify_std (GFC_STD_F2003, "DC format "
"specifier not allowed at %C") == FAILURE)
return FMT_ERROR;
token = FMT_DC;
/* X requires a prior number if we're being pedantic. */
if (mode != MODE_FORMAT)
format_locus.nextc += format_string_pos;
- if (gfc_notify_std (GFC_STD_GNU, "Extension: X descriptor "
+ if (gfc_notify_std (GFC_STD_GNU, "X descriptor "
"requires leading space count at %L", &format_locus)
== FAILURE)
return FAILURE;
if (t == FMT_ERROR)
goto fail;
- if (gfc_notify_std (GFC_STD_GNU, "Extension: $ descriptor at %L",
+ if (gfc_notify_std (GFC_STD_GNU, "$ descriptor at %L",
&format_locus) == FAILURE)
return FAILURE;
if (t != FMT_RPAREN || level > 0)
error = zero_width;
goto syntax;
}
- if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: 'G0' in "
+ if (gfc_notify_std (GFC_STD_F2008, "'G0' in "
"format at %L", &format_locus) == FAILURE)
return FAILURE;
u = format_lex ();
default:
if (mode != MODE_FORMAT)
format_locus.nextc += format_string_pos - 1;
- if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %L",
+ if (gfc_notify_std (GFC_STD_GNU, "Missing comma at %L",
&format_locus) == FAILURE)
return FAILURE;
/* If we do not actually return a failure, we need to unwind this
default:
if (mode != MODE_FORMAT)
format_locus.nextc += format_string_pos;
- if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %L",
+ if (gfc_notify_std (GFC_STD_GNU, "Missing comma at %L",
&format_locus) == FAILURE)
return FAILURE;
/* If we do not actually return a failure, we need to unwind this
}
else if (e->ts.type == BT_INTEGER && e->expr_type == EXPR_VARIABLE)
{
- if (gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: ASSIGNED "
+ if (gfc_notify_std (GFC_STD_F95_DEL, "ASSIGNED "
"variable in FORMAT tag at %L", &e->where)
== FAILURE)
return FAILURE;
It may be assigned an Hollerith constant. */
if (e->ts.type != BT_CHARACTER)
{
- if (gfc_notify_std (GFC_STD_LEGACY, "Extension: Non-character "
+ if (gfc_notify_std (GFC_STD_LEGACY, "Non-character "
"in FORMAT tag at %L", &e->where) == FAILURE)
return FAILURE;
if (tag == &tag_iomsg)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: IOMSG tag at %L",
+ if (gfc_notify_std (GFC_STD_F2003, "IOMSG tag at %L",
&e->where) == FAILURE)
return FAILURE;
}
if (tag == &tag_exist && e->ts.kind != gfc_default_logical_kind)
{
- if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Nondefault LOGICAL "
+ if (gfc_notify_std (GFC_STD_F2008, "Nondefault LOGICAL "
"in %s tag at %L", tag->name, &e->where)
== FAILURE)
return FAILURE;
if (tag == &tag_newunit)
{
- if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: NEWUNIT specifier"
+ if (gfc_notify_std (GFC_STD_F2008, "NEWUNIT specifier"
" at %L", &e->where) == FAILURE)
return FAILURE;
}
if (tag == &tag_convert)
{
- if (gfc_notify_std (GFC_STD_GNU, "Extension: CONVERT tag at %L",
+ if (gfc_notify_std (GFC_STD_GNU, "CONVERT tag at %L",
&e->where) == FAILURE)
return FAILURE;
}
else
if (n == ERROR)
{
- gfc_notify_std (GFC_STD_F2003, "Fortran 2003: %s specifier in "
+ gfc_notify_std (GFC_STD_F2003, "%s specifier in "
"%s statement at %C has value '%s'", specifier,
statement, allowed_f2003[i]);
return 0;
else
if (n == ERROR)
{
- gfc_notify_std (GFC_STD_GNU, "Extension: %s specifier in "
+ gfc_notify_std (GFC_STD_GNU, "%s specifier in "
"%s statement at %C has value '%s'", specifier,
statement, allowed_gnu[i]);
return 0;
/* Checks on the ASYNCHRONOUS specifier. */
if (open->asynchronous)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ASYNCHRONOUS= at %C "
+ if (gfc_notify_std (GFC_STD_F2003, "ASYNCHRONOUS= at %C "
"not allowed in Fortran 95") == FAILURE)
goto cleanup;
/* Checks on the BLANK specifier. */
if (open->blank)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: BLANK= at %C "
+ if (gfc_notify_std (GFC_STD_F2003, "BLANK= at %C "
"not allowed in Fortran 95") == FAILURE)
goto cleanup;
/* Checks on the DECIMAL specifier. */
if (open->decimal)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: DECIMAL= at %C "
+ if (gfc_notify_std (GFC_STD_F2003, "DECIMAL= at %C "
"not allowed in Fortran 95") == FAILURE)
goto cleanup;
/* Checks on the ENCODING specifier. */
if (open->encoding)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ENCODING= at %C "
+ if (gfc_notify_std (GFC_STD_F2003, "ENCODING= at %C "
"not allowed in Fortran 95") == FAILURE)
goto cleanup;
/* Checks on the ROUND specifier. */
if (open->round)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ROUND= at %C "
+ if (gfc_notify_std (GFC_STD_F2003, "ROUND= at %C "
"not allowed in Fortran 95") == FAILURE)
goto cleanup;
/* Checks on the SIGN specifier. */
if (open->sign)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: SIGN= at %C "
+ if (gfc_notify_std (GFC_STD_F2003, "SIGN= at %C "
"not allowed in Fortran 95") == FAILURE)
goto cleanup;
match
gfc_match_flush (void)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: FLUSH statement at %C")
+ if (gfc_notify_std (GFC_STD_F2003, "FLUSH statement at %C")
== FAILURE)
return MATCH_ERROR;
}
if (dt->extra_comma
- && gfc_notify_std (GFC_STD_GNU, "Extension: Comma before i/o "
+ && gfc_notify_std (GFC_STD_GNU, "Comma before i/o "
"item list at %L", &dt->extra_comma->where) == FAILURE)
return FAILURE;
if (dt->namelist != NULL)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Internal file "
+ if (gfc_notify_std (GFC_STD_F2003, "Internal file "
"at %L with namelist", &expr->where)
== FAILURE)
m = MATCH_ERROR;
if (dt->decimal)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: DECIMAL= at %C "
+ if (gfc_notify_std (GFC_STD_F2003, "DECIMAL= at %C "
"not allowed in Fortran 95") == FAILURE)
return MATCH_ERROR;
if (dt->blank)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: BLANK= at %C "
+ if (gfc_notify_std (GFC_STD_F2003, "BLANK= at %C "
"not allowed in Fortran 95") == FAILURE)
return MATCH_ERROR;
if (dt->pad)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PAD= at %C "
+ if (gfc_notify_std (GFC_STD_F2003, "PAD= at %C "
"not allowed in Fortran 95") == FAILURE)
return MATCH_ERROR;
if (dt->round)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ROUND= at %C "
+ if (gfc_notify_std (GFC_STD_F2003, "ROUND= at %C "
"not allowed in Fortran 95") == FAILURE)
return MATCH_ERROR;
if (dt->sign)
{
/* When implemented, change the following to use gfc_notify_std F2003.
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: SIGN= at %C "
+ if (gfc_notify_std (GFC_STD_F2003, "SIGN= at %C "
"not allowed in Fortran 95") == FAILURE)
return MATCH_ERROR; */
if (dt->sign->expr_type == EXPR_CONSTANT)
if (dt->delim)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: DELIM= at %C "
+ if (gfc_notify_std (GFC_STD_F2003, "DELIM= at %C "
"not allowed in Fortran 95") == FAILURE)
return MATCH_ERROR;
goto syntax;
}
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: WAIT at %C "
+ if (gfc_notify_std (GFC_STD_F2003, "WAIT at %C "
"not allowed in Fortran 95") == FAILURE)
goto cleanup;
return MATCH_ERROR;
}
- if (gfc_notify_std (GFC_STD_F95_OBS, "Obsolescent feature: Arithmetic IF "
+ if (gfc_notify_std (GFC_STD_F95_OBS, "Arithmetic IF "
"statement at %C") == FAILURE)
return MATCH_ERROR;
return MATCH_ERROR;
}
- if (gfc_notify_std (GFC_STD_F95_OBS, "Obsolescent feature: Arithmetic IF "
+ if (gfc_notify_std (GFC_STD_F95_OBS, "Arithmetic IF "
"statement at %C") == FAILURE)
return MATCH_ERROR;
if (gfc_implicit_pure (NULL))
gfc_current_ns->proc_name->attr.implicit_pure = 0;
- if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: CRITICAL statement at %C")
+ if (gfc_notify_std (GFC_STD_F2008, "CRITICAL statement at %C")
== FAILURE)
return MATCH_ERROR;
gfc_forall_iterator *head;
gfc_expr *mask;
- if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: DO CONCURRENT "
+ if (gfc_notify_std (GFC_STD_F2008, "DO CONCURRENT "
"construct at %C") == FAILURE)
return MATCH_ERROR;
return MATCH_ERROR;
}
gcc_assert (op == EXEC_EXIT);
- if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: EXIT statement with no"
+ if (gfc_notify_std (GFC_STD_F2008, "EXIT statement with no"
" do-construct-name at %C") == FAILURE)
return MATCH_ERROR;
break;
m = gfc_match_stopcode (ST_PAUSE);
if (m == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: PAUSE statement"
+ if (gfc_notify_std (GFC_STD_F95_DEL, "PAUSE statement"
" at %C")
== FAILURE)
m = MATCH_ERROR;
match
gfc_match_error_stop (void)
{
- if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: ERROR STOP statement at %C")
+ if (gfc_notify_std (GFC_STD_F2008, "ERROR STOP statement at %C")
== FAILURE)
return MATCH_ERROR;
match
gfc_match_lock (void)
{
- if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: LOCK statement at %C")
+ if (gfc_notify_std (GFC_STD_F2008, "LOCK statement at %C")
== FAILURE)
return MATCH_ERROR;
match
gfc_match_unlock (void)
{
- if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: UNLOCK statement at %C")
+ if (gfc_notify_std (GFC_STD_F2008, "UNLOCK statement at %C")
== FAILURE)
return MATCH_ERROR;
if (gfc_implicit_pure (NULL))
gfc_current_ns->proc_name->attr.implicit_pure = 0;
- if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: SYNC statement at %C")
+ if (gfc_notify_std (GFC_STD_F2008, "SYNC statement at %C")
== FAILURE)
return MATCH_ERROR;
return MATCH_ERROR;
if (gfc_match (" to %v%t", &expr) == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: ASSIGN "
+ if (gfc_notify_std (GFC_STD_F95_DEL, "ASSIGN "
"statement at %C")
== FAILURE)
return MATCH_ERROR;
if (gfc_match_variable (&expr, 0) == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: Assigned GOTO "
+ if (gfc_notify_std (GFC_STD_F95_DEL, "Assigned GOTO "
"statement at %C")
== FAILURE)
return MATCH_ERROR;
if (gfc_match (" %e%t", &expr) != MATCH_YES)
goto syntax;
- if (gfc_notify_std (GFC_STD_F95_OBS, "Obsolescent feature: Computed GOTO "
+ if (gfc_notify_std (GFC_STD_F95_OBS, "Computed GOTO "
"at %C") == FAILURE)
return MATCH_ERROR;
{
if (gfc_match (" :: ") == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: typespec in "
+ if (gfc_notify_std (GFC_STD_F2003, "typespec in "
"ALLOCATE at %L", &old_locus) == FAILURE)
goto cleanup;
goto cleanup;
if (m == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ERRMSG tag at %L",
+ if (gfc_notify_std (GFC_STD_F2003, "ERRMSG tag at %L",
&tmp->where) == FAILURE)
goto cleanup;
goto cleanup;
if (m == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: SOURCE tag at %L",
+ if (gfc_notify_std (GFC_STD_F2003, "SOURCE tag at %L",
&tmp->where) == FAILURE)
goto cleanup;
}
if (head->next
- && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: SOURCE tag at %L"
+ && gfc_notify_std (GFC_STD_F2008, "SOURCE tag at %L"
" with more than a single allocate object",
&tmp->where) == FAILURE)
goto cleanup;
goto cleanup;
if (m == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: MOLD tag at %L",
+ if (gfc_notify_std (GFC_STD_F2008, "MOLD tag at %L",
&tmp->where) == FAILURE)
goto cleanup;
goto cleanup;
if (m == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ERRMSG at %L",
+ if (gfc_notify_std (GFC_STD_F2003, "ERRMSG at %L",
&tmp->where) == FAILURE)
goto cleanup;
goto cleanup;
}
- if (gfc_notify_std (GFC_STD_F95_OBS, "Obsolescent feature: Alternate RETURN "
+ if (gfc_notify_std (GFC_STD_F95_OBS, "Alternate RETURN "
"at %C") == FAILURE)
return MATCH_ERROR;
done:
gfc_enclosing_unit (&s);
if (s == COMP_PROGRAM
- && gfc_notify_std (GFC_STD_GNU, "Extension: RETURN statement in "
+ && gfc_notify_std (GFC_STD_GNU, "RETURN statement in "
"main program at %C") == FAILURE)
return MATCH_ERROR;
sym->value = expr;
- if (gfc_notify_std (GFC_STD_F95_OBS, "Obsolescent feature: "
+ if (gfc_notify_std (GFC_STD_F95_OBS,
"Statement function at %C") == FAILURE)
return MATCH_ERROR;
{
if ((m = gfc_match (" %n ::", module_nature)) == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: module "
+ if (gfc_notify_std (GFC_STD_F2003, "module "
"nature in USE statement at %C") == FAILURE)
goto cleanup;
{
m = gfc_match (" ::");
if (m == MATCH_YES &&
- gfc_notify_std (GFC_STD_F2003, "Fortran 2003: "
+ gfc_notify_std (GFC_STD_F2003,
"\"USE :: module\" at %C") == FAILURE)
goto cleanup;
m = gfc_match (" =>");
if (type == INTERFACE_USER_OP && m == MATCH_YES
- && (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Renaming "
+ && (gfc_notify_std (GFC_STD_F2003, "Renaming "
"operators in USE statements at %C")
== FAILURE))
goto cleanup;
if (module_fp == NULL && !module->non_intrinsic)
{
if (strcmp (module_name, "iso_fortran_env") == 0
- && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ISO_FORTRAN_ENV "
+ && gfc_notify_std (GFC_STD_F2003, "ISO_FORTRAN_ENV "
"intrinsic module at %C") != FAILURE)
{
use_iso_fortran_env_module ();
}
if (strcmp (module_name, "iso_c_binding") == 0
- && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: "
+ && gfc_notify_std (GFC_STD_F2003,
"ISO_C_BINDING module at %C") != FAILURE)
{
import_iso_c_binding_module();
goto error;
case ST_PROCEDURE:
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Type-bound"
+ if (gfc_notify_std (GFC_STD_F2003, "Type-bound"
" procedure at %C") == FAILURE)
goto error;
break;
case ST_GENERIC:
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: GENERIC binding"
+ if (gfc_notify_std (GFC_STD_F2003, "GENERIC binding"
" at %C") == FAILURE)
goto error;
case ST_FINAL:
if (gfc_notify_std (GFC_STD_F2003,
- "Fortran 2003: FINAL procedure declaration"
+ "FINAL procedure declaration"
" at %C") == FAILURE)
goto error;
to_finish = true;
if (!seen_comps
- && (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Derived type "
+ && (gfc_notify_std (GFC_STD_F2008, "Derived type "
"definition at %C with empty CONTAINS "
"section") == FAILURE))
goto error;
compiling_type = 0;
if (!seen_component)
- gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Derived type "
+ gfc_notify_std (GFC_STD_F2003, "Derived type "
"definition at %C without components");
accept_statement (ST_END_TYPE);
case ST_CONTAINS:
gfc_notify_std (GFC_STD_F2003,
- "Fortran 2003: CONTAINS block in derived type"
+ "CONTAINS block in derived type"
" definition at %C");
accept_statement (ST_CONTAINS);
gfc_namespace* my_ns;
gfc_state_data s;
- gfc_notify_std (GFC_STD_F2008, "Fortran 2008: BLOCK construct at %C");
+ gfc_notify_std (GFC_STD_F2008, "BLOCK construct at %C");
my_ns = gfc_build_block_ns (gfc_current_ns);
gfc_statement st;
gfc_association_list* a;
- gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ASSOCIATE construct at %C");
+ gfc_notify_std (GFC_STD_F2003, "ASSOCIATE construct at %C");
my_ns = gfc_build_block_ns (gfc_current_ns);
pop_state ();
if (!contains_statements)
- gfc_notify_std (GFC_STD_F2008, "Fortran 2008: CONTAINS statement without "
+ gfc_notify_std (GFC_STD_F2008, "CONTAINS statement without "
"FUNCTION or SUBROUTINE statement at %C");
}
if (match_integer_constant (&e, 0) == MATCH_YES
&& gfc_match_char ('h') == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_LEGACY, "Extension: Hollerith constant "
+ if (gfc_notify_std (GFC_STD_LEGACY, "Hollerith constant "
"at %C") == FAILURE)
goto cleanup;
goto backup;
if (x_hex
- && (gfc_notify_std (GFC_STD_GNU, "Extension: Hexadecimal "
+ && (gfc_notify_std (GFC_STD_GNU, "Hexadecimal "
"constant at %C uses non-standard syntax")
== FAILURE))
return MATCH_ERROR;
goto backup;
}
- if (gfc_notify_std (GFC_STD_GNU, "Extension: BOZ constant "
+ if (gfc_notify_std (GFC_STD_GNU, "BOZ constant "
"at %C uses non-standard postfix syntax")
== FAILURE)
return MATCH_ERROR;
}
if (!gfc_in_match_data ()
- && (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: BOZ used outside a DATA "
+ && (gfc_notify_std (GFC_STD_F2003, "BOZ used outside a DATA "
"statement at %C")
== FAILURE))
return MATCH_ERROR;
if (c == 'q')
{
- if (gfc_notify_std (GFC_STD_GNU, "Extension: exponent-letter 'q' in "
+ if (gfc_notify_std (GFC_STD_GNU, "exponent-letter 'q' in "
"real-literal-constant at %C") == FAILURE)
return MATCH_ERROR;
else if (gfc_option.warn_real_q_constant)
return MATCH_ERROR;
}
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PARAMETER symbol in "
+ if (gfc_notify_std (GFC_STD_F2003, "PARAMETER symbol in "
"complex constant at %C") == FAILURE)
return MATCH_ERROR;
}
}
- if (gfc_notify_std (GFC_STD_GNU, "Extension: argument list "
+ if (gfc_notify_std (GFC_STD_GNU, "argument list "
"function at %C") == FAILURE)
{
m = MATCH_ERROR;
{
if (comp->initializer)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Structure"
+ if (gfc_notify_std (GFC_STD_F2003, "Structure"
" constructor with missing optional arguments"
" at %C") == FAILURE)
return FAILURE;
}
if (actual->name)
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Structure"
+ if (gfc_notify_std (GFC_STD_F2003, "Structure"
" constructor with named arguments at %C")
== FAILURE)
goto cleanup;
if (proc->attr.function && sym->attr.intent != INTENT_IN)
{
if (sym->attr.value)
- gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Argument '%s'"
+ gfc_notify_std (GFC_STD_F2008, "Argument '%s'"
" of pure function '%s' at %L with VALUE "
"attribute but without INTENT(IN)",
sym->name, proc->name, &sym->declared_at);
if (proc->attr.subroutine && sym->attr.intent == INTENT_UNKNOWN)
{
if (sym->attr.value)
- gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Argument '%s'"
+ gfc_notify_std (GFC_STD_F2008, "Argument '%s'"
" of pure subroutine '%s' at %L with VALUE "
"attribute but without INTENT", sym->name,
proc->name, &sym->declared_at);
&& ts->u.cl->length->expr_type == EXPR_CONSTANT
&& mpz_cmp (ts->u.cl->length->value.integer,
fts->u.cl->length->value.integer) != 0)))
- gfc_notify_std (GFC_STD_GNU, "Extension: Function %s at %L with "
+ gfc_notify_std (GFC_STD_GNU, "Function %s at %L with "
"entries returning variables of different "
"string lengths", ns->entries->sym->name,
&ns->entries->sym->declared_at);
sym->name, &common_root->n.common->where);
else if (sym->attr.result
|| gfc_is_function_return_value (sym, gfc_current_ns))
- gfc_notify_std (GFC_STD_F2003, "Fortran 2003: COMMON block '%s' at %L "
+ gfc_notify_std (GFC_STD_F2003, "COMMON block '%s' at %L "
"that is also a function result", sym->name,
&common_root->n.common->where);
else if (sym->attr.flavor == FL_PROCEDURE && sym->attr.proc != PROC_INTERNAL
&& sym->attr.proc != PROC_ST_FUNCTION)
- gfc_notify_std (GFC_STD_F2003, "Fortran 2003: COMMON block '%s' at %L "
+ gfc_notify_std (GFC_STD_F2003, "COMMON block '%s' at %L "
"that is also a global procedure", sym->name,
&common_root->n.common->where);
}
&& sym->ns->proc_name->attr.flavor != FL_MODULE)
{
if (gfc_notify_std (GFC_STD_F2008,
- "Fortran 2008: Internal procedure '%s' is"
+ "Internal procedure '%s' is"
" used as actual argument at %L",
sym->name, &e->where) == FAILURE)
return FAILURE;
}
if (index->ts.type == BT_REAL)
- if (gfc_notify_std (GFC_STD_LEGACY, "Extension: REAL array index at %L",
+ if (gfc_notify_std (GFC_STD_LEGACY, "REAL array index at %L",
&index->where) == FAILURE)
return FAILURE;
{
if (real_ok)
return gfc_notify_std (GFC_STD_F95_DEL,
- "Deleted feature: %s at %L must be integer",
+ "%s at %L must be integer",
_(name_msgid), &expr->where);
else
{
rhs = code->expr2;
if (rhs->is_boz
- && gfc_notify_std (GFC_STD_GNU, "Extension: BOZ literal at %L outside "
+ && gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L outside "
"a DATA statement and outside INT/REAL/DBLE/CMPLX",
&code->loc) == FAILURE)
return false;
"a deferred shape", sym->name, &sym->declared_at);
return FAILURE;
}
- else if (gfc_notify_std (GFC_STD_F2003, "Scalar object '%s' at %L "
- "may not be ALLOCATABLE", sym->name,
- &sym->declared_at) == FAILURE)
+ else if (gfc_notify_std (GFC_STD_F2003, "Scalar object "
+ "'%s' at %L may not be ALLOCATABLE",
+ sym->name, &sym->declared_at) == FAILURE)
return FAILURE;
}
&& !sym->ns->save_all && !sym->attr.save
&& !sym->attr.pointer && !sym->attr.allocatable
&& gfc_has_default_initializer (sym->ts.u.derived)
- && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Implied SAVE for "
+ && gfc_notify_std (GFC_STD_F2008, "Implied SAVE for "
"module variable '%s' at %L, needed due to "
"the default initialization", sym->name,
&sym->declared_at) == FAILURE)
&& arg->sym->ts.type == BT_DERIVED
&& !arg->sym->ts.u.derived->attr.use_assoc
&& !gfc_check_symbol_access (arg->sym->ts.u.derived)
- && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' is of a "
+ && gfc_notify_std (GFC_STD_F2003, "'%s' is of a "
"PRIVATE type and cannot be a dummy argument"
" of '%s', which is PUBLIC at %L",
arg->sym->name, sym->name, &sym->declared_at)
&& arg->sym->ts.type == BT_DERIVED
&& !arg->sym->ts.u.derived->attr.use_assoc
&& !gfc_check_symbol_access (arg->sym->ts.u.derived)
- && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Procedure "
+ && gfc_notify_std (GFC_STD_F2003, "Procedure "
"'%s' in PUBLIC interface '%s' at %L "
"takes dummy arguments of '%s' which is "
"PRIVATE", iface->sym->name, sym->name,
&& arg->sym->ts.type == BT_DERIVED
&& !arg->sym->ts.u.derived->attr.use_assoc
&& !gfc_check_symbol_access (arg->sym->ts.u.derived)
- && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Procedure "
+ && gfc_notify_std (GFC_STD_F2003, "Procedure "
"'%s' in PUBLIC interface '%s' at %L "
"takes dummy arguments of '%s' which is "
"PRIVATE", iface->sym->name, sym->name,
if (!sym->attr.contained
&& gfc_current_form != FORM_FIXED
&& !sym->ts.deferred)
- gfc_notify_std (GFC_STD_F95_OBS, "Obsolescent feature: "
+ gfc_notify_std (GFC_STD_F95_OBS,
"CHARACTER(*) function '%s' at %L",
sym->name, &sym->declared_at);
}
&& !is_sym_host_assoc (c->ts.u.derived, sym->ns)
&& !c->ts.u.derived->attr.use_assoc
&& !gfc_check_symbol_access (c->ts.u.derived)
- && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: the component '%s' "
+ && gfc_notify_std (GFC_STD_F2003, "the component '%s' "
"is a PRIVATE type and cannot be a component of "
"'%s', which is PUBLIC at %L", c->name,
sym->name, &sym->declared_at) == FAILURE)
if (gen_dt && gen_dt->generic && gen_dt->generic->next
&& (!gen_dt->generic->sym->attr.use_assoc
|| gen_dt->generic->sym->module != gen_dt->generic->next->sym->module)
- && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Generic name '%s' of "
+ && gfc_notify_std (GFC_STD_F2003, "Generic name '%s' of "
"function '%s' at %L being the same name as derived "
"type at %L", sym->name,
gen_dt->generic->sym == sym
}
if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SHAPE
- && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: NAMELIST array "
+ && gfc_notify_std (GFC_STD_F2003, "NAMELIST array "
"object '%s' with assumed shape in namelist "
"'%s' at %L", nl->sym->name, sym->name,
&sym->declared_at) == FAILURE)
return FAILURE;
if (is_non_constant_shape_array (nl->sym)
- && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: NAMELIST array "
+ && gfc_notify_std (GFC_STD_F2003, "NAMELIST array "
"object '%s' with nonconstant shape in namelist "
"'%s' at %L", nl->sym->name, sym->name,
&sym->declared_at) == FAILURE)
if (nl->sym->ts.type == BT_CHARACTER
&& (nl->sym->ts.u.cl->length == NULL
|| !gfc_is_constant_expr (nl->sym->ts.u.cl->length))
- && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: NAMELIST object "
+ && gfc_notify_std (GFC_STD_F2003, "NAMELIST object "
"'%s' with nonconstant character length in "
"namelist '%s' at %L", nl->sym->name, sym->name,
&sym->declared_at) == FAILURE)
&& (nl->sym->ts.u.derived->attr.alloc_comp
|| nl->sym->ts.u.derived->attr.pointer_comp))
{
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: NAMELIST object "
+ if (gfc_notify_std (GFC_STD_F2003, "NAMELIST object "
"'%s' in namelist '%s' at %L with ALLOCATABLE "
"or POINTER components", nl->sym->name,
sym->name, &sym->declared_at) == FAILURE)
&& !sym->ts.u.derived->attr.use_assoc
&& gfc_check_symbol_access (sym)
&& !gfc_check_symbol_access (sym->ts.u.derived)
- && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PUBLIC %s '%s' at %L "
+ && gfc_notify_std (GFC_STD_F2003, "PUBLIC %s '%s' at %L "
"of PRIVATE derived type '%s'",
(sym->attr.flavor == FL_PARAMETER) ? "parameter"
: "variable", sym->name, &sym->declared_at,
&& !gfc_check_symbol_access (sym->ts.u.derived)
&& gfc_check_symbol_access (sym))
{
- gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PUBLIC function '%s' at "
+ gfc_notify_std (GFC_STD_F2003, "PUBLIC function '%s' at "
"%L of PRIVATE type '%s'", sym->name,
&sym->declared_at, sym->ts.u.derived->name);
}
conf (external, subroutine);
if (attr->proc_pointer && gfc_notify_std (GFC_STD_F2003,
- "Fortran 2003: Procedure pointer at %C") == FAILURE)
+ "Procedure pointer at %C") == FAILURE)
return FAILURE;
conf (allocatable, pointer);
conflict_std:
if (name == NULL)
{
- return gfc_notify_std (standard, "Fortran 2003: %s attribute "
+ return gfc_notify_std (standard, "%s attribute "
"with %s attribute at %L", a1, a2,
where);
}
else
{
- return gfc_notify_std (standard, "Fortran 2003: %s attribute "
+ return gfc_notify_std (standard, "%s attribute "
"with %s attribute in '%s' at %L",
a1, a2, name, where);
}
if (where == NULL)
where = &gfc_current_locus;
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: BIND(C) at %L", where)
+ if (gfc_notify_std (GFC_STD_F2003, "BIND(C) at %L", where)
== FAILURE)
return FAILURE;
else
attr->extension = 1;
- if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: EXTENDS at %L", where)
+ if (gfc_notify_std (GFC_STD_F2003, "EXTENDS at %L", where)
== FAILURE)
return FAILURE;
}
if (gfc_notify_std (GFC_STD_GNU,
- "Extension: Symbol '%s' is used before"
+ "Symbol '%s' is used before"
" it is typed at %L", sym->name, &where) == FAILURE)
return FAILURE;
}
projects / thirdparty / gcc.git / commitdiff
