+2013-10-10 Pascal Obry <obry@adacore.com>
+
+ * prj-conf.adb: Minor typo fixes in comment.
+
+2013-10-10 Thomas Quinot <quinot@adacore.com>
+
+ * s-taprop-posix.adb (Compute_Deadline): New local subprogram,
+ factors common code between Timed_Sleep and Timed_Delay.
+
+2013-10-10 Robert Dewar <dewar@adacore.com>
+
+ * freeze.adb (Freeze_Record_Type): Don't replace others if
+ expander inactive. This avoids clobbering the ASIS tree in
+ -gnatct mode.
+
+2013-10-10 Robert Dewar <dewar@adacore.com>
+
+ * sem_res.adb (Resolve_Op_Expon): Avoid crash testing for
+ fixed-point case in preanalysis mode (error will be caught during
+ full analysis).
+
2013-10-10 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi: Refined_Pre and Refined_Post are now allowed as
-- of course we already know the list of choices corresponding
-- to the others choice (it's the list we're replacing!)
- declare
- Last_Var : constant Node_Id :=
- Last_Non_Pragma (Variants (V));
- Others_Node : Node_Id;
- begin
- if Nkind (First (Discrete_Choices (Last_Var))) /=
+ -- We only want to do this if the expander is active, since
+ -- we do not want to clobber the ASIS tree!
+
+ if Expander_Active then
+ declare
+ Last_Var : constant Node_Id :=
+ Last_Non_Pragma (Variants (V));
+
+ Others_Node : Node_Id;
+
+ begin
+ if Nkind (First (Discrete_Choices (Last_Var))) /=
N_Others_Choice
- then
- Others_Node := Make_Others_Choice (Sloc (Last_Var));
- Set_Others_Discrete_Choices
- (Others_Node, Discrete_Choices (Last_Var));
- Set_Discrete_Choices (Last_Var, New_List (Others_Node));
- end if;
- end;
+ then
+ Others_Node := Make_Others_Choice (Sloc (Last_Var));
+ Set_Others_Discrete_Choices
+ (Others_Node, Discrete_Choices (Last_Var));
+ Set_Discrete_Choices
+ (Last_Var, New_List (Others_Node));
+ end if;
+ end;
+ end if;
end if;
end Check_Variant_Part;
end Freeze_Record_Type;
-- Check for switches --config and --RTS in package Builder
procedure Get_Project_Target;
- -- Target_Name is empty, get the specifiedtarget in the project file,
- -- if any.
+ -- If Target_Name is empty, get the specified target in the project
+ -- file, if any.
function Get_Config_Switches return Argument_List_Access;
-- Return the --config switches to use for gprconfig
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
pragma Import (C,
GNAT_pthread_condattr_setup, "__gnat_pthread_condattr_setup");
+ procedure Compute_Deadline
+ (Time : Duration;
+ Mode : ST.Delay_Modes;
+ Check_Time : out Duration;
+ Abs_Time : out Duration;
+ Rel_time : out Duration);
+ -- Helper for Timed_Sleep and Timed_Delay: given a deadline specified by
+ -- Time and Mode, compute the current clock reading (Check_Time), and the
+ -- target absolute and relative clock readings (Abs_Time, Rel_Time). The
+ -- epoch for Time depends on Mode; the epoch for Check_Time and Abs_Time
+ -- is always that of CLOCK_RT_Ada.
+
-------------------
-- Abort_Handler --
-------------------
end if;
end Abort_Handler;
+ ----------------------
+ -- Compute_Deadline --
+ ----------------------
+
+ procedure Compute_Deadline
+ (Time : Duration;
+ Mode : ST.Delay_Modes;
+ Check_Time : out Duration;
+ Abs_Time : out Duration;
+ Rel_time : out Duration)
+ is
+ begin
+ Check_Time := Monotonic_Clock;
+
+ if Mode = Relative then
+ Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time;
+
+ if Relative_Timed_Wait then
+ Rel_Time := Duration'Min (Max_Sensible_Delay, Time);
+ end if;
+
+ else
+ Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
+
+ if Relative_Timed_Wait then
+ Rel_Time := Duration'Min (Max_Sensible_Delay, Time - Check_Time);
+ end if;
+ end if;
+ end Compute_Deadline;
+
-----------------
-- Stack_Guard --
-----------------
is
pragma Unreferenced (Reason);
- Base_Time : constant Duration := Monotonic_Clock;
- Check_Time : Duration := Base_Time;
- Rel_Time : Duration;
+ Base_Time : Duration;
+ Check_Time : Duration;
Abs_Time : Duration;
+ Rel_Time : Duration;
+
Request : aliased timespec;
Result : Interfaces.C.int;
Timedout := True;
Yielded := False;
- if Mode = Relative then
- Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time;
-
- if Relative_Timed_Wait then
- Rel_Time := Duration'Min (Max_Sensible_Delay, Time);
- end if;
-
- else
- Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
-
- if Relative_Timed_Wait then
- Rel_Time := Duration'Min (Max_Sensible_Delay, Time - Check_Time);
- end if;
- end if;
+ Compute_Deadline
+ (Time => Time,
+ Mode => Mode,
+ Check_Time => Check_Time,
+ Abs_Time => Abs_Time,
+ Rel_Time => Rel_Time);
+ Base_Time := Check_Time;
if Abs_Time > Check_Time then
Request :=
Time : Duration;
Mode : ST.Delay_Modes)
is
- Base_Time : constant Duration := Monotonic_Clock;
- Check_Time : Duration := Base_Time;
+ Base_Time : Duration;
+ Check_Time : Duration;
Abs_Time : Duration;
Rel_Time : Duration;
Request : aliased timespec;
Write_Lock (Self_ID);
- if Mode = Relative then
- Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time;
-
- if Relative_Timed_Wait then
- Rel_Time := Duration'Min (Max_Sensible_Delay, Time);
- end if;
-
- else
- Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
-
- if Relative_Timed_Wait then
- Rel_Time := Duration'Min (Max_Sensible_Delay, Time - Check_Time);
- end if;
- end if;
+ Compute_Deadline
+ (Time => Time,
+ Mode => Mode,
+ Check_Time => Check_Time,
+ Abs_Time => Abs_Time,
+ Rel_Time => Rel_Time);
+ Base_Time := Check_Time;
if Abs_Time > Check_Time then
Request :=
begin
-- Catch attempts to do fixed-point exponentiation with universal
-- operands, which is a case where the illegality is not caught during
- -- normal operator analysis.
+ -- normal operator analysis. This is not done in preanalysis mode
+ -- since the tree is not fully decorated during preanalysis.
- if Is_Fixed_Point_Type (Typ) and then Comes_From_Source (N) then
- Error_Msg_N ("exponentiation not available for fixed point", N);
- return;
+ if Full_Analysis then
+ if Is_Fixed_Point_Type (Typ) and then Comes_From_Source (N) then
+ Error_Msg_N ("exponentiation not available for fixed point", N);
+ return;
- elsif Nkind (Parent (N)) in N_Op
- and then Is_Fixed_Point_Type (Etype (Parent (N)))
- and then Etype (N) = Universal_Real
- and then Comes_From_Source (N)
- then
- Error_Msg_N ("exponentiation not available for fixed point", N);
- return;
+ elsif Nkind (Parent (N)) in N_Op
+ and then Is_Fixed_Point_Type (Etype (Parent (N)))
+ and then Etype (N) = Universal_Real
+ and then Comes_From_Source (N)
+ then
+ Error_Msg_N ("exponentiation not available for fixed point", N);
+ return;
+ end if;
end if;
if Comes_From_Source (N)
end if;
-- We do the resolution using the base type, because intermediate values
- -- in expressions always are of the base type, not a subtype of it.
+ -- in expressions are always of the base type, not a subtype of it.
Resolve (Left_Opnd (N), B_Typ);
Resolve (Right_Opnd (N), Standard_Integer);
projects / gcc.git / commitdiff