[Ada] AI12-0001: Independence and Representation clauses for atomic objects

2019-12-16  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* gcc-interface/decl.c (gnat_to_gnu_entity): Adjust calls to
	validate_size.
	(gnat_to_gnu_component_type): Likewise.
	(gnat_to_gnu_field): Likewise and pass string for error messages.
	(components_need_strict_alignment): Remove test on Is_Aliased and
	add test for the independence of the component.
	(validate_size): Add S1 and S2 string parameters and use them to
	give better error messages for fields.  Tweak a couple of messages.
	* einfo.ads (Has_Independent_Components): Document more cases.
	(Is_Independent): Likewise.
	(Strict_Alignment): Document new semantics.
	* exp_ch9.adb (Install_Private_Data_Declarations): Also set the
	Is_Independent flag along with Is_Aliased on the renaming
	entity.
	* freeze.adb (Size_Known): Remove always-false test and add test
	for the strict-alignment on the record type.  Remove redundant
	tests and add test for the strict-alignment on the component
	type.
	(Check_Strict_Alignment): Set the flag if the type is by-ref and
	remove now redundant conditions.  Set the flag on an array type
	if it has aliased components.  In the record type case, do not
	set type for C_Pass_By_Copy convention.
	(Freeze_Array_Type): Move code checking for conflicts between
	representation aspects and clauses to before specific handling
	of packed array types. Give a warnind instead of an error for a
	conflict with pragma Pack.  Do not test Has_Pragma_Pack for the
	specific handling of packed array types.
	(Freeze_Record_Type): Move error checking of representation
	clause to...
	(Freeze_Entity): ...here after Check_Strict_Alignment is called.
	* sem_aggr.adb (Array_Aggr_Subtype): Also set the Is_Independent
	flag along with Is_Aliased on the Itype.
	* sem_ch13.adb (Check_Record_Representation_Clause): Do not set
	the RM size for a strict-alignment type.
	* sem_ch3.adb (Add_Interface_Tag_Components): Also set the
	Is_Independent flag along with Is_Aliased on the tag.
	(Add_Interface_Tag_Components): Likewise on the offset.
	(Analyze_Component_Declaration): Likewise on the component.
	(Analyze_Object_Declaration): Likewise on the object.
	(Constrain_Array): Likewise on the array.
	(Record_Type_Declaration: Likewise on the tag.
	(Array_Type_Declaration): Also set the
	Has_Independent_Components flag along with
	Has_Aliased_Components on the array.
	(Copy_Array_Base_Type_Attributes): Copy
	Has_Independent_Components.
	(Copy_Array_Subtype_Attributes): Copy Is_Atomic, Is_Independent
	and Is_Volatile_Full_Access.
	(Analyze_Iterator_Specification): Set Is_Independent on the loop
	variable according to Independent_Components on the array.
	* sem_ch5.adb: Likewise.
	* sem_ch6.adb (Process_Formals): Also set the Is_Independent
	flag along with Is_Aliased on the formal.

gcc/testsuite/

	* gnat.dg/specs/clause_on_volatile.ads,
	gnat.dg/specs/size_clause3.ads: Update expected diagnostics.

From-SVN: r279430

1 files changed, 59 insertions, 43 deletions

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index b83f38c..57d1631 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -233,7 +233,8 @@ static vec<subst_pair> build_subst_list (Entity_Id, Entity_Id, bool);
 static vec<variant_desc> build_variant_list (tree, vec<subst_pair>,
 					     vec<variant_desc>);
 static tree maybe_saturate_size (tree);
-static tree validate_size (Uint, tree, Entity_Id, enum tree_code, bool, bool);
+static tree validate_size (Uint, tree, Entity_Id, enum tree_code, bool, bool,
+			   const char *, const char *);
 static void set_rm_size (Uint, tree, Entity_Id);
 static unsigned int validate_alignment (Uint, Entity_Id, unsigned int);
 static unsigned int promote_object_alignment (tree, Entity_Id);
@@ -780,7 +781,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 	if (Known_Esize (gnat_entity))
 	  gnu_size
 	    = validate_size (Esize (gnat_entity), gnu_type, gnat_entity,
-			     VAR_DECL, false, Has_Size_Clause (gnat_entity));
+			     VAR_DECL, false, Has_Size_Clause (gnat_entity),
+			     NULL, NULL);
 	if (gnu_size)
 	  {
 	    gnu_type
@@ -4243,7 +4245,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 			   ? Esize (gnat_entity) : RM_Size (gnat_entity);
 	  gnu_size
 	    = validate_size (gnat_size, gnu_type, gnat_entity, TYPE_DECL,
-			     false, Has_Size_Clause (gnat_entity));
+			     false, Has_Size_Clause (gnat_entity), NULL, NULL);
 	}
 
       /* If a size was specified, see if we can make a new type of that size
@@ -5090,8 +5092,8 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition,
   /* Get and validate any specified Component_Size.  */
   gnu_comp_size
     = validate_size (Component_Size (gnat_array), gnu_type, gnat_array,
-		     has_packed_components ? TYPE_DECL : VAR_DECL,
-		     true, Has_Component_Size_Clause (gnat_array));
+		     has_packed_components ? TYPE_DECL : VAR_DECL, true,
+		     Has_Component_Size_Clause (gnat_array), NULL, NULL);
 
   /* If the component type is a RECORD_TYPE that has a self-referential size,
      then use the maximum size for the component size.  */
