Skip to content

R
riscv-gcc-1
Commit 4530b919 by Arnaud Charlet
Options

[multiple changes] 

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).

From-SVN: r203362
parent 4169c2d2
Showing with 122 additions and 61 deletions
gcc/ada/ChangeLog
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
......
gcc/ada/freeze.adb
......@@ -2766,20 +2766,28 @@ package body Freeze is
-- 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;
......
gcc/ada/prj-conf.adb
......@@ -643,8 +643,8 @@ package body Prj.Conf is
-- 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
......
gcc/ada/s-taprop-posix.adb
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -178,6 +178,18 @@ package body System.Task_Primitives.Operations is
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 --
-------------------
......@@ -236,6 +248,36 @@ package body System.Task_Primitives.Operations is
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 --
-----------------
......@@ -528,10 +570,11 @@ package body System.Task_Primitives.Operations is
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;
......@@ -539,20 +582,13 @@ package body System.Task_Primitives.Operations is
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 :=
......@@ -597,8 +633,8 @@ package body System.Task_Primitives.Operations is
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;
......@@ -613,20 +649,13 @@ package body System.Task_Primitives.Operations is
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 :=
......
gcc/ada/sem_res.adb
......@@ -8295,19 +8295,22 @@ package body Sem_Res is
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)
......@@ -8326,7 +8329,7 @@ package body Sem_Res is
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);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment