aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorBob Duff <duff@adacore.com>2021-06-16 06:47:57 -0400
committerPierre-Marie de Rodat <derodat@adacore.com>2021-07-12 12:50:56 +0000
commit9b89dabfd851f0ee0e9f0c6e141f8e3fba08d1d7 (patch)
treecc0bb6341b5a75cb860101712c5a0a169b57945a /gcc/ada
parent86b228b87b64ffa6991fce0dc188985d7a9a173a (diff)
downloadgcc-9b89dabfd851f0ee0e9f0c6e141f8e3fba08d1d7.zip
gcc-9b89dabfd851f0ee0e9f0c6e141f8e3fba08d1d7.tar.gz
gcc-9b89dabfd851f0ee0e9f0c6e141f8e3fba08d1d7.tar.bz2
[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.
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/errout.ads2
-rw-r--r--gcc/ada/sem_ch13.adb67
2 files changed, 55 insertions, 14 deletions
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