[PATCH 7/13] v2 Use new per-location warning APIs in the FORTRAN front end

[Martin Sebor <msebor@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 118 bytes --]

The attached patch replaces the uses of TREE_NO_WARNING in the FORTRAN
front end with the new suppress_warning() API.

[-- Attachment #2: gcc-no-warning-fortran.diff --]
[-- Type: text/x-patch, Size: 17435 bytes --]

Add support for per-location warning groups.

gcc/fortran/ChangeLog:

	* trans-array.c (trans_array_constructor): Replace direct uses
	of TREE_NO_WARNING with warning_suppressed_p, and suppress_warning.
	* trans-decl.c (gfc_build_qualified_array): Same.
	(gfc_build_dummy_array_decl): Same.
	(generate_local_decl): Same.
	(gfc_generate_function_code): Same.
	* trans-openmp.c (gfc_omp_clause_default_ctor): Same.
	(gfc_omp_clause_copy_ctor): Same.
	* trans-types.c (get_dtype_type_node): Same.
	(gfc_get_desc_dim_type): Same.
	(gfc_get_array_descriptor_base): Same.
	(gfc_get_caf_vector_type): Same.
	(gfc_get_caf_reference_type): Same.
	* trans.c (gfc_create_var_np): Same.

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 7eeef554c0f..64a050ff196 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2755,7 +2755,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
   desc = ss_info->data.array.descriptor;
   offset = gfc_index_zero_node;
   offsetvar = gfc_create_var_np (gfc_array_index_type, "offset");
-  TREE_NO_WARNING (offsetvar) = 1;
+  suppress_warning (offsetvar);
   TREE_USED (offsetvar) = 0;
   gfc_trans_array_constructor_value (&outer_loop->pre, type, desc, c,
 				     &offset, &offsetvar, dynamic);
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index c32bd05bb1b..3f7953c8400 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1040,7 +1040,7 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
       if (GFC_TYPE_ARRAY_LBOUND (type, dim) == NULL_TREE)
 	{
 	  GFC_TYPE_ARRAY_LBOUND (type, dim) = create_index_var ("lbound", nest);
-	  TREE_NO_WARNING (GFC_TYPE_ARRAY_LBOUND (type, dim)) = 1;
+	  suppress_warning (GFC_TYPE_ARRAY_LBOUND (type, dim));
 	}
       /* Don't try to use the unknown bound for assumed shape arrays.  */
       if (GFC_TYPE_ARRAY_UBOUND (type, dim) == NULL_TREE
@@ -1048,13 +1048,13 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
 	      || dim < GFC_TYPE_ARRAY_RANK (type) - 1))
 	{
 	  GFC_TYPE_ARRAY_UBOUND (type, dim) = create_index_var ("ubound", nest);
-	  TREE_NO_WARNING (GFC_TYPE_ARRAY_UBOUND (type, dim)) = 1;
+	  suppress_warning (GFC_TYPE_ARRAY_UBOUND (type, dim));
 	}
 
       if (GFC_TYPE_ARRAY_STRIDE (type, dim) == NULL_TREE)
 	{
 	  GFC_TYPE_ARRAY_STRIDE (type, dim) = create_index_var ("stride", nest);
-	  TREE_NO_WARNING (GFC_TYPE_ARRAY_STRIDE (type, dim)) = 1;
+	  suppress_warning (GFC_TYPE_ARRAY_STRIDE (type, dim));
 	}
     }
   for (dim = GFC_TYPE_ARRAY_RANK (type);
@@ -1063,21 +1063,21 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
       if (GFC_TYPE_ARRAY_LBOUND (type, dim) == NULL_TREE)
 	{
 	  GFC_TYPE_ARRAY_LBOUND (type, dim) = create_index_var ("lbound", nest);
-	  TREE_NO_WARNING (GFC_TYPE_ARRAY_LBOUND (type, dim)) = 1;
+	  suppress_warning (GFC_TYPE_ARRAY_LBOUND (type, dim));
 	}
       /* Don't try to use the unknown ubound for the last coarray dimension.  */
       if (GFC_TYPE_ARRAY_UBOUND (type, dim) == NULL_TREE
           && dim < GFC_TYPE_ARRAY_RANK (type) + GFC_TYPE_ARRAY_CORANK (type) - 1)
 	{
 	  GFC_TYPE_ARRAY_UBOUND (type, dim) = create_index_var ("ubound", nest);
-	  TREE_NO_WARNING (GFC_TYPE_ARRAY_UBOUND (type, dim)) = 1;
+	  suppress_warning (GFC_TYPE_ARRAY_UBOUND (type, dim));
 	}
     }
   if (GFC_TYPE_ARRAY_OFFSET (type) == NULL_TREE)
     {
       GFC_TYPE_ARRAY_OFFSET (type) = gfc_create_var_np (gfc_array_index_type,
 							"offset");
-      TREE_NO_WARNING (GFC_TYPE_ARRAY_OFFSET (type)) = 1;
+      suppress_warning (GFC_TYPE_ARRAY_OFFSET (type));
 
       if (nest)
 	gfc_add_decl_to_parent_function (GFC_TYPE_ARRAY_OFFSET (type));
@@ -1089,7 +1089,7 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
       && as->type != AS_ASSUMED_SIZE)
     {
       GFC_TYPE_ARRAY_SIZE (type) = create_index_var ("size", nest);
-      TREE_NO_WARNING (GFC_TYPE_ARRAY_SIZE (type)) = 1;
+      suppress_warning (GFC_TYPE_ARRAY_SIZE (type));
     }
 
   if (POINTER_TYPE_P (type))
