diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 49 | ||||
| -rw-r--r-- | gcc/ada/a-calend-vms.adb | 69 | ||||
| -rw-r--r-- | gcc/ada/a-calend-vms.ads | 50 | ||||
| -rw-r--r-- | gcc/ada/a-calend.adb | 98 | ||||
| -rw-r--r-- | gcc/ada/a-calend.ads | 79 | ||||
| -rw-r--r-- | gcc/ada/a-calfor.adb | 77 | ||||
| -rw-r--r-- | gcc/ada/g-comlin.adb | 56 | ||||
| -rw-r--r-- | gcc/ada/g-comlin.ads | 24 | ||||
| -rw-r--r-- | gcc/ada/impunit.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 222 | ||||
| -rw-r--r-- | gcc/ada/sem_aux.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_eval.adb | 11 |
12 files changed, 432 insertions, 308 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 63039c9ac09..e1c40a95843 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,52 @@ +2012-05-15 Hristian Kirtchev <kirtchev@adacore.com> + + * a-calend.adb (Day_Of_Week): The routine once again treats + all dates as historic. (Formatting_Operations.Split): All + calls to UTC_Time_Offset are now controlled through formal + parameter Is_Historic. (Formatting_Operations.Time_Of): + All calls to UTC_Time_Offset are now handled through + formal parameter Is_Historic. + (Split): Update the call to Formatting_Operations.Split. + (Time_Of): Update the call to Formatting_Operations.Time_Of. + (To_Ada_Time): Update the call to Formatting_Operations.Time_Of. + (To_Strict_Tm): Update the call to Formatting_Operations.Split. + * a-calend.ads (Split): Add new formal Is_Historic along with + comment on usage. This routine is now exported for the purposes + of GNAT.Calendar.Locale. + (Time_Of): Remove defaults. Add new + formal Is_Historic along with comment on usage. This routine is + now exported for the purposes of GNAT.Calendar.Locale. + * a-calend-vms.adb (Split): Update the call to + Formatting_Operations.Split. + (Time_Of): Update the call to Formatting_Operations.Time_Of. + * a-calend-vms.ads (Split): Add new formal Is_Historic along + with comment on usage. (Time_Of): Remove defaults. Add new + formal Is_Historic along with comment on usage. + * a-calfor.adb (Split): Update the call to + Formatting_Operations.Split. + (Time_Of): Update the call to Formatting_Operations.Time_Of. + * impunit.adb: Include g-calloc to the list of non-RM defined + units. + +2012-05-15 Vincent Celier <celier@adacore.com> + + * prj-nmsc.adb (Add_Source): Always add the source if it is + excluded, to avoid incorrect duplicate checks. + +2012-05-15 Yannick Moy <moy@adacore.com> + + * sem_aux.ads: Correct typo. + * sem_eval.adb (Compile_Time_Known_Value): Return False in Alfa + mode for a deferred constant when outside of the scope of its + full view. + +2012-05-15 Emmanuel Briot <briot@adacore.com> + + * g-comlin.adb, g-comlin.ads (Define_Switch): Allow specifying the name + of the argument, for the automatic help message. + (Getopt): do not systematically initialize switches with string values + to the empty string, when the user has already specified a default. + 2012-05-14 Manuel López-Ibáñez <manu@gcc.gnu.org> PR 53063 diff --git a/gcc/ada/a-calend-vms.adb b/gcc/ada/a-calend-vms.adb index 1306488d9a4..bb8faaf9790 100644 --- a/gcc/ada/a-calend-vms.adb +++ b/gcc/ada/a-calend-vms.adb @@ -521,18 +521,19 @@ package body Ada.Calendar is -- irrelevant in this case. Formatting_Operations.Split - (Date => Date, - Year => Year, - Month => Month, - Day => Day, - Day_Secs => Seconds, - Hour => H, - Minute => M, - Second => Se, - Sub_Sec => Ss, - Leap_Sec => Le, - Use_TZ => False, - Time_Zone => 0); + (Date => Date, + Year => Year, + Month => Month, + Day => Day, + Day_Secs => Seconds, + Hour => H, + Minute => M, + Second => Se, + Sub_Sec => Ss, + Leap_Sec => Le, + Use_TZ => False, + Is_Historic => True, + Time_Zone => 0); -- Validity checks @@ -589,6 +590,7 @@ package body Ada.Calendar is Leap_Sec => False, Use_Day_Secs => True, Use_TZ => False, + Is_Historic => True, Time_Zone => 0); end Time_Of; @@ -836,6 +838,7 @@ package body Ada.Calendar is Leap_Sec => Leap, Use_Day_Secs => False, -- Time is given in h:m:s Use_TZ => True, -- Force usage of explicit time zone + Is_Historic => True, Time_Zone => 0)); -- Place the value in UTC -- Step 4: Daylight Savings Time @@ -980,22 +983,23 @@ package body Ada.Calendar is ----------- procedure Split - (Date : Time; - Year : out Year_Number; - Month : out Month_Number; - Day : out Day_Number; - Day_Secs : out Day_Duration; - Hour : out Integer; - Minute : out Integer; - Second : out Integer; - Sub_Sec : out Duration; - Leap_Sec : out Boolean; - Use_TZ : Boolean; - Time_Zone : Long_Integer) + (Date : Time; + Year : out Year_Number; + Month : out Month_Number; + Day : out Day_Number; + Day_Secs : out Day_Duration; + Hour : out Integer; + Minute : out Integer; + Second : out Integer; + Sub_Sec : out Duration; + Leap_Sec : out Boolean; + Use_TZ : Boolean; + Is_Historic : Boolean; + Time_Zone : Long_Integer) is - -- The flag Use_TZ is present for interfacing purposes + -- Flags Use_TZ and Is_Historic are present for interfacing purposes - pragma Unreferenced (Use_TZ); + pragma Unreferenced (Use_TZ, Is_Historic); procedure Numtim (Status : out Unsigned_Longword; @@ -1104,11 +1108,16 @@ package body Ada.Calendar is Minute : Integer; Second : Integer; Sub_Sec : Duration; - Leap_Sec : Boolean := False; - Use_Day_Secs : Boolean := False; - Use_TZ : Boolean := False; - Time_Zone : Long_Integer := 0) return Time + Leap_Sec : Boolean; + Use_Day_Secs : Boolean; + Use_TZ : Boolean; + Is_Historic : Boolean; + Time_Zone : Long_Integer) return Time is + -- Flag Is_Historic is present for interfacing purposes + + pragma Unreferenced (Is_Historic); + procedure Cvt_Vectim (Status : out Unsigned_Longword; Input_Time : Unsigned_Word_Array; diff --git a/gcc/ada/a-calend-vms.ads b/gcc/ada/a-calend-vms.ads index 83534c2c916..d0fdc4a6b91 100644 --- a/gcc/ada/a-calend-vms.ads +++ b/gcc/ada/a-calend-vms.ads @@ -218,21 +218,24 @@ private -- within the range of 0 .. 6 (Monday .. Sunday). procedure Split - (Date : Time; - Year : out Year_Number; - Month : out Month_Number; - Day : out Day_Number; - Day_Secs : out Day_Duration; - Hour : out Integer; - Minute : out Integer; - Second : out Integer; - Sub_Sec : out Duration; - Leap_Sec : out Boolean; - Use_TZ : Boolean; - Time_Zone : Long_Integer); - -- Split a time value into its components. Set Use_TZ to use the local - -- time zone (the value in Time_Zone is ignored) when splitting a time - -- value. + (Date : Time; + Year : out Year_Number; + Month : out Month_Number; + Day : out Day_Number; + Day_Secs : out Day_Duration; + Hour : out Integer; + Minute : out Integer; + Second : out Integer; + Sub_Sec : out Duration; + Leap_Sec : out Boolean; + Use_TZ : Boolean; + Is_Historic : Boolean; + Time_Zone : Long_Integer); + -- Split a time value into its components. If flag Is_Historic is set, + -- this routine would try to use to the best of the OS's abilities the + -- time zone offset that was or will be in effect on Date. Set Use_TZ + -- to use the local time zone (the value in Time_Zone is ignored) when + -- splitting a time value. function Time_Of (Year : Year_Number; @@ -243,16 +246,19 @@ private Minute : Integer; Second : Integer; Sub_Sec : Duration; - Leap_Sec : Boolean := False; - Use_Day_Secs : Boolean := False; - Use_TZ : Boolean := False; - Time_Zone : Long_Integer := 0) return Time; + Leap_Sec : Boolean; + Use_Day_Secs : Boolean; + Use_TZ : Boolean; + Is_Historic : Boolean; + Time_Zone : Long_Integer) return Time; -- Given all the components of a date, return the corresponding time -- value. Set Use_Day_Secs to use the value in Day_Secs, otherwise the -- day duration will be calculated from Hour, Minute, Second and Sub_ - -- Sec. Set Use_TZ to use the local time zone (the value in formal - -- Time_Zone is ignored) when building a time value and to verify the - -- validity of a requested leap second. + -- Sec. If flag Is_Historic is set, this routine would try to use to the + -- best of the OS's abilities the time zone offset that was or will be + -- in effect on the input date. Set Use_TZ to use the local time zone + -- (the value in formal Time_Zone is ignored) when building a time value + -- and to verify the validity of a requested leap second. end Formatting_Operations; diff --git a/gcc/ada/a-calend.adb b/gcc/ada/a-calend.adb index cecbc52d17e..3d70cf4f43b 100644 --- a/gcc/ada/a-calend.adb +++ b/gcc/ada/a-calend.adb @@ -579,18 +579,19 @@ package body Ada.Calendar is -- ensure that Split picks up the local time zone. Formatting_Operations.Split - (Date => Date, - Year => Year, - Month => Month, - Day => Day, - Day_Secs => Seconds, - Hour => H, - Minute => M, - Second => Se, - Sub_Sec => Ss, - Leap_Sec => Le, - Use_TZ => False, - Time_Zone => 0); + (Date => Date, + Year => Year, + Month => Month, + Day => Day, + Day_Secs => Seconds, + Hour => H, + Minute => M, + Second => Se, + Sub_Sec => Ss, + Leap_Sec => Le, + Use_TZ => False, + Is_Historic => True, + Time_Zone => 0); -- Validity checks @@ -649,6 +650,7 @@ package body Ada.Calendar is Leap_Sec => False, Use_Day_Secs => True, Use_TZ => False, + Is_Historic => True, Time_Zone => 0); end Time_Of; @@ -977,6 +979,7 @@ package body Ada.Calendar is Leap_Sec => Leap, Use_Day_Secs => False, -- Time is given in h:m:s Use_TZ => True, -- Force usage of explicit time zone + Is_Historic => True, Time_Zone => 0)); -- Place the value in UTC -- Step 4: Daylight Savings Time @@ -1055,8 +1058,19 @@ package body Ada.Calendar is -- Step 1: Split the input time Formatting_Operations.Split - (T, Year, Month, tm_day, Day_Secs, - tm_hour, tm_min, Second, Sub_Sec, Leap_Sec, True, 0); + (Date => T, + Year => Year, + Month => Month, + Day => tm_day, + Day_Secs => Day_Secs, + Hour => tm_hour, + Minute => tm_min, + Second => Second, + Sub_Sec => Sub_Sec, + Leap_Sec => Leap_Sec, + Use_TZ => True, + Is_Historic => False, + Time_Zone => 0); -- Step 2: Correct the year and month @@ -1154,12 +1168,8 @@ package body Ada.Calendar is ----------------- function Day_Of_Week (Date : Time) return Integer is - Date_N : constant Time_Rep := Time_Rep (Date); - - Time_Zone : constant Long_Integer := UTC_Time_Offset (Date, False); - -- Keep the internal usage of UTC_Time_Offset consistent with Time_Of - -- and Split. - + Date_N : constant Time_Rep := Time_Rep (Date); + Time_Zone : constant Long_Integer := UTC_Time_Offset (Date, True); Ada_Low_N : Time_Rep; Day_Count : Long_Integer; Day_Dur : Time_Dur; @@ -1199,18 +1209,19 @@ package body Ada.Calendar is ----------- procedure Split - (Date : Time; - Year : out Year_Number; - Month : out Month_Number; - Day : out Day_Number; - Day_Secs : out Day_Duration; - Hour : out Integer; - Minute : out Integer; - Second : out Integer; - Sub_Sec : out Duration; - Leap_Sec : out Boolean; - Use_TZ : Boolean; - Time_Zone : Long_Integer) + (Date : Time; + Year : out Year_Number; + Month : out Month_Number; + Day : out Day_Number; + Day_Secs : out Day_Duration; + Hour : out Integer; + Minute : out Integer; + Second : out Integer; + Sub_Sec : out Duration; + Leap_Sec : out Boolean; + Use_TZ : Boolean; + Is_Historic : Boolean; + Time_Zone : Long_Integer) is -- The following constants represent the number of nanoseconds -- elapsed since the start of Ada time to and including the non @@ -1272,7 +1283,7 @@ package body Ada.Calendar is else declare Off : constant Long_Integer := - UTC_Time_Offset (Time (Date_N), False); + UTC_Time_Offset (Time (Date_N), Is_Historic); begin Date_N := Date_N + Time_Rep (Off) * Nano; @@ -1388,10 +1399,11 @@ package body Ada.Calendar is Minute : Integer; Second : Integer; Sub_Sec : Duration; - Leap_Sec : Boolean := False; - Use_Day_Secs : Boolean := False; - Use_TZ : Boolean := False; - Time_Zone : Long_Integer := 0) return Time + Leap_Sec : Boolean; + Use_Day_Secs : Boolean; + Use_TZ : Boolean; + Is_Historic : Boolean; + Time_Zone : Long_Integer) return Time is Count : Integer; Elapsed_Leaps : Natural; @@ -1493,12 +1505,12 @@ package body Ada.Calendar is else declare - Current_Off : constant Long_Integer := - UTC_Time_Offset (Time (Res_N), False); - Current_Res_N : constant Time_Rep := - Res_N - Time_Rep (Current_Off) * Nano; - Off : constant Long_Integer := - UTC_Time_Offset (Time (Current_Res_N), False); + Cur_Off : constant Long_Integer := + UTC_Time_Offset (Time (Res_N), Is_Historic); + Cur_Res_N : constant Time_Rep := + Res_N - Time_Rep (Cur_Off) * Nano; + Off : constant Long_Integer := + UTC_Time_Offset (Time (Cur_Res_N), Is_Historic); begin Res_N := Res_N - Time_Rep (Off) * Nano; diff --git a/gcc/ada/a-calend.ads b/gcc/ada/a-calend.ads index d1697196855..668efb9b32a 100644 --- a/gcc/ada/a-calend.ads +++ b/gcc/ada/a-calend.ads @@ -193,33 +193,6 @@ private -- of year - 4 to year + 4. Internally, routines Split and Time_Of add or -- subtract a "fake" February 29 to facilitate the arithmetic involved. - ------------------------------------ - -- Time Zones and UTC_Time_Offset -- - ------------------------------------ - - -- The implementation-defined time zone of Ada.Calendar routines is the - -- local time zone. The term "local time zone" can be interpreted in two - -- different ways - either the offset from UTC of the "now" or the offset - -- from UTC of some input date. - - -- For efficency reasons, Split and Time_Of take the first approach. Since - -- the Ada Reference Manual does not mandate that Split and Time_Of should - -- be concious of historic time zones, this interpretation is acceptable - -- and efficent in terms of performance. Split and Time_Of localize their - -- respective input regardless of whether it represent a past or a future - -- date. - - -- UTC_Time_Offset on the other hand must be knowledgeable of historic time - -- zones. To achieve this, the implementation relies on various operating - -- system routines. Note that not all operating systems support time zones. - -- UTC_Time_Offset calculates the offset from UTC as it occurred or will - -- occur on the input date relative to the local time zone. Example: - - -- Date Offset Reason - -- 2012-01-11 -300 - -- 2011-03-12 -300 - -- 2011-03-14 -240 Daylight savings is in effect - ------------------------ -- Local Declarations -- ------------------------ @@ -341,21 +314,25 @@ private -- within the range of 0 .. 6 (Monday .. Sunday). procedure Split - (Date : Time; - Year : out Year_Number; - Month : out Month_Number; - Day : out Day_Number; - Day_Secs : out Day_Duration; - Hour : out Integer; - Minute : out Integer; - Second : out Integer; - Sub_Sec : out Duration; - Leap_Sec : out Boolean; - Use_TZ : Boolean; - Time_Zone : Long_Integer); - -- Split a time value into its components. Set Use_TZ to use the local - -- time zone (the value in Time_Zone is ignored) when splitting a time - -- value. + (Date : Time; + Year : out Year_Number; + Month : out Month_Number; + Day : out Day_Number; + Day_Secs : out Day_Duration; + Hour : out Integer; + Minute : out Integer; + Second : out Integer; + Sub_Sec : out Duration; + Leap_Sec : out Boolean; + Use_TZ : Boolean; + Is_Historic : Boolean; + Time_Zone : Long_Integer); + pragma Export (Ada, Split, "__gnat_split"); + -- Split a time value into its components. If flag Is_Historic is set, + -- this routine would try to use to the best of the OS's abilities the + -- time zone offset that was or will be in effect on Date. Set Use_TZ + -- to use the local time zone (the value in Time_Zone is ignored) when + -- splitting a time value. function Time_Of (Year : Year_Number; @@ -366,16 +343,20 @@ private Minute : Integer; Second : Integer; Sub_Sec : Duration; - Leap_Sec : Boolean := False; - Use_Day_Secs : Boolean := False; - Use_TZ : Boolean := False; - Time_Zone : Long_Integer := 0) return Time; + Leap_Sec : Boolean; + Use_Day_Secs : Boolean; + Use_TZ : Boolean; + Is_Historic : Boolean; + Time_Zone : Long_Integer) return Time; + pragma Export (Ada, Time_Of, "__gnat_time_of"); -- Given all the components of a date, return the corresponding time -- value. Set Use_Day_Secs to use the value in Day_Secs, otherwise the -- day duration will be calculated from Hour, Minute, Second and Sub_ - -- Sec. Set Use_TZ to use the local time zone (the value in formal - -- Time_Zone is ignored) when building a time value and to verify the - -- validity of a requested leap second. + -- Sec. If flag Is_Historic is set, this routine would try to use to the + -- best of the OS's abilities the time zone offset that was or will be + -- in effect on the input date. Set Use_TZ to use the local time zone + -- (the value in formal Time_Zone is ignored) when building a time value + -- and to verify the validity of a requested leap second. end Formatting_Operations; diff --git a/gcc/ada/a-calfor.adb b/gcc/ada/a-calfor.adb index e328a4eff5d..1376f9367af 100644 --- a/gcc/ada/a-calfor.adb +++ b/gcc/ada/a-calfor.adb @@ -421,18 +421,19 @@ package body Ada.Calendar.Formatting is begin Formatting_Operations.Split - (Date => Date, - Year => Year, - Month => Month, - Day => Day, - Day_Secs => Seconds, - Hour => H, - Minute => M, - Second => Se, - Sub_Sec => Su, - Leap_Sec => Leap_Second, - Use_TZ => True, - Time_Zone => Tz); + (Date => Date, + Year => Year, + Month => Month, + Day => Day, + Day_Secs => Seconds, + Hour => H, + Minute => M, + Second => Se, + Sub_Sec => Su, + Leap_Sec => Leap_Second, + Use_TZ => True, + Is_Historic => True, + Time_Zone => Tz); -- Validity checks @@ -466,18 +467,19 @@ package body Ada.Calendar.Formatting is begin Formatting_Operations.Split - (Date => Date, - Year => Year, - Month => Month, - Day => Day, - Day_Secs => Dd, - Hour => Hour, - Minute => Minute, - Second => Second, - Sub_Sec => Sub_Second, - Leap_Sec => Le, - Use_TZ => True, - Time_Zone => Tz); + (Date => Date, + Year => Year, + Month => Month, + Day => Day, + Day_Secs => Dd, + Hour => Hour, + Minute => Minute, + Second => Second, + Sub_Sec => Sub_Second, + Leap_Sec => Le, + Use_TZ => True, + Is_Historic => True, + Time_Zone => Tz); -- Validity checks @@ -514,18 +516,19 @@ package body Ada.Calendar.Formatting is begin Formatting_Operations.Split - (Date => Date, - Year => Year, - Month => Month, - Day => Day, - Day_Secs => Dd, - Hour => Hour, - Minute => Minute, - Second => Second, - Sub_Sec => Sub_Second, - Leap_Sec => Leap_Second, - Use_TZ => True, - Time_Zone => Tz); + (Date => Date, + Year => Year, + Month => Month, + Day => Day, + Day_Secs => Dd, + Hour => Hour, + Minute => Minute, + Second => Second, + Sub_Sec => Sub_Second, + Leap_Sec => Leap_Second, + Use_TZ => True, + Is_Historic => True, + Time_Zone => Tz); -- Validity checks @@ -630,6 +633,7 @@ package body Ada.Calendar.Formatting is Leap_Sec => Leap_Second, Use_Day_Secs => True, Use_TZ => True, + Is_Historic => True, Time_Zone => Tz); end Time_Of; @@ -679,6 +683,7 @@ package body Ada.Calendar.Formatting is Leap_Sec => Leap_Second, Use_Day_Secs => False, Use_TZ => True, + Is_Historic => True, Time_Zone => Tz); end Time_Of; diff --git a/gcc/ada/g-comlin.adb b/gcc/ada/g-comlin.adb index 60dde356d78..8615b024f23 100644 --- a/gcc/ada/g-comlin.adb +++ b/gcc/ada/g-comlin.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -128,7 +128,8 @@ package body GNAT.Command_Line is Switch : String := ""; Long_Switch : String := ""; Help : String := ""; - Section : String := ""); + Section : String := ""; + Argument : String := "ARG"); -- Initialize [Def] with the contents of the other parameters. -- This also checks consistency of the switch parameters, and will raise -- Invalid_Switch if they do not match. @@ -1280,11 +1281,12 @@ package body GNAT.Command_Line is --------------------------- procedure Initialize_Switch_Def - (Def : out Switch_Definition; + (Def : out Switch_Definition; Switch : String := ""; Long_Switch : String := ""; Help : String := ""; - Section : String := "") + Section : String := ""; + Argument : String := "ARG") is P1, P2 : Switch_Parameter_Type := Parameter_None; Last1, Last2 : Integer; @@ -1316,6 +1318,10 @@ package body GNAT.Command_Line is Def.Section := new String'(Section); end if; + if Argument /= "ARG" then + Def.Argument := new String'(Argument); + end if; + if Help /= "" then Def.Help := new String'(Help); end if; @@ -1330,12 +1336,14 @@ package body GNAT.Command_Line is Switch : String := ""; Long_Switch : String := ""; Help : String := ""; - Section : String := "") + Section : String := ""; + Argument : String := "ARG") is Def : Switch_Definition; begin if Switch /= "" or else Long_Switch /= "" then - Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section); + Initialize_Switch_Def + (Def, Switch, Long_Switch, Help, Section, Argument); Add (Config, Def); end if; end Define_Switch; @@ -1375,12 +1383,14 @@ package body GNAT.Command_Line is Help : String := ""; Section : String := ""; Initial : Integer := 0; - Default : Integer := 1) + Default : Integer := 1; + Argument : String := "ARG") is Def : Switch_Definition (Switch_Integer); begin if Switch /= "" or else Long_Switch /= "" then - Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section); + Initialize_Switch_Def + (Def, Switch, Long_Switch, Help, Section, Argument); Def.Integer_Output := Output.all'Unchecked_Access; Def.Integer_Default := Default; Def.Integer_Initial := Initial; @@ -1398,12 +1408,14 @@ package body GNAT.Command_Line is Switch : String := ""; Long_Switch : String := ""; Help : String := ""; - Section : String := "") + Section : String := ""; + Argument : String := "ARG") is Def : Switch_Definition (Switch_String); begin if Switch /= "" or else Long_Switch /= "" then - Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section); + Initialize_Switch_Def + (Def, Switch, Long_Switch, Help, Section, Argument); Def.String_Output := Output.all'Unchecked_Access; Add (Config, Def); end if; @@ -3206,17 +3218,31 @@ package body GNAT.Command_Line is Decompose_Switch (Def.Long_Switch.all, P2, Last2); Append (Result, ", " & Def.Long_Switch (Def.Long_Switch'First .. Last2)); - Append (Result, Param_Name (P2, "ARG")); + + if Def.Argument = null then + Append (Result, Param_Name (P2, "ARG")); + else + Append (Result, Param_Name (P2, Def.Argument.all)); + end if; else - Append (Result, Param_Name (P1, "ARG")); + if Def.Argument = null then + Append (Result, Param_Name (P1, "ARG")); + else + Append (Result, Param_Name (P1, Def.Argument.all)); + end if; end if; else -- Long_Switch necessarily not null Decompose_Switch (Def.Long_Switch.all, P2, Last2); Append (Result, Def.Long_Switch (Def.Long_Switch'First .. Last2)); - Append (Result, Param_Name (P2, "ARG")); + + if Def.Argument = null then + Append (Result, Param_Name (P2, "ARG")); + else + Append (Result, Param_Name (P2, Def.Argument.all)); + end if; end if; end if; @@ -3393,7 +3419,9 @@ package body GNAT.Command_Line is Config.Switches (S).Integer_Initial; when Switch_String => - Config.Switches (S).String_Output.all := new String'(""); + if Config.Switches (S).String_Output.all = null then + Config.Switches (S).String_Output.all := new String'(""); + end if; end case; end loop; diff --git a/gcc/ada/g-comlin.ads b/gcc/ada/g-comlin.ads index 9b2b0059788..c3479bbfb42 100644 --- a/gcc/ada/g-comlin.ads +++ b/gcc/ada/g-comlin.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1999-2011, AdaCore -- +-- Copyright (C) 1999-2012, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -595,7 +595,8 @@ package GNAT.Command_Line is Switch : String := ""; Long_Switch : String := ""; Help : String := ""; - Section : String := ""); + Section : String := ""; + Argument : String := "ARG"); -- Indicates a new switch. The format of this switch follows the getopt -- format (trailing ':', '?', etc for defining a switch with parameters). -- @@ -617,6 +618,9 @@ package GNAT.Command_Line is -- -- In_Section indicates in which section the switch is valid (you need to -- first define the section through a call to Define_Section). + -- + -- Argument is the name of the argument, as displayed in the automatic + -- help message. It is always capitalized for consistency. procedure Define_Switch (Config : in out Command_Line_Configuration; @@ -643,7 +647,8 @@ package GNAT.Command_Line is Help : String := ""; Section : String := ""; Initial : Integer := 0; - Default : Integer := 1); + Default : Integer := 1; + Argument : String := "ARG"); -- See Define_Switch for a description of the parameters. -- When the switch is found on the command line, Getopt will set -- Output.all to the value of the switch's parameter. If the parameter is @@ -651,6 +656,7 @@ package GNAT.Command_Line is -- Output is always initialized to Initial. If the switch has an optional -- argument which isn't specified by the user, then Output will be set to -- Default. + -- The switch must accept an argument. procedure Define_Switch (Config : in out Command_Line_Configuration; @@ -658,10 +664,14 @@ package GNAT.Command_Line is Switch : String := ""; Long_Switch : String := ""; Help : String := ""; - Section : String := ""); + Section : String := ""; + Argument : String := "ARG"); -- Set Output to the value of the switch's parameter when the switch is -- found on the command line. - -- Output is always initialized to the empty string. + -- Output is always initialized to the empty string if it does not have + -- a value already (otherwise it is left as is so that you can specify the + -- default value directly in the declaration of the variable). + -- The switch must accept an argument. procedure Set_Usage (Config : in out Command_Line_Configuration; @@ -1096,6 +1106,10 @@ private Section : GNAT.OS_Lib.String_Access; Help : GNAT.OS_Lib.String_Access; + Argument : GNAT.OS_Lib.String_Access; + -- null if "ARG". + -- Name of the argument for this switch. + case Typ is when Switch_Untyped => null; diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index 99d0c27140b..30ec793cc36 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -246,6 +246,7 @@ package body Impunit is ("g-byorma", F), -- GNAT.Byte_Order_Mark ("g-bytswa", F), -- GNAT.Byte_Swapping ("g-calend", F), -- GNAT.Calendar + ("g-calloc", F), -- GNAT.Calendar.Locale ("g-catiio", F), -- GNAT.Calendar.Time_IO ("g-casuti", F), -- GNAT.Case_Util ("g-cgi ", F), -- GNAT.CGI diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 56866e4d824..28d2f0faa17 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -642,143 +642,153 @@ package body Prj.Nmsc is Add_Src := True; - if Unit /= No_Name then - Prev_Unit := Units_Htable.Get (Data.Tree.Units_HT, Unit); - end if; + -- Always add the source if it is locally removed, to avoid incorrect + -- duplicate checks. - if Prev_Unit /= No_Unit_Index - and then (Kind = Impl or else Kind = Spec) - and then Prev_Unit.File_Names (Kind) /= null - then - -- Suspicious, we need to check later whether this is authorized - - Add_Src := False; - Source := Prev_Unit.File_Names (Kind); + if not Locally_Removed then + if Unit /= No_Name then + Prev_Unit := Units_Htable.Get (Data.Tree.Units_HT, Unit); + end if; - else - Source := Source_Files_Htable.Get - (Data.Tree.Source_Files_HT, File_Name); + if Prev_Unit /= No_Unit_Index + and then (Kind = Impl or else Kind = Spec) + and then Prev_Unit.File_Names (Kind) /= null + then + -- Suspicious, we need to check later whether this is authorized - if Source /= No_Source and then Source.Index = Index then Add_Src := False; + Source := Prev_Unit.File_Names (Kind); + + else + Source := Source_Files_Htable.Get + (Data.Tree.Source_Files_HT, File_Name); + + if Source /= No_Source and then Source.Index = Index then + Add_Src := False; + end if; end if; - end if; - -- Duplication of file/unit in same project is allowed if order of - -- source directories is known, or if there is no compiler for the - -- language. + -- Duplication of file/unit in same project is allowed if order of + -- source directories is known, or if there is no compiler for the + -- language. - if Add_Src = False then - Add_Src := True; + if Add_Src = False then + Add_Src := True; - if Project = Source.Project then - if Prev_Unit = No_Unit_Index then - if Data.Flags.Allow_Duplicate_Basenames then - Add_Src := True; + if Project = Source.Project then + if Prev_Unit = No_Unit_Index then + if Data.Flags.Allow_Duplicate_Basenames then + Add_Src := True; - elsif Lang_Id.Config.Compiler_Driver = Empty_File then - Add_Src := True; + elsif Lang_Id.Config.Compiler_Driver = Empty_File then + Add_Src := True; - elsif Source_Dir_Rank /= Source.Source_Dir_Rank then - Add_Src := False; + elsif Source_Dir_Rank /= Source.Source_Dir_Rank then + Add_Src := False; + + else + Error_Msg_File_1 := File_Name; + Error_Msg + (Data.Flags, "duplicate source file name {", + Location, Project); + Add_Src := False; + end if; else - Error_Msg_File_1 := File_Name; - Error_Msg - (Data.Flags, "duplicate source file name {", - Location, Project); - Add_Src := False; - end if; + if Source_Dir_Rank /= Source.Source_Dir_Rank then + Add_Src := False; - else - if Source_Dir_Rank /= Source.Source_Dir_Rank then - Add_Src := False; + -- We might be seeing the same file through a different + -- path (for instance because of symbolic links). - -- We might be seeing the same file through a different path - -- (for instance because of symbolic links). + elsif Source.Path.Name /= Path.Name then + if not Source.Duplicate_Unit then + Error_Msg_Name_1 := Unit; + Error_Msg + (Data.Flags, + "\duplicate unit %%", + Location, + Project); + Source.Duplicate_Unit := True; + end if; - elsif Source.Path.Name /= Path.Name then - if not Source.Duplicate_Unit then - Error_Msg_Name_1 := Unit; - Error_Msg - (Data.Flags, "\duplicate unit %%", Location, Project); - Source.Duplicate_Unit := True; + Add_Src := False; end if; - - Add_Src := False; end if; - end if; - -- Do not allow the same unit name in different projects, except - -- if one is extending the other. + -- Do not allow the same unit name in different projects, + -- except if one is extending the other. - -- For a file based language, the same file name replaces a file - -- in a project being extended, but it is allowed to have the same - -- file name in unrelated projects. + -- For a file based language, the same file name replaces a + -- file in a project being extended, but it is allowed to have + -- the same file name in unrelated projects. - elsif Is_Extending (Project, Source.Project) then - if not Locally_Removed and then Naming_Exception /= Inherited then - Source_To_Replace := Source; - end if; + elsif Is_Extending (Project, Source.Project) then + if not Locally_Removed + and then Naming_Exception /= Inherited + then + Source_To_Replace := Source; + end if; - elsif Prev_Unit /= No_Unit_Index - and then Prev_Unit.File_Names (Kind) /= null - and then not Source.Locally_Removed - and then not Data.In_Aggregate_Lib - then - -- Path is set if this is a source we found on the disk, in which - -- case we can provide more explicit error message. Path is unset - -- when the source is added from one of the naming exceptions in - -- the project. + elsif Prev_Unit /= No_Unit_Index + and then Prev_Unit.File_Names (Kind) /= null + and then not Source.Locally_Removed + and then not Data.In_Aggregate_Lib + then + -- Path is set if this is a source we found on the disk, in + -- which case we can provide more explicit error message. Path + -- is unset when the source is added from one of the naming + -- exceptions in the project. - if Path /= No_Path_Information then - Error_Msg_Name_1 := Unit; - Error_Msg - (Data.Flags, - "unit %% cannot belong to several projects", - Location, Project); + if Path /= No_Path_Information then + Error_Msg_Name_1 := Unit; + Error_Msg + (Data.Flags, + "unit %% cannot belong to several projects", + Location, Project); - Error_Msg_Name_1 := Project.Name; - Error_Msg_Name_2 := Name_Id (Path.Display_Name); - Error_Msg - (Data.Flags, "\ project %%, %%", Location, Project); + Error_Msg_Name_1 := Project.Name; + Error_Msg_Name_2 := Name_Id (Path.Display_Name); + Error_Msg + (Data.Flags, "\ project %%, %%", Location, Project); - Error_Msg_Name_1 := Source.Project.Name; - Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name); - Error_Msg - (Data.Flags, "\ project %%, %%", Location, Project); + Error_Msg_Name_1 := Source.Project.Name; + Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name); + Error_Msg + (Data.Flags, "\ project %%, %%", Location, Project); - else - Error_Msg_Name_1 := Unit; - Error_Msg_Name_2 := Source.Project.Name; - Error_Msg - (Data.Flags, "unit %% already belongs to project %%", - Location, Project); - end if; + else + Error_Msg_Name_1 := Unit; + Error_Msg_Name_2 := Source.Project.Name; + Error_Msg + (Data.Flags, "unit %% already belongs to project %%", + Location, Project); + end if; - Add_Src := False; + Add_Src := False; - elsif not Source.Locally_Removed - and then not Data.Flags.Allow_Duplicate_Basenames - and then Lang_Id.Config.Kind = Unit_Based - and then Source.Language.Config.Kind = Unit_Based - and then not Data.In_Aggregate_Lib - then - Error_Msg_File_1 := File_Name; - Error_Msg_File_2 := File_Name_Type (Source.Project.Name); - Error_Msg - (Data.Flags, - "{ is already a source of project {", Location, Project); + elsif not Source.Locally_Removed + and then not Data.Flags.Allow_Duplicate_Basenames + and then Lang_Id.Config.Kind = Unit_Based + and then Source.Language.Config.Kind = Unit_Based + and then not Data.In_Aggregate_Lib + then + Error_Msg_File_1 := File_Name; + Error_Msg_File_2 := File_Name_Type (Source.Project.Name); + Error_Msg + (Data.Flags, + "{ is already a source of project {", Location, Project); - -- Add the file anyway, to avoid further warnings like "language - -- unknown". + -- Add the file anyway, to avoid further warnings like + -- "language unknown". - Add_Src := True; + Add_Src := True; + end if; end if; - end if; - if not Add_Src then - return; + if not Add_Src then + return; + end if; end if; -- Add the new file diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads index d4875a46127..9fd9c659a09 100644 --- a/gcc/ada/sem_aux.ads +++ b/gcc/ada/sem_aux.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -99,7 +99,7 @@ package Sem_Aux is function Constant_Value (Ent : Entity_Id) return Node_Id; -- Ent is a variable, constant, named integer, or named real entity. This -- call obtains the initialization expression for the entity. Will return - -- Empty for for a deferred constant whose full view is not available or + -- Empty for a deferred constant whose full view is not available or -- in some other cases of internal entities, which cannot be treated as -- constants from the point of view of constant folding. Empty is also -- returned for variables with no initialization expression. diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 2bd111b9bec..0daeb4cee0c 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -1302,7 +1302,16 @@ package body Sem_Eval is if Ekind (E) = E_Enumeration_Literal then return True; - elsif Ekind (E) = E_Constant then + -- In Alfa mode, the value of deferred constants should be ignored + -- outside the scope of their full view. This allows parameterized + -- formal verification, in which a deferred constant value if not + -- known from client units. + + elsif Ekind (E) = E_Constant + and then not (Alfa_Mode + and then Present (Full_View (E)) + and then not In_Open_Scopes (Scope (E))) + then V := Constant_Value (E); return Present (V) and then Compile_Time_Known_Value (V); end if; |