+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
-- 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
Leap_Sec => False,
Use_Day_Secs => True,
Use_TZ => False,
+ Is_Historic => True,
Time_Zone => 0);
end Time_Of;
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
-----------
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;
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;
-- 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;
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;
-- 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
Leap_Sec => False,
Use_Day_Secs => True,
Use_TZ => False,
+ Is_Historic => True,
Time_Zone => 0);
end Time_Of;
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
-- 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
-----------------
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;
-----------
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
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;
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;
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;
-- 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 --
------------------------
-- 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;
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;
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
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
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
Leap_Sec => Leap_Second,
Use_Day_Secs => True,
Use_TZ => True,
+ Is_Historic => True,
Time_Zone => Tz);
end Time_Of;
Leap_Sec => Leap_Second,
Use_Day_Secs => False,
Use_TZ => True,
+ Is_Historic => True,
Time_Zone => Tz);
end Time_Of;
-- --
-- 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- --
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.
---------------------------
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;
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;
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;
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;
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;
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;
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;
-- --
-- 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- --
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).
--
--
-- 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;
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
-- 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;
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;
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;
("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
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
-- --
-- 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- --
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.
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;
projects / gcc.git / commitdiff