@@ -6999,6 +7001,8 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
   const Node_Id gnat_clause = Component_Clause (gnat_field);
   const Entity_Id gnat_record_type = Underlying_Type (Scope (gnat_field));
   const Entity_Id gnat_field_type = Etype (gnat_field);
+  tree gnu_field_type = gnat_to_gnu_type (gnat_field_type);
+  tree gnu_field_id = get_entity_name (gnat_field);
   const bool is_atomic
     = (Is_Atomic_Or_VFA (gnat_field) || Is_Atomic_Or_VFA (gnat_field_type));
   const bool is_aliased = Is_Aliased (gnat_field);
@@ -7006,6 +7010,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
     = (Is_Independent (gnat_field) || Is_Independent (gnat_field_type));
   const bool is_volatile
     = (Treat_As_Volatile (gnat_field) || Treat_As_Volatile (gnat_field_type));
+  const bool is_by_ref = TYPE_IS_BY_REFERENCE_P (gnu_field_type);
   const bool is_strict_alignment = Strict_Alignment (gnat_field_type);
   /* We used to consider that volatile fields also require strict alignment,
      but that was an interpolation and would cause us to reject a pragma
@@ -7014,16 +7019,36 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
      involve load-modify-store sequences, but that's OK for volatile.  The
      only constraint is the implementation advice whereby only the bits of
      the components should be accessed if they both start and end on byte
-     boundaries, but that should be guaranteed by the GCC memory model.  */
-  const bool needs_strict_alignment
-    = (is_atomic || is_aliased || is_independent || is_strict_alignment);
-  bool is_bitfield;
-  tree gnu_field_type = gnat_to_gnu_type (gnat_field_type);
-  tree gnu_field_id = get_entity_name (gnat_field);
+     boundaries, but that should be guaranteed by the GCC memory model.
+     Note that we have some redundancies (is_atomic => is_independent,
+     is_aliased => is_independent and is_by_ref => is_strict_alignment)
+     so the following formula is sufficient.  */
+  const bool needs_strict_alignment = (is_independent || is_strict_alignment);
+  const char *field_s, *size_s;
   tree gnu_field, gnu_size, gnu_pos;
+  bool is_bitfield;
+
+  /* The qualifier to be used in messages.  */
+  if (is_atomic)
+    field_s = "atomic&";
+  else if (is_aliased)
+    field_s = "aliased&";
+  else if (is_independent)
+    field_s = "independent&";
+  else if (is_by_ref)
+    field_s = "& with by-reference type";
+  else if (is_strict_alignment)
+    field_s = "& with aliased part";
+  else
+    field_s = "&";
 
-  /* If this field requires strict alignment, we cannot pack it because
-     it would very likely be under-aligned in the record.  */
+  /* The message to be used for incompatible size.  */
+  if (is_atomic || is_aliased)
+    size_s = "size for %s must be ^";
+  else if (field_s)
+    size_s = "size for %s too small{, minimum allowed is ^}";
+
+  /* If a field requires strict alignment, we cannot pack it (RM 13.2(7)).  */
   if (needs_strict_alignment)
     packed = 0;
   else
