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

[multiple changes] 

2009-11-30  Sergey Rybin  <rybin@adacore.com>

	* gnat_ugn.texi: Update gnatcheck doc.

2009-11-30  Robert Dewar  <dewar@adacore.com>

	make.adb, prj-makr.adb, g-sothco.ads: Minor reformattting
	* s-taprop-dummy.adb: Minor code reorganization (raise with msgs start
	with lower case).
	* i-vxwoio.adb, g-dirope.adb, g-sercom-linux.adb,
	g-enblsp-vms-alpha.adb, g-regist.adb, s-imgcha.adb, s-tarest.adb,
	s-taprop-mingw.adb, g-exctra.adb, g-expect.adb, g-comlin.adb,
	g-debpoo.adb, g-expect-vms.adb, g-pehage.adb, g-trasym-vms-alpha.adb,
	g-enblsp-vms-ia64.adb, s-fatgen.adb, s-fileio.adb: Minor code
	reorganization (use conditional expressions).

From-SVN: r154773
This commit is contained in:
Arnaud Charlet 2009-11-30 11:28:23 +01:00
parent ff149a358c
commit e64e5f7438
24 changed files with 106 additions and 171 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -1,3 +1,19 @@
2009-11-30 Sergey Rybin <rybin@adacore.com>
* gnat_ugn.texi: Update gnatcheck doc.
2009-11-30 Robert Dewar <dewar@adacore.com>
make.adb, prj-makr.adb, g-sothco.ads: Minor reformattting
* s-taprop-dummy.adb: Minor code reorganization (raise with msgs start
with lower case).
* i-vxwoio.adb, g-dirope.adb, g-sercom-linux.adb,
g-enblsp-vms-alpha.adb, g-regist.adb, s-imgcha.adb, s-tarest.adb,
s-taprop-mingw.adb, g-exctra.adb, g-expect.adb, g-comlin.adb,
g-debpoo.adb, g-expect-vms.adb, g-pehage.adb, g-trasym-vms-alpha.adb,
g-enblsp-vms-ia64.adb, s-fatgen.adb, s-fileio.adb: Minor code
reorganization (use conditional expressions).
2009-11-30 Vincent Celier <celier@adacore.com>
* prj-makr.adb (Source_Files): New hash table to keep track of source

23
gcc/ada/g-comlin.adb
View File

