2009-07-13 Robert Dewar <dewar@adacore.com>
+ * gnat_ugn.texi: The gnatf switch no longer is needed to get full
+ details on unsupported constructs.
+
+ * rtsfind.adb: Remove references to All_Errors_Mode, give errors
+ unconditionally.
+
+ * s-trafor-default.adb: Correct some warnings
+
+ * s-valwch.adb, a-calend.adb, freeze.adb, prj.ads, s-vmexta.adb,
+ sem.adb, sem_ch10.adb, sem_ch6.adb, sem_disp.adb, vxaddr2line.adb:
+ Minor reformatting.
+
+ * par-ch4.adb (Conditional_Expression): Capture proper location for
+ conditional expression, should point to IF.
+
+ * s-tassta.adb, a-wtdeau.adb, s-tasren.adb, s-arit64.adb, s-imgdec.adb,
+ s-direio.adb, s-tpobop.adb, g-socket.adb, s-tposen.adb, s-taskin.adb,
+ g-calend.adb, s-regpat.adb, s-scaval.adb, g-catiio.adb: Minor code
+ reorganization (use conditional expressions).
+
+2009-07-13 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_util.adb (Remove_Side_Effects): If the expression is a call to a
+ build-in-place function that returns an inherently limited type (not
+ just a task type) create proper object declaration so that extra
+ build-in-place actuals are properly added to the call.
+
+2009-07-13 Robert Dewar <dewar@adacore.com>
+
* freeze.adb (Freeze_Entity): Implement Warn_On_Suspicious_Modulus_Value
* gnat_ugn.texi: Add documentation for -gnatw.m/.M
Res_N := Res_N + Duration_To_Time_Rep (Day_Secs);
else
- Res_N := Res_N +
- Time_Rep (Hour * 3_600 + Minute * 60 + Second) * Nano;
+ Res_N :=
+ Res_N + Time_Rep (Hour * 3_600 + Minute * 60 + Second) * Nano;
if Sub_Sec = 1.0 then
Res_N := Res_N + Time_Rep (1) * Nano;
Ptr : Natural := 0;
begin
- if Exp = 0 then
- Fore := To'Length - 1 - Aft;
- else
- Fore := To'Length - 2 - Aft - Exp;
- end if;
+ Fore :=
+ (if Exp = 0
+ then To'Length - 1 - Aft
+ else To'Length - 2 - Aft - Exp);
if Fore < 1 then
raise Layout_Error;
Make_Subtype_From_Expr (Exp, Underlying_Record_View (Unc_Type)));
end if;
- -- In Ada95, Nothing to be done if the type of the expression is
+ -- In Ada95, nothing to be done if the type of the expression is
-- limited, because in this case the expression cannot be copied,
-- and its use can only be by reference.
-- Otherwise we generate a reference to the value
else
- -- Special processing for function calls that return a task. We need
- -- to build a declaration that will enable build-in-place expansion
- -- of the call.
+ -- Special processing for function calls that return a limited type.
+ -- We need to build a declaration that will enable build-in-place
+ -- expansion of the call. This is not done if the context is already
+ -- an object declaration, to prevent infinite recursion.
-- This is relevant only in Ada 2005 mode. In Ada 95 programs we have
-- to accommodate functions returning limited objects by reference.
if Nkind (Exp) = N_Function_Call
- and then Is_Task_Type (Etype (Exp))
+ and then Is_Inherently_Limited_Type (Etype (Exp))
+ and then Nkind (Parent (Exp)) /= N_Object_Declaration
and then Ada_Version >= Ada_05
then
declare
begin
Par := Parent (E);
- -- Array may be qualified, so find outer context.
+ -- Array may be qualified, so find outer context
if Nkind (Par) = N_Qualified_Expression then
Par := Parent (Par);
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2008, AdaCore --
+-- Copyright (C) 1999-2009, 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- --
begin
Split (Date, Year, Month, Day, Day_Secs);
- if Day_Secs = 0.0 then
- Secs := 0;
- else
- Secs := Natural (Day_Secs - 0.5);
- end if;
-
+ Secs := (if Day_Secs = 0.0 then 0 else Natural (Day_Secs - 0.5));
Sub_Second := Second_Duration (Day_Secs - Day_Duration (Secs));
Hour := Hour_Number (Secs / 3_600);
Secs := Secs mod 3_600;
begin
if Last_Year then
- if Is_Leap (Year - 1) then
- Shift := -2;
- else
- Shift := -1;
- end if;
-
+ Shift := (if Is_Leap (Year - 1) then -2 else -1);
elsif Next_Year then
- if Is_Leap (Year) then
- Shift := 2;
- else
- Shift := 1;
- end if;
+ Shift := (if Is_Leap (Year) then 2 else 1);
end if;
return Day_Name'Val ((Day_Name'Pos (Jan_1) + Shift) mod 7);
-- when special casing the first week of January and the last week of
-- December.
- if Day = 1 and then Month = 1 then
- Jan_1 := Day_Of_Week (Date);
- else
- Jan_1 := Day_Of_Week (Time_Of (Year, 1, 1, 0.0));
- end if;
+ Jan_1 := Day_Of_Week (if Day = 1 and then Month = 1
+ then Date
+ else (Time_Of (Year, 1, 1, 0.0)));
+
+ -- Special cases for January
if Month = 1 then
or else
(Day = 3 and then Jan_1 = Friday)
then
- if Last_Year_Has_53_Weeks (Jan_1, Year) then
- Week := 53;
- else
- Week := 52;
- end if;
+ Week := (if Last_Year_Has_53_Weeks (Jan_1, Year) then 53 else 52);
-- January 1, 2 and 3 belong to the previous year
return;
end if;
+ -- Month other than 1
+
-- Special case 3: December 29, 30 and 31. These days may belong to
-- next year's first week.
-- not belong to the first week of the input year, then the next week
-- is the first week.
- if Jan_1 in Friday .. Sunday then
- Start_Week := 1;
- else
- Start_Week := 2;
- end if;
+ Start_Week := (if Jan_1 in Friday .. Sunday then 1 else 2);
-- At this point all special combinations have been accounted for and
-- the proper start week has been found. Since January 1 may not fall
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2008, AdaCore --
+-- Copyright (C) 1999-2009, 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- --
when 'w' =>
declare
- DOW : Natural range 0 .. 6;
-
+ DOW : constant Natural range 0 .. 6 :=
+ (if Day_Of_Week (Date) = Sunday
+ then 0
+ else Day_Name'Pos (Day_Of_Week (Date)));
begin
- if Day_Of_Week (Date) = Sunday then
- DOW := 0;
- else
- DOW := Day_Name'Pos (Day_Of_Week (Date));
- end if;
-
Result := Result & Image (DOW, Length => 1);
end;
-- Start of processing for Image
begin
- if Hex then
- Separator := ':';
- else
- Separator := '.';
- end if;
+ Separator := (if Hex then ':' else '.');
for J in Val'Range loop
if Hex then
-- Last is set to Stream_Element_Offset'Last.
Last := Ada.Streams.Stream_Element_Offset'Last;
+
else
Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
end if;
-- Last is set to Stream_Element_Offset'Last.
Last := Ada.Streams.Stream_Element_Offset'Last;
+
else
Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
end if;
pragma Warnings (Off);
-- Following test may be compile time known on some targets
- if Vector'Length - Iov_Count > SOSC.IOV_MAX then
- This_Iov_Count := SOSC.IOV_MAX;
- else
- This_Iov_Count := Vector'Length - Iov_Count;
- end if;
+ This_Iov_Count :=
+ (if Vector'Length - Iov_Count > SOSC.IOV_MAX
+ then SOSC.IOV_MAX
+ else Vector'Length - Iov_Count);
pragma Warnings (On);
@itemize @bullet
@item
-Full details on entities not available in high integrity mode
-@item
Details on possibly non-portable unchecked conversion
@item
List possible interpretations for ambiguous calls
function P_Conditional_Expression return Node_Id is
Exprs : constant List_Id := New_List;
- Loc : constant Source_Ptr := Scan_Ptr;
+ Loc : constant Source_Ptr := Token_Ptr;
Expr : Node_Id;
State : Saved_Scan_State;
end record;
function Empty_Project return Project_Data;
- -- Return the representation of an empty project.
+ -- Return the representation of an empty project
function Is_Extending
(Extending : Project_Id;
-- "had semantic errors"
--
-- The "not found" case is treated specially in that it is considered
- -- a normal situation in configurable run-time mode (and the message in
- -- this case is suppressed unless we are operating in All_Errors_Mode).
+ -- a normal situation in configurable run-time mode, and generates
+ -- a warning, but is otherwise ignored.
procedure Load_RTU
(U_Id : RTU_Id;
-- Output file name and reason string
- if S /= "not found"
- or else not Configurable_Run_Time_Mode
- or else All_Errors_Mode
- then
- M (1 .. 6) := "\file ";
- P := 6;
+ M (1 .. 6) := "\file ";
+ P := 6;
- Get_Name_String
- (Get_File_Name (RT_Unit_Table (U_Id).Uname, Subunit => False));
- M (P + 1 .. P + Name_Len) := Name_Buffer (1 .. Name_Len);
- P := P + Name_Len;
+ Get_Name_String
+ (Get_File_Name (RT_Unit_Table (U_Id).Uname, Subunit => False));
+ M (P + 1 .. P + Name_Len) := Name_Buffer (1 .. Name_Len);
+ P := P + Name_Len;
- M (P + 1) := ' ';
- P := P + 1;
+ M (P + 1) := ' ';
+ P := P + 1;
- M (P + 1 .. P + S'Length) := S;
- P := P + S'Length;
+ M (P + 1 .. P + S'Length) := S;
+ P := P + S'Length;
- RTE_Error_Msg (M (1 .. P));
+ RTE_Error_Msg (M (1 .. P));
- -- Output entity name
+ -- Output entity name
- Output_Entity_Name (Id, "not available");
- end if;
+ Output_Entity_Name (Id, "not available");
-- In configurable run time mode, we raise RE_Not_Available, and the
-- caller is expected to deal gracefully with this. In the case of a
RE_Image : constant String := RE_Id'Image (Id);
begin
- if Id = RE_Null or else not All_Errors_Mode then
+ if Id = RE_Null then
return;
end if;
end if;
else
- if Zhi /= 0 then
- T2 := Ylo * Zhi;
- else
- T2 := 0;
- end if;
+ T2 := (if Zhi /= 0 then Ylo * Zhi else 0);
end if;
T1 := Ylo * Zlo;
if X >= 0 then
R := To_Int (Ru);
-
- if Den_Pos then
- Q := To_Int (Qu);
- else
- Q := -To_Int (Qu);
- end if;
+ Q := (if Den_Pos then To_Int (Qu) else -To_Int (Qu));
-- Case of dividend (X) sign negative
else
R := -To_Int (Ru);
-
- if Den_Pos then
- Q := -To_Int (Qu);
- else
- Q := To_Int (Qu);
- end if;
+ Q := (if Den_Pos then -To_Int (Qu) else To_Int (Qu));
end if;
end Double_Divide;
-- which ensured the first bit of the divisor is set, this gives
-- an estimate of the quotient that is at most two too high.
- if D (J + 1) = Zhi then
- Qd (J + 1) := 2 ** 32 - 1;
- else
- Qd (J + 1) := Lo ((D (J + 1) & D (J + 2)) / Zhi);
- end if;
+ Qd (J + 1) := (if D (J + 1) = Zhi
+ then 2 ** 32 - 1
+ else Lo ((D (J + 1) & D (J + 2)) / Zhi));
-- Compute amount to subtract
-- Case of dividend (X * Y) sign positive
- if (X >= 0 and then Y >= 0)
- or else (X < 0 and then Y < 0)
- then
+ if (X >= 0 and then Y >= 0) or else (X < 0 and then Y < 0) then
R := To_Pos_Int (Ru);
-
- if Z > 0 then
- Q := To_Pos_Int (Qu);
- else
- Q := To_Neg_Int (Qu);
- end if;
+ Q := (if Z > 0 then To_Pos_Int (Qu) else To_Neg_Int (Qu));
-- Case of dividend (X * Y) sign negative
else
R := To_Neg_Int (Ru);
-
- if Z > 0 then
- Q := To_Neg_Int (Qu);
- else
- Q := To_Pos_Int (Qu);
- end if;
+ Q := (if Z > 0 then To_Neg_Int (Qu) else To_Pos_Int (Qu));
end if;
end Scaled_Divide;
-- last operation as other, to force the file position to be reset
-- on the next read.
- if File.Bytes = Size then
- File.Last_Op := Op_Read;
- else
- File.Last_Op := Op_Other;
- end if;
+ File.Last_Op := (if File.Bytes = Size then Op_Read else Op_Other);
end Read;
-- The following is the required overriding for Stream.Read, which is
-- last operation as other, to force the file position to be reset
-- on the next write.
- if File.Bytes = Size then
- File.Last_Op := Op_Write;
- else
- File.Last_Op := Op_Other;
- end if;
+ File.Last_Op := (if File.Bytes = Size then Op_Write else Op_Other);
end Write;
-- The following is the required overriding for Stream.Write, which is
-- exception is for the value zero, which by convention has an
-- exponent of +0.
- if Zero then
- Expon := 0;
- else
- Expon := Digits_Before_Point - 1;
- end if;
-
+ Expon := (if Zero then 0 else Digits_Before_Point - 1);
Set ('E');
ND := 0;
-- B o d y --
-- --
-- Copyright (C) 1986 by University of Toronto. --
--- Copyright (C) 1999-2008, AdaCore --
+-- Copyright (C) 1999-2009, 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- --
case (C) is
when '^' =>
- if (Flags and Multiple_Lines) /= 0 then
- IP := Emit_Node (MBOL);
- elsif (Flags and Single_Line) /= 0 then
- IP := Emit_Node (SBOL);
- else
- IP := Emit_Node (BOL);
- end if;
+ IP :=
+ Emit_Node
+ (if (Flags and Multiple_Lines) /= 0 then MBOL
+ elsif (Flags and Single_Line) /= 0 then SBOL
+ else BOL);
when '$' =>
- if (Flags and Multiple_Lines) /= 0 then
- IP := Emit_Node (MEOL);
- elsif (Flags and Single_Line) /= 0 then
- IP := Emit_Node (SEOL);
- else
- IP := Emit_Node (EOL);
- end if;
+ IP :=
+ Emit_Node
+ (if (Flags and Multiple_Lines) /= 0 then MEOL
+ elsif (Flags and Single_Line) /= 0 then SEOL
+ else EOL);
when '.' =>
- if (Flags and Single_Line) /= 0 then
- IP := Emit_Node (SANY);
- else
- IP := Emit_Node (ANY);
- end if;
+ IP :=
+ Emit_Node
+ (if (Flags and Single_Line) /= 0 then SANY else ANY);
Expr_Flags.Has_Width := True;
Expr_Flags.Simple := True;
begin
Flags := Worst_Expression; -- Tentatively
-
- if First then
- IP := Emit_Ptr;
- else
- IP := Emit_Node (BRANCH);
- end if;
+ IP := (if First then Emit_Ptr else Emit_Node (BRANCH));
Chain := 0;
-
while Parse_Pos <= Parse_End
and then E (Parse_Pos) /= ')'
and then E (Parse_Pos) /= ASCII.LF
begin
Parse_Pos := Parse_Pos - 1; -- Look at current character
- if (Flags and Case_Insensitive) /= 0 then
- IP := Emit_Node (EXACTF);
- else
- IP := Emit_Node (EXACT);
- end if;
+ IP :=
+ Emit_Node
+ (if (Flags and Case_Insensitive) /= 0 then EXACTF else EXACT);
Length_Ptr := Emit_Ptr;
Emit_Ptr := String_Operand (IP);
Op := Expression (Parse_Pos);
- if Op /= '+' then
- Expr_Flags := (SP_Start => True, others => False);
- else
- Expr_Flags := (Has_Width => True, others => False);
- end if;
+ Expr_Flags :=
+ (if Op /= '+'
+ then (SP_Start => True, others => False)
+ else (Has_Width => True, others => False));
-- Detect non greedy operators in the easy cases
if
E (Parse_Pos .. Parse_Pos + Alnum'Length - 1) = Alnum
then
- if Invert then
- Class := ANYOF_NALNUMC;
- else
- Class := ANYOF_ALNUMC;
- end if;
-
+ Class :=
+ (if Invert then ANYOF_NALNUMC else ANYOF_ALNUMC);
Parse_Pos := Parse_Pos + Alnum'Length;
elsif
E (Parse_Pos .. Parse_Pos + Alpha'Length - 1) = Alpha
then
- if Invert then
- Class := ANYOF_NALPHA;
- else
- Class := ANYOF_ALPHA;
- end if;
-
+ Class :=
+ (if Invert then ANYOF_NALPHA else ANYOF_ALPHA);
Parse_Pos := Parse_Pos + Alpha'Length;
elsif E (Parse_Pos .. Parse_Pos + Ascii_C'Length - 1) =
Ascii_C
then
- if Invert then
- Class := ANYOF_NASCII;
- else
- Class := ANYOF_ASCII;
- end if;
-
+ Class :=
+ (if Invert then ANYOF_NASCII else ANYOF_ASCII);
Parse_Pos := Parse_Pos + Ascii_C'Length;
-
else
Fail ("Invalid character class: " & E);
end if;
and then
E (Parse_Pos .. Parse_Pos + Cntrl'Length - 1) = Cntrl
then
- if Invert then
- Class := ANYOF_NCNTRL;
- else
- Class := ANYOF_CNTRL;
- end if;
-
+ Class := (if Invert then ANYOF_NCNTRL else ANYOF_CNTRL);
Parse_Pos := Parse_Pos + Cntrl'Length;
-
else
Fail ("Invalid character class: " & E);
end if;
and then
E (Parse_Pos .. Parse_Pos + Digit'Length - 1) = Digit
then
- if Invert then
- Class := ANYOF_NDIGIT;
- else
- Class := ANYOF_DIGIT;
- end if;
-
+ Class := (if Invert then ANYOF_NDIGIT else ANYOF_DIGIT);
Parse_Pos := Parse_Pos + Digit'Length;
end if;
and then
E (Parse_Pos .. Parse_Pos + Graph'Length - 1) = Graph
then
- if Invert then
- Class := ANYOF_NGRAPH;
- else
- Class := ANYOF_GRAPH;
- end if;
-
+ Class := (if Invert then ANYOF_NGRAPH else ANYOF_GRAPH);
Parse_Pos := Parse_Pos + Graph'Length;
-
else
Fail ("Invalid character class: " & E);
end if;
and then
E (Parse_Pos .. Parse_Pos + Lower'Length - 1) = Lower
then
- if Invert then
- Class := ANYOF_NLOWER;
- else
- Class := ANYOF_LOWER;
- end if;
-
+ Class := (if Invert then ANYOF_NLOWER else ANYOF_LOWER);
Parse_Pos := Parse_Pos + Lower'Length;
-
else
Fail ("Invalid character class: " & E);
end if;
if
E (Parse_Pos .. Parse_Pos + Print'Length - 1) = Print
then
- if Invert then
- Class := ANYOF_NPRINT;
- else
- Class := ANYOF_PRINT;
- end if;
-
+ Class :=
+ (if Invert then ANYOF_NPRINT else ANYOF_PRINT);
Parse_Pos := Parse_Pos + Print'Length;
elsif
E (Parse_Pos .. Parse_Pos + Punct'Length - 1) = Punct
then
- if Invert then
- Class := ANYOF_NPUNCT;
- else
- Class := ANYOF_PUNCT;
- end if;
-
+ Class :=
+ (if Invert then ANYOF_NPUNCT else ANYOF_PUNCT);
Parse_Pos := Parse_Pos + Punct'Length;
else
and then
E (Parse_Pos .. Parse_Pos + Space'Length - 1) = Space
then
- if Invert then
- Class := ANYOF_NSPACE;
- else
- Class := ANYOF_SPACE;
- end if;
-
+ Class := (if Invert then ANYOF_NSPACE else ANYOF_SPACE);
Parse_Pos := Parse_Pos + Space'Length;
-
else
Fail ("Invalid character class: " & E);
end if;
and then
E (Parse_Pos .. Parse_Pos + Upper'Length - 1) = Upper
then
- if Invert then
- Class := ANYOF_NUPPER;
- else
- Class := ANYOF_UPPER;
- end if;
-
+ Class := (if Invert then ANYOF_NUPPER else ANYOF_UPPER);
Parse_Pos := Parse_Pos + Upper'Length;
-
else
Fail ("Invalid character class: " & E);
end if;
and then
E (Parse_Pos .. Parse_Pos + Word'Length - 1) = Word
then
- if Invert then
- Class := ANYOF_NALNUM;
- else
- Class := ANYOF_ALNUM;
- end if;
-
+ Class := (if Invert then ANYOF_NALNUM else ANYOF_ALNUM);
Parse_Pos := Parse_Pos + Word'Length;
-
else
Fail ("Invalid character class: " & E);
end if;
and then
E (Parse_Pos .. Parse_Pos + Xdigit'Length - 1) = Xdigit
then
- if Invert then
- Class := ANYOF_NXDIGIT;
- else
- Class := ANYOF_XDIGIT;
- end if;
-
+ Class := (if Invert then ANYOF_NXDIGIT else ANYOF_XDIGIT);
Parse_Pos := Parse_Pos + Xdigit'Length;
else
N := Is_Alnum (Data (Input_Pos - 1));
end if;
- if Input_Pos > Last_In_Data then
- Ln := False;
- else
- Ln := Is_Alnum (Data (Input_Pos));
- end if;
+ Ln :=
+ (if Input_Pos > Last_In_Data
+ then False
+ else Is_Alnum (Data (Input_Pos)));
if Op = BOUND then
if N = Ln then
else
-- Convert the two hex digits (we know they are valid here)
- if C1 in '0' .. '9' then
- B := Character'Pos (C1) - Character'Pos ('0');
- else
- B := Character'Pos (C1) - (Character'Pos ('A') - 10);
- end if;
-
- if C2 in '0' .. '9' then
- B := B * 16 + Character'Pos (C2) - Character'Pos ('0');
- else
- B := B * 16 + Character'Pos (C2) - (Character'Pos ('A') - 10);
- end if;
+ B := 16 * (Character'Pos (C1)
+ - (if C1 in '0' .. '9'
+ then Character'Pos ('0')
+ else Character'Pos ('A') - 10))
+ + (Character'Pos (C2)
+ - (if C2 in '0' .. '9'
+ then Character'Pos ('0')
+ else Character'Pos ('A') - 10));
-- Initialize data values from the hex value
-- Initialize Environment Task
- if Main_Priority = Unspecified_Priority then
- Base_Priority := Default_Priority;
- else
- Base_Priority := Priority (Main_Priority);
- end if;
+ Base_Priority :=
+ (if Main_Priority = Unspecified_Priority
+ then Default_Priority
+ else Priority (Main_Priority));
T := STPO.New_ATCB (0);
Initialize_ATCB
-- If this is a call made inside of an abort deferred region,
-- the call should be never abortable.
- if Self_Id.Deferral_Level > 1 then
- Entry_Call.State := Never_Abortable;
- else
- Entry_Call.State := Now_Abortable;
- end if;
+ Entry_Call.State :=
+ (if Self_Id.Deferral_Level > 1
+ then Never_Abortable
+ else Now_Abortable);
Entry_Call.E := Entry_Index (E);
Entry_Call.Prio := Get_Priority (Self_Id);
-- If this is a call made inside of an abort deferred region,
-- the call should be never abortable.
- if Self_Id.Deferral_Level > 1 then
- Entry_Call.State := Never_Abortable;
- else
- Entry_Call.State := Now_Abortable;
- end if;
+ Entry_Call.State :=
+ (if Self_Id.Deferral_Level > 1
+ then Never_Abortable
+ else Now_Abortable);
Entry_Call.E := Entry_Index (E);
Entry_Call.Prio := Get_Priority (Self_Id);
Write_Lock (P);
Write_Lock (C);
- if C.Common.Base_Priority < Get_Priority (Self_ID) then
- Activate_Prio := Get_Priority (Self_ID);
- else
- Activate_Prio := C.Common.Base_Priority;
- end if;
+ Activate_Prio :=
+ (if C.Common.Base_Priority < Get_Priority (Self_ID)
+ then Get_Priority (Self_ID)
+ else C.Common.Base_Priority);
System.Task_Primitives.Operations.Create_Task
(C, Task_Wrapper'Address,
pragma Debug (Debug.Trace (Self_ID, "Create_Task", 'C'));
- if Priority = Unspecified_Priority then
- Base_Priority := Self_ID.Common.Base_Priority;
- else
- Base_Priority := System.Any_Priority (Priority);
- end if;
+ Base_Priority :=
+ (if Priority = Unspecified_Priority
+ then Self_ID.Common.Base_Priority
+ else System.Any_Priority (Priority));
-- Find parent P of new Task, via master level number
-- confused when waiting for these tasks to terminate.
T.Master_of_Task := Library_Task_Level;
+
else
T.Master_of_Task := Master;
end if;
-- Assume a size of the stack taken at this stage
- if Size < Small_Stack_Limit then
- Overflow_Guard := Small_Overflow_Guard;
- else
- Overflow_Guard := Big_Overflow_Guard;
- end if;
+ Overflow_Guard :=
+ (if Size < Small_Stack_Limit
+ then Small_Overflow_Guard
+ else Big_Overflow_Guard);
if not Parameters.Sec_Stack_Dynamic then
Self_ID.Common.Compiler_Data.Sec_Stack_Addr :=
Entry_Call.Mode := Mode;
Entry_Call.Cancellation_Attempted := False;
- if Self_ID.Deferral_Level > 1 then
- Entry_Call.State := Never_Abortable;
- else
- Entry_Call.State := Now_Abortable;
- end if;
+ Entry_Call.State :=
+ (if Self_ID.Deferral_Level > 1
+ then Never_Abortable else Now_Abortable);
Entry_Call.E := Entry_Index (E);
Entry_Call.Prio := STPO.Get_Priority (Self_ID);
pragma Debug
(Debug.Trace (Self_Id, "TPEC: exited to ATC level: " &
ATC_Level'Image (Self_Id.ATC_Nesting_Level), 'A'));
- Entry_Call :=
- Self_Id.Entry_Calls (Self_Id.ATC_Nesting_Level)'Access;
+ Entry_Call := Self_Id.Entry_Calls (Self_Id.ATC_Nesting_Level)'Access;
Entry_Call.Next := null;
Entry_Call.Mode := Timed_Call;
Entry_Call.Cancellation_Attempted := False;
- if Self_Id.Deferral_Level > 1 then
- Entry_Call.State := Never_Abortable;
- else
- Entry_Call.State := Now_Abortable;
- end if;
+ Entry_Call.State :=
+ (if Self_Id.Deferral_Level > 1
+ then Never_Abortable
+ else Now_Abortable);
Entry_Call.E := Entry_Index (E);
Entry_Call.Prio := STPO.Get_Priority (Self_Id);
STPO.Timed_Sleep
(Self_Id, Wakeup_Time, Mode, Entry_Caller_Sleep, Timedout, Yielded);
- if Timedout then
- Entry_Call.State := Cancelled;
- else
- Entry_Call.State := Done;
- end if;
-
+ Entry_Call.State := (if Timedout then Cancelled else Done);
Self_Id.Common.State := Runnable;
end Wait_For_Completion_With_Timeout;
------------------
function Format_Trace (Source : String) return String_Trace is
- Length : Integer := Source'Length;
- Result : String_Trace := (others => ' ');
+ Length : constant Integer := Source'Length;
+ Result : String_Trace := (others => ' ');
begin
-- If run-time tracing active, then fill the string
Result (Length + 1 .. Max_Size) := (others => ' ');
Result (Length + 1) := ASCII.NUL;
else
- Result (1 .. Max_Size - 1) := Source (1 .. Max_Size - 1);
+ Result (1 .. Max_Size - 1) :=
+ Source (Source'First .. Source'First - 1 + Max_Size - 1);
Result (Max_Size) := ASCII.NUL;
end if;
end if;
(Source : String_Trace;
Annex : String) return String_Trace
is
- Result : String_Trace := (others => ' ');
- Annex_Length : Integer := Annex'Length;
+ Result : String_Trace := (others => ' ');
+ Annex_Length : constant Integer := Annex'Length;
Source_Length : Integer;
begin
if S (F + 1) = '[' then
W := Wide_Wide_Character'Val (UTF_32 ('[', WCEM_Brackets));
-
else
W := Wide_Wide_Character'Val (UTF_32 (S (F + 1), EM));
end if;
-- --
------------------------------------------------------------------------------
--- This is an Alpha/VMS package.
+-- This is an Alpha/VMS package
with System.HTable;
pragma Elaborate_All (System.HTable);
end;
end loop;
- -- Now traverse compilation units in order.
+ -- Now traverse compilation units in order
Cur := First_Elmt (Comp_Unit_List);
while Present (Cur) loop
end if;
end if;
- -- Preserve structure of homonym chain.
+ -- Preserve structure of homonym chain
Set_Homonym (E, Homonym (Lim_Typ));
end if;
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (Make_Null_Statement (Loc))));
- -- Create new entities for body and formals.
+ -- Create new entities for body and formals
Set_Defining_Unit_Name (Specification (Null_Body),
Make_Defining_Identifier (Loc, Chars (Defining_Entity (N))));
E := First_Entity (Subp);
while Present (E) loop
- -- For an access parameter, check designated type.
+ -- For an access parameter, check designated type
if Ekind (Etype (E)) = E_Anonymous_Access_Type then
Typ := Designated_Type (Etype (E));
Set_Scope (Subp, Current_Scope);
Tagged_Type := Find_Dispatching_Type (Subp);
- -- Add Old_Subp to primitive operations if not already present.
+ -- Add Old_Subp to primitive operations if not already present
if Present (Tagged_Type) and then Is_Tagged_Type (Tagged_Type) then
Append_Unique_Elmt (Old_Subp, Primitive_Operations (Tagged_Type));
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2008, AdaCore --
+-- Copyright (C) 2002-2009, 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- --
procedure VxAddr2Line is
package Unsigned_32_IO is new Modular_IO (Unsigned_32);
- -- Instantiate Modular_IO to have Put.
+ -- Instantiate Modular_IO to have Put
Ref_Symbol : constant String := "adainit";
-- This is the name of the reference symbol which runtime address shall
projects / platform / upstream / linaro-gcc.git / commitdiff