@@ -7034,7 +7059,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
      for further details.  */
   if (Present (gnat_clause) || Known_Esize (gnat_field))
     gnu_size = validate_size (Esize (gnat_field), gnu_field_type, gnat_field,
-			      FIELD_DECL, false, true);
+			      FIELD_DECL, false, true, size_s, field_s);
   else if (packed == 1)
     {
       gnu_size = rm_size (gnu_field_type);
@@ -7152,23 +7177,11 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
 	  && !(type_annotate_only && Is_Tagged_Type (gnat_field_type)))
 	{
 	  const unsigned int type_align = TYPE_ALIGN (gnu_field_type);
-	  const char *field_s;
 
 	  if (TYPE_ALIGN (gnu_record_type)
 	      && TYPE_ALIGN (gnu_record_type) < type_align)
 	    SET_TYPE_ALIGN (gnu_record_type, type_align);
 
-	  if (is_atomic)
-	    field_s = "atomic &";
-	  else if (is_aliased)
-	    field_s = "aliased &";
-	  else if (is_independent)
-	    field_s = "independent &";
-	  else if (is_strict_alignment)
-	    field_s = "& with aliased or tagged part";
-	  else
-	    gcc_unreachable ();
-
 	  /* If the position is not a multiple of the storage unit, then error
 	     out and reset the position.  */
 	  if (!integer_zerop (size_binop (TRUNC_MOD_EXPR, gnu_pos,
@@ -7221,11 +7234,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
 		       || (cmp > 0 && (is_atomic || is_aliased)))
 		{
 		  char s[128];
-		  if (is_atomic || is_aliased)
-		    snprintf (s, sizeof (s), "size for %s must be ^", field_s);
-		  else
-  		    snprintf (s, sizeof (s), "size for %s must be at least ^",
-			      field_s);
+		  snprintf (s, sizeof (s), size_s, field_s);
 		  post_error_ne_tree (s, Last_Bit (gnat_clause), gnat_field,
 				      type_size);
 		  gnu_size = NULL_TREE;
@@ -7362,7 +7371,7 @@ components_need_strict_alignment (Node_Id component_list)
     {
       Entity_Id gnat_field = Defining_Entity (component_decl);
 
-      if (Is_Aliased (gnat_field))
+      if (Is_Independent (gnat_field) || Is_Independent (Etype (gnat_field)))
 	return true;
 
       if (Strict_Alignment (Etype (gnat_field)))
@@ -8838,11 +8847,12 @@ maybe_saturate_size (tree size)
    true if we are being called to process the Component_Size of GNAT_OBJECT;
    this is used only for error messages.  ZERO_OK is true if a size of zero
    is permitted; if ZERO_OK is false, it means that a size of zero should be
-   treated as an unspecified size.  */
+   treated as an unspecified size.  S1 and S2 are used for error messages.  */
 
 static tree
 validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
-	       enum tree_code kind, bool component_p, bool zero_ok)
+	       enum tree_code kind, bool component_p, bool zero_ok,
+	       const char *s1, const char *s2)
 {
   Node_Id gnat_error_node;
   tree old_size, size;
@@ -8888,10 +8898,10 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
       && !integer_zerop (size_binop (TRUNC_MOD_EXPR, size, bitsize_unit_node)))
     {
       if (component_p)
-	post_error_ne ("component size for& is not a multiple of Storage_Unit",
+	post_error_ne ("component size for& must be multiple of Storage_Unit",
 		       gnat_error_node, gnat_object);
       else
-	post_error_ne ("size for& is not a multiple of Storage_Unit",
+	post_error_ne ("size for& must be multiple of Storage_Unit",
 		       gnat_error_node, gnat_object);
       return NULL_TREE;
     }
@@ -8932,14 +8942,20 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
       || TREE_OVERFLOW (old_size)
       || tree_int_cst_lt (size, old_size))
     {
-      if (component_p)
-	post_error_ne_tree
-	  ("component size for& too small{, minimum allowed is ^}",
-	   gnat_error_node, gnat_object, old_size);
+      char buf[128];
+      const char *s;
+
+      if (kind == FIELD_DECL)
+	{
+	  snprintf (buf, sizeof (buf), s1, s2);
+	  s = buf;
+	}
+      else if (component_p)
+	s = "component size for& too small{, minimum allowed is ^}";
       else
-	post_error_ne_tree
-	  ("size for& too small{, minimum allowed is ^}",
-	   gnat_error_node, gnat_object, old_size);
+	s = "size for& too small{, minimum allowed is ^}";
+      post_error_ne_tree (s, gnat_error_node, gnat_object, old_size);
+
       return NULL_TREE;
     }