From: Bob Duff <duff@adacore.com>
Date: Wed, 16 Jun 2021 10:47:57 +0000 (-0400)
Subject: [Ada] Duplicate Size/Value_Size clause
X-Git-Tag: upstream/12.2.0~6450
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=9b89dabfd851f0ee0e9f0c6e141f8e3fba08d1d7;p=platform%2Fupstream%2Fgcc.git

[Ada] Duplicate Size/Value_Size clause

gcc/ada/

	* sem_ch13.adb (Duplicate_Clause): Add a helper routine
	Check_One_Attr, with a parameter for the attribute_designator we
	are looking for, and one for the attribute_designator of the
	current node (which are usually the same). For Size and
	Value_Size, call it twice, once for each.
	* errout.ads: Fix a typo.
---

diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index b0cbd82..9b2e08d 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -279,7 +279,7 @@ package Errout is
    --      The character ? appearing anywhere in a message makes the message
    --      warning instead of a normal error message, and the text of the
    --      message will be preceded by "warning:" in the normal case. The
-   --      handling of warnings if further controlled by the Warning_Mode
+   --      handling of warnings is further controlled by the Warning_Mode
    --      option (-w switch), see package Opt for further details, and also by
    --      the current setting from pragma Warnings. This pragma applies only
    --      to warnings issued from the semantic phase (not the parser), but
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index f0962ca0..91d41b4 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -5181,7 +5181,9 @@ package body Sem_Ch13 is
       --  This routine checks if the aspect for U_Ent being given by attribute
       --  definition clause N is for an aspect that has already been specified,
       --  and if so gives an error message. If there is a duplicate, True is
-      --  returned, otherwise if there is no error, False is returned.
+      --  returned, otherwise there is no error, and False is returned. Size
+      --  and Value_Size are considered to conflict, but for compatibility,
+      --  this is merely a warning.
 
       procedure Check_Indexing_Functions;
       --  Check that the function in Constant_Indexing or Variable_Indexing
@@ -6007,7 +6009,47 @@ package body Sem_Ch13 is
       ----------------------
 
       function Duplicate_Clause return Boolean is
-         A : Node_Id;
+
+         function Check_One_Attr (Attr_1, Attr_2 : Name_Id) return Boolean;
+         --  Check for one attribute; Attr_1 is the attribute_designator we are
+         --  looking for. Attr_2 is the attribute_designator of the current
+         --  node. Normally, this is called just once by Duplicate_Clause, with
+         --  Attr_1 = Attr_2. However, it needs to be called twice for Size and
+         --  Value_Size, because these mean the same thing. For compatibility,
+         --  we allow specifying both Size and Value_Size, but only if the two
+         --  sizes are equal.
+
+         --------------------
+         -- Check_One_Attr --
+         --------------------
+
+         function Check_One_Attr (Attr_1, Attr_2 : Name_Id) return Boolean is
+            A : constant Node_Id :=
+              Get_Rep_Item (U_Ent, Attr_1, Check_Parents => False);
+         begin
+            if Present (A) then
+               if Attr_1 = Attr_2 then
+                  Error_Msg_Name_1 := Attr_1;
+                  Error_Msg_Sloc := Sloc (A);
+                  Error_Msg_NE ("aspect% for & previously given#", N, U_Ent);
+
+               else
+                  pragma Assert (Attr_1 in Name_Size | Name_Value_Size);
+                  pragma Assert (Attr_2 in Name_Size | Name_Value_Size);
+
+                  Error_Msg_Name_1 := Attr_2;
+                  Error_Msg_Name_2 := Attr_1;
+                  Error_Msg_Sloc := Sloc (A);
+                  Error_Msg_NE ("?% for & conflicts with % #", N, U_Ent);
+               end if;
+
+               return True;
+            end if;
+
+            return False;
+         end Check_One_Attr;
+
+      --  Start of processing for Duplicate_Clause
 
       begin
          --  Nothing to do if this attribute definition clause comes from
@@ -6019,21 +6061,20 @@ package body Sem_Ch13 is
             return False;
          end if;
 
-         --  Otherwise current clause may duplicate previous clause, or a
-         --  previously given pragma or aspect specification for the same
-         --  aspect.
-
-         A := Get_Rep_Item (U_Ent, Chars (N), Check_Parents => False);
+         --  Special cases for Size and Value_Size
 
-         if Present (A) then
-            Error_Msg_Name_1 := Chars (N);
-            Error_Msg_Sloc := Sloc (A);
-
-            Error_Msg_NE ("aspect% for & previously given#", N, U_Ent);
+         if (Chars (N) = Name_Size
+               and then Check_One_Attr (Name_Value_Size, Name_Size))
+           or else
+            (Chars (N) = Name_Value_Size
+               and then Check_One_Attr (Name_Size, Name_Value_Size))
+         then
             return True;
          end if;
 
-         return False;
+         --  Normal case (including Size and Value_Size)
+
+         return Check_One_Attr (Chars (N), Chars (N));
       end Duplicate_Clause;
 
    --  Start of processing for Analyze_Attribute_Definition_Clause