From 9cb62ce3c795fe9991d20a294a53c1bbeadf2751 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 4 Oct 2012 11:23:38 +0200 Subject: [PATCH] [multiple changes] 2012-10-04 Robert Dewar * sem_res.adb (Resolve_Set_Membership): Warn on duplicates. 2012-10-04 Emmanuel Briot * g-comlin.adb (Getopt): Fix value of Full_Switch returned in case of invalid switch. 2012-10-04 Arnaud Charlet * gcc-interface/Make-lang.in: Update dependencies. From-SVN: r192073 --- gcc/ada/ChangeLog | 13 +++ gcc/ada/g-comlin.adb | 127 ++++++++++++++------- gcc/ada/gcc-interface/Make-lang.in | 173 +++++++++++++++-------------- gcc/ada/sem_res.adb | 47 +++++++- 4 files changed, 229 insertions(+), 131 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ac7e2858667..8196e94e8ad 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2012-10-04 Robert Dewar + + * sem_res.adb (Resolve_Set_Membership): Warn on duplicates. + +2012-10-04 Emmanuel Briot + + * g-comlin.adb (Getopt): Fix value of Full_Switch returned in case of + invalid switch. + +2012-10-04 Arnaud Charlet + + * gcc-interface/Make-lang.in: Update dependencies. + 2012-10-04 Robert Dewar * sem_eval.adb (Fold_Str, Fold_Uint, Fold_Ureal): Reset static diff --git a/gcc/ada/g-comlin.adb b/gcc/ada/g-comlin.adb index 723ff120ff6..f11846fbb79 100644 --- a/gcc/ada/g-comlin.adb +++ b/gcc/ada/g-comlin.adb @@ -39,6 +39,10 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; package body GNAT.Command_Line is + -- General note: this entire body could use much more commenting. There + -- are large sections of uncommented code throughout, and many formal + -- parameters of local subprograms are not documented at all ??? + package CL renames Ada.Command_Line; type Switch_Parameter_Type is @@ -56,6 +60,12 @@ package body GNAT.Command_Line is Extra : Character := ASCII.NUL); pragma Inline (Set_Parameter); -- Set the parameter that will be returned by Parameter below + -- + -- Extra is a character that needs to be added when reporting Full_Switch. + -- (it will in general be the switch character, for instance '-'). + -- Otherwise, Full_Switch will report 'f' instead of '-f'. In particular, + -- it needs to be set when reporting an invalid switch or handling '*'. + -- -- Parameters need to be defined ??? function Goto_Next_Argument_In_Section (Parser : Opt_Parser) return Boolean; @@ -95,9 +105,9 @@ package body GNAT.Command_Line is Index_In_Switches : out Integer; Switch_Length : out Integer; Param : out Switch_Parameter_Type); - -- Return the Longest switch from Switches that at least partially - -- partially Arg. Index_In_Switches is set to 0 if none matches. - -- What are other parameters??? in particular Param is not always set??? + -- Return the Longest switch from Switches that at least partially matches + -- Arg. Index_In_Switches is set to 0 if none matches. What are other + -- parameters??? in particular Param is not always set??? procedure Unchecked_Free is new Ada.Unchecked_Deallocation (Argument_List, Argument_List_Access); @@ -663,17 +673,45 @@ package body GNAT.Command_Line is if Index_Switches = 0 then - -- Depending on the value of Concatenate, the full switch is - -- a single character or the rest of the argument. + -- Find the current switch that we did not recognize. This is in + -- fact difficult because Getopt does not know explicitly about + -- short and long switches. Ideally, we would want the following + -- behavior: - End_Index := - (if Concatenate then Parser.Current_Index else Arg'Last); + -- * for short switches, with Concatenate: + -- if -a is not recognized, and the command line has -daf + -- we should report the invalid switch as "-a". + + -- * for short switches, wihtout Concatenate: + -- we should report the invalid switch as "-daf". + + -- * for long switches: + -- if the commadn line is "--long" we should report --long + -- as unrecongized. + + -- Unfortunately, the fact that long switches start with a + -- duplicate switch character is just a convention (so we could + -- have a long switch "-long" for instance). We'll still rely on + -- this convention here to try and get as helpful an error message + -- as possible. + + -- Long switch case (starting with double switch character) + + if Arg (Arg'First + 1) = Parser.Switch_Character then + End_Index := Arg'Last; + + -- Short switch case + + else + End_Index := + (if Concatenate then Parser.Current_Index else Arg'Last); + end if; if Switches (Switches'First) = '*' then - -- Always prepend the switch character, so that users know that - -- this comes from a switch on the command line. This is - -- especially important when Concatenate is False, since + -- Always prepend the switch character, so that users know + -- that this comes from a switch on the command line. This + -- is especially important when Concatenate is False, since -- otherwise the current argument first character is lost. if Parser.Section (Parser.Current_Argument) = 0 then @@ -696,11 +734,21 @@ package body GNAT.Command_Line is end if; end if; - Set_Parameter - (Parser.The_Switch, - Arg_Num => Parser.Current_Argument, - First => Parser.Current_Index, - Last => End_Index); + if Parser.Current_Index = Arg'First then + Set_Parameter + (Parser.The_Switch, + Arg_Num => Parser.Current_Argument, + First => Parser.Current_Index, + Last => End_Index); + else + Set_Parameter + (Parser.The_Switch, + Arg_Num => Parser.Current_Argument, + First => Parser.Current_Index, + Last => End_Index, + Extra => Parser.Switch_Character); + end if; + Parser.Current_Index := End_Index + 1; raise Invalid_Switch; @@ -762,7 +810,7 @@ package body GNAT.Command_Line is raise Invalid_Parameter; end if; - -- If the switch is of the form xxx + -- Case of switch of the form xxx elsif Parser.Current_Argument < Parser.Arg_Count and then Parser.Section (Parser.Current_Argument + 1) /= 0 @@ -830,7 +878,8 @@ package body GNAT.Command_Line is (Parser.The_Switch, Arg_Num => Parser.Current_Argument, First => Parser.Current_Index, - Last => Arg'Last); + Last => Arg'Last, + Extra => Parser.Switch_Character); Parser.Current_Index := Arg'Last + 1; raise Invalid_Switch; end if; @@ -1170,9 +1219,7 @@ package body GNAT.Command_Line is procedure Unchecked_Free is new Ada.Unchecked_Deallocation (Opt_Parser_Data, Opt_Parser); begin - if Parser /= null - and then Parser /= Command_Line_Parser - then + if Parser /= null and then Parser /= Command_Line_Parser then Free (Parser.Arguments); Unchecked_Free (Parser); end if; @@ -1189,6 +1236,7 @@ package body GNAT.Command_Line is Section : String := "") is Def : Alias_Definition; + begin if Config = null then Config := new Command_Line_Configuration_Record; @@ -1255,8 +1303,9 @@ package body GNAT.Command_Line is -- Add -- --------- - procedure Add (Def : in out Alias_Definitions_List; - Alias : Alias_Definition) + procedure Add + (Def : in out Alias_Definitions_List; + Alias : Alias_Definition) is procedure Unchecked_Free is new Ada.Unchecked_Deallocation @@ -1511,7 +1560,7 @@ package body GNAT.Command_Line is Foreach (Config, Section => Section); - -- Adding relevant aliases + -- Add relevant aliases if Config.Aliases /= null then for A in Config.Aliases'Range loop @@ -1585,8 +1634,8 @@ package body GNAT.Command_Line is function Real_Full_Switch (S : Character; Parser : Opt_Parser) return String; - -- Ensure that the returned switch value contains the - -- Switch_Char prefix if needed. + -- Ensure that the returned switch value contains the Switch_Char prefix + -- if needed. ---------------------- -- Real_Full_Switch -- @@ -2465,13 +2514,12 @@ package body GNAT.Command_Line is ((Cmd.Params (C) = null and then Param = "") or else (Cmd.Params (C) /= null - and then - -- Ignore the separator stored in Parameter + -- Ignore the separator stored in Parameter + and then Cmd.Params (C) (Cmd.Params (C)'First + 1 - .. Cmd.Params (C)'Last) = - Param)) + .. Cmd.Params (C)'Last) = Param)) then Remove (Cmd.Expanded, C); Remove (Cmd.Params, C); @@ -2550,9 +2598,7 @@ package body GNAT.Command_Line is -- Start of processing for Group_Switches begin - if Cmd.Config = null - or else Cmd.Config.Prefixes = null - then + if Cmd.Config = null or else Cmd.Config.Prefixes = null then return; end if; @@ -2638,10 +2684,9 @@ package body GNAT.Command_Line is First : Natural; procedure Check_Cb (Switch, Separator, Param : String; Index : Integer); - -- Checks whether the command line contains [Switch]. - -- Sets the global variable [Found] appropriately. - -- This will be called for each simple switch that make up an alias, to - -- know whether the alias should be applied. + -- Checks whether the command line contains [Switch]. Sets the global + -- variable [Found] appropriately. This is called for each simple switch + -- that make up an alias, to know whether the alias should be applied. procedure Remove_Cb (Switch, Separator, Param : String; Index : Integer); -- Remove the simple switch [Switch] from the command line, since it is @@ -2708,9 +2753,7 @@ package body GNAT.Command_Line is -- Start of processing for Alias_Switches begin - if Cmd.Config = null - or else Cmd.Config.Aliases = null - then + if Cmd.Config = null or else Cmd.Config.Aliases = null then return; end if; @@ -3079,7 +3122,7 @@ package body GNAT.Command_Line is procedure Display_Help (Config : Command_Line_Configuration) is function Switch_Name - (Def : Switch_Definition; + (Def : Switch_Definition; Section : String) return String; -- Return the "-short, --long=ARG" string for Def. -- Returns "" if the switch is not in the section. @@ -3194,7 +3237,7 @@ package body GNAT.Command_Line is ----------------- function Switch_Name - (Def : Switch_Definition; + (Def : Switch_Definition; Section : String) return String is use Ada.Strings.Unbounded; @@ -3488,7 +3531,7 @@ package body GNAT.Command_Line is Put_Line (Standard_Error, Base_Name (Ada.Command_Line.Command_Name) & ": unrecognized option '" - & Parser.Switch_Character & Full_Switch (Parser) + & Full_Switch (Parser) & "'"); Put_Line (Standard_Error, "Try `" diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index 5dcb935aabf..60637c9bb1d 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -1259,31 +1259,31 @@ ada/checks.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/eval_fat.ads ada/exp_aggr.ads ada/exp_ch11.ads ada/exp_ch2.ads \ ada/exp_ch4.ads ada/exp_ch6.ads ada/exp_ch7.ads ada/exp_disp.ads \ ada/exp_dist.ads ada/exp_pakd.ads ada/exp_tss.ads ada/exp_util.ads \ - ada/exp_util.adb ada/fname.ads ada/fname-uf.ads ada/freeze.ads \ - ada/get_targ.ads ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads \ - ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads ada/itypes.ads \ - ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \ - ada/lib-sort.adb ada/lib-util.ads ada/lib-xref.ads ada/namet.ads \ - ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \ - ada/opt.adb ada/output.ads ada/put_alfa.ads ada/restrict.ads \ - ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/rtsfind.adb \ - ada/scans.ads ada/sem.ads ada/sem_attr.ads ada/sem_aux.ads \ - ada/sem_cat.ads ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch7.ads \ - ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads ada/sem_eval.ads \ - ada/sem_eval.adb ada/sem_prag.ads ada/sem_res.ads ada/sem_type.ads \ - ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads \ - ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/sprint.ads \ - ada/stand.ads ada/stringt.ads ada/style.ads ada/styleg.ads \ - ada/styleg.adb ada/stylesw.ads ada/system.ads ada/s-exctab.ads \ - ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \ - ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \ - ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \ - ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \ - ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \ - ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \ - ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \ - ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/validsw.ads \ - ada/widechar.ads + ada/exp_util.adb ada/expander.ads ada/fname.ads ada/fname-uf.ads \ + ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-hesorg.ads \ + ada/g-htable.ads ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads \ + ada/itypes.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \ + ada/lib-load.ads ada/lib-sort.adb ada/lib-util.ads ada/lib-xref.ads \ + ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \ + ada/opt.ads ada/opt.adb ada/output.ads ada/put_alfa.ads \ + ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \ + ada/rtsfind.adb ada/scans.ads ada/sem.ads ada/sem_attr.ads \ + ada/sem_aux.ads ada/sem_cat.ads ada/sem_ch3.ads ada/sem_ch6.ads \ + ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads \ + ada/sem_eval.ads ada/sem_eval.adb ada/sem_prag.ads ada/sem_res.ads \ + ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \ + ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads \ + ada/sprint.ads ada/stand.ads ada/stringt.ads ada/style.ads \ + ada/styleg.ads ada/styleg.adb ada/stylesw.ads ada/system.ads \ + ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \ + ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \ + ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ + ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \ + ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \ + ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \ + ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \ + ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \ + ada/validsw.ads ada/widechar.ads ada/comperr.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \ @@ -1642,28 +1642,28 @@ ada/exp_ch3.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/exp_ch4.ads ada/exp_ch6.ads ada/exp_ch7.ads ada/exp_ch9.ads \ ada/exp_dbug.ads ada/exp_disp.ads ada/exp_disp.adb ada/exp_dist.ads \ ada/exp_pakd.ads ada/exp_smem.ads ada/exp_strm.ads ada/exp_tss.ads \ - ada/exp_tss.adb ada/exp_util.ads ada/exp_util.adb ada/fname.ads \ - ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \ - ada/g-htable.ads ada/hostparm.ads ada/inline.ads ada/itypes.ads \ - ada/layout.ads ada/lib.ads ada/lib-load.ads ada/namet.ads \ - ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \ - ada/output.ads ada/restrict.ads ada/restrict.adb ada/rident.ads \ - ada/rtsfind.ads ada/rtsfind.adb ada/scil_ll.ads ada/sem.ads \ - ada/sem_attr.ads ada/sem_aux.ads ada/sem_aux.adb ada/sem_cat.ads \ - ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads \ - ada/sem_disp.ads ada/sem_dist.ads ada/sem_eval.ads ada/sem_mech.ads \ - ada/sem_prag.ads ada/sem_res.ads ada/sem_scil.ads ada/sem_type.ads \ - ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \ - ada/sinput.ads ada/snames.ads ada/sprint.ads ada/stand.ads \ - ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \ - ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \ - ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \ - ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \ - ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \ - ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \ - ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \ - ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \ - ada/urealp.ads ada/validsw.ads + ada/exp_tss.adb ada/exp_util.ads ada/exp_util.adb ada/expander.ads \ + ada/fname.ads ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads \ + ada/gnat.ads ada/g-htable.ads ada/hostparm.ads ada/inline.ads \ + ada/itypes.ads ada/layout.ads ada/lib.ads ada/lib-load.ads \ + ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \ + ada/opt.ads ada/output.ads ada/restrict.ads ada/restrict.adb \ + ada/rident.ads ada/rtsfind.ads ada/rtsfind.adb ada/scil_ll.ads \ + ada/sem.ads ada/sem_attr.ads ada/sem_aux.ads ada/sem_aux.adb \ + ada/sem_cat.ads ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch7.ads \ + ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads ada/sem_eval.ads \ + ada/sem_mech.ads ada/sem_prag.ads ada/sem_res.ads ada/sem_scil.ads \ + ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads \ + ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/sprint.ads \ + ada/stand.ads ada/stringt.ads ada/system.ads ada/s-exctab.ads \ + ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \ + ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \ + ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \ + ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \ + ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \ + ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \ + ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \ + ada/unchdeal.ads ada/urealp.ads ada/validsw.ads ada/exp_ch4.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \ @@ -1674,10 +1674,10 @@ ada/exp_ch4.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/exp_ch2.ads ada/exp_ch3.ads ada/exp_ch4.ads ada/exp_ch4.adb \ ada/exp_ch6.ads ada/exp_ch7.ads ada/exp_ch9.ads ada/exp_disp.ads \ ada/exp_fixd.ads ada/exp_intr.ads ada/exp_pakd.ads ada/exp_tss.ads \ - ada/exp_util.ads ada/exp_util.adb ada/exp_vfpt.ads ada/fname.ads \ - ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \ - ada/g-hesorg.ads ada/g-htable.ads ada/hostparm.ads ada/inline.ads \ - ada/itypes.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \ + ada/exp_util.ads ada/exp_util.adb ada/exp_vfpt.ads ada/expander.ads \ + ada/fname.ads ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads \ + ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads ada/hostparm.ads \ + ada/inline.ads ada/itypes.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \ ada/lib-sort.adb ada/lib-util.ads ada/lib-xref.ads ada/namet.ads \ ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \ ada/output.ads ada/par_sco.ads ada/put_alfa.ads ada/restrict.ads \ @@ -1708,28 +1708,28 @@ ada/exp_ch5.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/exp_aggr.ads ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch4.ads \ ada/exp_ch5.ads ada/exp_ch5.adb ada/exp_ch6.ads ada/exp_ch7.ads \ ada/exp_dbug.ads ada/exp_disp.ads ada/exp_pakd.ads ada/exp_tss.ads \ - ada/exp_util.ads ada/exp_util.adb ada/fname.ads ada/fname-uf.ads \ - ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \ - ada/hostparm.ads ada/inline.ads ada/itypes.ads ada/lib.ads \ - ada/lib-util.ads ada/lib-xref.ads ada/namet.ads ada/nlists.ads \ - ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \ - ada/put_alfa.ads ada/restrict.ads ada/restrict.adb ada/rident.ads \ - ada/rtsfind.ads ada/scans.ads ada/sem.ads ada/sem_attr.ads \ - ada/sem_aux.ads ada/sem_cat.ads ada/sem_ch13.ads ada/sem_ch3.ads \ - ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_disp.ads ada/sem_eval.ads \ - ada/sem_eval.adb ada/sem_prag.ads ada/sem_res.ads ada/sem_type.ads \ - ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads \ - ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/sprint.ads \ - ada/stand.ads ada/stringt.ads ada/stringt.adb ada/style.ads \ - ada/styleg.ads ada/styleg.adb ada/stylesw.ads ada/system.ads \ - ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \ - ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \ - ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ - ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \ - ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \ - ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \ - ada/types.ads ada/uintp.ads ada/uname.ads ada/unchconv.ads \ - ada/unchdeal.ads ada/urealp.ads ada/validsw.ads + ada/exp_util.ads ada/exp_util.adb ada/expander.ads ada/fname.ads \ + ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \ + ada/g-htable.ads ada/hostparm.ads ada/inline.ads ada/itypes.ads \ + ada/lib.ads ada/lib-util.ads ada/lib-xref.ads ada/namet.ads \ + ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \ + ada/output.ads ada/put_alfa.ads ada/restrict.ads ada/restrict.adb \ + ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/sem.ads \ + ada/sem_attr.ads ada/sem_aux.ads ada/sem_cat.ads ada/sem_ch13.ads \ + ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_disp.ads \ + ada/sem_eval.ads ada/sem_eval.adb ada/sem_prag.ads ada/sem_res.ads \ + ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \ + ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads \ + ada/sprint.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \ + ada/style.ads ada/styleg.ads ada/styleg.adb ada/stylesw.ads \ + ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \ + ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \ + ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \ + ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \ + ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \ + ada/targparm.ads ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads \ + ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uname.ads \ + ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads ada/exp_ch6.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \ @@ -2044,10 +2044,10 @@ ada/exp_pakd.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/exp_aggr.ads ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch4.ads \ ada/exp_ch6.ads ada/exp_ch7.ads ada/exp_dbug.ads ada/exp_pakd.ads \ ada/exp_pakd.adb ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb \ - ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \ - ada/hostparm.ads ada/inline.ads ada/itypes.ads ada/layout.ads \ - ada/lib.ads ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads \ - ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \ + ada/expander.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \ + ada/g-htable.ads ada/hostparm.ads ada/inline.ads ada/itypes.ads \ + ada/layout.ads ada/lib.ads ada/namet.ads ada/nlists.ads ada/nlists.adb \ + ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \ ada/rident.ads ada/rtsfind.ads ada/sem.ads ada/sem_aux.ads \ ada/sem_ch13.ads ada/sem_ch3.ads ada/sem_ch8.ads ada/sem_eval.ads \ ada/sem_prag.ads ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \ @@ -4179,15 +4179,16 @@ ada/switch-b.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/types.ads ada/unchconv.ads ada/unchdeal.ads ada/switch-c.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ - ada/a-uncdea.ads ada/alloc.ads ada/debug.ads ada/gnatvsn.ads \ - ada/hostparm.ads ada/lib.ads ada/namet.ads ada/opt.ads ada/osint.ads \ - ada/output.ads ada/stylesw.ads ada/switch.ads ada/switch-c.ads \ - ada/switch-c.adb ada/system.ads ada/s-exctab.ads ada/s-memory.ads \ - ada/s-os_lib.ads ada/s-parame.ads ada/s-soflin.ads ada/s-stache.ads \ - ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \ - ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \ - ada/table.adb ada/tree_io.ads ada/types.ads ada/unchconv.ads \ - ada/unchdeal.ads ada/validsw.ads ada/warnsw.ads + ada/a-uncdea.ads ada/alloc.ads ada/debug.ads ada/get_targ.ads \ + ada/gnatvsn.ads ada/hostparm.ads ada/lib.ads ada/namet.ads ada/opt.ads \ + ada/osint.ads ada/output.ads ada/stylesw.ads ada/switch.ads \ + ada/switch-c.ads ada/switch-c.adb ada/system.ads ada/s-exctab.ads \ + ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-soflin.ads \ + ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \ + ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \ + ada/table.ads ada/table.adb ada/tree_io.ads ada/ttypes.ads \ + ada/types.ads ada/unchconv.ads ada/unchdeal.ads ada/validsw.ads \ + ada/warnsw.ads ada/switch.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/a-uncdea.ads ada/alloc.ads ada/debug.ads ada/gnatvsn.ads \ diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 81c4e142cab..4383754fa31 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -7685,10 +7685,11 @@ package body Sem_Res is ---------------------------- procedure Resolve_Set_Membership is - Alt : Node_Id; + Alt : Node_Id; + Ltyp : constant Entity_Id := Etype (L); begin - Resolve (L, Etype (L)); + Resolve (L, Ltyp); Alt := First (Alternatives (N)); while Present (Alt) loop @@ -7699,11 +7700,51 @@ package body Sem_Res is if not Is_Entity_Name (Alt) or else not Is_Type (Entity (Alt)) then - Resolve (Alt, Etype (L)); + Resolve (Alt, Ltyp); end if; Next (Alt); end loop; + + -- Check for duplicates for discrete case + + if Is_Discrete_Type (Ltyp) then + declare + type Ent is record + Alt : Node_Id; + Val : Uint; + end record; + + Alts : array (0 .. List_Length (Alternatives (N))) of Ent; + Nalts : Nat; + + begin + -- Loop checking duplicates. This is quadratic, but giant sets + -- are unlikely in this context so it's a reasonable choice. + + Nalts := 0; + Alt := First (Alternatives (N)); + while Present (Alt) loop + if Is_Static_Expression (Alt) + and then (Nkind_In (Alt, N_Integer_Literal, + N_Character_Literal) + or else Nkind (Alt) in N_Has_Entity) + then + Nalts := Nalts + 1; + Alts (Nalts) := (Alt, Expr_Value (Alt)); + + for J in 1 .. Nalts - 1 loop + if Alts (J).Val = Alts (Nalts).Val then + Error_Msg_Sloc := Sloc (Alts (J).Alt); + Error_Msg_N ("duplicate of value given#?", Alt); + end if; + end loop; + end if; + + Alt := Next (Alt); + end loop; + end; + end if; end Resolve_Set_Membership; -- Start of processing for Resolve_Membership_Op