===================================================================
@@ -2972,14 +2972,20 @@
--
-- This variable is updated as a side effect of function Get_Value.
+ Box_Node : Node_Id;
Is_Box_Present : Boolean := False;
- Others_Box : Boolean := False;
+ Others_Box : Integer := 0;
+
-- Ada 2005 (AI-287): Variables used in case of default initialization
-- to provide a functionality similar to Others_Etype. Box_Present
-- indicates that the component takes its default initialization;
- -- Others_Box indicates that at least one component takes its default
- -- initialization. Similar to Others_Etype, they are also updated as a
+ -- Others_Box counts the number of components of the current aggregate
+ -- (which may be a sub-aggregate of a larger one) that are default-
+ -- initialized. A value of One indicates that an others_box is present.
+ -- Any larger value indicates that the others_box is not redundant.
+ -- These variables, similar to Others_Etype, are also updated as a
-- side effect of function Get_Value.
+ -- Box_Node is used to place a warning on a redundant others_box.
procedure Add_Association
(Component : Entity_Id;
@@ -3231,7 +3237,7 @@
-- checks when the default includes function calls.
if Box_Present (Assoc) then
- Others_Box := True;
+ Others_Box := Others_Box + 1;
Is_Box_Present := True;
if Expander_Active then
@@ -3704,7 +3710,8 @@
-- any component.
elsif Box_Present (Assoc) then
- Others_Box := True;
+ Others_Box := 1;
+ Box_Node := Assoc;
end if;
else
@@ -4439,7 +4446,8 @@
Comp_Elmt := First_Elmt (Components);
while Present (Comp_Elmt) loop
- if Ekind (Node (Comp_Elmt)) /= E_Discriminant
+ if
+ Ekind (Node (Comp_Elmt)) /= E_Discriminant
then
Process_Component (Node (Comp_Elmt));
end if;
@@ -4585,9 +4593,14 @@
-- Ada 2005 (AI-287): others choice may have expression or box
- if No (Others_Etype) and then not Others_Box then
+ if No (Others_Etype) and then Others_Box = 0 then
Error_Msg_N
("OTHERS must represent at least one component", Selectr);
+
+ elsif Others_Box = 1 and then Warn_On_Redundant_Constructs then
+ Error_Msg_N ("others choice is redundant?", Box_Node);
+ Error_Msg_N ("\previous choices cover all components?",
+ Box_Node);
end if;
exit Verification;
This patch adds a warning on a record aggregate that includes an association with a box, when all other components of the record have explicit associations in the aggregate. Compiling: gcc -c -gnatwr question.ads must yield: question.ads:13:53: warning: others choice is redundant question.ads:13:53: warning: previous choices cover all components question.ads:14:57: warning: others choice is redundant question.ads:14:57: warning: previous choices cover all components question.ads:14:72: warning: others choice is redundant question.ads:14:72: warning: previous choices cover all components question.ads:19:12: warning: "others" choice is redundant question.ads:19:12: warning: previous choices cover all values --- package Question is type Mon_Enum_T is (A, B); type Mon_Record_T is record Mon_Enum : Mon_Enum_T; end record; type nested is record this : Mon_Record_T; end record; Mon_Record : Mon_Record_T := (Mon_Enum=>A,others=><>); My_Nest : Nested := (THis => (Mon_Enum => A, others => <>), others => <>); function Ma_Fonction(Mon_Enum : in Mon_Enum_T) return Boolean is ((case Mon_Enum is when A | B => True, when others => False)); --line 14 end Question; Tested on x86_64-pc-linux-gnu, committed on trunk 2016-04-18 Ed Schonberg <schonberg@adacore.com> * sem_aggr.adb (Resolve_Record_Aggregate): If Warn_On_Redundant_Constructs is enabled, report a redundant box association that does not cover any components, as it done for redundant others associations in case statements.