re PR fortran/51081 ([F03] Proc-pointer assignment: Rejects valid internal proc)

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.

From-SVN: r189589

1 files changed, 23 insertions, 23 deletions

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 407052f..bfd1205 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -862,7 +862,7 @@ gfc_check_a_p (gfc_expr *a, gfc_expr *p)
 
   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;
     }
@@ -1081,7 +1081,7 @@ gfc_check_besn (gfc_expr *n, gfc_expr *x)
     {
       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;
     }
@@ -1306,7 +1306,7 @@ gfc_check_count (gfc_expr *mask, gfc_expr *dim, gfc_expr *kind)
     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;
@@ -1664,7 +1664,7 @@ gfc_check_float (gfc_expr *a)
     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;
@@ -1724,7 +1724,7 @@ gfc_check_fn_rc2008 (gfc_expr *a)
     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)
@@ -1792,7 +1792,7 @@ gfc_check_iand (gfc_expr *i, gfc_expr *j)
 
   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;
     }
@@ -1837,7 +1837,7 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind)
   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;
@@ -1918,7 +1918,7 @@ gfc_check_ieor (gfc_expr *i, gfc_expr *j)
 
   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;
     }
@@ -1940,7 +1940,7 @@ gfc_check_index (gfc_expr *string, gfc_expr *substring, gfc_expr *back,
 
   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;
@@ -1992,7 +1992,7 @@ gfc_check_ior (gfc_expr *i, gfc_expr *j)
 
   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;
     }
@@ -2134,7 +2134,7 @@ gfc_check_lbound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
 
   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;
@@ -2179,7 +2179,7 @@ gfc_check_len_lentrim (gfc_expr *s, gfc_expr *kind)
 
   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;
@@ -2344,7 +2344,7 @@ check_rest (bt type, int kind, gfc_actual_arglist *arglist)
 	{
 	  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;
 	    }
@@ -2381,7 +2381,7 @@ gfc_check_min_max (gfc_actual_arglist *arg)
 
   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;
@@ -2863,7 +2863,7 @@ gfc_check_null (gfc_expr *mold)
     }
 
   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;
 
@@ -3399,7 +3399,7 @@ gfc_check_scan (gfc_expr *x, gfc_expr *y, gfc_expr *z, gfc_expr *kind)
 
   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;
@@ -3460,7 +3460,7 @@ gfc_try
 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;
@@ -3491,7 +3491,7 @@ gfc_check_selected_real_kind (gfc_expr *p, gfc_expr *r, gfc_expr *radix)
       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;
@@ -3533,7 +3533,7 @@ gfc_check_shape (gfc_expr *source, gfc_expr *kind)
 
   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;
@@ -3588,7 +3588,7 @@ gfc_check_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
 
   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;
@@ -3646,7 +3646,7 @@ gfc_check_sngl (gfc_expr *a)
     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;
@@ -4127,7 +4127,7 @@ gfc_check_ubound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
 
   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;
@@ -4256,7 +4256,7 @@ gfc_check_verify (gfc_expr *x, gfc_expr *y, gfc_expr *z, gfc_expr *kind)
 
   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;