@@ -1294,7 +1294,7 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
 
   /* Avoid uninitialized warnings for optional dummy arguments.  */
   if (sym->attr.optional)
-    TREE_NO_WARNING (decl) = 1;
+    suppress_warning (decl);
 
   /* We should never get deferred shape arrays here.  We used to because of
      frontend bugs.  */
@@ -5981,7 +5981,7 @@ generate_local_decl (gfc_symbol * sym)
 			     "does not have a default initializer",
 			     sym->name, &sym->declared_at);
 	      if (sym->backend_decl != NULL_TREE)
-		TREE_NO_WARNING(sym->backend_decl) = 1;
+		suppress_warning (sym->backend_decl);
 	    }
 	  else if (warn_unused_dummy_argument)
 	    {
@@ -5991,7 +5991,7 @@ generate_local_decl (gfc_symbol * sym)
 			     &sym->declared_at);
 
 	      if (sym->backend_decl != NULL_TREE)
-		TREE_NO_WARNING(sym->backend_decl) = 1;
+		suppress_warning (sym->backend_decl);
 	    }
 	}
 
@@ -6007,7 +6007,7 @@ generate_local_decl (gfc_symbol * sym)
 			   "explicitly imported at %L", sym->name,
 			   &sym->declared_at);
 	      if (sym->backend_decl != NULL_TREE)
-		TREE_NO_WARNING(sym->backend_decl) = 1;
+		suppress_warning (sym->backend_decl);
 	    }
 	  else if (!sym->attr.use_assoc)
 	    {
@@ -6025,7 +6025,7 @@ generate_local_decl (gfc_symbol * sym)
 			     "Unused variable %qs declared at %L",
 			     sym->name, &sym->declared_at);
 	      if (sym->backend_decl != NULL_TREE)
-		TREE_NO_WARNING(sym->backend_decl) = 1;
+		suppress_warning (sym->backend_decl);
 	    }
 	}
 
@@ -6140,7 +6140,7 @@ generate_local_decl (gfc_symbol * sym)
 	  /* Silence bogus "unused parameter" warnings from the
 	     middle end.  */
 	  if (sym->backend_decl != NULL_TREE)
