From 9b89dabfd851f0ee0e9f0c6e141f8e3fba08d1d7 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Wed, 16 Jun 2021 06:47:57 -0400 Subject: [PATCH] [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. --- gcc/ada/errout.ads | 2 +- gcc/ada/sem_ch13.adb | 67 +++++++++++++++++++++++++++++++++++--------- 2 files changed, 55 insertions(+), 14 deletions(-) diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index b0cbd828e47f..9b2e08d65e7c 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 f0962ca0e247..91d41b4a63ba 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 -- 2.43.5