diff options
49 files changed, 479 insertions, 534 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ea28b0e30aa..7d168c87aac 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,35 @@ 2009-04-07 Robert Dewar <dewar@adacore.com> + (Osint.Fail): Change calling sequence to have one string arg + (Make.Make_Failed): Same change + All callers are adjusted to use concatenation + +2009-04-07 Robert Dewar <dewar@adacore.com> + + * exp_ch4.adb: Fix documentation typo + +2009-04-07 Robert Dewar <dewar@adacore.com> + + * tbuild.ads: Minor reformatting + +2009-04-07 Javier Miranda <miranda@adacore.com> + + * exp_disp.adb (Make_DT): Avoid the generation of the OSD_Table + when compiling under ZFP runtime. + +2009-04-07 Robert Dewar <dewar@adacore.com> + + * g-comlin.adb: Minor reformatting + +2009-04-07 Thomas Quinot <quinot@adacore.com> + + * socket.c, g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb, + g-socthi-vxworks.ads, g-socthi-mingw.adb, g-socthi-mingw.ads, + g-socthi.adb, g-socthi.ads, g-socket.adb, g-socket.ads, g-sothco.ads: + Remove dynamic allocation of Fd_Set in Socket_Set_Type objects. + +2009-04-07 Robert Dewar <dewar@adacore.com> + * gnat_ugn.texi: Document -gnatDnn/-gnatGnn * opt.ads (Sprint_Line_Limit): New parameter diff --git a/gcc/ada/binde.adb b/gcc/ada/binde.adb index fc1ebeb128c..bbc990dc892 100644 --- a/gcc/ada/binde.adb +++ b/gcc/ada/binde.adb @@ -918,9 +918,9 @@ package body Binde is end if; Osint.Fail - ("could not find unit ", - Withed (Withed'First .. Last_Withed) & " needed by " & - Withing (Withing'First .. Last_Withing) & Spec_Body); + ("could not find unit " + & Withed (Withed'First .. Last_Withed) & " needed by " + & Withing (Withing'First .. Last_Withing) & Spec_Body); end; end if; diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 30aa9a45c41..5df43cd1a04 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -1625,7 +1625,7 @@ package body Clean is procedure Bad_Argument is begin - Fail ("invalid argument """, Arg, """"); + Fail ("invalid argument """ & Arg & """"); end Bad_Argument; begin @@ -1680,7 +1680,7 @@ package body Clean is Dir : constant String := Arg (3 .. Arg'Last); begin if not Is_Directory (Dir) then - Fail (Dir, " is not a directory"); + Fail (Dir & " is not a directory"); else Add_Lib_Search_Dir (Dir); end if; @@ -1697,7 +1697,7 @@ package body Clean is Dir : constant String := Argument (Index); begin if not Is_Directory (Dir) then - Fail (Dir, " is not a directory"); + Fail (Dir & " is not a directory"); else Add_Lib_Search_Dir (Dir); end if; @@ -1853,8 +1853,9 @@ package body Clean is else Fail - ("illegal external assignment '", - Ext_Asgn, "'"); + ("illegal external assignment '" + & Ext_Asgn + & "'"); end if; end; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index f924214bfab..e511e97e2e8 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -4547,8 +4547,8 @@ package body Exp_Ch4 is -- -- 0 None available -- 2 RE_Str_Concat available, RE_Str_Concat_3 not available - -- 3 RE_Str_Concat/Concat_2 available, RE_Str_Concat_4 not available - -- 4 RE_Str_Concat/Concat_2/3 available, RE_Str_Concat_5 not available + -- 3 RE_Str_Concat/Concat_3 available, RE_Str_Concat_4 not available + -- 4 RE_Str_Concat/Concat_3/4 available, RE_Str_Concat_5 not available -- 5 All routines including RE_Str_Concat_5 available Char_Concat_Available : Boolean; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index a14adf0b0a4..96dd8dae610 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -3479,6 +3479,7 @@ package body Exp_Disp is or else not Is_Limited_Type (Typ) or else not Has_Interfaces (Typ) or else not Build_Thunks + or else not RTE_Record_Component_Available (RE_OSD_Table) then -- No OSD table required diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index c01e8ef76b3..8f16a117866 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -169,8 +169,8 @@ begin if Source_Config_File = No_Source_File then Osint.Fail - ("cannot find configuration pragmas file ", - Config_File_Names (Index).all); + ("cannot find configuration pragmas file " + & Config_File_Names (Index).all); end if; Initialize_Scanner (No_Unit, Source_Config_File); diff --git a/gcc/ada/g-comlin.adb b/gcc/ada/g-comlin.adb index 47f821d4271..b67d4fe50f1 100644 --- a/gcc/ada/g-comlin.adb +++ b/gcc/ada/g-comlin.adb @@ -1404,7 +1404,7 @@ package body GNAT.Command_Line is function Group_Analysis (Prefix : String; Group : String) return Boolean; - -- Perform the analysis of a group of switches. + -- Perform the analysis of a group of switches -------------------- -- Group_Analysis -- diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index 0906aecc8ec..0112ed8b84e 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -454,110 +454,89 @@ package body GNAT.Sockets is TPtr : Timeval_Access; begin - begin - Status := Completed; - - -- No timeout or Forever is indicated by a null timeval pointer - - if Timeout = Forever then - TPtr := null; - else - TVal := To_Timeval (Timeout); - TPtr := TVal'Unchecked_Access; - end if; + Status := Completed; - -- Copy R_Socket_Set in RSet and add read signalling socket + -- No timeout or Forever is indicated by a null timeval pointer - RSet := (Set => New_Socket_Set (R_Socket_Set.Set), - Last => R_Socket_Set.Last); - Set (RSet, RSig); + if Timeout = Forever then + TPtr := null; + else + TVal := To_Timeval (Timeout); + TPtr := TVal'Unchecked_Access; + end if; - -- Copy W_Socket_Set in WSet + -- Copy R_Socket_Set in RSet and add read signalling socket - WSet := (Set => New_Socket_Set (W_Socket_Set.Set), - Last => W_Socket_Set.Last); + RSet := R_Socket_Set; + Set (RSet, RSig); - -- Copy E_Socket_Set in ESet + -- Copy W_Socket_Set in WSet - ESet := (Set => New_Socket_Set (E_Socket_Set.Set), - Last => E_Socket_Set.Last); + WSet := W_Socket_Set; - Last := C.int'Max (C.int'Max (C.int (RSet.Last), - C.int (WSet.Last)), - C.int (ESet.Last)); + -- Copy E_Socket_Set in ESet - Res := - C_Select - (Last + 1, - RSet.Set, - WSet.Set, - ESet.Set, - TPtr); + ESet := E_Socket_Set; - if Res = Failure then - Raise_Socket_Error (Socket_Errno); - end if; + Last := C.int'Max (C.int'Max (C.int (RSet.Last), + C.int (WSet.Last)), + C.int (ESet.Last)); - -- If Select was resumed because of read signalling socket, read this - -- data and remove socket from set. + Res := + C_Select + (Last + 1, + RSet.Set'Access, + WSet.Set'Access, + ESet.Set'Access, + TPtr); - if Is_Set (RSet, RSig) then - Clear (RSet, RSig); + if Res = Failure then + Raise_Socket_Error (Socket_Errno); + end if; - Res := Signalling_Fds.Read (C.int (RSig)); + -- If Select was resumed because of read signalling socket, read this + -- data and remove socket from set. - if Res = Failure then - Raise_Socket_Error (Socket_Errno); - end if; + if Is_Set (RSet, RSig) then + Clear (RSet, RSig); - Status := Aborted; + Res := Signalling_Fds.Read (C.int (RSig)); - elsif Res = 0 then - Status := Expired; + if Res = Failure then + Raise_Socket_Error (Socket_Errno); end if; - -- Update RSet, WSet and ESet in regard to their new socket sets + Status := Aborted; - Narrow (RSet); - Narrow (WSet); - Narrow (ESet); - - -- Reset RSet as it should be if R_Sig_Socket was not added - - if Is_Empty (RSet) then - Empty (RSet); - end if; - - if Is_Empty (WSet) then - Empty (WSet); - end if; + elsif Res = 0 then + Status := Expired; + end if; - if Is_Empty (ESet) then - Empty (ESet); - end if; + -- Update RSet, WSet and ESet in regard to their new socket sets - -- Deliver RSet, WSet and ESet + Narrow (RSet); + Narrow (WSet); + Narrow (ESet); - Empty (R_Socket_Set); - R_Socket_Set := RSet; + -- Reset RSet as it should be if R_Sig_Socket was not added - Empty (W_Socket_Set); - W_Socket_Set := WSet; + if Is_Empty (RSet) then + Empty (RSet); + end if; - Empty (E_Socket_Set); - E_Socket_Set := ESet; + if Is_Empty (WSet) then + Empty (WSet); + end if; - exception - when Socket_Error => + if Is_Empty (ESet) then + Empty (ESet); + end if; - -- The local socket sets must be emptied before propagating - -- Socket_Error so the associated storage is freed. + -- Deliver RSet, WSet and ESet - Empty (RSet); - Empty (WSet); - Empty (ESet); - raise; - end; + R_Socket_Set := RSet; + W_Socket_Set := WSet; + E_Socket_Set := ESet; end Check_Selector; ----------- @@ -571,8 +550,8 @@ package body GNAT.Sockets is Last : aliased C.int := C.int (Item.Last); begin if Item.Last /= No_Socket then - Remove_Socket_From_Set (Item.Set, C.int (Socket)); - Last_Socket_In_Set (Item.Set, Last'Unchecked_Access); + Remove_Socket_From_Set (Item.Set'Access, C.int (Socket)); + Last_Socket_In_Set (Item.Set'Access, Last'Unchecked_Access); Item.Last := Socket_Type (Last); end if; end Clear; @@ -737,11 +716,7 @@ package body GNAT.Sockets is Target : in out Socket_Set_Type) is begin - Empty (Target); - if Source.Last /= No_Socket then - Target.Set := New_Socket_Set (Source.Set); - Target.Last := Source.Last; - end if; + Target := Source; end Copy; --------------------- @@ -795,11 +770,7 @@ package body GNAT.Sockets is procedure Empty (Item : in out Socket_Set_Type) is begin - if Item.Set /= No_Fd_Set_Access then - Free_Socket_Set (Item.Set); - Item.Set := No_Fd_Set_Access; - end if; - + Reset_Socket_Set (Item.Set'Access); Item.Last := No_Socket; end Empty; @@ -842,7 +813,7 @@ package body GNAT.Sockets is begin if Item.Last /= No_Socket then Get_Socket_From_Set - (Item.Set, L'Unchecked_Access, S'Unchecked_Access); + (Item.Set'Access, L'Unchecked_Access, S'Unchecked_Access); Item.Last := Socket_Type (L); Socket := Socket_Type (S); else @@ -1340,7 +1311,7 @@ package body GNAT.Sockets is begin return Item.Last /= No_Socket and then Socket <= Item.Last - and then Is_Socket_In_Set (Item.Set, C.int (Socket)) /= 0; + and then Is_Socket_In_Set (Item.Set'Access, C.int (Socket)) /= 0; end Is_Set; ------------------- @@ -1365,8 +1336,8 @@ package body GNAT.Sockets is procedure Narrow (Item : in out Socket_Set_Type) is Last : aliased C.int := C.int (Item.Last); begin - if Item.Set /= No_Fd_Set_Access then - Last_Socket_In_Set (Item.Set, Last'Unchecked_Access); + if Item.Last /= No_Socket then + Last_Socket_In_Set (Item.Set'Access, Last'Unchecked_Access); Item.Last := Socket_Type (Last); end if; end Narrow; @@ -1858,15 +1829,16 @@ package body GNAT.Sockets is procedure Set (Item : in out Socket_Set_Type; Socket : Socket_Type) is begin - if Item.Set = No_Fd_Set_Access then - Item.Set := New_Socket_Set (No_Fd_Set_Access); + if Item.Last = No_Socket then + -- Uninitialized socket set, make sure it is properly zeroed out + + Reset_Socket_Set (Item.Set'Access); Item.Last := Socket; elsif Item.Last < Socket then Item.Last := Socket; end if; - - Insert_Socket_In_Set (Item.Set, C.int (Socket)); + Insert_Socket_In_Set (Item.Set'Access, C.int (Socket)); end Set; ---------------------- diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads index cd12b016975..be7325fc22b 100644 --- a/gcc/ada/g-socket.ads +++ b/gcc/ada/g-socket.ads @@ -52,7 +52,10 @@ with Ada.Exceptions; with Ada.Streams; with Ada.Unchecked_Deallocation; +with Interfaces.C; + with System.OS_Constants; +with System.Storage_Elements; package GNAT.Sockets is @@ -963,9 +966,9 @@ package GNAT.Sockets is type Socket_Set_Type is limited private; -- This type allows to manipulate sets of sockets. It allows to wait for - -- events on multiple endpoints at one time. This is an access type on a - -- system dependent structure. To avoid memory leaks it is highly - -- recommended to clean the access value with procedure Empty. + -- events on multiple endpoints at one time. This type used to contain + -- a pointer to dynamically allocated storage, but this is not the case + -- anymore, and no special precautions are required to avoid memory leaks. procedure Clear (Item : in out Socket_Set_Type; Socket : Socket_Type); -- Remove Socket from Item @@ -974,7 +977,7 @@ package GNAT.Sockets is -- Copy Source into Target as Socket_Set_Type is limited private procedure Empty (Item : in out Socket_Set_Type); - -- Remove all Sockets from Item and deallocate internal data + -- Remove all Sockets from Item procedure Get (Item : in out Socket_Set_Type; Socket : out Socket_Type); -- Extract a Socket from socket set Item. Socket is set to @@ -1053,8 +1056,7 @@ package GNAT.Sockets is procedure Abort_Selector (Selector : Selector_Type); -- Send an abort signal to the selector - type Fd_Set_Access is private; - No_Fd_Set_Access : constant Fd_Set_Access; + type Fd_Set is private; -- ??? This type must not be used directly, it needs to be visible because -- it is used in the visible part of GNAT.Sockets.Thin_Common. This is -- really an inversion of abstraction. The private part of GNAT.Sockets @@ -1076,14 +1078,17 @@ private pragma Volatile (Selector_Type); - type Fd_Set is null record; + type Fd_Set is + new System.Storage_Elements.Storage_Array (1 .. SOSC.SIZEOF_fd_set); + for Fd_Set'Alignment use Interfaces.C.int'Alignment; + type Fd_Set_Access is access all Fd_Set; pragma Convention (C, Fd_Set_Access); No_Fd_Set_Access : constant Fd_Set_Access := null; type Socket_Set_Type is record - Last : Socket_Type := No_Socket; - Set : Fd_Set_Access; + Last : Socket_Type := No_Socket; + Set : aliased Fd_Set; end record; subtype Inet_Addr_Comp_Type is Natural range 0 .. 255; diff --git a/gcc/ada/g-socthi-mingw.adb b/gcc/ada/g-socthi-mingw.adb index c853ce41eb5..a99c715fb31 100644 --- a/gcc/ada/g-socthi-mingw.adb +++ b/gcc/ada/g-socthi-mingw.adb @@ -58,9 +58,9 @@ package body GNAT.Sockets.Thin is function Standard_Select (Nfds : C.int; - Readfds : Fd_Set_Access; - Writefds : Fd_Set_Access; - Exceptfds : Fd_Set_Access; + Readfds : access Fd_Set; + Writefds : access Fd_Set; + Exceptfds : access Fd_Set; Timeout : Timeval_Access) return C.int; pragma Import (Stdcall, Standard_Select, "select"); @@ -286,17 +286,15 @@ package body GNAT.Sockets.Thin is function C_Select (Nfds : C.int; - Readfds : Fd_Set_Access; - Writefds : Fd_Set_Access; - Exceptfds : Fd_Set_Access; + Readfds : access Fd_Set; + Writefds : access Fd_Set; + Exceptfds : access Fd_Set; Timeout : Timeval_Access) return C.int is pragma Warnings (Off, Exceptfds); - RFS : constant Fd_Set_Access := Readfds; - WFS : constant Fd_Set_Access := Writefds; - WFSC : Fd_Set_Access := No_Fd_Set_Access; - EFS : Fd_Set_Access := Exceptfds; + Original_WFS : aliased constant Fd_Set := Writefds.all; + Res : C.int; S : aliased C.int; Last : aliased C.int; @@ -311,36 +309,27 @@ package body GNAT.Sockets.Thin is -- the initial write fd set, then move the socket from the -- exception fd set to the write fd set. - if WFS /= No_Fd_Set_Access then + if Writefds /= No_Fd_Set_Access then -- Add any socket present in write fd set into exception fd set - if EFS = No_Fd_Set_Access then - EFS := New_Socket_Set (WFS); - - else - WFSC := New_Socket_Set (WFS); - + declare + WFS : aliased Fd_Set := Writefds.all; + begin Last := Nfds - 1; loop Get_Socket_From_Set - (WFSC, S'Unchecked_Access, Last'Unchecked_Access); + (WFS'Access, S'Unchecked_Access, Last'Unchecked_Access); exit when S = -1; - Insert_Socket_In_Set (EFS, S); + Insert_Socket_In_Set (Exceptfds, S); end loop; - - Free_Socket_Set (WFSC); - end if; - - -- Keep a copy of write fd set - - WFSC := New_Socket_Set (WFS); + end; end if; - Res := Standard_Select (Nfds, RFS, WFS, EFS, Timeout); + Res := Standard_Select (Nfds, Readfds, Writefds, Exceptfds, Timeout); - if EFS /= No_Fd_Set_Access then + if Exceptfds /= No_Fd_Set_Access then declare - EFSC : constant Fd_Set_Access := New_Socket_Set (EFS); + EFSC : aliased Fd_Set := Exceptfds.all; Flag : constant C.int := SOSC.MSG_PEEK + SOSC.MSG_OOB; Buffer : Character; Length : C.int; @@ -350,7 +339,7 @@ package body GNAT.Sockets.Thin is Last := Nfds - 1; loop Get_Socket_From_Set - (EFSC, S'Unchecked_Access, Last'Unchecked_Access); + (EFSC'Access, S'Unchecked_Access, Last'Unchecked_Access); -- No more sockets in EFSC @@ -359,42 +348,27 @@ package body GNAT.Sockets.Thin is -- Check out-of-band data Length := C_Recvfrom - (S, Buffer'Address, 1, Flag, - null, Fromlen'Unchecked_Access); + (S, Buffer'Address, 1, Flag, null, Fromlen'Unchecked_Access); -- If the signal is not an out-of-band data, then it -- is a connection failure notification. if Length = -1 then - Remove_Socket_From_Set (EFS, S); + Remove_Socket_From_Set (Exceptfds, S); - -- If S is present in the initial write fd set, - -- move it from exception fd set back to write fd - -- set. Otherwise, ignore this event since the user - -- is not watching for it. + -- If S is present in the initial write fd set, move it from + -- exception fd set back to write fd set. Otherwise, ignore + -- this event since the user is not watching for it. - if WFSC /= No_Fd_Set_Access - and then (Is_Socket_In_Set (WFSC, S) /= 0) + if Writefds /= No_Fd_Set_Access + and then (Is_Socket_In_Set (Original_WFS'Access, S) /= 0) then - Insert_Socket_In_Set (WFS, S); + Insert_Socket_In_Set (Writefds, S); end if; end if; end loop; - - Free_Socket_Set (EFSC); end; - - if Exceptfds = No_Fd_Set_Access then - Free_Socket_Set (EFS); - end if; end if; - - -- Free any copy of write fd set - - if WFSC /= No_Fd_Set_Access then - Free_Socket_Set (WFSC); - end if; - return Res; end C_Select; diff --git a/gcc/ada/g-socthi-mingw.ads b/gcc/ada/g-socthi-mingw.ads index 231564012b2..ae4aeea4019 100644 --- a/gcc/ada/g-socthi-mingw.ads +++ b/gcc/ada/g-socthi-mingw.ads @@ -148,9 +148,9 @@ package GNAT.Sockets.Thin is function C_Select (Nfds : C.int; - Readfds : Fd_Set_Access; - Writefds : Fd_Set_Access; - Exceptfds : Fd_Set_Access; + Readfds : access Fd_Set; + Writefds : access Fd_Set; + Exceptfds : access Fd_Set; Timeout : Timeval_Access) return C.int; function C_Send diff --git a/gcc/ada/g-socthi-vms.adb b/gcc/ada/g-socthi-vms.adb index 0151ef567f4..77c61cc5a07 100644 --- a/gcc/ada/g-socthi-vms.adb +++ b/gcc/ada/g-socthi-vms.adb @@ -40,8 +40,7 @@ with Interfaces.C; use Interfaces.C; package body GNAT.Sockets.Thin is - Non_Blocking_Sockets : constant Fd_Set_Access := - New_Socket_Set (No_Fd_Set_Access); + Non_Blocking_Sockets : aliased Fd_Set; -- When this package is initialized with Process_Blocking_IO set -- to True, sockets are set in non-blocking mode to avoid blocking -- the whole process when a thread wants to perform a blocking IO @@ -113,7 +112,7 @@ package body GNAT.Sockets.Thin is (Domain, Typ, Protocol : C.int) return C.int; pragma Import (C, Syscall_Socket, "socket"); - function Non_Blocking_Socket (S : C.int) return Boolean; + function Non_Blocking_Socket (S : C.int) return Boolean; procedure Set_Non_Blocking_Socket (S : C.int; V : Boolean); -------------- @@ -178,32 +177,29 @@ package body GNAT.Sockets.Thin is end if; declare - WSet : Fd_Set_Access; + WSet : aliased Fd_Set; Now : aliased Timeval; begin - WSet := New_Socket_Set (No_Fd_Set_Access); + Reset_Socket_Set (WSet'Access); loop - Insert_Socket_In_Set (WSet, S); + Insert_Socket_In_Set (WSet'Access, S); Now := Immediat; Res := C_Select (S + 1, No_Fd_Set_Access, - WSet, + WSet'Access, No_Fd_Set_Access, Now'Unchecked_Access); exit when Res > 0; if Res = Failure then - Free_Socket_Set (WSet); return Res; end if; delay Quantum; end loop; - - Free_Socket_Set (WSet); end; Res := Syscall_Connect (S, Name, Namelen); @@ -393,7 +389,7 @@ package body GNAT.Sockets.Thin is procedure Initialize is begin - null; + Reset_Socket_Set (Non_Blocking_Sockets'Access); end Initialize; ------------------------- @@ -404,7 +400,7 @@ package body GNAT.Sockets.Thin is R : Boolean; begin Task_Lock.Lock; - R := (Is_Socket_In_Set (Non_Blocking_Sockets, S) /= 0); + R := (Is_Socket_In_Set (Non_Blocking_Sockets'Access, S) /= 0); Task_Lock.Unlock; return R; end Non_Blocking_Socket; @@ -418,9 +414,9 @@ package body GNAT.Sockets.Thin is Task_Lock.Lock; if V then - Insert_Socket_In_Set (Non_Blocking_Sockets, S); + Insert_Socket_In_Set (Non_Blocking_Sockets'Access, S); else - Remove_Socket_From_Set (Non_Blocking_Sockets, S); + Remove_Socket_From_Set (Non_Blocking_Sockets'Access, S); end if; Task_Lock.Unlock; diff --git a/gcc/ada/g-socthi-vms.ads b/gcc/ada/g-socthi-vms.ads index 3bcc21b8c67..47ccf651ffa 100644 --- a/gcc/ada/g-socthi-vms.ads +++ b/gcc/ada/g-socthi-vms.ads @@ -151,9 +151,9 @@ package GNAT.Sockets.Thin is function C_Select (Nfds : C.int; - Readfds : Fd_Set_Access; - Writefds : Fd_Set_Access; - Exceptfds : Fd_Set_Access; + Readfds : access Fd_Set; + Writefds : access Fd_Set; + Exceptfds : access Fd_Set; Timeout : Timeval_Access) return C.int; function C_Send diff --git a/gcc/ada/g-socthi-vxworks.adb b/gcc/ada/g-socthi-vxworks.adb index 3a1d1fe9a5f..d9d436fc3e1 100644 --- a/gcc/ada/g-socthi-vxworks.adb +++ b/gcc/ada/g-socthi-vxworks.adb @@ -44,8 +44,7 @@ with Interfaces.C; use Interfaces.C; package body GNAT.Sockets.Thin is - Non_Blocking_Sockets : constant Fd_Set_Access := - New_Socket_Set (No_Fd_Set_Access); + Non_Blocking_Sockets : aliased Fd_Set; -- When this package is initialized with Process_Blocking_IO set -- to True, sockets are set in non-blocking mode to avoid blocking -- the whole process when a thread wants to perform a blocking IO @@ -125,7 +124,7 @@ package body GNAT.Sockets.Thin is Protocol : C.int) return C.int; pragma Import (C, Syscall_Socket, "socket"); - function Non_Blocking_Socket (S : C.int) return Boolean; + function Non_Blocking_Socket (S : C.int) return Boolean; procedure Set_Non_Blocking_Socket (S : C.int; V : Boolean); -------------- @@ -191,33 +190,28 @@ package body GNAT.Sockets.Thin is end if; declare - WSet : Fd_Set_Access; + WSet : aliased Fd_Set; Now : aliased Timeval; - begin - WSet := New_Socket_Set (No_Fd_Set_Access); - + Reset_Socket_Set (WSet'Access); loop - Insert_Socket_In_Set (WSet, S); + Insert_Socket_In_Set (WSet'Access, S); Now := Immediat; Res := C_Select (S + 1, No_Fd_Set_Access, - WSet, + WSet'Access, No_Fd_Set_Access, Now'Unchecked_Access); exit when Res > 0; if Res = Failure then - Free_Socket_Set (WSet); return Res; end if; delay Quantum; end loop; - - Free_Socket_Set (WSet); end; Res := Syscall_Connect (S, Name, Namelen); @@ -409,7 +403,7 @@ package body GNAT.Sockets.Thin is procedure Initialize is begin - null; + Reset_Socket_Set (Non_Blocking_Sockets'Access); end Initialize; ------------------------- @@ -420,7 +414,7 @@ package body GNAT.Sockets.Thin is R : Boolean; begin Task_Lock.Lock; - R := (Is_Socket_In_Set (Non_Blocking_Sockets, S) /= 0); + R := (Is_Socket_In_Set (Non_Blocking_Sockets'Access, S) /= 0); Task_Lock.Unlock; return R; end Non_Blocking_Socket; @@ -433,9 +427,9 @@ package body GNAT.Sockets.Thin is begin Task_Lock.Lock; if V then - Insert_Socket_In_Set (Non_Blocking_Sockets, S); + Insert_Socket_In_Set (Non_Blocking_Sockets'Access, S); else - Remove_Socket_From_Set (Non_Blocking_Sockets, S); + Remove_Socket_From_Set (Non_Blocking_Sockets'Access, S); end if; Task_Lock.Unlock; diff --git a/gcc/ada/g-socthi-vxworks.ads b/gcc/ada/g-socthi-vxworks.ads index fa3f82f57e2..5c74e880142 100644 --- a/gcc/ada/g-socthi-vxworks.ads +++ b/gcc/ada/g-socthi-vxworks.ads @@ -149,9 +149,9 @@ package GNAT.Sockets.Thin is function C_Select (Nfds : C.int; - Readfds : Fd_Set_Access; - Writefds : Fd_Set_Access; - Exceptfds : Fd_Set_Access; + Readfds : access Fd_Set; + Writefds : access Fd_Set; + Exceptfds : access Fd_Set; Timeout : Timeval_Access) return C.int; function C_Send diff --git a/gcc/ada/g-socthi.adb b/gcc/ada/g-socthi.adb index 57b76bc2fe0..289adbe7932 100644 --- a/gcc/ada/g-socthi.adb +++ b/gcc/ada/g-socthi.adb @@ -44,8 +44,7 @@ with Interfaces.C; use Interfaces.C; package body GNAT.Sockets.Thin is - Non_Blocking_Sockets : constant Fd_Set_Access := - New_Socket_Set (No_Fd_Set_Access); + Non_Blocking_Sockets : aliased Fd_Set; -- When this package is initialized with Process_Blocking_IO set -- to True, sockets are set in non-blocking mode to avoid blocking -- the whole process when a thread wants to perform a blocking IO @@ -195,32 +194,29 @@ package body GNAT.Sockets.Thin is end if; declare - WSet : Fd_Set_Access; + WSet : aliased Fd_Set; Now : aliased Timeval; begin - WSet := New_Socket_Set (No_Fd_Set_Access); + Reset_Socket_Set (WSet'Access); loop - Insert_Socket_In_Set (WSet, S); + Insert_Socket_In_Set (WSet'Access, S); Now := Immediat; Res := C_Select (S + 1, No_Fd_Set_Access, - WSet, + WSet'Access, No_Fd_Set_Access, Now'Unchecked_Access); exit when Res > 0; if Res = Failure then - Free_Socket_Set (WSet); return Res; end if; delay Quantum; end loop; - - Free_Socket_Set (WSet); end; Res := Syscall_Connect (S, Name, Namelen); @@ -412,6 +408,7 @@ package body GNAT.Sockets.Thin is procedure Initialize is begin Disable_All_SIGPIPEs; + Reset_Socket_Set (Non_Blocking_Sockets'Access); end Initialize; ------------------------- @@ -422,7 +419,7 @@ package body GNAT.Sockets.Thin is R : Boolean; begin Task_Lock.Lock; - R := (Is_Socket_In_Set (Non_Blocking_Sockets, S) /= 0); + R := (Is_Socket_In_Set (Non_Blocking_Sockets'Access, S) /= 0); Task_Lock.Unlock; return R; end Non_Blocking_Socket; @@ -436,9 +433,9 @@ package body GNAT.Sockets.Thin is Task_Lock.Lock; if V then - Insert_Socket_In_Set (Non_Blocking_Sockets, S); + Insert_Socket_In_Set (Non_Blocking_Sockets'Access, S); else - Remove_Socket_From_Set (Non_Blocking_Sockets, S); + Remove_Socket_From_Set (Non_Blocking_Sockets'Access, S); end if; Task_Lock.Unlock; diff --git a/gcc/ada/g-socthi.ads b/gcc/ada/g-socthi.ads index 01e4d817be3..eb1119301a4 100644 --- a/gcc/ada/g-socthi.ads +++ b/gcc/ada/g-socthi.ads @@ -150,9 +150,9 @@ package GNAT.Sockets.Thin is function C_Select (Nfds : C.int; - Readfds : Fd_Set_Access; - Writefds : Fd_Set_Access; - Exceptfds : Fd_Set_Access; + Readfds : access Fd_Set; + Writefds : access Fd_Set; + Exceptfds : access Fd_Set; Timeout : Timeval_Access) return C.int; function C_Send diff --git a/gcc/ada/g-sothco.ads b/gcc/ada/g-sothco.ads index 434557d1f08..fc8304757c6 100644 --- a/gcc/ada/g-sothco.ads +++ b/gcc/ada/g-sothco.ads @@ -250,11 +250,8 @@ package GNAT.Sockets.Thin_Common is pragma Convention (C, Int_Access); -- Access to C integers - procedure Free_Socket_Set (Set : Fd_Set_Access); - -- Free system-dependent socket set - procedure Get_Socket_From_Set - (Set : Fd_Set_Access; + (Set : access Fd_Set; Socket : Int_Access; Last : Int_Access); -- Get last socket in Socket and remove it from the socket set. The @@ -264,18 +261,18 @@ package GNAT.Sockets.Thin_Common is -- socket set. procedure Insert_Socket_In_Set - (Set : Fd_Set_Access; + (Set : access Fd_Set; Socket : C.int); -- Insert socket in the socket set function Is_Socket_In_Set - (Set : Fd_Set_Access; + (Set : access constant Fd_Set; Socket : C.int) return C.int; -- Check whether Socket is in the socket set, return a non-zero -- value if it is, zero if it is not. procedure Last_Socket_In_Set - (Set : Fd_Set_Access; + (Set : access Fd_Set; Last : Int_Access); -- Find the largest socket in the socket set. This is needed for select(). -- When Last_Socket_In_Set is called, parameter Last is a maximum value of @@ -283,17 +280,12 @@ package GNAT.Sockets.Thin_Common is -- socket sets. After the call, Last is set back to the real largest socket -- in the socket set. - function New_Socket_Set - (Set : Fd_Set_Access) return Fd_Set_Access; - -- Allocate a new socket set which is a system-dependent structure and - -- initialize by copying Set if it is non-null, by making it empty - -- otherwise. - - procedure Remove_Socket_From_Set - (Set : Fd_Set_Access; - Socket : C.int); + procedure Remove_Socket_From_Set (Set : access Fd_Set; Socket : C.int); -- Remove socket from the socket set + procedure Reset_Socket_Set (Set : access Fd_Set); + -- Make Set empty + ------------------------------------------ -- Pairs of signalling file descriptors -- ------------------------------------------ @@ -313,12 +305,10 @@ package GNAT.Sockets.Thin_Common is -- file descriptors. private - - pragma Import (C, Free_Socket_Set, "__gnat_free_socket_set"); pragma Import (C, Get_Socket_From_Set, "__gnat_get_socket_from_set"); pragma Import (C, Is_Socket_In_Set, "__gnat_is_socket_in_set"); pragma Import (C, Last_Socket_In_Set, "__gnat_last_socket_in_set"); - pragma Import (C, New_Socket_Set, "__gnat_new_socket_set"); pragma Import (C, Insert_Socket_In_Set, "__gnat_insert_socket_in_set"); pragma Import (C, Remove_Socket_From_Set, "__gnat_remove_socket_from_set"); + pragma Import (C, Reset_Socket_Set, "__gnat_reset_socket_set"); end GNAT.Sockets.Thin_Common; diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index a1552dcb3fa..a59fc30d1ca 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -393,8 +393,7 @@ begin if Targparm.GCC_ZCX_Support_On_Target then Exception_Mechanism := Back_End_Exceptions; else - Osint.Fail - ("Zero Cost Exceptions not supported on this target"); + Osint.Fail ("Zero Cost Exceptions not supported on this target"); end if; end if; diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index c75931a42d5..ddb62c58c7c 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -1479,9 +1479,9 @@ begin if Command_List (The_Command).VMS_Only then Non_VMS_Usage; Fail - ("Command """, - Command_List (The_Command).Cname.all, - """ can only be used on VMS"); + ("Command """ + & Command_List (The_Command).Cname.all + & """ can only be used on VMS"); end if; exception @@ -1500,7 +1500,7 @@ begin exception when Constraint_Error => Non_VMS_Usage; - Fail ("Unknown command: ", Argument (Command_Arg)); + Fail ("Unknown command: " & Argument (Command_Arg)); end; end; @@ -1750,7 +1750,7 @@ begin when '2' => Current_Verbosity := Prj.High; when others => - Fail ("Invalid switch: ", Argv.all); + Fail ("Invalid switch: " & Argv.all); end case; Remove_Switch (Arg_Num); @@ -1763,9 +1763,10 @@ begin if Project_File /= null then Fail - (Argv.all, - ": second project file forbidden (first is """, - Project_File.all & """)"); + (Argv.all + & ": second project file forbidden (first is """ + & Project_File.all + & """)"); -- The two style project files (-p and -P) cannot be -- used together. @@ -1824,8 +1825,8 @@ begin Value => Argv (Equal_Pos + 1 .. Argv'Last)); else Fail - (Argv.all, - " is not a valid external assignment."); + (Argv.all + & " is not a valid external assignment."); end if; end; @@ -1882,7 +1883,7 @@ begin Packages_To_Check => Packages_To_Check); if Project = Prj.No_Project then - Fail ("""", Project_File.all, """ processing failed"); + Fail ("""" & Project_File.all & """ processing failed"); end if; -- Check if a package with the name of the tool is in the project diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index 22aaed31d62..36e2ee6218d 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- -- -- 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- -- @@ -1238,7 +1238,7 @@ procedure Gnatls is elsif (Argv'Length = 3 and then Argv (3) = '-') or else (Argv'Length = 4 and then Argv (4) = '-') then - Fail ("Trailing ""-"" at the end of ", Argv, " forbidden."); + Fail ("Trailing ""-"" at the end of " & Argv & " forbidden."); -- Processing for -Idir diff --git a/gcc/ada/gnatname.adb b/gcc/ada/gnatname.adb index d684551ed91..7e817b5bf03 100644 --- a/gcc/ada/gnatname.adb +++ b/gcc/ada/gnatname.adb @@ -186,7 +186,7 @@ procedure Gnatname is Excluded_Pattern_Expected : Boolean; procedure Check_Regular_Expression (S : String); - -- Compile string S into a Regexp. Fail if any error. + -- Compile string S into a Regexp, fail if any error ----------------------------- -- Check_Regular_Expression-- @@ -199,7 +199,7 @@ procedure Gnatname is Dummy := Compile (S, Glob => True); exception when Error_In_Regexp => - Fail ("invalid regular expression """, S, """"); + Fail ("invalid regular expression """ & S & """"); end Check_Regular_Expression; -- Start of processing for Scan_Args diff --git a/gcc/ada/gnatsym.adb b/gcc/ada/gnatsym.adb index a47716cf5ab..dec5257f45c 100644 --- a/gcc/ada/gnatsym.adb +++ b/gcc/ada/gnatsym.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2003-2008, Free Software Foundation, Inc. -- -- -- -- 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- -- @@ -160,7 +160,7 @@ procedure Gnatsym is Version_String := new String'(GNAT.Command_Line.Parameter); when others => - Fail ("invalid switch: ", Full_Switch); + Fail ("invalid switch: " & Full_Switch); end case; end loop; @@ -181,7 +181,7 @@ procedure Gnatsym is exception when Invalid_Switch => Usage; - Fail ("invalid switch : ", Full_Switch); + Fail ("invalid switch : " & Full_Switch); end Parse_Cmd_Line; ----------- diff --git a/gcc/ada/gprep.adb b/gcc/ada/gprep.adb index 44633b9c902..c4cf14ba93c 100644 --- a/gcc/ada/gprep.adb +++ b/gcc/ada/gprep.adb @@ -236,9 +236,9 @@ package body GPrep is Sinput.Main_Source_File := Deffile; if Deffile = No_Source_File then - Fail ("unable to find definition file """, - Get_Name_String (Deffile_Name), - """"); + Fail ("unable to find definition file """ + & Get_Name_String (Deffile_Name) + & """"); end if; Scanner.Initialize_Scanner (Deffile); @@ -251,8 +251,9 @@ package body GPrep is if Total_Errors_Detected > 0 then Errutil.Finalize (Source_Type => "definition"); - Fail ("errors in definition file """, - Get_Name_String (Deffile_Name), """"); + Fail ("errors in definition file """ + & Get_Name_String (Deffile_Name) + & """"); end if; -- If -s switch was specified, print a sorted list of symbol names and @@ -487,8 +488,9 @@ package body GPrep is exception when others => Fail - ("unable to create output file """, - Get_Name_String (Outfile_Name), """"); + ("unable to create output file """ + & Get_Name_String (Outfile_Name) + & """"); end; -- Load the input file @@ -496,8 +498,9 @@ package body GPrep is Infile := Sinput.C.Load_File (Get_Name_String (Infile_Name)); if Infile = No_Source_File then - Fail ("unable to find input file """, - Get_Name_String (Infile_Name), """"); + Fail ("unable to find input file """ + & Get_Name_String (Infile_Name) + & """"); end if; -- Set Main_Source_File to the input file for the benefit of @@ -632,8 +635,9 @@ package body GPrep is exception when Directory_Error => - Fail ("could not create directory """, - Output, """"); + Fail ("could not create directory """ + & Output + & """"); end; end if; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 3df5482f28e..7a0e1e032ab 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -445,10 +445,10 @@ package body Make is Link_With_Shared_Libgcc : Argument_List_Access := No_Shared_Libgcc_Switch'Access; - procedure Make_Failed (S1 : String; S2 : String := ""; S3 : String := ""); - -- Delete all temp files created by Gnatmake and call Osint.Fail, - -- with the parameter S1, S2 and S3 (see osint.ads). - -- This is called from the Prj hierarchy and the MLib hierarchy. + procedure Make_Failed (S : String); + -- Delete all temp files created by Gnatmake and call Osint.Fail, with the + -- parameter S (see osint.ads). This is called from the Prj hierarchy and + -- the MLib hierarchy. -------------------------- -- Obsolete Executables -- @@ -1305,8 +1305,7 @@ package body Make is "it to Global_Compilation_Switches.", Element.Location); Errutil.Finalize; - Make_Failed - ("*** illegal switch """, Argv, """"); + Make_Failed ("*** illegal switch """ & Argv & """"); end if; end; end if; @@ -1360,7 +1359,7 @@ package body Make is Display (Gnatbind.all, Bind_Args (Args'First .. Bind_Last)); if Gnatbind_Path = null then - Make_Failed ("error, unable to locate ", Gnatbind.all); + Make_Failed ("error, unable to locate " & Gnatbind.all); end if; GNAT.OS_Lib.Spawn @@ -3132,7 +3131,7 @@ package body Make is Display (Gcc.all, Comp_Args (Args'First .. Comp_Last)); if Gcc_Path = null then - Make_Failed ("error, unable to locate ", Gcc.all); + Make_Failed ("error, unable to locate " & Gcc.all); end if; return @@ -3413,11 +3412,11 @@ package body Make is and then Arguments_Project = No_Project and then not External_Unit_Compilation_Allowed then - Make_Failed ("external source (", - Get_Name_String (Source_File), - ") is not part of any project;" - & " cannot be compiled without" & - " gnatmake switch -x"); + Make_Failed ("external source (" + & Get_Name_String (Source_File) + & ") is not part of any project;" + & " cannot be compiled without" + & " gnatmake switch -x"); end if; -- Is this the first file we have to compile? @@ -3923,12 +3922,11 @@ package body Make is if not Is_Regular_File (Path) then if Debug.Debug_Flag_F then Make_Failed - ("cannot find configuration pragmas file ", - File_Name (Path)); + ("cannot find configuration pragmas file " + & File_Name (Path)); else Make_Failed - ("cannot find configuration pragmas file ", - Path); + ("cannot find configuration pragmas file " & Path); end if; end if; @@ -3968,12 +3966,12 @@ package body Make is if not Is_Regular_File (Path) then if Debug.Debug_Flag_F then Make_Failed - ("cannot find configuration pragmas file ", - File_Name (Path)); + ("cannot find configuration pragmas file " + & File_Name (Path)); else Make_Failed - ("cannot find configuration pragmas file ", Path); + ("cannot find configuration pragmas file " & Path); end if; end if; @@ -4383,8 +4381,7 @@ package body Make is if Proj = No_Project then Make_Failed - ("""" & Main & - """ is not a source of any project"); + ("""" & Main & """ is not a source of any project"); else -- If there is directory information, check that @@ -4416,8 +4413,7 @@ package body Make is -- Fail if the file cannot be found if Real_Path = null then - Make_Failed - ("file """ & Main & """ does not exist"); + Make_Failed ("file """ & Main & """ does not exist"); end if; declare @@ -4924,7 +4920,7 @@ package body Make is if not At_Least_One_Main then Make_Failed - ("no Ada mains; use -B to build foreign main"); + ("no Ada mains, use -B to build foreign main"); end if; end; @@ -5105,9 +5101,9 @@ package body Make is -- We fail if we cannot find the main source file if Main_Unit_File_Name = "" then - Make_Failed ('"' & Main_Source_File_Name, - """ is not a unit of project ", - Project_File_Name.all & "."); + Make_Failed ('"' & Main_Source_File_Name + & """ is not a unit of project " + & Project_File_Name.all & "."); else -- Remove any directory information from the main -- source file name. @@ -5445,10 +5441,10 @@ package body Make is No_Path_Information then Make_Failed - ("no object files to build library for project """, - Get_Name_String - (Project_Tree.Projects.Table (Proj).Name), - """"); + ("no object files to build library for project """ + & Get_Name_String + (Project_Tree.Projects.Table (Proj).Name) + & """"); Project_Tree.Projects.Table (Proj).Need_To_Build_Lib := False; @@ -6559,9 +6555,9 @@ package body Make is -- as an immediate source of the main project file. if Main_Unit_File_Name = "" then - Make_Failed ('"' & Main_Source_File_Name, - """ is not a unit of project ", - Project_File_Name.all & "."); + Make_Failed ('"' & Main_Source_File_Name + & """ is not a unit of project " + & Project_File_Name.all & "."); else -- Remove any directory information from the main @@ -7005,7 +7001,8 @@ package body Make is end if; if Main_Project = No_Project then - Make_Failed ("""", Project_File_Name.all, """ processing failed"); + Make_Failed + ("""" & Project_File_Name.all & """ processing failed"); end if; Create_Mapping_File := True; @@ -7422,7 +7419,7 @@ package body Make is Display (Gnatlink.all, Link_Args); if Gnatlink_Path = null then - Make_Failed ("error, unable to locate ", Gnatlink.all); + Make_Failed ("error, unable to locate " & Gnatlink.all); end if; GNAT.OS_Lib.Spawn (Gnatlink_Path.all, Link_Args, Success); @@ -7518,10 +7515,10 @@ package body Make is -- Make_Failed -- ----------------- - procedure Make_Failed (S1 : String; S2 : String := ""; S3 : String := "") is + procedure Make_Failed (S : String) is begin Delete_All_Temp_Files; - Osint.Fail (S1, S2, S3); + Osint.Fail (S); end Make_Failed; -------------------- @@ -7729,7 +7726,7 @@ package body Make is Make_Failed ("object directory path name missing after -D"); elsif not Is_Directory (Argv) then - Make_Failed ("cannot find object directory """, Argv, """"); + Make_Failed ("cannot find object directory """ & Argv & """"); else Add_Lib_Search_Dir (Argv); @@ -7950,7 +7947,7 @@ package body Make is or else (Argv'Length > 10 and then Argv (1 .. 10) = "-GNATLINK=") or else (Argv'Length > 10 and then Argv (1 .. 10) = "-GNATBIND=") then - Make_Failed ("option ", Argv, " should start with '--'"); + Make_Failed ("option " & Argv & " should start with '--'"); -- -I- @@ -7962,7 +7959,8 @@ package body Make is elsif (Argv'Length = 3 and then Argv (3) = '-') or else (Argv'Length = 4 and then Argv (4) = '-') then - Make_Failed ("trailing ""-"" at the end of ", Argv, " forbidden."); + Make_Failed + ("trailing ""-"" at the end of " & Argv & " forbidden."); -- -Idir @@ -8048,7 +8046,7 @@ package body Make is elsif Argv'Last > 2 and then Argv (2) = 'C' then if And_Save then if Argv (3) /= '=' or else Argv'Last <= 3 then - Make_Failed ("illegal switch ", Argv); + Make_Failed ("illegal switch " & Argv); end if; Gnatmake_Mapping_File := new String'(Argv (4 .. Argv'Last)); diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 3d0ee62eaed..afddc059b77 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -670,9 +670,9 @@ package body Makeutl is if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then if Parent = null or else Parent'Length = 0 then Do_Fail - ("relative search path switches (""", - Sw, - """) are not allowed"); + ("relative search path switches (""" + & Sw + & """) are not allowed"); else Switch := @@ -688,7 +688,7 @@ package body Makeutl is if not Is_Absolute_Path (Sw) then if Parent = null or else Parent'Length = 0 then Do_Fail - ("relative paths (""", Sw, """) are not allowed"); + ("relative paths (""" & Sw & """) are not allowed"); else Switch := diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index b6483f3e520..705e6e72436 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -32,10 +32,7 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; package Makeutl is - type Fail_Proc is access procedure - (S1 : String; - S2 : String := ""; - S3 : String := ""); + type Fail_Proc is access procedure (S : String); Do_Fail : Fail_Proc := Osint.Fail'Access; -- Failing procedure called from procedure Test_If_Relative_Path below. -- May be redirected. diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index 9b532be27d7..66951e63dd2 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -828,7 +828,7 @@ package body MLib.Prj is -- Fail if project is not a library project if not Data.Library then - Com.Fail ("project """, Project_Name, """ has no library"); + Com.Fail ("project """ & Project_Name & """ has no library"); end if; -- Do not attempt to build the library if it is externally built @@ -868,11 +868,11 @@ package body MLib.Prj is if Bind then if Gnatbind_Path = null then - Com.Fail ("unable to locate ", Gnatbind); + Com.Fail ("unable to locate " & Gnatbind); end if; if Gcc_Path = null then - Com.Fail ("unable to locate ", Gcc); + Com.Fail ("unable to locate " & Gcc); end if; -- Allocate Arguments, if it is the first time we see a standalone @@ -1176,8 +1176,8 @@ package body MLib.Prj is end if; if not Success then - Com.Fail ("could not bind standalone library ", - Get_Name_String (Data.Library_Name)); + Com.Fail ("could not bind standalone library " + & Get_Name_String (Data.Library_Name)); end if; end if; @@ -1268,8 +1268,8 @@ package body MLib.Prj is if not Success then Com.Fail - ("could not compile binder generated file for library ", - Get_Name_String (Data.Library_Name)); + ("could not compile binder generated file for library " + & Get_Name_String (Data.Library_Name)); end if; -- Process binder generated file for pragmas Linker_Options @@ -1532,10 +1532,10 @@ package body MLib.Prj is exception when Directory_Error => - Com.Fail ("cannot find object directory """, - Get_Name_String - (Data.Object_Directory.Display_Name), - """"); + Com.Fail ("cannot find object directory """ + & Get_Name_String + (Data.Object_Directory.Display_Name) + & """"); end; end if; @@ -1817,9 +1817,9 @@ package body MLib.Prj is exception when others => Com.Fail - ("unable to access library directory """, - Name_Buffer (1 .. Name_Len), - """"); + ("unable to access library directory """ + & Name_Buffer (1 .. Name_Len) + & """"); end; Open (Dir, "."); @@ -1972,9 +1972,9 @@ package body MLib.Prj is exception when others => Com.Fail - ("unable to access library source copy directory """, - Name_Buffer (1 .. Name_Len), - """"); + ("unable to access library source copy directory """ + & Name_Buffer (1 .. Name_Len) + & """"); end; declare @@ -2060,7 +2060,7 @@ package body MLib.Prj is procedure Check (Filename : String) is begin if not Is_Regular_File (Filename) then - Com.Fail (Filename, " not found."); + Com.Fail (Filename & " not found."); end if; end Check; diff --git a/gcc/ada/mlib-tgt-specific-vms-alpha.adb b/gcc/ada/mlib-tgt-specific-vms-alpha.adb index 0c4ab953f33..c9ffa0d837e 100644 --- a/gcc/ada/mlib-tgt-specific-vms-alpha.adb +++ b/gcc/ada/mlib-tgt-specific-vms-alpha.adb @@ -196,8 +196,9 @@ package body MLib.Tgt.Specific is exception when Constraint_Error => - Fail ("illegal version """, Lib_Version, - """ (on VMS version must be a positive number)"); + Fail ("illegal version """ + & Lib_Version + & """ (on VMS version must be a positive number)"); return ""; end; end if; @@ -239,7 +240,7 @@ package body MLib.Tgt.Specific is Gnatsym_Path := Locate_Exec_On_Path (Gnatsym_Name); if Gnatsym_Path = null then - Fail (Gnatsym_Name, " not found in path"); + Fail (Gnatsym_Name & " not found in path"); end if; end if; @@ -313,8 +314,9 @@ package body MLib.Tgt.Specific is end if; if not OK then - Fail ("creation of auto-init assembly file """, - Macro_File_Name, """ failed"); + Fail ("creation of auto-init assembly file """ + & Macro_File_Name + & """ failed"); end if; end; @@ -330,8 +332,9 @@ package body MLib.Tgt.Specific is mode (mode'First)'Address); if Popen_Result = Null_Address then - Fail ("assembly of auto-init assembly file """, - Macro_File_Name, """ failed"); + Fail ("assembly of auto-init assembly file """ + & Macro_File_Name + & """ failed"); end if; -- Wait for the end of execution of the macro-assembler @@ -339,8 +342,9 @@ package body MLib.Tgt.Specific is Pclose_Result := pclose (Popen_Result); if Pclose_Result < 0 then - Fail ("assembly of auto init assembly file """, - Macro_File_Name, """ failed"); + Fail ("assembly of auto init assembly file """ + & Macro_File_Name + & """ failed"); end if; -- Add the generated object file to the list of objects to be @@ -432,8 +436,9 @@ package body MLib.Tgt.Specific is Success => Success); if not Success then - Fail ("unable to create symbol file for library """, - Lib_Filename, """"); + Fail ("unable to create symbol file for library """ + & Lib_Filename + & """"); end if; Free (Arguments); diff --git a/gcc/ada/mlib-tgt-specific-vms-ia64.adb b/gcc/ada/mlib-tgt-specific-vms-ia64.adb index c133ef0d4b5..247b2eb304b 100644 --- a/gcc/ada/mlib-tgt-specific-vms-ia64.adb +++ b/gcc/ada/mlib-tgt-specific-vms-ia64.adb @@ -195,8 +195,9 @@ package body MLib.Tgt.Specific is exception when Constraint_Error => - Fail ("illegal version """, Lib_Version, - """ (on VMS version must be a positive number)"); + Fail ("illegal version """ + & Lib_Version + & """ (on VMS version must be a positive number)"); return ""; end; end if; @@ -221,7 +222,7 @@ package body MLib.Tgt.Specific is then For_Linker_Opt := new String'("--for-linker=" & Opt_File_Name); else - Fail ("Options File """, Opt_File_Name, """ must end with .opt"); + Fail ("Options File """ & Opt_File_Name & """ must end with .opt"); end if; VMS_Options (VMS_Options'First) := For_Linker_Opt; @@ -236,7 +237,7 @@ package body MLib.Tgt.Specific is Gnatsym_Path := Locate_Exec_On_Path (Gnatsym_Name); if Gnatsym_Path = null then - Fail (Gnatsym_Name, " not found in path"); + Fail (Gnatsym_Name & " not found in path"); end if; end if; @@ -316,8 +317,9 @@ package body MLib.Tgt.Specific is end if; if not OK then - Fail ("creation of auto-init assembly file """, - Macro_File_Name, """ failed"); + Fail ("creation of auto-init assembly file """ + & Macro_File_Name + & """ failed"); end if; end; @@ -333,8 +335,9 @@ package body MLib.Tgt.Specific is mode (mode'First)'Address); if Popen_Result = Null_Address then - Fail ("assembly of auto-init assembly file """, - Macro_File_Name, """ failed"); + Fail ("assembly of auto-init assembly file """ + & Macro_File_Name + & """ failed"); end if; -- Wait for the end of execution of the macro-assembler @@ -342,8 +345,9 @@ package body MLib.Tgt.Specific is Pclose_Result := pclose (Popen_Result); if Pclose_Result < 0 then - Fail ("assembly of auto init assembly file """, - Macro_File_Name, """ failed"); + Fail ("assembly of auto init assembly file """ + & Macro_File_Name + & """ failed"); end if; -- Add the generated object file to the list of objects to be @@ -434,8 +438,9 @@ package body MLib.Tgt.Specific is Success => Success); if not Success then - Fail ("unable to create symbol file for library """, - Lib_Filename, """"); + Fail ("unable to create symbol file for library """ + & Lib_Filename + & """"); end if; Free (Arguments); diff --git a/gcc/ada/mlib-utl.adb b/gcc/ada/mlib-utl.adb index 76e7db5332b..78378a673b9 100644 --- a/gcc/ada/mlib-utl.adb +++ b/gcc/ada/mlib-utl.adb @@ -150,7 +150,7 @@ package body MLib.Utl is end if; if Ar_Exec = null then - Fail (Ar_Name.all, " not found in path"); + Fail (Ar_Name.all & " not found in path"); elsif Opt.Verbose_Mode then Write_Str ("found "); @@ -275,7 +275,7 @@ package body MLib.Utl is end if; if not Success then - Fail (Ar_Name.all, " execution error."); + Fail (Ar_Name.all & " execution error."); end if; -- If we have found ranlib, run it over the library @@ -293,7 +293,7 @@ package body MLib.Utl is Success); if not Success then - Fail (Ranlib_Name.all, " execution error."); + Fail (Ranlib_Name.all & " execution error."); end if; end if; end Ar; @@ -418,7 +418,7 @@ package body MLib.Utl is Gcc_Exec := Locate_Exec_On_Path (Gcc_Name.all); if Gcc_Exec = null then - Fail (Gcc_Name.all, " not found in path"); + Fail (Gcc_Name.all & " not found in path"); end if; end if; @@ -428,7 +428,7 @@ package body MLib.Utl is Driver := Locate_Exec_On_Path (Get_Name_String (Driver_Name)); if Driver = null then - Fail (Get_Name_String (Driver_Name), " not found in path"); + Fail (Get_Name_String (Driver_Name) & " not found in path"); end if; end if; @@ -586,9 +586,9 @@ package body MLib.Utl is if not Success then if Driver_Name = No_Name then - Fail (Gcc_Name.all, " execution error"); + Fail (Gcc_Name.all & " execution error"); else - Fail (Get_Name_String (Driver_Name), " execution error"); + Fail (Get_Name_String (Driver_Name) & " execution error"); end if; end if; end Gcc; diff --git a/gcc/ada/mlib.adb b/gcc/ada/mlib.adb index f037bdb144e..5a8a66128b2 100644 --- a/gcc/ada/mlib.adb +++ b/gcc/ada/mlib.adb @@ -70,20 +70,22 @@ package body MLib is end if; if Name'Length > Max_Characters_In_Library_Name then - Prj.Com.Fail ("illegal library name """, Name, """: too long"); + Prj.Com.Fail ("illegal library name """ + & Name + & """: too long"); end if; if not Is_Letter (Name (Name'First)) then - Prj.Com.Fail ("illegal library name """, - Name, - """: should start with a letter"); + Prj.Com.Fail ("illegal library name """ + & Name + & """: should start with a letter"); end if; for Index in Name'Range loop if not Is_Alphanumeric (Name (Index)) then - Prj.Com.Fail ("illegal library name """, - Name, - """: should include only letters and digits"); + Prj.Com.Fail ("illegal library name """ + & Name + & """: should include only letters and digits"); end if; end loop; end Check_Library_Name; diff --git a/gcc/ada/mlib.ads b/gcc/ada/mlib.ads index ed0ffc1b36c..684e6e70c37 100644 --- a/gcc/ada/mlib.ads +++ b/gcc/ada/mlib.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1999-2007, AdaCore -- +-- Copyright (C) 1999-2008, 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- -- @@ -40,8 +40,7 @@ package MLib is -- Maximum number of characters in a library name. -- Used by Check_Library_Name below. - type Fail_Proc is access procedure - (S1 : String; S2 : String := ""; S3 : String := ""); + type Fail_Proc is access procedure (S1 : String); Fail : Fail_Proc := Osint.Fail'Access; -- This procedure is used in the MLib hierarchy, instead of diff --git a/gcc/ada/osint-b.adb b/gcc/ada/osint-b.adb index 80009a56c74..b66cebf2ac2 100644 --- a/gcc/ada/osint-b.adb +++ b/gcc/ada/osint-b.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2008, Free Software Foundation, Inc. -- -- -- -- 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- -- @@ -39,8 +39,8 @@ package body Osint.B is if not Status then Fail - ("error while closing generated file ", - Get_Name_String (Output_File_Name)); + ("error while closing generated file " + & Get_Name_String (Output_File_Name)); end if; end Close_Binder_Output; diff --git a/gcc/ada/osint-c.adb b/gcc/ada/osint-c.adb index d93214cd606..e4dab2aed04 100644 --- a/gcc/ada/osint-c.adb +++ b/gcc/ada/osint-c.adb @@ -64,8 +64,8 @@ package body Osint.C is if not Status then Fail - ("error while closing expanded source file ", - Get_Name_String (Output_File_Name)); + ("error while closing expanded source file " + & Get_Name_String (Output_File_Name)); end if; end Close_Debug_File; @@ -81,8 +81,8 @@ package body Osint.C is if not Status then Fail - ("error while closing list file ", - Get_Name_String (Output_File_Name)); + ("error while closing list file " + & Get_Name_String (Output_File_Name)); end if; end Close_List_File; @@ -98,8 +98,8 @@ package body Osint.C is if not Status then Fail - ("error while closing ALI file ", - Get_Name_String (Output_File_Name)); + ("error while closing ALI file " + & Get_Name_String (Output_File_Name)); end if; end Close_Output_Library_Info; @@ -115,8 +115,8 @@ package body Osint.C is if not Status then Fail - ("error while closing representation info file ", - Get_Name_String (Output_File_Name)); + ("error while closing representation info file " + & Get_Name_String (Output_File_Name)); end if; end Close_Repinfo_File; @@ -401,8 +401,8 @@ package body Osint.C is if not Status then Fail - ("error while closing tree file ", - Get_Name_String (Output_File_Name)); + ("error while closing tree file " + & Get_Name_String (Output_File_Name)); end if; end Tree_Close; diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index 993ecdf3578..0363f5e27eb 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -643,7 +643,7 @@ package body Osint is Fdesc := Create_File (Name_Buffer'Address, Fmode); if Fdesc = Invalid_FD then - Fail ("Cannot create: ", Name_Buffer (1 .. Name_Len)); + Fail ("Cannot create: " & Name_Buffer (1 .. Name_Len)); end if; end Create_File_And_Check; @@ -900,7 +900,7 @@ package body Osint is -- Fail -- ---------- - procedure Fail (S1 : String; S2 : String := ""; S3 : String := "") is + procedure Fail (S : String) is begin -- We use Output in case there is a special output set up. -- In this case Set_Standard_Error will have no immediate effect. @@ -908,9 +908,7 @@ package body Osint is Set_Standard_Error; Osint.Write_Program_Name; Write_Str (": "); - Write_Str (S1); - Write_Str (S2); - Write_Str (S3); + Write_Str (S); Write_Eol; Exit_Program (E_Fatal); @@ -2102,7 +2100,7 @@ package body Osint is if Current_Full_Lib_Name = No_File then if Fatal_Err then - Fail ("Cannot find: ", Name_Buffer (1 .. Name_Len)); + Fail ("Cannot find: " & Name_Buffer (1 .. Name_Len)); else Current_Full_Obj_Stamp := Empty_Time_Stamp; return null; @@ -2121,7 +2119,7 @@ package body Osint is if Lib_FD = Invalid_FD then if Fatal_Err then - Fail ("Cannot open: ", Name_Buffer (1 .. Name_Len)); + Fail ("Cannot open: " & Name_Buffer (1 .. Name_Len)); else Current_Full_Obj_Stamp := Empty_Time_Stamp; return null; @@ -2147,7 +2145,7 @@ package body Osint is -- No need to check the status, we fail anyway - Fail ("Cannot find: ", Name_Buffer (1 .. Name_Len)); + Fail ("Cannot find: " & Name_Buffer (1 .. Name_Len)); else Current_Full_Obj_Stamp := Empty_Time_Stamp; @@ -2240,7 +2238,7 @@ package body Osint is if N = Current_Main then Get_Name_String (N); - Fail ("Cannot find: ", Name_Buffer (1 .. Name_Len)); + Fail ("Cannot find: " & Name_Buffer (1 .. Name_Len)); end if; Src := null; @@ -2561,7 +2559,7 @@ package body Osint is exception when others => - Fail ("erroneous directory spec: ", Host_Dir); + Fail ("erroneous directory spec: " & Host_Dir); return null; end To_Canonical_Dir_Spec; @@ -2654,7 +2652,7 @@ package body Osint is exception when others => - Fail ("erroneous file spec: ", Host_File); + Fail ("erroneous file spec: " & Host_File); return null; end To_Canonical_File_Spec; @@ -2687,7 +2685,7 @@ package body Osint is exception when others => - Fail ("erroneous path spec: ", Host_Path); + Fail ("erroneous path spec: " & Host_Path); return null; end To_Canonical_Path_Spec; diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index eff00dea9b2..4d82c86a5a2 100644 --- a/gcc/ada/osint.ads +++ b/gcc/ada/osint.ads @@ -121,11 +121,11 @@ package Osint is -- Writes name of program as invoked to the current output (normally -- standard output). - procedure Fail (S1 : String; S2 : String := ""; S3 : String := ""); + procedure Fail (S : String); pragma No_Return (Fail); - -- Outputs error messages S1 & S2 & S3 preceded by the name of the - -- executing program and exits with E_Fatal. The output goes to standard - -- error, except if special output is in effect (see Output). + -- Outputs error message S preceded by the name of the executing program + -- and exits with E_Fatal. The output goes to standard error, except if + -- special output is in effect (see Output). function Is_Directory_Separator (C : Character) return Boolean; -- Returns True if C is a directory separator diff --git a/gcc/ada/prep.adb b/gcc/ada/prep.adb index c1f4a5e780b..810669917f3 100644 --- a/gcc/ada/prep.adb +++ b/gcc/ada/prep.adb @@ -260,7 +260,7 @@ package body Prep is Result := True_Value; elsif Index = Definition'First then - Fail ("invalid symbol definition """, Definition, """"); + Fail ("invalid symbol definition """ & Definition & """"); else -- Put the symbol in the name buffer @@ -280,9 +280,9 @@ package body Prep is null; when others => - Fail ("illegal value """, - Definition (Index + 1 .. Definition'Last), - """"); + Fail ("illegal value """ + & Definition (Index + 1 .. Definition'Last) + & """"); end case; end loop; end if; @@ -301,9 +301,9 @@ package body Prep is if Name_Buffer (1) not in 'a' .. 'z' and then Name_Buffer (1) not in 'A' .. 'Z' then - Fail ("symbol """, - Name_Buffer (1 .. Name_Len), - """ does not start with a letter"); + Fail ("symbol """ + & Name_Buffer (1 .. Name_Len) + & """ does not start with a letter"); end if; for J in 2 .. Name_Len loop @@ -313,20 +313,20 @@ package body Prep is when '_' => if J = Name_Len then - Fail ("symbol """, - Name_Buffer (1 .. Name_Len), - """ end with a '_'"); + Fail ("symbol """ + & Name_Buffer (1 .. Name_Len) + & """ end with a '_'"); elsif Name_Buffer (J + 1) = '_' then - Fail ("symbol """, - Name_Buffer (1 .. Name_Len), - """ contains consecutive '_'"); + Fail ("symbol """ + & Name_Buffer (1 .. Name_Len) + & """ contains consecutive '_'"); end if; when others => - Fail ("symbol """, - Name_Buffer (1 .. Name_Len), - """ contains illegal character(s)"); + Fail ("symbol """ + & Name_Buffer (1 .. Name_Len) + & """ contains illegal character(s)"); end case; end loop; diff --git a/gcc/ada/prepcomp.adb b/gcc/ada/prepcomp.adb index a2b58be7ab1..981da86eac2 100644 --- a/gcc/ada/prepcomp.adb +++ b/gcc/ada/prepcomp.adb @@ -240,9 +240,9 @@ package body Prepcomp is if Source_Index_Of_Preproc_Data_File = No_Source_File then Get_Name_String (N); - Fail ("preprocessing data file """, - Name_Buffer (1 .. Name_Len), - """ not found"); + Fail ("preprocessing data file """ + & Name_Buffer (1 .. Name_Len) + & """ not found"); end if; -- Initialize scanner and set its behavior for processing a data file @@ -561,9 +561,8 @@ package body Prepcomp is if Total_Errors_Detected > T then Errout.Finalize (Last_Call => True); Errout.Output_Messages; - Fail ("errors found in preprocessing data file """, - Get_Name_String (N), - """"); + Fail ("errors found in preprocessing data file """ + & Get_Name_String (N) & """"); end if; -- Record the dependency on the preprocessor data file @@ -656,9 +655,9 @@ package body Prepcomp is begin if Deffile = No_Source_File then - Fail ("definition file """, - Get_Name_String (N), - """ cannot be found"); + Fail ("definition file """ + & Get_Name_String (N) + & """ cannot be found"); end if; -- Initialize the preprocessor and set the characteristics of the @@ -688,9 +687,9 @@ package body Prepcomp is if T /= Total_Errors_Detected then Errout.Finalize (Last_Call => True); Errout.Output_Messages; - Fail ("errors found in definition file """, - Get_Name_String (N), - """"); + Fail ("errors found in definition file """ + & Get_Name_String (N) + & """"); end if; for Index in 1 .. Dependencies.Last loop diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb index 63651f94d9b..250a412e58d 100644 --- a/gcc/ada/prj-attr.adb +++ b/gcc/ada/prj-attr.adb @@ -467,9 +467,9 @@ package body Prj.Attr is for Index in First_Package .. Package_Attributes.Last loop if Package_Name = Package_Attributes.Table (Index).Name then - Osint.Fail ("duplicate name """, - Initialization_Data (Start .. Finish - 1), - """ in predefined packages."); + Osint.Fail ("duplicate name """ + & Initialization_Data (Start .. Finish - 1) + & """ in predefined packages."); end if; end loop; @@ -576,9 +576,9 @@ package body Prj.Attr is for Index in First_Attribute .. Attrs.Last - 1 loop if Attribute_Name = Attrs.Table (Index).Name then - Osint.Fail ("duplicate attribute """, - Initialization_Data (Start .. Finish - 1), - """ in " & Attribute_Location); + Osint.Fail ("duplicate attribute """ + & Initialization_Data (Start .. Finish - 1) + & """ in " & Attribute_Location); end if; end loop; @@ -716,8 +716,9 @@ package body Prj.Attr is end if; if In_Package = Empty_Package then - Fail ("attempt to add attribute """, Name, - """ to an undefined package"); + Fail ("attempt to add attribute """ + & Name + & """ to an undefined package"); raise Project_Error; end if; @@ -731,11 +732,12 @@ package body Prj.Attr is Curr_Attr := First_Attr; while Curr_Attr /= Empty_Attr loop if Attrs.Table (Curr_Attr).Name = Attr_Name then - Fail ("duplicate attribute name """, Name, - """ in package """ & - Get_Name_String - (Package_Attributes.Table (In_Package.Value).Name) & - """"); + Fail ("duplicate attribute name """ + & Name + & """ in package """ + & Get_Name_String + (Package_Attributes.Table (In_Package.Value).Name) + & """"); raise Project_Error; end if; @@ -794,8 +796,9 @@ package body Prj.Attr is for Index in Package_Attributes.First .. Package_Attributes.Last loop if Package_Attributes.Table (Index).Name = Pkg_Name then - Fail ("cannot register a package with a non unique name""", - Name, """"); + Fail ("cannot register a package with a non unique name""" + & Name + & """"); Id := Empty_Package; return; end if; @@ -831,8 +834,9 @@ package body Prj.Attr is for Index in Package_Attributes.First .. Package_Attributes.Last loop if Package_Attributes.Table (Index).Name = Pkg_Name then - Fail ("cannot register a package with a non unique name""", - Name, """"); + Fail ("cannot register a package with a non unique name""" + & Name + & """"); raise Project_Error; end if; end loop; @@ -843,8 +847,11 @@ package body Prj.Attr is Curr_Attr := First_Attr; while Curr_Attr /= Empty_Attr loop if Attrs.Table (Curr_Attr).Name = Attr_Name then - Fail ("duplicate attribute name """, Attributes (Index).Name, - """ in new package """ & Name & """"); + Fail ("duplicate attribute name """ + & Attributes (Index).Name + & """ in new package """ + & Name + & """"); raise Project_Error; end if; diff --git a/gcc/ada/prj-com.ads b/gcc/ada/prj-com.ads index c9142379ca9..f5f2fa689f9 100644 --- a/gcc/ada/prj-com.ads +++ b/gcc/ada/prj-com.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2008, Free Software Foundation, Inc. -- -- -- -- 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- -- @@ -30,10 +30,7 @@ with Osint; package Prj.Com is - type Fail_Proc is access procedure - (S1 : String; - S2 : String := ""; - S3 : String := ""); + type Fail_Proc is access procedure (S : String); Fail : Fail_Proc := Osint.Fail'Access; -- This procedure is used in the project facility, instead of directly diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 1744716342d..e7d5fee6cd4 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -2574,7 +2574,7 @@ package body Prj.Env is begin if Host_Spec = null then Prj.Com.Fail - ("could not convert file name """, Value, """ to host spec"); + ("could not convert file name """ & Value & """ to host spec"); else Setenv (Name, Host_Spec.all); Free (Host_Spec); diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb index 98a55f7379b..1274c4f3bf1 100644 --- a/gcc/ada/prj-makr.adb +++ b/gcc/ada/prj-makr.adb @@ -241,7 +241,7 @@ package body Prj.Makr is if Output_FD = Invalid_FD then Prj.Com.Fail - ("cannot create new """, Path_Name (1 .. Path_Last), """"); + ("cannot create new """ & Path_Name (1 .. Path_Last) & """"); end if; if Project_File then @@ -257,7 +257,7 @@ package body Prj.Makr is Success => Discard); end; - -- And create a new source list file. Fail if file cannot be created. + -- And create a new source list file, fail if file cannot be created Source_List_FD := Create_New_File (Name => Source_List_Path (1 .. Source_List_Last), @@ -265,9 +265,9 @@ package body Prj.Makr is if Source_List_FD = Invalid_FD then Prj.Com.Fail - ("cannot create file """, - Source_List_Path (1 .. Source_List_Last), - """"); + ("cannot create file """ + & Source_List_Path (1 .. Source_List_Last) + & """"); end if; if Opt.Verbose_Mode then @@ -703,9 +703,9 @@ package body Prj.Makr is if Output_FD = Invalid_FD then Prj.Com.Fail - ("cannot create new """, - Project_Naming_File_Name (1 .. Project_Naming_Last), - """"); + ("cannot create new """ + & Project_Naming_File_Name (1 .. Project_Naming_Last) + & """"); end if; -- Output the naming project file @@ -1023,9 +1023,9 @@ package body Prj.Makr is exception when Directory_Error => Prj.Com.Fail - ("unknown directory """, - Path_Name (1 .. Directory_Last), - """"); + ("unknown directory """ + & Path_Name (1 .. Directory_Last) + & """"); end; end if; end Initialize; @@ -1091,7 +1091,7 @@ package body Prj.Makr is Open (Dir, Dir_Name); exception when Directory_Error => - Prj.Com.Fail ("cannot open directory """, Dir_Name, """"); + Prj.Com.Fail ("cannot open directory """ & Dir_Name & """"); end; -- Process each regular file in the directory diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index 5e0b14f0151..ad4c7ea7f3d 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -515,9 +515,10 @@ package body Prj.Part is if Path_Name = "" then Prj.Com.Fail - ("project file """, - Project_File_Name, - """ not found in " & Project_Path); + ("project file """ + & Project_File_Name + & """ not found in " + & Project_Path); Project := Empty_Node; return; end if; diff --git a/gcc/ada/socket.c b/gcc/ada/socket.c index aadc9b084f7..1716a96f6c2 100644 --- a/gcc/ada/socket.c +++ b/gcc/ada/socket.c @@ -57,13 +57,13 @@ extern int __gnat_create_signalling_fds (int *fds); extern int __gnat_read_signalling_fd (int rsig); extern int __gnat_write_signalling_fd (int wsig); extern void __gnat_close_signalling_fd (int sig); -extern void __gnat_free_socket_set (fd_set *); extern void __gnat_last_socket_in_set (fd_set *, int *); extern void __gnat_get_socket_from_set (fd_set *, int *, int *); extern void __gnat_insert_socket_in_set (fd_set *, int); extern int __gnat_is_socket_in_set (fd_set *, int); extern fd_set *__gnat_new_socket_set (fd_set *); extern void __gnat_remove_socket_from_set (fd_set *, int); +extern void __gnat_reset_socket_set (fd_set *set); extern int __gnat_get_h_errno (void); /* Disable the sending of SIGPIPE for writes on a broken stream */ @@ -266,14 +266,6 @@ __gnat_safe_getservbyport (int port, const char *proto, } #endif -/* Free socket set. */ - -void -__gnat_free_socket_set (fd_set *set) -{ - __gnat_free (set); -} - /* Find the largest socket in the socket set SET. This is needed for `select'. LAST is the maximum value for the largest socket. This hint is used to avoid scanning very large socket sets. On return, LAST is the @@ -334,28 +326,6 @@ __gnat_is_socket_in_set (fd_set *set, int socket) return FD_ISSET (socket, set); } -/* Allocate a new socket set and set it as empty. */ - -fd_set * -__gnat_new_socket_set (fd_set *set) -{ - fd_set *new; - -#ifdef VMS -extern void *__gnat_malloc32 (__SIZE_TYPE__); - new = (fd_set *) __gnat_malloc32 (sizeof (fd_set)); -#else - new = (fd_set *) __gnat_malloc (sizeof (fd_set)); -#endif - - if (set) - memcpy (new, set, sizeof (fd_set)); - else - FD_ZERO (new); - - return new; -} - /* Remove SOCKET from the socket set SET. */ void @@ -364,6 +334,13 @@ __gnat_remove_socket_from_set (fd_set *set, int socket) FD_CLR (socket, set); } +/* Reset SET */ +void +__gnat_reset_socket_set (fd_set *set) +{ + FD_ZERO (set); +} + /* Get the value of the last host error */ int diff --git a/gcc/ada/switch-b.adb b/gcc/ada/switch-b.adb index 793d8da495b..82caa29f99e 100644 --- a/gcc/ada/switch-b.adb +++ b/gcc/ada/switch-b.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2008, Free Software Foundation, Inc. -- -- -- -- 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- -- @@ -80,8 +80,7 @@ package body Switch.B is exception when Constraint_Error => - Osint.Fail - ("numeric value out of range for switch: ", (1 => S)); + Osint.Fail ("numeric value out of range for switch: " & S); end; return Result; @@ -104,8 +103,8 @@ package body Switch.B is if Switch_Chars'Last >= Ptr + 3 and then Switch_Chars (Ptr .. Ptr + 3) = "gnat" then - Osint.Fail ("invalid switch: """, Switch_Chars, """" - & " (gnat not needed here)"); + Osint.Fail ("invalid switch: """ & Switch_Chars & """" + & " (gnat not needed here)"); end if; -- Loop to scan through switches given in switch string diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index a7299ab29fa..937a3a86b6f 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -133,8 +133,7 @@ package body Switch.C is elsif RTS_Specified.all /= Switch_Chars (Ptr + 4 .. Max) then - Osint.Fail - ("--RTS cannot be specified multiple times"); + Osint.Fail ("--RTS cannot be specified multiple times"); end if; -- Valid --RTS switch diff --git a/gcc/ada/switch.adb b/gcc/ada/switch.adb index bf32e64ac5a..e185d70df15 100644 --- a/gcc/ada/switch.adb +++ b/gcc/ada/switch.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- -- -- 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- -- @@ -34,12 +34,12 @@ package body Switch is procedure Bad_Switch (Switch : Character) is begin - Osint.Fail ("invalid switch: ", (1 => Switch)); + Osint.Fail ("invalid switch: " & Switch); end Bad_Switch; procedure Bad_Switch (Switch : String) is begin - Osint.Fail ("invalid switch: ", Switch); + Osint.Fail ("invalid switch: " & Switch); end Bad_Switch; ------------------------------ @@ -163,7 +163,7 @@ package body Switch is Result := 0; if Ptr > Max or else Switch_Chars (Ptr) not in '0' .. '9' then - Osint.Fail ("missing numeric value for switch: ", (1 => Switch)); + Osint.Fail ("missing numeric value for switch: " & Switch); else while Ptr <= Max and then Switch_Chars (Ptr) in '0' .. '9' loop @@ -172,8 +172,7 @@ package body Switch is Ptr := Ptr + 1; if Result > Switch_Max_Value then - Osint.Fail - ("numeric value out of range for switch: ", (1 => Switch)); + Osint.Fail ("numeric value out of range for switch: " & Switch); end if; end loop; end if; @@ -196,7 +195,7 @@ package body Switch is Scan_Nat (Switch_Chars, Max, Ptr, Temp, Switch); if Temp = 0 then - Osint.Fail ("numeric value out of range for switch: ", (1 => Switch)); + Osint.Fail ("numeric value out of range for switch: " & Switch); end if; Result := Temp; diff --git a/gcc/ada/tbuild.ads b/gcc/ada/tbuild.ads index 7652a3f8465..efa8960516f 100644 --- a/gcc/ada/tbuild.ads +++ b/gcc/ada/tbuild.ads @@ -256,12 +256,11 @@ package Tbuild is function New_Occurrence_Of (Def_Id : Entity_Id; Loc : Source_Ptr) return Node_Id; - -- New_Occurrence_Of creates an N_Identifier node which is an - -- occurrence of the defining identifier which is passed as its - -- argument. The Entity and Etype of the result are set from - -- the given defining identifier as follows: Entity is simply - -- a copy of Def_Id. Etype is a copy of Def_Id for types, and - -- a copy of the Etype of Def_Id for other entities. + -- New_Occurrence_Of creates an N_Identifier node which is an occurrence + -- of the defining identifier which is passed as its argument. The Entity + -- and Etype of the result are set from the given defining identifier as + -- follows: Entity is simply a copy of Def_Id. Etype is a copy of Def_Id + -- for types, and a copy of the Etype of Def_Id for other entities. function New_Reference_To (Def_Id : Entity_Id; |