-		TREE_NO_WARNING (sym->backend_decl) = 1;
+		suppress_warning (sym->backend_decl);
 	}
     }
 
@@ -6971,7 +6971,7 @@ gfc_generate_function_code (gfc_namespace * ns)
 			 "Return value of function %qs at %L not set",
 			 sym->name, &sym->declared_at);
 	  if (warn_return_type > 0)
-	    TREE_NO_WARNING(sym->backend_decl) = 1;
+	    suppress_warning (sym->backend_decl);
 	}
       if (result != NULL_TREE)
 	gfc_add_expr_to_block (&body, gfc_generate_return ());
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 1e22cdb82b7..39260027473 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -763,7 +763,7 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer)
 					 else_b));
       /* Avoid -W*uninitialized warnings.  */
       if (DECL_P (decl))
-	TREE_NO_WARNING (decl) = 1;
+	suppress_warning (decl, OPT_Wuninitialized);
     }
   else
     gfc_add_expr_to_block (&block, then_b);
@@ -948,7 +948,7 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
 				     void_type_node, cond, then_b, else_b));
   /* Avoid -W*uninitialized warnings.  */
   if (DECL_P (dest))
-    TREE_NO_WARNING (dest) = 1;
+    suppress_warning (dest, OPT_Wuninitialized);
 
   return gfc_finish_block (&block);
 }
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 9f21b3ee780..4e26aea7fe7 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -150,23 +150,23 @@ tree get_dtype_type_node (void)
       field = gfc_add_field_to_struct_1 (dtype_node,
 					 get_identifier ("elem_len"),
 					 size_type_node, &dtype_chain);
-      TREE_NO_WARNING (field) = 1;
+      suppress_warning (field);
       field = gfc_add_field_to_struct_1 (dtype_node,
 					 get_identifier ("version"),
 					 integer_type_node, &dtype_chain);
-      TREE_NO_WARNING (field) = 1;
+      suppress_warning (field);
       field = gfc_add_field_to_struct_1 (dtype_node,
 					 get_identifier ("rank"),
 					 signed_char_type_node, &dtype_chain);
-      TREE_NO_WARNING (field) = 1;
+      suppress_warning (field);
       field = gfc_add_field_to_struct_1 (dtype_node,
 					 get_identifier ("type"),
 					 signed_char_type_node, &dtype_chain);
-      TREE_NO_WARNING (field) = 1;
+      suppress_warning (field);
       field = gfc_add_field_to_struct_1 (dtype_node,
 					 get_identifier ("attribute"),
 					 short_integer_type_node, &dtype_chain);
-      TREE_NO_WARNING (field) = 1;
+      suppress_warning (field);
       gfc_finish_type (dtype_node);
       TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (dtype_node)) = 1;
       dtype_type_node = dtype_node;
@@ -1453,17 +1453,17 @@ gfc_get_desc_dim_type (void)
   decl = gfc_add_field_to_struct_1 (type,
 				    get_identifier ("stride"),
 				    gfc_array_index_type, &chain);
-  TREE_NO_WARNING (decl) = 1;
+  suppress_warning (decl);
 
   decl = gfc_add_field_to_struct_1 (type,
 				    get_identifier ("lbound"),
 				    gfc_array_index_type, &chain);
-  TREE_NO_WARNING (decl) = 1;
+  suppress_warning (decl);
 
   decl = gfc_add_field_to_struct_1 (type,
 				    get_identifier ("ubound"),
 				    gfc_array_index_type, &chain);
-  TREE_NO_WARNING (decl) = 1;
+  suppress_warning (decl);
 
   /* Finish off the type.  */
   gfc_finish_type (type);
@@ -1831,19 +1831,19 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
   decl = gfc_add_field_to_struct_1 (fat_type,
 				    get_identifier ("offset"),
 				    gfc_array_index_type, &chain);
