From 7f2cf564eba680b23a70b5a610426d6a993a7f4a Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 13 Jul 2009 08:39:28 +0000 Subject: [PATCH] 2009-07-13 Robert Dewar * 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 * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149551 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 29 ++++++++ gcc/ada/a-calend.adb | 4 +- gcc/ada/a-wtdeau.adb | 9 +-- gcc/ada/exp_util.adb | 12 +-- gcc/ada/freeze.adb | 2 +- gcc/ada/g-calend.adb | 46 ++++-------- gcc/ada/g-catiio.adb | 14 ++-- gcc/ada/g-socket.adb | 17 ++--- gcc/ada/gnat_ugn.texi | 2 - gcc/ada/par-ch4.adb | 2 +- gcc/ada/prj.ads | 2 +- gcc/ada/rtsfind.adb | 37 ++++------ gcc/ada/s-arit64.adb | 46 +++--------- gcc/ada/s-direio.adb | 12 +-- gcc/ada/s-imgdec.adb | 7 +- gcc/ada/s-regpat.adb | 171 +++++++++++-------------------------------- gcc/ada/s-scaval.adb | 19 ++--- gcc/ada/s-taskin.adb | 9 +-- gcc/ada/s-tasren.adb | 18 ++--- gcc/ada/s-tassta.adb | 28 ++++--- gcc/ada/s-tpobop.adb | 20 ++--- gcc/ada/s-tposen.adb | 7 +- gcc/ada/s-trafor-default.adb | 11 +-- gcc/ada/s-valwch.adb | 1 - gcc/ada/s-vmexta.adb | 2 +- gcc/ada/sem.adb | 2 +- gcc/ada/sem_ch10.adb | 2 +- gcc/ada/sem_ch6.adb | 2 +- gcc/ada/sem_disp.adb | 4 +- gcc/ada/vxaddr2line.adb | 4 +- 30 files changed, 198 insertions(+), 343 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e04f218..35ffd97 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,34 @@ 2009-07-13 Robert Dewar + * 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 + + * 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 + * freeze.adb (Freeze_Entity): Implement Warn_On_Suspicious_Modulus_Value * gnat_ugn.texi: Add documentation for -gnatw.m/.M diff --git a/gcc/ada/a-calend.adb b/gcc/ada/a-calend.adb index 04ea98b..05c327d 100644 --- a/gcc/ada/a-calend.adb +++ b/gcc/ada/a-calend.adb @@ -1357,8 +1357,8 @@ package body Ada.Calendar is 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; diff --git a/gcc/ada/a-wtdeau.adb b/gcc/ada/a-wtdeau.adb index 48bb16c..78b1029 100644 --- a/gcc/ada/a-wtdeau.adb +++ b/gcc/ada/a-wtdeau.adb @@ -244,11 +244,10 @@ package body Ada.Wide_Text_IO.Decimal_Aux is 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; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 1de9c6e..21183b2 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -1350,7 +1350,7 @@ package body Exp_Util is 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. @@ -4736,15 +4736,17 @@ package body Exp_Util is -- 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 diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 98a23a2..302b431 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1127,7 +1127,7 @@ package body Freeze is 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); diff --git a/gcc/ada/g-calend.adb b/gcc/ada/g-calend.adb index 8ccd433..46d647f 100644 --- a/gcc/ada/g-calend.adb +++ b/gcc/ada/g-calend.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -182,12 +182,7 @@ package body GNAT.Calendar is 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; @@ -370,18 +365,9 @@ package body GNAT.Calendar is 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); @@ -452,11 +438,11 @@ package body GNAT.Calendar is -- 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 @@ -479,11 +465,7 @@ package body GNAT.Calendar is 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 @@ -516,6 +498,8 @@ package body GNAT.Calendar is 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. @@ -551,11 +535,7 @@ package body GNAT.Calendar is -- 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 diff --git a/gcc/ada/g-catiio.adb b/gcc/ada/g-catiio.adb index 469d1c1..66a6480 100644 --- a/gcc/ada/g-catiio.adb +++ b/gcc/ada/g-catiio.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -471,15 +471,11 @@ package body GNAT.Calendar.Time_IO is 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; diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index 22c28ec..badebbc 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -1150,11 +1150,7 @@ package body GNAT.Sockets is -- 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 @@ -1592,6 +1588,7 @@ package body GNAT.Sockets is -- 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; @@ -1873,6 +1870,7 @@ package body GNAT.Sockets is -- 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; @@ -1904,11 +1902,10 @@ package body GNAT.Sockets is 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); diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 35aab90..c88a240 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -4784,8 +4784,6 @@ some error messages. Some examples are: @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 diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index 6bfc40a..c164e60 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -2658,7 +2658,7 @@ package body Ch4 is 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; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 375c7ba..1923df1 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -1236,7 +1236,7 @@ package Prj is 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; diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index 41dae0f..450fdc0 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -158,8 +158,8 @@ package body Rtsfind is -- "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; @@ -537,30 +537,25 @@ package body Rtsfind is -- 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 @@ -869,7 +864,7 @@ package body Rtsfind is 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; diff --git a/gcc/ada/s-arit64.adb b/gcc/ada/s-arit64.adb index 2d18b88..b6f2535 100644 --- a/gcc/ada/s-arit64.adb +++ b/gcc/ada/s-arit64.adb @@ -211,11 +211,7 @@ package body System.Arith_64 is 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; @@ -254,23 +250,13 @@ package body System.Arith_64 is 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; @@ -548,11 +534,9 @@ package body System.Arith_64 is -- 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 @@ -598,27 +582,15 @@ package body System.Arith_64 is -- 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; diff --git a/gcc/ada/s-direio.adb b/gcc/ada/s-direio.adb index 11d2ca6..dee00cd 100644 --- a/gcc/ada/s-direio.adb +++ b/gcc/ada/s-direio.adb @@ -223,11 +223,7 @@ package body System.Direct_IO is -- 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 @@ -376,11 +372,7 @@ package body System.Direct_IO 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 diff --git a/gcc/ada/s-imgdec.adb b/gcc/ada/s-imgdec.adb index efead0b..6ddf5e0 100644 --- a/gcc/ada/s-imgdec.adb +++ b/gcc/ada/s-imgdec.adb @@ -273,12 +273,7 @@ package body System.Img_Dec 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; diff --git a/gcc/ada/s-regpat.adb b/gcc/ada/s-regpat.adb index 68d915f..8d83b93 100755 --- a/gcc/ada/s-regpat.adb +++ b/gcc/ada/s-regpat.adb @@ -7,7 +7,7 @@ -- 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- -- @@ -988,29 +988,23 @@ package body System.Regpat is 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; @@ -1146,15 +1140,9 @@ package body System.Regpat is 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 @@ -1566,11 +1554,9 @@ package body System.Regpat is 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); @@ -1707,11 +1693,10 @@ package body System.Regpat is 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 @@ -1840,36 +1825,23 @@ package body System.Regpat is 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; @@ -1883,14 +1855,8 @@ package body System.Regpat is 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; @@ -1900,12 +1866,7 @@ package body System.Regpat is 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; @@ -1914,14 +1875,8 @@ package body System.Regpat is 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; @@ -1931,14 +1886,8 @@ package body System.Regpat is 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; @@ -1951,23 +1900,15 @@ package body System.Regpat is 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 @@ -1983,14 +1924,8 @@ package body System.Regpat is 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; @@ -2000,14 +1935,8 @@ package body System.Regpat is 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; @@ -2017,14 +1946,8 @@ package body System.Regpat is 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; @@ -2034,12 +1957,7 @@ package body System.Regpat is 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 @@ -2633,11 +2551,10 @@ package body System.Regpat is 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 diff --git a/gcc/ada/s-scaval.adb b/gcc/ada/s-scaval.adb index 415763c..f1742a7 100644 --- a/gcc/ada/s-scaval.adb +++ b/gcc/ada/s-scaval.adb @@ -270,17 +270,14 @@ package body System.Scalar_Values is 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 diff --git a/gcc/ada/s-taskin.adb b/gcc/ada/s-taskin.adb index 35fcbdf..e3d30fc 100644 --- a/gcc/ada/s-taskin.adb +++ b/gcc/ada/s-taskin.adb @@ -187,11 +187,10 @@ package body System.Tasking is -- 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 diff --git a/gcc/ada/s-tasren.adb b/gcc/ada/s-tasren.adb index 7cdde56..35e0dd3 100644 --- a/gcc/ada/s-tasren.adb +++ b/gcc/ada/s-tasren.adb @@ -405,11 +405,10 @@ package body System.Tasking.Rendezvous is -- 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); @@ -1706,11 +1705,10 @@ package body System.Tasking.Rendezvous is -- 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); diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb index 76e3740..e26a09d 100644 --- a/gcc/ada/s-tassta.adb +++ b/gcc/ada/s-tassta.adb @@ -282,11 +282,10 @@ package body System.Tasking.Stages is 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, @@ -517,11 +516,10 @@ package body System.Tasking.Stages is 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 @@ -589,6 +587,7 @@ package body System.Tasking.Stages is -- confused when waiting for these tasks to terminate. T.Master_of_Task := Library_Task_Level; + else T.Master_of_Task := Master; end if; @@ -1075,11 +1074,10 @@ package body System.Tasking.Stages is -- 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 := diff --git a/gcc/ada/s-tpobop.adb b/gcc/ada/s-tpobop.adb index 06102da..13688e6 100644 --- a/gcc/ada/s-tpobop.adb +++ b/gcc/ada/s-tpobop.adb @@ -582,11 +582,9 @@ package body System.Tasking.Protected_Objects.Operations is 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); @@ -972,17 +970,15 @@ package body System.Tasking.Protected_Objects.Operations is 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); diff --git a/gcc/ada/s-tposen.adb b/gcc/ada/s-tposen.adb index a429903..10cfca2 100644 --- a/gcc/ada/s-tposen.adb +++ b/gcc/ada/s-tposen.adb @@ -231,12 +231,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is 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; diff --git a/gcc/ada/s-trafor-default.adb b/gcc/ada/s-trafor-default.adb index 85a6617..93f0e24 100644 --- a/gcc/ada/s-trafor-default.adb +++ b/gcc/ada/s-trafor-default.adb @@ -40,8 +40,8 @@ package body System.Traces.Format is ------------------ 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 @@ -52,7 +52,8 @@ package body System.Traces.Format is 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; @@ -68,8 +69,8 @@ package body System.Traces.Format is (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 diff --git a/gcc/ada/s-valwch.adb b/gcc/ada/s-valwch.adb index fd573f8..b2db500 100644 --- a/gcc/ada/s-valwch.adb +++ b/gcc/ada/s-valwch.adb @@ -119,7 +119,6 @@ package body System.Val_WChar is 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; diff --git a/gcc/ada/s-vmexta.adb b/gcc/ada/s-vmexta.adb index 51c94d6..b19e274 100644 --- a/gcc/ada/s-vmexta.adb +++ b/gcc/ada/s-vmexta.adb @@ -29,7 +29,7 @@ -- -- ------------------------------------------------------------------------------ --- This is an Alpha/VMS package. +-- This is an Alpha/VMS package with System.HTable; pragma Elaborate_All (System.HTable); diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index dad352b..f5beda4 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -1788,7 +1788,7 @@ package body Sem is 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 diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 41c6a72..d715432 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -5721,7 +5721,7 @@ package body Sem_Ch10 is end if; end if; - -- Preserve structure of homonym chain. + -- Preserve structure of homonym chain Set_Homonym (E, Homonym (Lim_Typ)); end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 7fba92c..009af96 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -2637,7 +2637,7 @@ package body Sem_Ch6 is 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)))); diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 239742a..f56fd8a 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -758,7 +758,7 @@ package body Sem_Disp is 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)); @@ -1346,7 +1346,7 @@ package body Sem_Disp is 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)); diff --git a/gcc/ada/vxaddr2line.adb b/gcc/ada/vxaddr2line.adb index 1fd85ec..f1bb48a 100644 --- a/gcc/ada/vxaddr2line.adb +++ b/gcc/ada/vxaddr2line.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -75,7 +75,7 @@ with GNAT.Regpat; use GNAT.Regpat; 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 -- 2.7.4