diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 21 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 34 | ||||
| -rw-r--r-- | gcc/ada/prj-conf.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/s-taprop-posix.adb | 97 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 27 |
5 files changed, 122 insertions, 61 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6fd73d0..ddec47a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +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 diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index e8a2d9f..79b0a0d 100644 --- a/gcc/ada/freeze.adb +++ b/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; diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index fcd0ce3..f16509b 100644 --- a/gcc/ada/prj-conf.adb +++ b/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 diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb index 667603b..275828d 100644 --- a/gcc/ada/s-taprop-posix.adb +++ b/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 := diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 387e06f..ca2b551 100644 --- a/gcc/ada/sem_res.adb +++ b/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); |