-  TREE_NO_WARNING (decl) = 1;
+  suppress_warning (decl);
 
   /* Add the dtype component.  */
   decl = gfc_add_field_to_struct_1 (fat_type,
 				    get_identifier ("dtype"),
 				    get_dtype_type_node (), &chain);
-  TREE_NO_WARNING (decl) = 1;
+  suppress_warning (decl);
 
   /* Add the span component.  */
   decl = gfc_add_field_to_struct_1 (fat_type,
 				    get_identifier ("span"),
 				    gfc_array_index_type, &chain);
-  TREE_NO_WARNING (decl) = 1;
+  suppress_warning (decl);
 
   /* Build the array type for the stride and bound components.  */
   if (dimen + codimen > 0)
@@ -1856,7 +1856,7 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
 
       decl = gfc_add_field_to_struct_1 (fat_type, get_identifier ("dim"),
 					arraytype, &chain);
-      TREE_NO_WARNING (decl) = 1;
+      suppress_warning (decl);
     }
 
   if (flag_coarray == GFC_FCOARRAY_LIB)
@@ -1864,7 +1864,7 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
       decl = gfc_add_field_to_struct_1 (fat_type,
 					get_identifier ("token"),
 					prvoid_type_node, &chain);
-      TREE_NO_WARNING (decl) = 1;
+      suppress_warning (decl);
     }
 
   /* Finish off the type.  */
@@ -2856,7 +2856,7 @@ copy_derived_types:
 	  token = gfc_find_component (derived, caf_name, true, true, NULL);
 	  gcc_assert (token);
 	  c->caf_token = token->backend_decl;
-	  TREE_NO_WARNING (c->caf_token) = 1;
+	  suppress_warning (c->caf_token);
 	}
     }
 
@@ -3521,11 +3521,11 @@ gfc_get_caf_vector_type (int dim)
       tmp = gfc_add_field_to_struct_1 (vect_struct_type,
 				       get_identifier ("vector"),
 				       pvoid_type_node, &chain);
-      TREE_NO_WARNING (tmp) = 1;
+      suppress_warning (tmp);
       tmp = gfc_add_field_to_struct_1 (vect_struct_type,
 				       get_identifier ("kind"),
 				       integer_type_node, &chain);
-      TREE_NO_WARNING (tmp) = 1;
+      suppress_warning (tmp);
       gfc_finish_type (vect_struct_type);
 
       chain = 0;
@@ -3533,34 +3533,34 @@ gfc_get_caf_vector_type (int dim)
       tmp = gfc_add_field_to_struct_1 (triplet_struct_type,
 				       get_identifier ("lower_bound"),
 				       gfc_array_index_type, &chain);
-      TREE_NO_WARNING (tmp) = 1;
+      suppress_warning (tmp);
       tmp = gfc_add_field_to_struct_1 (triplet_struct_type,
 				       get_identifier ("upper_bound"),
 				       gfc_array_index_type, &chain);
-      TREE_NO_WARNING (tmp) = 1;
+      suppress_warning (tmp);
       tmp = gfc_add_field_to_struct_1 (triplet_struct_type, get_identifier ("stride"),
 				       gfc_array_index_type, &chain);
-      TREE_NO_WARNING (tmp) = 1;
+      suppress_warning (tmp);
       gfc_finish_type (triplet_struct_type);
 
       chain = 0;
       union_type = make_node (UNION_TYPE);
       tmp = gfc_add_field_to_struct_1 (union_type, get_identifier ("v"),
                                        vect_struct_type, &chain);
-      TREE_NO_WARNING (tmp) = 1;
+      suppress_warning (tmp);
       tmp = gfc_add_field_to_struct_1 (union_type, get_identifier ("triplet"),
 				       triplet_struct_type, &chain);
