OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2009-10-30  Robert Dewar  <dewar@adacore.com>

	* 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  <schonberg@adacore.com>

	* gnat_ugn.texi: Additional info on gnatw.i and gnatw.I

	* sem_case.adb: Improved error message.

2009-10-30  Emmanuel Briot  <briot@adacore.com>

	* 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

From-SVN: r153744
This commit is contained in:
Arnaud Charlet 2009-10-30 14:27:40 +01:00
parent 297f34d719
commit 5fd3fd793a
22 changed files with 104 additions and 111 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
gcc/ada/ChangeLog
View File

@ -1,3 +1,26 @@
2009-10-30 Robert Dewar <dewar@adacore.com>
* 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 <schonberg@adacore.com>
* gnat_ugn.texi: Additional info on gnatw.i and gnatw.I
* sem_case.adb: Improved error message.
2009-10-30 Emmanuel Briot <briot@adacore.com>
* 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 <dewar@adacore.com>
* sem_res.adb (Resolve_Type_Conversion): Avoid false positive when

6
gcc/ada/a-direct.adb
View File

@ -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

19
gcc/ada/a-ngelfu.adb
View File

@ -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;
Z := (if abs Y > abs X then abs (X / Y) else abs (Y / X));
if Z < Sqrt_Epsilon then
Raw_Atan := Z;
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;

6
gcc/ada/a-ngrear.adb
View File

@ -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;

15
gcc/ada/a-reatim.adb
View File

@ -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;

6
gcc/ada/a-ststio.adb
View File

@ -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;
----------

7
gcc/ada/a-tideau.adb
View File

@ -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;

1
gcc/ada/a-tideio.adb
View File

@ -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;

10
gcc/ada/a-wtdeio.adb
View File

@ -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;

34
gcc/ada/a-wtedit.adb
View File

@ -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

7
gcc/ada/a-ztdeau.adb
View File

@ -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;

10
gcc/ada/a-ztdeio.adb
View File

@ -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;

19
gcc/ada/a-ztedit.adb
View File

@ -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;

12
gcc/ada/gnat_ugn.texi
View File

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

1
gcc/ada/gnatcmd.adb
View File

@ -1612,6 +1612,7 @@ begin
elsif Argv.all = "-eL" then
Follow_Links_For_Files := True;
Follow_Links_For_Dirs := True;
Remove_Switch (Arg_Num);

1
gcc/ada/gnatname.adb
View File

@ -385,6 +385,7 @@ procedure Gnatname is
elsif Arg = "-eL" then
Opt.Follow_Links_For_Files := True;
Opt.Follow_Links_For_Dirs := True;
-- -f

4
gcc/ada/makeutl.adb
View File

@ -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;

2
gcc/ada/opt.ads
View File

@ -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

20
gcc/ada/osint.adb
View File

@ -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),

5
gcc/ada/prj-ext.adb
View File

@ -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

6
gcc/ada/sem_case.adb
View File

@ -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;

1
gcc/ada/switch-m.adb
View File

@ -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