@ -574,11 +574,8 @@ package body GNAT.Command_Line is
-- Depending on the value of Concatenate, the full switch is
-- a single character or the rest of the argument.
if Concatenate then
End_Index := Parser.Current_Index;
else
End_Index := Arg'Last;
end if;
End_Index :=
(if Concatenate then Parser.Current_Index else Arg'Last);
if Switches (Switches'First) = '*' then
@ -2279,20 +2276,16 @@ package body GNAT.Command_Line is
Cmd.Coalesce_Sections := new Argument_List (Cmd.Sections'Range);
for E in Cmd.Sections'Range loop
if Cmd.Sections (E) = null then
Cmd.Coalesce_Sections (E) := null;
else
Cmd.Coalesce_Sections (E) := new String'(Cmd.Sections (E).all);
end if;
Cmd.Coalesce_Sections (E) :=
(if Cmd.Sections (E) = null then null
else new String'(Cmd.Sections (E).all));
end loop;
Cmd.Coalesce_Params := new Argument_List (Cmd.Params'Range);
for E in Cmd.Params'Range loop
if Cmd.Params (E) = null then
Cmd.Coalesce_Params (E) := null;
else
Cmd.Coalesce_Params (E) := new String'(Cmd.Params (E).all);
end if;
Cmd.Coalesce_Params (E) :=
(if Cmd.Params (E) = null then null
else new String'(Cmd.Params (E).all));
end loop;
-- Not a clone, since we will not modify the parameters anyway

13
gcc/ada/g-debpoo.adb
View File

@ -985,11 +985,7 @@ package body GNAT.Debug_Pools is
is
begin
if H.Block_Size /= 0 then
if In_Use then
To_Byte (A).all := In_Use_Mark;
else
To_Byte (A).all := Free_Mark;
end if;
To_Byte (A).all := (if In_Use then In_Use_Mark else Free_Mark);
end if;
end Mark;
@ -1416,11 +1412,8 @@ package body GNAT.Debug_Pools is
Backtrace_Htable_Cumulate.Set (Elem);
if Cumulate then
if Data.Kind = Alloc then
K := Indirect_Alloc;
else
K := Indirect_Dealloc;
end if;
K := (if Data.Kind = Alloc then Indirect_Alloc
else Indirect_Dealloc);
-- Propagate the direct call to all its parents

24
gcc/ada/g-dirope.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2008, AdaCore --
-- Copyright (C) 1998-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- --
@ -97,12 +97,7 @@ package body GNAT.Directory_Operations is
begin
-- Cut_Start point to the first basename character
if Cut_Start = 0 then
Cut_Start := Path'First;
else
Cut_Start := Cut_Start + 1;
end if;
Cut_Start := (if Cut_Start = 0 then Path'First else Cut_Start + 1);
-- Cut_End point to the last basename character
@ -580,11 +575,8 @@ package body GNAT.Directory_Operations is
begin
Local_Get_Current_Dir (Buffer'Address, Path_Len'Address);
if Dir'Length > Path_Len then
Last := Dir'First + Path_Len - 1;
else
Last := Dir'Last;
end if;
Last :=
(if Dir'Length > Path_Len then Dir'First + Path_Len - 1 else Dir'Last);
Dir (Buffer'First .. Last) := Buffer (Buffer'First .. Last);
@ -683,11 +675,9 @@ package body GNAT.Directory_Operations is
return;
end if;
if Str'Length > Filename_Len then
Last := Str'First + Filename_Len - 1;
else
Last := Str'Last;
end if;
Last :=
(if Str'Length > Filename_Len then Str'First + Filename_Len - 1
else Str'Last);
declare
subtype Path_String is String (1 .. Filename_Len);

10
gcc/ada/g-enblsp-vms-alpha.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2005-2008, AdaCore --
-- Copyright (C) 2005-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- --
@ -77,11 +77,9 @@ begin
-- Fork a new process (it is not possible to do this in a subprogram)
if Alloc_Vfork_Blocks >= 0 then
Descriptor.Pid := Get_Current_Invo_Context (Get_Vfork_Jmpbuf);
else
Descriptor.Pid := -1;
end if;
Descriptor.Pid :=
(if Alloc_Vfork_Blocks >= 0
then Get_Current_Invo_Context (Get_Vfork_Jmpbuf) else -1);
-- Are we now in the child

9
gcc/ada/g-enblsp-vms-ia64.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2005-2008, AdaCore --
-- Copyright (C) 2005-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,11 +75,8 @@ begin
-- Fork a new process (it is not possible to do this in a subprogram)
if Alloc_Vfork_Blocks >= 0 then
Descriptor.Pid := Setjmp1 (Get_Vfork_Jmpbuf);
else
Descriptor.Pid := -1;
end if;
Descriptor.Pid :=
(if Alloc_Vfork_Blocks >= 0 then Setjmp1 (Get_Vfork_Jmpbuf) else -1);
-- Are we now in the child

14
gcc/ada/g-exctra.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2000-2005, AdaCore --
-- Copyright (C) 2000-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- --
@ -88,17 +88,11 @@ package body GNAT.Exception_Traces is
procedure Set_Trace_Decorator (Decorator : Traceback_Decorator) is
begin
Current_Decorator := Decorator;
if Current_Decorator /= null then
Traceback_Decorator_Wrapper := Decorator_Wrapper'Access;
else
Traceback_Decorator_Wrapper := null;
end if;
Traceback_Decorator_Wrapper :=
(if Current_Decorator /= null
then Decorator_Wrapper'Access else null);
end Set_Trace_Decorator;
-- Trace_On/Trace_Off control the kind of automatic output to occur
-- by way of the global Exception_Trace variable.
---------------
-- Trace_Off --
---------------

6
gcc/ada/g-expect-vms.adb
View File

@ -1030,11 +1030,7 @@ package body GNAT.Expect is
Reinitialize_Buffer (Descriptor);
end if;
if Add_LF then
Last := Full_Str'Last;
else
Last := Full_Str'Last - 1;
end if;
Last := (if Add_LF then Full_Str'Last else Full_Str'Last - 1);
Call_Filters (Descriptor, Full_Str (Full_Str'First .. Last), Input);

9
gcc/ada/g-expect.adb
View File

@ -1003,11 +1003,10 @@ package body GNAT.Expect is
-- Prepare low-level argument list from the normalized arguments
for K in Arg_List'Range loop
if Arg_List (K) /= null then
C_Arg_List (K) := Arg_List (K).all'Address;
else
C_Arg_List (K) := System.Null_Address;
end if;
C_Arg_List (K) :=
(if Arg_List (K) /= null
then Arg_List (K).all'Address
else System.Null_Address);
end loop;
-- This does not return on Unix systems

15
gcc/ada/g-pehage.adb
View File

@ -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- --
@ -1970,11 +1970,7 @@ package body GNAT.Perfect_Hash_Generators is
Q := Seed / 127773;
X := 16807 * R - 2836 * Q;
if X < 0 then
Seed := X + 2147483647;
else
Seed := X;
end if;
Seed := (if X < 0 then X + 2147483647 else X);
end Random;
-------------
@ -2233,11 +2229,8 @@ package body GNAT.Perfect_Hash_Generators is
-- The first position should not exceed the minimum key length.
-- Otherwise, we may end up with an empty word once reduced.
if Last_Sel_Pos = 0 then
Max_Sel_Pos := Min_Key_Len;
else
Max_Sel_Pos := Max_Key_Len;
end if;
Max_Sel_Pos :=
(if Last_Sel_Pos = 0 then Min_Key_Len else Max_Key_Len);
-- Find which position increases more the number of differences

6
gcc/ada/g-regist.adb
View File

@ -417,11 +417,7 @@ package body GNAT.Registry is
Result : LONG;
begin
if Expand then
Value_Type := REG_EXPAND_SZ;
else
Value_Type := REG_SZ;
end if;
Value_Type := (if Expand then REG_EXPAND_SZ else REG_SZ);
Result :=
RegSetValueEx

11
gcc/ada/g-sercom-linux.adb
View File

@ -211,7 +211,10 @@ package body GNAT.Serial_Communications is
pragma Import (C, tcflush, "tcflush");
Current : termios;
Res : int;
Res : int;
pragma Warnings (Off, Res);
-- Warnings off, since we don't always test the result
begin
if Port.H = null then
@ -246,11 +249,7 @@ package body GNAT.Serial_Communications is
-- Block
if Block then
Res := fcntl (int (Port.H.all), F_SETFL, 0);
else
Res := fcntl (int (Port.H.all), F_SETFL, FNDELAY);
end if;
Res := fcntl (int (Port.H.all), F_SETFL, (if Block then 0 else FNDELAY));
if Res = -1 then
Raise_Error ("set: fcntl failed");

17
gcc/ada/g-sothco.ads
View File

@ -212,8 +212,8 @@ package GNAT.Sockets.Thin_Common is
C.Strings.Null_Ptr);
-- Arrays of C (char *)
type Servent is new System.Storage_Elements.Storage_Array
(1 .. SOSC.SIZEOF_struct_servent);
type Servent is new
System.Storage_Elements.Storage_Array (1 .. SOSC.SIZEOF_struct_servent);
for Servent'Alignment use 8;
-- Service entry. This is an opaque type used only via the following
-- accessor functions, because 'struct servent' has different layouts on
@ -223,11 +223,14 @@ package GNAT.Sockets.Thin_Common is
pragma Convention (C, Servent_Access);
-- Access to service entry
function Servent_S_Name (E : Servent_Access) return C.Strings.chars_ptr;
function Servent_S_Aliases (E : Servent_Access)
return Chars_Ptr_Pointers.Pointer;
function Servent_S_Port (E : Servent_Access) return C.int;
function Servent_S_Proto (E : Servent_Access) return C.Strings.chars_ptr;
function Servent_S_Name
(E : Servent_Access) return C.Strings.chars_ptr;
function Servent_S_Aliases
(E : Servent_Access) return Chars_Ptr_Pointers.Pointer;
function Servent_S_Port
(E : Servent_Access) return C.int;
function Servent_S_Proto
(E : Servent_Access) return C.Strings.chars_ptr;
------------------
-- Host entries --

8
gcc/ada/g-trasym-vms-alpha.adb
View File

@ -217,11 +217,9 @@ package body GNAT.Traceback.Symbolic is
System.Soft_Links.Lock_Task.all;
for J in Traceback'Range loop
if J = Traceback'Last then
Return_Address := Address_Zero;
else
Return_Address := PC_For (Traceback (J + 1));
end if;
Return_Address :=
(if J = Traceback'Last then Address_Zero
else PC_For (Traceback (J + 1)));
Symbolize
(Status,

10
gcc/ada/gnat_ugn.texi
View File

@ -22519,7 +22519,9 @@ This rule has no parameters.
@cindex @code{Positional_Generic_Parameters} rule (for @command{gnatcheck})
@noindent
Flag each instantiation using positional parameter notation.
Flag each positional actual generic parameter except for the case when
the generic unit being iinstantiated has exactly one generic formal
parameter.
This rule has no parameters.
@ -22529,15 +22531,15 @@ This rule has no parameters.
@cindex @code{Positional_Parameters} rule (for @command{gnatcheck})
@noindent
Flag each subprogram or entry call using positional parameter notation,
Flag each positional parameter notation in a subprogram or entry call,
except for the following:
@itemize @bullet
@item
Invocations of prefix or infix operators are not flagged
Parameters of calls to of prefix or infix operators are not flagged
@item
If the called subprogram or entry has only one formal parameter,
the call is not flagged;
the parameter of the call is not flagged;
@item
If a subprogram call uses the @emph{Object.Operation} notation, then
@itemize @minus

8
gcc/ada/i-vxwoio.adb
View File

@ -63,16 +63,10 @@ package body Interfaces.VxWorks.IO is
is
Status : int;
Fd : int;
begin
Fd := fileno (File);
Status := ioctl (Fd, FIOSETOPTIONS, OPT_TERMINAL);
if Status /= int (ERROR) then
Success := True;
else
Success := False;
end if;
Success := (if Status /= int (ERROR) then True else False);
end Disable_Get_Immediate;
end Interfaces.VxWorks.IO;

4
gcc/ada/make.adb
View File

@ -3427,8 +3427,8 @@ package body Make is
end if;
-- Start the compilation and record it. We can do this
-- because there is at least one free process. This
-- might change the current directory.
-- because there is at least one free process. This might
-- change the current directory.
Collect_Arguments_And_Compile
(Full_Source_File => Full_Source_File,

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

@ -39,7 +39,7 @@ with Table; use Table;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with System.Case_Util; use System.Case_Util;
with System.Case_Util; use System.Case_Util;
with System.CRTL;
with System.HTable;
@ -613,13 +613,14 @@ package body Prj.Makr is
In_Tree => Tree);
begin
-- Add source file name to the source list file, if it is not
-- Add source file name to the source list file if it is not
-- already there.
if not Source_Files.Get (Current_Source.File_Name) then
Source_Files.Set (Current_Source.File_Name, True);
Get_Name_String (Current_Source.File_Name);
Add_Char_To_Name_Buffer (ASCII.LF);
if Write (Source_List_FD,
Name_Buffer (1)'Address,
Name_Len) /= Name_Len

7
gcc/ada/s-fatgen.adb
View File

@ -232,12 +232,7 @@ package body System.Fat_Gen is
end loop;
end if;
if X > 0.0 then
Frac := Ax;
else
Frac := -Ax;
end if;
Frac := (if X > 0.0 then Ax else -Ax);
Expo := Ex;
end;
end if;

18
gcc/ada/s-fileio.adb
View File

@ -519,27 +519,17 @@ package body System.File_IO is
end if;
when Inout_File | Append_File =>
if Creat then
Fopstr (1) := 'w';
else
Fopstr (1) := 'r';
end if;
Fopstr (1) := (if Creat then 'w' else 'r');
Fopstr (2) := '+';
Fptr := 3;
end case;
-- If text_translation_required is true then we need to append
-- either a t or b to the string to get the right mode
-- If text_translation_required is true then we need to append either a
-- "t" or "b" to the string to get the right mode.
if text_translation_required then
if Text then
Fopstr (Fptr) := 't';
else
Fopstr (Fptr) := 'b';
end if;
Fopstr (Fptr) := (if Text then 't' else 'b');
Fptr := Fptr + 1;
end if;

13
gcc/ada/s-imgcha.adb
View File

@ -124,22 +124,13 @@ package body System.Img_Char is
if V in C0_Range then
S (1 .. 3) := C0 (V);
if S (3) = ' ' then
P := 2;
else
P := 3;
end if;
P := (if S (3) = ' ' then 2 else 3);
elsif V in C1_Range then
S (1 .. 3) := C1 (V);
if S (1) /= 'r' then
if S (3) = ' ' then
P := 2;
else
P := 3;
end if;
P := (if S (3) = ' ' then 2 else 3);
-- Special case, res means RESERVED_nnn where nnn is the three digit
-- decimal value corresponding to the code position (more efficient

2
gcc/ada/s-taprop-dummy.adb
View File

@ -190,7 +190,7 @@ package body System.Task_Primitives.Operations is
procedure Initialize (Environment_Task : Task_Id) is
No_Tasking : Boolean;
begin
raise Program_Error with "Tasking not implemented on this configuration";
raise Program_Error with "tasking not implemented on this configuration";
end Initialize;
procedure Initialize (S : in out Suspension_Object) is

11
gcc/ada/s-taprop-mingw.adb
View File

@ -312,18 +312,17 @@ package body System.Task_Primitives.Operations is
Unlock (L, Global_Lock => True);
-- No problem if we are interrupted here: if the condition is signaled,
-- WaitForSingleObject will simply not block
-- WaitForSingleObject will simply not block.
if Rel_Time <= 0.0 then
Timed_Out := True;
Wait_Result := 0;
else
if Rel_Time >= Duration (Time_Out_Max) / 1000 then
Time_Out := Time_Out_Max;
else
Time_Out := DWORD (Rel_Time * 1000);
end if;
Time_Out :=
(if Rel_Time >= Duration (Time_Out_Max) / 1000
then Time_Out_Max
else DWORD (Rel_Time * 1000));
Wait_Result := WaitForSingleObject (HANDLE (Cond.all), Time_Out);

18
gcc/ada/s-tarest.adb
View File

@ -340,11 +340,10 @@ package body System.Tasking.Restricted.Stages is
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);
STPO.Create_Task
(C, Task_Wrapper'Address,
@ -477,11 +476,10 @@ package body System.Tasking.Restricted.Stages is
pragma Assert (Stack_Address = Null_Address);
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));
if Single_Lock then
Lock_RTS;