From ec40265d92e9db6dd4fac77cbe77138c3a5ebc35 Mon Sep 17 00:00:00 2001 From: charlet Date: Fri, 30 Oct 2009 13:27:40 +0000 Subject: [PATCH] 2009-10-30 Robert Dewar * a-tideio.adb: Minor reformatting * a-wtdeio.adb, a-ztdeio.adb: Update comments, code clean up. * a-reatim.adb, a-tideau.adb, a-ngelfu.adb, a-ztdeau.adb, a-ngrear.adb, a-wtedit.adb, a-ststio.adb, a-ztedit.adb: Minor code reorganization (use conditional expressions). 2009-10-30 Ed Schonberg * gnat_ugn.texi: Additional info on gnatw.i and gnatw.I * sem_case.adb: Improved error message. 2009-10-30 Emmanuel Briot * a-direct.adb, gnatcmd.adb, gnatname.adb, makeutl.adb, opt.ads, osint.adb, prj-ext.adb, switch-m.adb (Follow_Links_For_Dirs): Now defaults to False, and controlled by -eL. * a-direct.adb: Add comments. * osint.adb (File_Stamp): Avoid unneeded duplicate system call git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@153744 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 23 +++++++++++++++++++++++ gcc/ada/a-direct.adb | 6 ++++++ gcc/ada/a-ngelfu.adb | 19 +++++-------------- gcc/ada/a-ngrear.adb | 6 +----- gcc/ada/a-reatim.adb | 15 ++++----------- gcc/ada/a-ststio.adb | 6 +----- gcc/ada/a-tideau.adb | 7 ++----- gcc/ada/a-tideio.adb | 1 - gcc/ada/a-wtdeio.adb | 10 ++-------- gcc/ada/a-wtedit.adb | 34 ++++++++++++++-------------------- gcc/ada/a-ztdeau.adb | 7 ++----- gcc/ada/a-ztdeio.adb | 10 ++-------- gcc/ada/a-ztedit.adb | 19 ++++++------------- gcc/ada/gnat_ugn.texi | 12 +++++++++--- gcc/ada/gnatcmd.adb | 1 + gcc/ada/gnatname.adb | 1 + gcc/ada/makeutl.adb | 4 +++- gcc/ada/opt.ads | 2 +- gcc/ada/osint.adb | 20 +++++++++++++------- gcc/ada/prj-ext.adb | 5 ++++- gcc/ada/sem_case.adb | 6 +++--- gcc/ada/switch-m.adb | 1 + 22 files changed, 104 insertions(+), 111 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3e021e9..e3943b6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,28 @@ 2009-10-30 Robert Dewar + * a-tideio.adb: Minor reformatting + * a-wtdeio.adb, a-ztdeio.adb: Update comments, code clean up. + + * a-reatim.adb, a-tideau.adb, a-ngelfu.adb, a-ztdeau.adb, a-ngrear.adb, + a-wtedit.adb, a-ststio.adb, a-ztedit.adb: Minor code reorganization + (use conditional expressions). + +2009-10-30 Ed Schonberg + + * gnat_ugn.texi: Additional info on gnatw.i and gnatw.I + + * sem_case.adb: Improved error message. + +2009-10-30 Emmanuel Briot + + * a-direct.adb, gnatcmd.adb, gnatname.adb, makeutl.adb, opt.ads, + osint.adb, prj-ext.adb, switch-m.adb (Follow_Links_For_Dirs): Now + defaults to False, and controlled by -eL. + * a-direct.adb: Add comments. + * osint.adb (File_Stamp): Avoid unneeded duplicate system call + +2009-10-30 Robert Dewar + * sem_res.adb (Resolve_Type_Conversion): Avoid false positive when converting non-static subtype to "identical" static subtype. diff --git a/gcc/ada/a-direct.adb b/gcc/ada/a-direct.adb index f0182c6..ae7a28e 100644 --- a/gcc/ada/a-direct.adb +++ b/gcc/ada/a-direct.adb @@ -210,6 +210,8 @@ package body Ada.Directories is else declare + -- We need to resolve links because of A.16(47), since we must not + -- return alternative names for files Norm : constant String := Normalize_Pathname (Name); Last_DS : constant Natural := Strings.Fixed.Index @@ -441,6 +443,8 @@ package body Ada.Directories is Local_Get_Current_Dir (Buffer'Address, Path_Len'Address); declare + -- We need to resolve links because of A.16(47), since we must not + -- return alternative names for files Cur : constant String := Normalize_Pathname (Buffer (1 .. Path_Len)); begin @@ -781,6 +785,8 @@ package body Ada.Directories is -- Use System.OS_Lib.Normalize_Pathname declare + -- We need to resolve links because of A.16(47), since we must not + -- return alternative names for files Value : constant String := Normalize_Pathname (Name); subtype Result is String (1 .. Value'Length); begin diff --git a/gcc/ada/a-ngelfu.adb b/gcc/ada/a-ngelfu.adb index ef9aadd..55d14e7 100644 --- a/gcc/ada/a-ngelfu.adb +++ b/gcc/ada/a-ngelfu.adb @@ -729,21 +729,12 @@ package body Ada.Numerics.Generic_Elementary_Functions is Raw_Atan : Float_Type'Base; begin - if abs Y > abs X then - Z := abs (X / Y); - else - Z := abs (Y / X); - end if; - - if Z < Sqrt_Epsilon then - Raw_Atan := Z; + Z := (if abs Y > abs X then abs (X / Y) else abs (Y / X)); - elsif Z = 1.0 then - Raw_Atan := Pi / 4.0; - - else - Raw_Atan := Float_Type'Base (Aux.Atan (Double (Z))); - end if; + Raw_Atan := + (if Z < Sqrt_Epsilon then Z + elsif Z = 1.0 then Pi / 4.0 + else Float_Type'Base (Aux.Atan (Double (Z)))); if abs Y > abs X then Raw_Atan := Half_Pi - Raw_Atan; diff --git a/gcc/ada/a-ngrear.adb b/gcc/ada/a-ngrear.adb index b0cf3e1..5c8a009 100644 --- a/gcc/ada/a-ngrear.adb +++ b/gcc/ada/a-ngrear.adb @@ -433,11 +433,7 @@ package body Ada.Numerics.Generic_Real_Arrays is end if; for J in 1 .. N loop - if Piv (J) /= J then - Det := -Det * LU (J, J); - else - Det := Det * LU (J, J); - end if; + Det := (if Piv (J) /= J then -Det * LU (J, J) else Det * LU (J, J)); end loop; return Det; diff --git a/gcc/ada/a-reatim.adb b/gcc/ada/a-reatim.adb index 2ca4472..c3cbec6 100644 --- a/gcc/ada/a-reatim.adb +++ b/gcc/ada/a-reatim.adb @@ -7,7 +7,7 @@ -- B o d y -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2006, AdaCore -- +-- Copyright (C) 1995-2009, AdaCore -- -- -- -- 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- -- @@ -189,19 +189,12 @@ package body Ada.Real_Time is -- Special-case for Time_First, whose absolute value is anomalous, -- courtesy of two's complement. - if T = Time_First then - T_Val := abs (Time_Last); - else - T_Val := abs (T); - end if; + T_Val := (if T = Time_First then abs (Time_Last) else abs (T)); -- Extract the integer part of T, truncating towards zero - if T_Val < 0.5 then - SC := 0; - else - SC := Seconds_Count (Time_Span'(T_Val - 0.5)); - end if; + SC := + (if T_Val < 0.5 then 0 else Seconds_Count (Time_Span'(T_Val - 0.5))); if T < 0.0 then SC := -SC; diff --git a/gcc/ada/a-ststio.adb b/gcc/ada/a-ststio.adb index cf2f4ea..79ee6cd 100644 --- a/gcc/ada/a-ststio.adb +++ b/gcc/ada/a-ststio.adb @@ -241,11 +241,7 @@ package body Ada.Streams.Stream_IO is -- (and furthermore there are situations (such as the case of writing -- a sequential Posix FIFO file) where the lseek would cause problems. - if Mode = Out_File then - File.Last_Op := Op_Write; - else - File.Last_Op := Op_Read; - end if; + File.Last_Op := (if Mode = Out_File then Op_Write else Op_Read); end Open; ---------- diff --git a/gcc/ada/a-tideau.adb b/gcc/ada/a-tideau.adb index 298507a..2790bed 100644 --- a/gcc/ada/a-tideau.adb +++ b/gcc/ada/a-tideau.adb @@ -242,11 +242,8 @@ package body Ada.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/a-tideio.adb b/gcc/ada/a-tideio.adb index 9db0478..5dceb12 100644 --- a/gcc/ada/a-tideio.adb +++ b/gcc/ada/a-tideio.adb @@ -51,7 +51,6 @@ package body Ada.Text_IO.Decimal_IO is begin if Num'Size > Integer'Size then Item := Num'Fixed_Value (Aux.Get_LLD (File, Width, Scale)); - else Item := Num'Fixed_Value (Aux.Get_Dec (File, Width, Scale)); end if; diff --git a/gcc/ada/a-wtdeio.adb b/gcc/ada/a-wtdeio.adb index 8d42e85..598b72a 100644 --- a/gcc/ada/a-wtdeio.adb +++ b/gcc/ada/a-wtdeio.adb @@ -54,16 +54,10 @@ package body Ada.Wide_Text_IO.Decimal_IO is is begin if Num'Size > Integer'Size then - Item := Num (Aux.Get_LLD (TFT (File), Width, Scale)); - -- Item := Num'Fixed_Value (Aux.Get_LLD (TFT (File), Width, Scale)); - -- above is what we should write, but gets assert error ??? - + Item := Num'Fixed_Value (Aux.Get_LLD (TFT (File), Width, Scale)); else - Item := Num (Aux.Get_Dec (TFT (File), Width, Scale)); - -- Item := Num'Fixed_Value (Aux.Get_Dec (TFT (File), Width, Scale)); - -- above is what we should write, but gets assert error ??? + Item := Num'Fixed_Value (Aux.Get_Dec (TFT (File), Width, Scale)); end if; - exception when Constraint_Error => raise Data_Error; end Get; diff --git a/gcc/ada/a-wtedit.adb b/gcc/ada/a-wtedit.adb index dbe09a9..cc41dc1 100644 --- a/gcc/ada/a-wtedit.adb +++ b/gcc/ada/a-wtedit.adb @@ -477,21 +477,17 @@ package body Ada.Wide_Text_IO.Editing is raise Layout_Error; end if; - if Pic.Radix_Position = Invalid_Position then - Position := Answer'Last; - else - Position := Pic.Radix_Position - 1; - end if; + Position := + (if Pic.Radix_Position = Invalid_Position then Answer'Last + else Pic.Radix_Position - 1); for J in reverse Attrs.Start_Of_Int .. Attrs.End_Of_Int loop - while Answer (Position) /= '9' and then Answer (Position) /= Pic.Floater loop if Answer (Position) = '_' then Answer (Position) := Separator_Character; - elsif Answer (Position) = 'b' then Answer (Position) := ' '; end if; @@ -790,25 +786,22 @@ package body Ada.Wide_Text_IO.Editing is -- No trailing digits, but now J may need to stick in a currency -- symbol or sign. - if Pic.Start_Currency = Invalid_Position then - Position := Answer'Last + 1; - else - Position := Pic.Start_Currency; - end if; + Position := + (if Pic.Start_Currency = Invalid_Position then Answer'Last + 1 + else Pic.Start_Currency); end if; for J in Position .. Answer'Last loop - if Pic.Start_Currency /= Invalid_Position and then Answer (Pic.Start_Currency) = '#' then Currency_Pos := 1; end if; - -- Note: There are some weird cases J can imagine with 'b' or '#' - -- in currency strings where the following code will cause - -- glitches. The trick is to tell when the character in the - -- answer should be checked, and when to look at the original - -- string. Some other time. RIE 11/26/96 ??? + -- Note: There are some weird cases J can imagine with 'b' or '#' in + -- currency strings where the following code will cause glitches. The + -- trick is to tell when the character in the answer should be + -- checked, and when to look at the original string. Some other time. + -- RIE 11/26/96 ??? case Answer (J) is when '*' => @@ -942,8 +935,9 @@ package body Ada.Wide_Text_IO.Editing is -- 1) Expand $, replace '.' with Radix_Point - return Answer (1 .. Currency_Pos - 1) & Currency_Symbol & - Answer (Currency_Pos + 1 .. Answer'Last); + return + Answer (1 .. Currency_Pos - 1) & Currency_Symbol & + Answer (Currency_Pos + 1 .. Answer'Last); else -- 2) No currency expansion, replace '.' with Radix_Point diff --git a/gcc/ada/a-ztdeau.adb b/gcc/ada/a-ztdeau.adb index b9feb4c..38450fc 100644 --- a/gcc/ada/a-ztdeau.adb +++ b/gcc/ada/a-ztdeau.adb @@ -244,11 +244,8 @@ package body Ada.Wide_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/a-ztdeio.adb b/gcc/ada/a-ztdeio.adb index cc61e8c..52f8820 100644 --- a/gcc/ada/a-ztdeio.adb +++ b/gcc/ada/a-ztdeio.adb @@ -54,16 +54,10 @@ package body Ada.Wide_Wide_Text_IO.Decimal_IO is is begin if Num'Size > Integer'Size then - Item := Num (Aux.Get_LLD (TFT (File), Width, Scale)); - -- Item := Num'Fixed_Value (Aux.Get_LLD (TFT (File), Width, Scale)); - -- above is what we should write, but gets assert error ??? - + Item := Num'Fixed_Value (Aux.Get_LLD (TFT (File), Width, Scale)); else - Item := Num (Aux.Get_Dec (TFT (File), Width, Scale)); - -- Item := Num'Fixed_Value (Aux.Get_Dec (TFT (File), Width, Scale)); - -- above is what we should write, but gets assert error ??? + Item := Num'Fixed_Value (Aux.Get_Dec (TFT (File), Width, Scale)); end if; - exception when Constraint_Error => raise Data_Error; end Get; diff --git a/gcc/ada/a-ztedit.adb b/gcc/ada/a-ztedit.adb index 555e664..9b5036a 100644 --- a/gcc/ada/a-ztedit.adb +++ b/gcc/ada/a-ztedit.adb @@ -478,21 +478,17 @@ package body Ada.Wide_Wide_Text_IO.Editing is raise Layout_Error; end if; - if Pic.Radix_Position = Invalid_Position then - Position := Answer'Last; - else - Position := Pic.Radix_Position - 1; - end if; + Position := + (if Pic.Radix_Position = Invalid_Position then Answer'Last + else Pic.Radix_Position - 1); for J in reverse Attrs.Start_Of_Int .. Attrs.End_Of_Int loop - while Answer (Position) /= '9' and then Answer (Position) /= Pic.Floater loop if Answer (Position) = '_' then Answer (Position) := Separator_Character; - elsif Answer (Position) = 'b' then Answer (Position) := ' '; end if; @@ -791,15 +787,12 @@ package body Ada.Wide_Wide_Text_IO.Editing is -- No trailing digits, but now J may need to stick in a currency -- symbol or sign. - if Pic.Start_Currency = Invalid_Position then - Position := Answer'Last + 1; - else - Position := Pic.Start_Currency; - end if; + Position := + (if Pic.Start_Currency = Invalid_Position then Answer'Last + 1 + else Pic.Start_Currency); end if; for J in Position .. Answer'Last loop - if Pic.Start_Currency /= Invalid_Position and then Answer (Pic.Start_Currency) = '#' then Currency_Pos := 1; diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index f4cae36..19304a7 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -5271,9 +5271,15 @@ implementation unit. @item -gnatw.i @emph{Activate warnings on overlapping actuals.} @cindex @option{-gnatw.i} (@command{gcc}) -This switch enables a warning on statically detectable overlapping actuals -in a subprogram call, when one of the actuals is an in-out parameter, and -the types of the actuals are not by-copy types. +This switch enables a warning on statically detectable overlapping actuals in +a subprogram call, when one of the actuals is an in-out parameter, and the +types of the actuals are not by-copy types. The warning is off by default, +and is not included under -gnatwa. + +@item -gnatw.I +@emph{Disable warnings on overlapping actuals.} +@cindex @option{-gnatw.I} (@command{gcc}) +This switch disables warnings on overlapping actuals in a call.. @item -gnatwj @emph{Activate warnings on obsolescent features (Annex J).} diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 563b92d..e0ccc22 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -1612,6 +1612,7 @@ begin elsif Argv.all = "-eL" then Follow_Links_For_Files := True; + Follow_Links_For_Dirs := True; Remove_Switch (Arg_Num); diff --git a/gcc/ada/gnatname.adb b/gcc/ada/gnatname.adb index 4c6d00b..4c935be 100644 --- a/gcc/ada/gnatname.adb +++ b/gcc/ada/gnatname.adb @@ -385,6 +385,7 @@ procedure Gnatname is elsif Arg = "-eL" then Opt.Follow_Links_For_Files := True; + Opt.Follow_Links_For_Dirs := True; -- -f diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index f977549..307ec6f 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -328,7 +328,9 @@ package body Makeutl is return ""; end if; - return Normalize_Pathname (Exec (Exec'First .. Path_Last - 4)) + return Normalize_Pathname + (Exec (Exec'First .. Path_Last - 4), + Resolve_Links => Opt.Follow_Links_For_Dirs) & Directory_Separator; end Get_Install_Dir; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index a71c823..542b1f0 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -663,7 +663,7 @@ package Opt is -- still valid if they point to a file which is outside of the project), -- and that no directory has a name which is a valid source name. - Follow_Links_For_Dirs : Boolean := True; + Follow_Links_For_Dirs : Boolean := False; -- PROJECT MANAGER -- Set to True if directories can be links in this project, and therefore -- additional system calls must be performed to ensure that we always see diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index a02e1ee..a8db0a5 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -80,7 +80,8 @@ package body Osint is -- Appends Suffix to Name and returns the new name function OS_Time_To_GNAT_Time (T : OS_Time) return Time_Stamp_Type; - -- Convert OS format time to GNAT format time stamp + -- Convert OS format time to GNAT format time stamp. + -- Returns Empty_Time_Stamp if T is Invalid_Time function Executable_Prefix return String_Ptr; -- Returns the name of the root directory where the executable is stored. @@ -970,12 +971,13 @@ package body Osint is Get_Name_String (Name); - if not Is_Regular_File (Name_Buffer (1 .. Name_Len)) then - return Empty_Time_Stamp; - else - Name_Buffer (Name_Len + 1) := ASCII.NUL; - return OS_Time_To_GNAT_Time (File_Time_Stamp (Name_Buffer)); - end if; + -- File_Time_Stamp will always return Invalid_Time if the file does not + -- exist, and that OS_Time_To_GNAT_Time will convert that to + -- Empty_Time_Stamp. Therefore we do not need to first test whether the + -- file actually exists, which saves a system call + + return OS_Time_To_GNAT_Time + (File_Time_Stamp (Name_Buffer (1 .. Name_Len))); end File_Stamp; function File_Stamp (Name : Path_Name_Type) return Time_Stamp_Type is @@ -1887,6 +1889,10 @@ package body Osint is S : Second_Type; begin + if T = Invalid_Time then + return Empty_Time_Stamp; + end if; + GM_Split (T, Y, Mo, D, H, Mn, S); Make_Time_Stamp (Year => Nat (Y), diff --git a/gcc/ada/prj-ext.adb b/gcc/ada/prj-ext.adb index 9c9707c..8c7a5d9 100644 --- a/gcc/ada/prj-ext.adb +++ b/gcc/ada/prj-ext.adb @@ -26,6 +26,7 @@ with System.OS_Lib; use System.OS_Lib; with Hostparm; with Makeutl; use Makeutl; +with Opt; with Osint; use Osint; with Prj.Tree; use Prj.Tree; with Sdefault; @@ -212,7 +213,9 @@ package body Prj.Ext is declare New_Dir : constant String := - Normalize_Pathname (Name_Buffer (First .. Last)); + Normalize_Pathname + (Name_Buffer (First .. Last), + Resolve_Links => Opt.Follow_Links_For_Dirs); begin -- If the absolute path was resolved and is different from diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index 0a342f9..840214d 100644 --- a/gcc/ada/sem_case.adb +++ b/gcc/ada/sem_case.adb @@ -239,7 +239,7 @@ package body Sem_Case is " alternatives must cover base type", Expr, Expr); else - Error_Msg_N ("expression is not static," & + Error_Msg_N ("subtype of expression is not static," & " alternatives must cover base type!", Expr); end if; @@ -249,8 +249,8 @@ package body Sem_Case is elsif not Is_Entity_Name (Expr) then Error_Msg_N - ("expression is not static, alternatives must cover base type!", - Expr); + ("subtype of expression is not static, " & + "alternatives must cover base type!", Expr); end if; end Explain_Non_Static_Bound; diff --git a/gcc/ada/switch-m.adb b/gcc/ada/switch-m.adb index 316b77e..a7a8d19 100644 --- a/gcc/ada/switch-m.adb +++ b/gcc/ada/switch-m.adb @@ -656,6 +656,7 @@ package body Switch.M is else Follow_Links_For_Files := True; + Follow_Links_For_Dirs := True; end if; -- Processing for eS switch -- 2.7.4