-      TREE_NO_WARNING (tmp) = 1;
+      suppress_warning (tmp);
       gfc_finish_type (union_type);
 
       chain = 0;
       vec_type = make_node (RECORD_TYPE);
       tmp = gfc_add_field_to_struct_1 (vec_type, get_identifier ("nvec"),
 				       size_type_node, &chain);
-      TREE_NO_WARNING (tmp) = 1;
+      suppress_warning (tmp);
       tmp = gfc_add_field_to_struct_1 (vec_type, get_identifier ("u"),
 				       union_type, &chain);
-      TREE_NO_WARNING (tmp) = 1;
+      suppress_warning (tmp);
       gfc_finish_type (vec_type);
       TYPE_NAME (vec_type) = get_identifier ("caf_vector_t");
     }
@@ -3587,11 +3587,11 @@ gfc_get_caf_reference_type ()
   tmp = gfc_add_field_to_struct_1 (c_struct_type,
 				   get_identifier ("offset"),
 				   gfc_array_index_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (c_struct_type,
 				   get_identifier ("caf_token_offset"),
 				   gfc_array_index_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   gfc_finish_type (c_struct_type);
 
   chain = 0;
@@ -3599,15 +3599,15 @@ gfc_get_caf_reference_type ()
   tmp = gfc_add_field_to_struct_1 (s_struct_type,
 				   get_identifier ("start"),
 				   gfc_array_index_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (s_struct_type,
 				   get_identifier ("end"),
 				   gfc_array_index_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (s_struct_type,
 				   get_identifier ("stride"),
 				   gfc_array_index_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   gfc_finish_type (s_struct_type);
 
   chain = 0;
@@ -3615,25 +3615,25 @@ gfc_get_caf_reference_type ()
   tmp = gfc_add_field_to_struct_1 (v_struct_type,
 				   get_identifier ("vector"),
 				   pvoid_type_node, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (v_struct_type,
 				   get_identifier ("nvec"),
 				   size_type_node, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (v_struct_type,
 				   get_identifier ("kind"),
 				   integer_type_node, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   gfc_finish_type (v_struct_type);
 
   chain = 0;
   union_type = make_node (UNION_TYPE);
   tmp = gfc_add_field_to_struct_1 (union_type, get_identifier ("s"),
 				   s_struct_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (union_type, get_identifier ("v"),
 				   v_struct_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   gfc_finish_type (union_type);
 
   tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node,
@@ -3648,40 +3648,40 @@ gfc_get_caf_reference_type ()
 						    gfc_index_zero_node,
 					 gfc_rank_cst[GFC_MAX_DIMENSIONS - 1])),
 		&chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (a_struct_type,
 				   get_identifier ("static_array_type"),
 				   integer_type_node, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (a_struct_type, get_identifier ("dim"),
 				   dim_union_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   gfc_finish_type (a_struct_type);
 
   chain = 0;
   u_union_type = make_node (UNION_TYPE);
   tmp = gfc_add_field_to_struct_1 (u_union_type, get_identifier ("c"),
 				   c_struct_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (u_union_type, get_identifier ("a"),
 				   a_struct_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   gfc_finish_type (u_union_type);
 
   chain = 0;
   reference_type = make_node (RECORD_TYPE);
   tmp = gfc_add_field_to_struct_1 (reference_type, get_identifier ("next"),
 				   build_pointer_type (reference_type), &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (reference_type, get_identifier ("type"),
 				   integer_type_node, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (reference_type, get_identifier ("item_size"),
 				   size_type_node, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (reference_type, get_identifier ("u"),
 				   u_union_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   gfc_finish_type (reference_type);
   TYPE_NAME (reference_type) = get_identifier ("caf_reference_t");
 
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 3ffa394d406..6db02bcdf24 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -129,7 +129,7 @@ gfc_create_var_np (tree type, const char *prefix)
 
   /* No warnings for anonymous variables.  */
   if (prefix == NULL)
-    TREE_NO_WARNING (t) = 1;
+    suppress_warning (t);
 
   return t;
 }