diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/a-numeri.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/clean.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/csets.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/debug.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/g-socket.ads | 393 | ||||
| -rw-r--r-- | gcc/ada/gnat1drv.adb | 158 | ||||
| -rw-r--r-- | gcc/ada/gnatfind.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/gnatlink.adb | 28 | ||||
| -rw-r--r-- | gcc/ada/gnatmem.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/gnatname.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/i-cobol.adb | 83 | ||||
| -rw-r--r-- | gcc/ada/sem_eval.ads | 3 | ||||
| -rw-r--r-- | gcc/ada/usage.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/xr_tabls.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/xsinfo.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/xsnames.adb | 4 |
16 files changed, 343 insertions, 400 deletions
diff --git a/gcc/ada/a-numeri.ads b/gcc/ada/a-numeri.ads index e0dfef2..dab5365 100644 --- a/gcc/ada/a-numeri.ads +++ b/gcc/ada/a-numeri.ads @@ -23,9 +23,9 @@ pragma Pure (Numerics); 3.14159_26535_89793_23846_26433_83279_50288_41971_69399_37511; ["03C0"] : constant := Pi; - -- This is the greek letter Pi. Note that it is conforming to have this - -- present even in Ada 95 mode, because there is no way for a normal mode - -- Ada 95 program to reference this identifier in any case. + -- This is the greek letter Pi (for Ada 2005 AI-388). Note that it is + -- conforming to have this present even in Ada 95 mode, because there is + -- no way for a normal mode Ada 95 program to reference this identifier. e : constant := 2.71828_18284_59045_23536_02874_71352_66249_77572_47093_69996; diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 3af3211..c0f6e16 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003-2004, Free Software Foundation, Inc. -- +-- Copyright (C) 2003-2005, 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,9 +80,9 @@ package body Clean is -- files will be done. Do_Nothing : Boolean := False; - -- Set to True when switch -n is specified. - -- When True, no file is deleted. gnatclean only lists the files that - -- would have been deleted if the switch -n had not been specified. + -- Set to True when switch -n is specified. When True, no file is deleted. + -- gnatclean only lists the files that would have been deleted if the + -- switch -n had not been specified. File_Deleted : Boolean := False; -- Set to True if at least one file has been deleted @@ -151,7 +151,7 @@ package body Clean is -- Extracts the first element from the Q Q_Front : Natural; - -- Points to the first valid element in the Q. + -- Points to the first valid element in the Q package Q is new Table.Table ( Table_Component_Type => File_Name_Type, @@ -1041,7 +1041,7 @@ package body Clean is if not Copyright_Displayed then Copyright_Displayed := True; Put_Line ("GNATCLEAN " & Gnatvsn.Gnat_Version_String - & " Copyright 2003-2004 Free Software Foundation, Inc."); + & " Copyright 2003-2005 Free Software Foundation, Inc."); end if; end Display_Copyright; diff --git a/gcc/ada/csets.adb b/gcc/ada/csets.adb index 319989b..4fc2288 100644 --- a/gcc/ada/csets.adb +++ b/gcc/ada/csets.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2002, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005, 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- -- @@ -1159,8 +1159,7 @@ package body Csets is Identifier_Char ('[') := True; -- Add entry for ESC if wide characters in use with a wide character - -- encoding method active that uses the ESC code for encoding. Also - -- add entry for left bracket to capture use of brackets notation. + -- encoding method active that uses the ESC code for encoding. if Identifier_Character_Set = 'w' and then Wide_Character_Encoding_Method in WC_ESC_Encoding_Method diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 90036e2..a0cc0fb 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -120,8 +120,6 @@ package body Debug is -- d.y -- d.z - - -- d1 Error msgs have node numbers where possible -- d2 Eliminate error flags in verbose form error messages -- d3 Dump bad node in Comperr on an abort diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads index f56b4cc..c613d20 100644 --- a/gcc/ada/g-socket.ads +++ b/gcc/ada/g-socket.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2004 Ada Core Technologies, Inc. -- +-- Copyright (C) 2001-2005 Ada Core Technologies, 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- -- @@ -31,26 +31,23 @@ -- -- ------------------------------------------------------------------------------ --- This package provides an interface to the sockets communication --- facility provided on many operating systems. This is implemented --- on the following platforms: +-- This package provides an interface to the sockets communication facility +-- provided on many operating systems. This is implemented on the following +-- platforms: --- All native ports, except Interix, with restrictions as follows +-- All native ports, with restrictions as follows --- Multicast is available only on systems which provide support --- for this feature, so it is not available if Multicast is not --- supported, or not installed. In particular Multicast is not --- available with the Windows version. +-- Multicast is available only on systems which provide support for this +-- feature, so it is not available if Multicast is not supported, or not +-- installed. In particular Multicast is not available with the Windows +-- version. --- The VMS implementation has implemented using the DECC RTL Socket --- API, and is thus subject to limitations in the implementation of --- this API. +-- The VMS implementation has implemented using the DECC RTL Socket API, +-- and is thus subject to limitations in the implementation of this API. --- This package is not supported on the Interix port of GNAT. +-- VxWorks cross ports fully implement this package --- VxWorks cross ports fully implement this package. - --- This package is not yet implemented on LynxOS. +-- This package is not yet implemented on LynxOS or other cross ports with Ada.Exceptions; with Ada.Streams; @@ -64,24 +61,22 @@ package GNAT.Sockets is -- between applications. This package provides an Ada-like interface -- similar to that proposed as part of the BSD socket layer. - -- GNAT.Sockets has been designed with several ideas in mind. + -- GNAT.Sockets has been designed with several ideas in mind - -- This is a system independent interface. Therefore, we try as - -- much as possible to mask system incompatibilities. Some - -- functionalities are not available because there are not fully - -- supported on some systems. + -- This is a system independent interface. Therefore, we try as much as + -- possible to mask system incompatibilities. Some functionalities are not + -- available because there are not fully supported on some systems. - -- This is a thick binding. For instance, a major effort has been - -- done to avoid using memory addresses or untyped ints. We - -- preferred to define streams and enumeration types. Errors are - -- not returned as returned values but as exceptions. + -- This is a thick binding. For instance, a major effort has been done to + -- avoid using memory addresses or untyped ints. We preferred to define + -- streams and enumeration types. Errors are not returned as returned + -- values but as exceptions. -- This package provides a POSIX-compliant interface (between two - -- different implementations of the same routine, we adopt the one - -- closest to the POSIX specification). For instance, using - -- select(), the notification of an asynchronous connect failure - -- is delivered in the write socket set (POSIX) instead of the - -- exception socket set (NT). + -- different implementations of the same routine, we adopt the one closest + -- to the POSIX specification). For instance, using select(), the + -- notification of an asynchronous connect failure is delivered in the + -- write socket set (POSIX) instead of the exception socket set (NT). -- Here is a typical example of what you can do: @@ -120,11 +115,10 @@ package GNAT.Sockets is -- Address.Port := 5876; -- -- The first step is to create a socket. Once created, this - -- -- socket must be associated to with an address. Usually only - -- -- a server (Pong here) needs to bind an address explicitly. - -- -- Most of the time clients can skip this step because the - -- -- socket routines will bind an arbitrary address to an unbound - -- -- socket. + -- -- socket must be associated to with an address. Usually only a + -- -- server (Pong here) needs to bind an address explicitly. Most + -- -- of the time clients can skip this step because the socket + -- -- routines will bind an arbitrary address to an unbound socket. -- Create_Socket (Server); @@ -289,7 +283,7 @@ package GNAT.Sockets is -- Channel := Stream (Socket); - -- -- Send message to server Pong. + -- -- Send message to server Pong -- String'Output (Channel, "Hello world"); @@ -373,28 +367,26 @@ package GNAT.Sockets is -- end PingPong; procedure Initialize (Process_Blocking_IO : Boolean := False); - -- Initialize must be called before using any other socket routines. - -- The Process_Blocking_IO parameter indicates whether the thread - -- library provides process-blocking or thread-blocking input/output - -- operations. In the former case (typically with FSU threads) - -- GNAT.Sockets should be initialized with a value of True to - -- provide task-blocking IO through an emulation mechanism. - -- Only the first call to Initialize is taken into account (further - -- calls will be ignored). Note that with the default value - -- of Process_Blocking_IO, this operation is a no-op on UNIX - -- platforms, but applications should make sure to call it - -- if portability is expected: some platforms (such as Windows) - -- require initialization before any other socket operations. + -- Initialize must be called before using any other socket routines. The + -- Process_Blocking_IO parameter indicates whether the thread library + -- provides process-blocking or thread-blocking input/output operations. + -- In the former case (typically with FSU threads) GNAT.Sockets should be + -- initialized with a value of True to provide task-blocking IO through an + -- emulation mechanism. Only the first call to Initialize is taken into + -- account (further calls will be ignored). Note that with the default + -- value of Process_Blocking_IO, this operation is a no-op on UNIX + -- platforms, but applications should make sure to call it if portability + -- is expected: some platforms (such as Windows) require initialization + -- before any other socket operations. procedure Finalize; -- After Finalize is called it is not possible to use any routines -- exported in by this package. This procedure is idempotent. type Socket_Type is private; - -- Sockets are used to implement a reliable bi-directional - -- point-to-point, stream-based connections between - -- hosts. No_Socket provides a special value to denote - -- uninitialized sockets. + -- Sockets are used to implement a reliable bi-directional point-to-point, + -- stream-based connections between hosts. No_Socket provides a special + -- value to denote uninitialized sockets. No_Socket : constant Socket_Type; @@ -436,11 +428,10 @@ package GNAT.Sockets is No_Port : constant Port_Type; type Inet_Addr_Type (Family : Family_Type := Family_Inet) is private; - -- An Internet address depends on an address family (IPv4 contains - -- 4 octets and Ipv6 contains 16 octets). Any_Inet_Addr is a special - -- value treated like a wildcard enabling all addresses. - -- No_Inet_Addr provides a special value to denote uninitialized - -- inet addresses. + -- An Internet address depends on an address family (IPv4 contains 4 + -- octets and Ipv6 contains 16 octets). Any_Inet_Addr is a special value + -- treated like a wildcard enabling all addresses. No_Inet_Addr provides a + -- special value to denote uninitialized inet addresses. Any_Inet_Addr : constant Inet_Addr_Type; No_Inet_Addr : constant Inet_Addr_Type; @@ -449,28 +440,28 @@ package GNAT.Sockets is Addr : Inet_Addr_Type (Family); Port : Port_Type; end record; - -- Socket addresses fully define a socket connection with a - -- protocol family, an Internet address and a port. No_Sock_Addr - -- provides a special value for uninitialized socket addresses. + -- Socket addresses fully define a socket connection with protocol family, + -- an Internet address and a port. No_Sock_Addr provides a special value + -- for uninitialized socket addresses. No_Sock_Addr : constant Sock_Addr_Type; function Image (Value : Inet_Addr_Type) return String; - -- Return an image of an Internet address. IPv4 notation consists - -- in 4 octets in decimal format separated by dots. IPv6 notation - -- consists in 16 octets in hexadecimal format separated by - -- colons (and possibly dots). + -- Return an image of an Internet address. IPv4 notation consists in 4 + -- octets in decimal format separated by dots. IPv6 notation consists in + -- 16 octets in hexadecimal format separated by colons (and possibly + -- dots). function Image (Value : Sock_Addr_Type) return String; - -- Return inet address image and port image separated by a colon. + -- Return inet address image and port image separated by a colon function Inet_Addr (Image : String) return Inet_Addr_Type; -- Convert address image from numbers-and-dots notation into an -- inet address. - -- Host entries provide complete information on a given host: - -- the official name, an array of alternative names or aliases and - -- array of network addresses. + -- Host entries provide complete information on a given host: the official + -- name, an array of alternative names or aliases and array of network + -- addresses. type Host_Entry_Type (Aliases_Length, Addresses_Length : Natural) is private; @@ -487,39 +478,38 @@ package GNAT.Sockets is function Aliases (E : Host_Entry_Type; N : Positive := 1) return String; - -- Return N'th aliases in host entry. The first index is 1. + -- Return N'th aliases in host entry. The first index is 1 function Addresses (E : Host_Entry_Type; N : Positive := 1) return Inet_Addr_Type; - -- Return N'th addresses in host entry. The first index is 1. + -- Return N'th addresses in host entry. The first index is 1 Host_Error : exception; - -- Exception raised by the two following procedures. Once raised, - -- its message contains a string describing the error code. This - -- exception is raised when an host entry can not be retrieved. + -- Exception raised by the two following procedures. Once raised, its + -- message contains a string describing the error code. This exception is + -- raised when an host entry can not be retrieved. function Get_Host_By_Address (Address : Inet_Addr_Type; Family : Family_Type := Family_Inet) return Host_Entry_Type; - -- Return host entry structure for the given Inet address. - -- Note that no result will be returned if there is no mapping of this - -- IP address to a host name in the system tables (host database, - -- DNS or otherwise). + -- Return host entry structure for the given Inet address. Note that no + -- result will be returned if there is no mapping of this IP address to a + -- host name in the system tables (host database, DNS or otherwise). function Get_Host_By_Name (Name : String) return Host_Entry_Type; - -- Return host entry structure for the given host name. Here name - -- is either a host name, or an IP address. If Name is an IP address, - -- this is equivalent to Get_Host_By_Address (Inet_Addr (Name)). + -- Return host entry structure for the given host name. Here name is + -- either a host name, or an IP address. If Name is an IP address, this is + -- equivalent to Get_Host_By_Address (Inet_Addr (Name)). function Host_Name return String; -- Return the name of the current host type Service_Entry_Type (Aliases_Length : Natural) is private; - -- Service entries provide complete information on a given - -- service: the official name, an array of alternative names or - -- aliases and the port number. + -- Service entries provide complete information on a given service: the + -- official name, an array of alternative names or aliases and the port + -- number. function Official_Name (S : Service_Entry_Type) return String; -- Return official name in service entry @@ -536,7 +526,7 @@ package GNAT.Sockets is function Aliases (S : Service_Entry_Type; N : Positive := 1) return String; - -- Return N'th aliases in service entry. The first index is 1. + -- Return N'th aliases in service entry (the first index is 1) function Get_Service_By_Name (Name : String; @@ -552,9 +542,9 @@ package GNAT.Sockets is -- Comment required ??? -- Errors are described by an enumeration type. There is only one - -- exception Socket_Error in this package to deal with an error - -- during a socket routine. Once raised, its message contains the - -- error code between brackets and a string describing the error code. + -- exception Socket_Error in this package to deal with an error during a + -- socket routine. Once raised, its message contains the error code + -- between brackets and a string describing the error code. -- The name of the enumeration constant documents the error condition @@ -604,10 +594,9 @@ package GNAT.Sockets is Unknown_Server_Error, Cannot_Resolve_Error); - -- Get_Socket_Options and Set_Socket_Options manipulate options - -- associated with a socket. Options may exist at multiple - -- protocol levels in the communication stack. Socket_Level is the - -- uppermost socket level. + -- Get_Socket_Options and Set_Socket_Options manipulate options associated + -- with a socket. Options may exist at multiple protocol levels in the + -- communication stack. Socket_Level is the uppermost socket level. type Level_Type is ( Socket_Level, @@ -615,9 +604,9 @@ package GNAT.Sockets is IP_Protocol_For_UDP_Level, IP_Protocol_For_TCP_Level); - -- There are several options available to manipulate sockets. Each - -- option has a name and several values available. Most of the - -- time, the value is a boolean to enable or disable this option. + -- There are several options available to manipulate sockets. Each option + -- has a name and several values available. Most of the time, the value is + -- a boolean to enable or disable this option. type Option_Name is ( Keep_Alive, -- Enable sending of keep-alive messages @@ -668,10 +657,10 @@ package GNAT.Sockets is end case; end record; - -- There are several controls available to manipulate - -- sockets. Each option has a name and several values available. - -- These controls differ from the socket options in that they are - -- not specific to sockets but are available for any device. + -- There are several controls available to manipulate sockets. Each option + -- has a name and several values available. These controls differ from the + -- socket options in that they are not specific to sockets but are + -- available for any device. type Request_Name is ( Non_Blocking_IO, -- Cause a caller not to wait on blocking operations. @@ -688,35 +677,36 @@ package GNAT.Sockets is end case; end record; - -- A request flag allows to specify the type of message - -- transmissions or receptions. A request flag can be a - -- combination of zero or more predefined request flags. + -- A request flag allows to specify the type of message transmissions or + -- receptions. A request flag can be combination of zero or more + -- predefined request flags. type Request_Flag_Type is private; No_Request_Flag : constant Request_Flag_Type; - -- This flag corresponds to the normal execution of an operation. + -- This flag corresponds to the normal execution of an operation Process_Out_Of_Band_Data : constant Request_Flag_Type; - -- This flag requests that the receive or send function operates - -- on out-of-band data when the socket supports this notion (e.g. + -- This flag requests that the receive or send function operates on + -- out-of-band data when the socket supports this notion (e.g. -- Socket_Stream). Peek_At_Incoming_Data : constant Request_Flag_Type; -- This flag causes the receive operation to return data from the - -- beginning of the receive queue without removing that data from - -- the queue. A subsequent receive call will return the same data. + -- beginning of the receive queue without removing that data from the + -- queue. A subsequent receive call will return the same data. Wait_For_A_Full_Reception : constant Request_Flag_Type; - -- This flag requests that the operation block until the full - -- request is satisfied. However, the call may still return less - -- data than requested if a signal is caught, an error or - -- disconnect occurs, or the next data to be received is of a dif- - -- ferent type than that returned. + -- This flag requests that the operation block until the full request is + -- satisfied. However, the call may still return less data than requested + -- if a signal is caught, an error or disconnect occurs, or the next data + -- to be received is of a different type than that returned. Note that + -- this flag depends on support in the underlying sockets implementation, + -- and is not supported under Windows. Send_End_Of_Record : constant Request_Flag_Type; - -- This flag indicates that the entire message has been sent and - -- so this terminates the record. + -- This flag indicates that the entire message has been sent and so this + -- terminates the record. function "+" (L, R : Request_Flag_Type) return Request_Flag_Type; -- Combine flag L with flag R @@ -734,17 +724,17 @@ package GNAT.Sockets is (Socket : out Socket_Type; Family : Family_Type := Family_Inet; Mode : Mode_Type := Socket_Stream); - -- Create an endpoint for communication. Raises Socket_Error on error. + -- Create an endpoint for communication. Raises Socket_Error on error procedure Accept_Socket (Server : Socket_Type; Socket : out Socket_Type; Address : out Sock_Addr_Type); - -- Extract the first connection request on the queue of pending - -- connections, creates a new connected socket with mostly the - -- same properties as Server, and allocates a new socket. The - -- returned Address is filled in with the address of the - -- connection. Raises Socket_Error on error. + -- Extracts the first connection request on the queue of pending + -- connections, creates a new connected socket with mostly the same + -- properties as Server, and allocates a new socket. The returned Address + -- is filled in with the address of the connection. Raises Socket_Error on + -- error. procedure Bind_Socket (Socket : Socket_Type; @@ -753,7 +743,7 @@ package GNAT.Sockets is -- Socket_Error on error. procedure Close_Socket (Socket : Socket_Type); - -- Close a socket and more specifically a non-connected socket. + -- Close a socket and more specifically a non-connected socket procedure Connect_Socket (Socket : Socket_Type; @@ -764,9 +754,9 @@ package GNAT.Sockets is procedure Control_Socket (Socket : Socket_Type; Request : in out Request_Type); - -- Obtain or set parameter values that control the socket. This - -- control differs from the socket options in that they are not - -- specific to sockets but are available for any device. + -- Obtain or set parameter values that control the socket. This control + -- differs from the socket options in that they are not specific to + -- sockets but are available for any device. function Get_Peer_Name (Socket : Socket_Type) return Sock_Addr_Type; -- Return the peer or remote socket address of a socket. Raise @@ -774,8 +764,8 @@ package GNAT.Sockets is function Get_Socket_Name (Socket : Socket_Type) return Sock_Addr_Type; -- Return the local or current socket address of a socket. Return - -- No_Sock_Addr on error (for instance, socket closed or not - -- locally bound). + -- No_Sock_Addr on error (for instance, socket closed or not locally + -- bound). function Get_Socket_Option (Socket : Socket_Type; @@ -787,21 +777,20 @@ package GNAT.Sockets is procedure Listen_Socket (Socket : Socket_Type; Length : Positive := 15); - -- To accept connections, a socket is first created with - -- Create_Socket, a willingness to accept incoming connections and - -- a queue Length for incoming connections are specified. Raise - -- Socket_Error on error. + -- To accept connections, a socket is first created with Create_Socket, + -- a willingness to accept incoming connections and a queue Length for + -- incoming connections are specified. Raise Socket_Error on error. procedure Receive_Socket (Socket : Socket_Type; Item : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset; Flags : Request_Flag_Type := No_Request_Flag); - -- Receive message from Socket. Last is the index value such that - -- Item (Last) is the last character assigned. Note that Last is - -- set to Item'First - 1 when the socket has been closed by - -- peer. This is not an error and no exception is raised. Flags - -- allows to control the reception. Raise Socket_Error on error. + -- Receive message from Socket. Last is the index value such that Item + -- (Last) is the last character assigned. Note that Last is set to + -- Item'First - 1 when the socket has been closed by peer. This is not an + -- error and no exception is raised. Flags allows to control the + -- reception. Raise Socket_Error on error. procedure Receive_Socket (Socket : Socket_Type; @@ -809,11 +798,10 @@ package GNAT.Sockets is Last : out Ada.Streams.Stream_Element_Offset; From : out Sock_Addr_Type; Flags : Request_Flag_Type := No_Request_Flag); - -- Receive message from Socket. If Socket is not - -- connection-oriented, the source address From of the message is - -- filled in. Last is the index value such that Item (Last) is the - -- last character assigned. Flags allows to control the - -- reception. Raises Socket_Error on error. + -- Receive message from Socket. If Socket is not connection-oriented, the + -- source address From of the message is filled in. Last is the index + -- value such that Item (Last) is the last character assigned. Flags + -- allows to control the reception. Raises Socket_Error on error. procedure Receive_Vector (Socket : Socket_Type; @@ -824,11 +812,10 @@ package GNAT.Sockets is function Resolve_Exception (Occurrence : Ada.Exceptions.Exception_Occurrence) return Error_Type; - -- When Socket_Error or Host_Error are raised, the exception - -- message contains the error code between brackets and a string - -- describing the error code. Resolve_Error extracts the error - -- code from an exception message and translate it into an - -- enumeration value. + -- When Socket_Error or Host_Error are raised, the exception message + -- contains the error code between brackets and a string describing the + -- error code. Resolve_Error extracts the error code from an exception + -- message and translate it into an enumeration value. procedure Send_Socket (Socket : Socket_Type; @@ -837,9 +824,8 @@ package GNAT.Sockets is Flags : Request_Flag_Type := No_Request_Flag); -- Transmit a message to another socket. Note that Last is set to -- Item'First-1 when socket has been closed by peer. This is not - -- considered an error and no exception is raised. Flags allows to - -- control the transmission. Raises Socket_Error on any other - -- error condition. + -- considered an error and no exception is raised. Flags allows to control + -- the transmission. Raises Socket_Error on any other error condition. procedure Send_Socket (Socket : Socket_Type; @@ -847,9 +833,8 @@ package GNAT.Sockets is Last : out Ada.Streams.Stream_Element_Offset; To : Sock_Addr_Type; Flags : Request_Flag_Type := No_Request_Flag); - -- Transmit a message to another socket. The address is given by - -- To. Flags allows to control the transmission. Raises - -- Socket_Error on error. + -- Transmit a message to another socket. The address is given by To. Flags + -- allows to control the transmission. Raises Socket_Error on error. procedure Send_Vector (Socket : Socket_Type; @@ -862,15 +847,15 @@ package GNAT.Sockets is (Socket : Socket_Type; Level : Level_Type := Socket_Level; Option : Option_Type); - -- Manipulate socket options. Raises Socket_Error on error. + -- Manipulate socket options. Raises Socket_Error on error procedure Shutdown_Socket (Socket : Socket_Type; How : Shutmode_Type := Shut_Read_Write); - -- Shutdown a connected socket. If How is Shut_Read, further - -- receives will be disallowed. If How is Shut_Write, further - -- sends will be disallowed. If how is Shut_Read_Write, further - -- sends and receives will be disallowed. + -- Shutdown a connected socket. If How is Shut_Read, further receives will + -- be disallowed. If How is Shut_Write, further sends will be disallowed. + -- If how is Shut_Read_Write, further sends and receives will be + -- disallowed. type Stream_Access is access all Ada.Streams.Root_Stream_Type'Class; -- Same interface as Ada.Streams.Stream_IO @@ -883,26 +868,24 @@ package GNAT.Sockets is function Stream (Socket : Socket_Type; Send_To : Sock_Addr_Type) return Stream_Access; - -- Create a stream associated with a datagram-based socket that is - -- already bound. Send_To is the socket address to which messages are - -- being sent. + -- Create a stream associated with a datagram-based socket that is already + -- bound. Send_To is the socket address to which messages are being sent. function Get_Address (Stream : Stream_Access) return Sock_Addr_Type; - -- Return the socket address from which the last message was received. + -- Return the socket address from which the last message was received procedure Free is new Ada.Unchecked_Deallocation (Ada.Streams.Root_Stream_Type'Class, Stream_Access); -- Destroy a stream created by one of the Stream functions above, - -- releasing the corresponding resources. The user is responsible - -- for calling this subprogram when the stream is not needed anymore. + -- releasing the corresponding resources. The user is responsible for + -- calling this subprogram when the stream is not needed anymore. 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. + -- 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. procedure Clear (Item : in out Socket_Set_Type; Socket : Socket_Type); -- Remove Socket from Item @@ -929,33 +912,31 @@ package GNAT.Sockets is procedure Set (Item : in out Socket_Set_Type; Socket : Socket_Type); -- Insert Socket into Item - -- C select() waits for a number of file descriptors to change - -- status. Usually, three independent sets of descriptors are - -- watched (read, write and exception). A timeout gives an upper - -- bound on the amount of time elapsed before select returns. - -- This function blocks until an event occurs. On some platforms, - -- C select can block the full process. + -- C select() waits for a number of file descriptors to change status. + -- Usually, three independent sets of descriptors are watched (read, write + -- and exception). A timeout gives an upper bound on the amount of time + -- elapsed before select returns. This function blocks until an event + -- occurs. On some platforms, C select can block the full process. -- - -- Check_Selector provides the very same behaviour. The only - -- difference is that it does not watch for exception events. Note - -- that on some platforms it is kept process blocking in purpose. - -- The timeout parameter allows the user to have the behaviour he - -- wants. Abort_Selector allows to abort safely a Check_Selector - -- that is blocked forever. A special file descriptor is opened by - -- Create_Selector and included in each call to - -- Check_Selector. Abort_Selector causes an event to occur on this - -- descriptor in order to unblock Check_Selector. The user must - -- call Close_Selector to discard this special file. A reason to - -- abort a select operation is typically to add a socket in one of - -- the socket sets when the timeout is set to forever. + -- Check_Selector provides the very same behaviour. The only difference is + -- that it does not watch for exception events. Note that on some + -- platforms it is kept process blocking in purpose. The timeout parameter + -- allows the user to have the behaviour he wants. Abort_Selector allows + -- to abort safely a Check_Selector that is blocked forever. A special + -- file descriptor is opened by Create_Selector and included in each call + -- to Check_Selector. Abort_Selector causes an event to occur on this + -- descriptor in order to unblock Check_Selector. The user must call + -- Close_Selector to discard this special file. A reason to abort a select + -- operation is typically to add a socket in one of the socket sets when + -- the timeout is set to forever. type Selector_Type is limited private; type Selector_Access is access all Selector_Type; - -- Selector_Duration is a subtype of Standard.Duration because the - -- full range of Standard.Duration cannot be represented in the - -- equivalent C structure. Moreover, negative values are not - -- allowed to avoid system incompatibilities. + -- Selector_Duration is a subtype of Standard.Duration because the full + -- range of Standard.Duration cannot be represented in the equivalent C + -- structure. Moreover, negative values are not allowed to avoid system + -- incompatibilities. Immediate : constant := 0.0; Forever : constant := Duration (Integer'Last) * 1.0; @@ -976,18 +957,17 @@ package GNAT.Sockets is W_Socket_Set : in out Socket_Set_Type; Status : out Selector_Status; Timeout : Selector_Duration := Forever); - -- Return when one Socket in R_Socket_Set has some data to be read - -- or if one Socket in W_Socket_Set is ready to receive some - -- data. In these cases Status is set to Completed and sockets - -- that are ready are set in R_Socket_Set or W_Socket_Set. Status - -- is set to Expired if no socket was ready after a Timeout - -- expiration. Status is set to Aborted if an abort signal has been - -- received while checking socket status. As this procedure - -- returns when Timeout occurs, it is a design choice to keep this - -- procedure process blocking. Note that a Timeout of 0.0 returns - -- immediately. Also note that two different objects must be passed - -- as R_Socket_Set and W_Socket_Set (even if they contain the same - -- set of Sockets), or some event will be lost. + -- Return when one Socket in R_Socket_Set has some data to be read or if + -- one Socket in W_Socket_Set is ready to receive some data. In these + -- cases Status is set to Completed and sockets that are ready are set in + -- R_Socket_Set or W_Socket_Set. Status is set to Expired if no socket was + -- ready after a Timeout expiration. Status is set to Aborted if an abort + -- signal has been received while checking socket status. As this + -- procedure returns when Timeout occurs, it is a design choice to keep + -- this procedure process blocking. Note that a Timeout of 0.0 returns + -- immediately. Also note that two different objects must be passed as + -- R_Socket_Set and W_Socket_Set (even if they contain the same set of + -- Sockets), or some event will be lost. procedure Check_Selector (Selector : in out Selector_Type; @@ -996,13 +976,13 @@ package GNAT.Sockets is E_Socket_Set : in out Socket_Set_Type; Status : out Selector_Status; Timeout : Selector_Duration := Forever); - -- This refined version of Check_Selector allows to watch for - -- exception events (that is notifications of out-of-band - -- transmission and reception). As above, all of R_Socket_Set, - -- W_Socket_Set and E_Socket_Set must be different objects. + -- This refined version of Check_Selector allows to watch for exception + -- events (that is notifications of out-of-band transmission and + -- reception). As above, all of R_Socket_Set, W_Socket_Set and + -- E_Socket_Set must be different objects. procedure Abort_Selector (Selector : Selector_Type); - -- Send an abort signal to the selector. + -- Send an abort signal to the selector private @@ -1016,8 +996,7 @@ private pragma Volatile (Selector_Type); - -- The two signalling sockets are used to abort a select - -- operation. + -- The two signalling sockets are used to abort a select operation subtype Socket_Set_Access is System.Address; No_Socket_Set : constant Socket_Set_Access := System.Null_Address; diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 0a31d559..d7bd378 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -179,7 +179,7 @@ begin Write_Str ("GNAT "); Write_Str (Gnat_Version_String); Write_Eol; - Write_Str ("Copyright 1992-2004 Free Software Foundation, Inc."); + Write_Str ("Copyright 1992-2005 Free Software Foundation, Inc."); Write_Eol; end if; @@ -247,9 +247,9 @@ begin Suppress_Options (Overflow_Check) := True; end if; - -- Check we have exactly one source file, this happens only in - -- the case where the driver is called directly, it cannot happen - -- when gnat1 is invoked from gcc in the normal case. + -- Check we have exactly one source file, this happens only in the case + -- where the driver is called directly, it cannot happen when gnat1 is + -- invoked from gcc in the normal case. if Osint.Number_Of_Files /= 1 then Usage; @@ -280,27 +280,33 @@ begin or else Nkind (Original_Node (Unit (Main_Unit_Node))) in N_Generic_Instantiation) then - declare + Bad_Body : declare Sname : Unit_Name_Type := Unit_Name (Main_Unit); Src_Ind : Source_File_Index; Fname : File_Name_Type; - procedure Bad_Body (Msg : String); + procedure Bad_Body_Error (Msg : String); -- Issue message for bad body found - procedure Bad_Body (Msg : String) is + -------------------- + -- Bad_Body_Error -- + -------------------- + + procedure Bad_Body_Error (Msg : String) is begin Error_Msg_N (Msg, Main_Unit_Node); Error_Msg_Name_1 := Fname; Error_Msg_N ("remove incorrect body in file{!", Main_Unit_Node); - end Bad_Body; + end Bad_Body_Error; + + -- Start of processing for Bad_Body begin Sname := Unit_Name (Main_Unit); - -- If we do not already have a body name, then get the body - -- name (but how can we have a body name here ???) + -- If we do not already have a body name, then get the body name + -- (but how can we have a body name here ???) if not Is_Body_Name (Sname) then Sname := Get_Body_Name (Sname); @@ -311,18 +317,18 @@ begin -- Case where body is present and it is not a subunit. Exclude -- the subunit case, because it has nothing to do with the - -- package we are compiling. It is illegal for a child unit - -- and a subunit with the same expanded name (RM 10.2(9)) to - -- appear together in a partition, but there is nothing to - -- stop a compilation environment from having both, and the - -- test here simply allows that. If there is an attempt to - -- include both in a partition, this is diagnosed at bind time. - -- In Ada 83 mode this is not a warning case. - - -- Note: if weird file names are being used, we can have a - -- situation where the file name that supposedly contains a - -- body, in fact contains a spec, or we can't tell what it - -- contains. Skip the error message in these cases. + -- package we are compiling. It is illegal for a child unit and a + -- subunit with the same expanded name (RM 10.2(9)) to appear + -- together in a partition, but there is nothing to stop a + -- compilation environment from having both, and the test here + -- simply allows that. If there is an attempt to include both in + -- a partition, this is diagnosed at bind time. In Ada 83 mode + -- this is not a warning case. + + -- Note: if weird file names are being used, we can have + -- situation where the file name that supposedly contains body, + -- in fact contains a spec, or we can't tell what it contains. + -- Skip the error message in these cases. if Src_Ind /= No_Source_File and then Get_Expected_Unit_Type (Fname) = Expect_Body @@ -330,12 +336,12 @@ begin then Error_Msg_Name_1 := Sname; - -- Ada 83 case of a package body being ignored. This is not - -- an error as far as the Ada 83 RM is concerned, but it is + -- Ada 83 case of a package body being ignored. This is not an + -- error as far as the Ada 83 RM is concerned, but it is -- almost certainly not what is wanted so output a warning. -- Give this message only if there were no errors, since - -- otherwise it may be incorrect (we may have misinterpreted - -- a junk spec as not needing a body when it really does). + -- otherwise it may be incorrect (we may have misinterpreted a + -- junk spec as not needing a body when it really does). if Main_Kind = N_Package_Declaration and then Ada_Version = Ada_83 @@ -358,33 +364,35 @@ begin if Nkind (Original_Node (Unit (Main_Unit_Node))) in N_Generic_Instantiation then - Bad_Body + Bad_Body_Error ("generic instantiation for % does not allow a body"); -- A library unit that is a renaming never allows a body elsif Main_Kind in N_Renaming_Declaration then - Bad_Body + Bad_Body_Error ("renaming declaration for % does not allow a body!"); - -- Remaining cases are packages and generic packages. - -- Here we only do the test if there are no previous - -- errors, because if there are errors, they may lead - -- us to incorrectly believe that a package does not - -- allow a body when in fact it does. + -- Remaining cases are packages and generic packages. Here + -- we only do the test if there are no previous errors, + -- because if there are errors, they may lead us to + -- incorrectly believe that a package does not allow a body + -- when in fact it does. elsif not Compilation_Errors then if Main_Kind = N_Package_Declaration then - Bad_Body ("package % does not allow a body!"); + Bad_Body_Error + ("package % does not allow a body!"); elsif Main_Kind = N_Generic_Package_Declaration then - Bad_Body ("generic package % does not allow a body!"); + Bad_Body_Error + ("generic package % does not allow a body!"); end if; end if; end if; end if; - end; + end Bad_Body; end if; -- Exit if compilation errors detected @@ -405,9 +413,9 @@ begin Exit_Program (E_Errors); end if; - -- Set Generate_Code on main unit and its spec. We do this even if - -- are not generating code, since Lib-Writ uses this to determine - -- which units get written in the ali file. + -- Set Generate_Code on main unit and its spec. We do this even if are + -- not generating code, since Lib-Writ uses this to determine which + -- units get written in the ali file. Set_Generate_Code (Main_Unit); @@ -437,15 +445,15 @@ begin -- be generated (i.e. no -gnatc or -gnats switch was used). Check if -- we can in fact satisfy this request. - -- Cannot generate code if someone has turned off code generation - -- for any reason at all. We will try to figure out a reason below. + -- Cannot generate code if someone has turned off code generation for + -- any reason at all. We will try to figure out a reason below. elsif Operating_Mode /= Generate_Code then Back_End_Mode := Skip; - -- We can generate code for a subprogram body unless there were - -- missing subunits. Note that we always generate code for all - -- generic units (a change from some previous versions of GNAT). + -- We can generate code for a subprogram body unless there were missing + -- subunits. Note that we always generate code for all generic units (a + -- change from some previous versions of GNAT). elsif Main_Kind = N_Subprogram_Body and then not Subunits_Missing @@ -507,17 +515,17 @@ begin Back_End_Mode := Skip; end if; - -- At this stage Call_Back_End is set to indicate if the backend - -- should be called to generate code. If it is not set, then code - -- generation has been turned off, even though code was requested - -- by the original command. This is not an error from the user - -- point of view, but it is an error from the point of view of - -- the gcc driver, so we must exit with an error status. + -- At this stage Call_Back_End is set to indicate if the backend should + -- be called to generate code. If it is not set, then code generation + -- has been turned off, even though code was requested by the original + -- command. This is not an error from the user point of view, but it is + -- an error from the point of view of the gcc driver, so we must exit + -- with an error status. - -- We generate an informative message (from the gcc point of view, - -- it is an error message, but from the users point of view this - -- is not an error, just a consequence of compiling something that - -- cannot generate code). + -- We generate an informative message (from the gcc point of view, it + -- is an error message, but from the users point of view this is not an + -- error, just a consequence of compiling something that cannot + -- generate code). if Back_End_Mode = Skip then Write_Str ("cannot generate code for "); @@ -603,9 +611,9 @@ begin return; end if; - -- Ensure that we properly register a dependency on system.ads, - -- since even if we do not semantically depend on this, Targparm - -- has read system parameters from the system.ads file. + -- Ensure that we properly register a dependency on system.ads, since + -- even if we do not semantically depend on this, Targparm has read + -- system parameters from the system.ads file. Lib.Writ.Ensure_System_Dependency; @@ -631,22 +639,22 @@ begin Back_End.Call_Back_End (Back_End_Mode); - -- Once the backend is complete, we unlock the names table. This - -- call allows a few extra entries, needed for example for the file - -- name for the library file output. + -- Once the backend is complete, we unlock the names table. This call + -- allows a few extra entries, needed for example for the file name for + -- the library file output. Namet.Unlock; - -- Validate unchecked conversions (using the values for size - -- and alignment annotated by the backend where possible). + -- Validate unchecked conversions (using the values for size and + -- alignment annotated by the backend where possible). Sem_Ch13.Validate_Unchecked_Conversions; - -- Now we complete output of errors, rep info and the tree info. - -- These are delayed till now, since it is perfectly possible for - -- gigi to generate errors, modify the tree (in particular by setting - -- flags indicating that elaboration is required, and also to back - -- annotate representation information for List_Rep_Info. + -- Now we complete output of errors, rep info and the tree info. These + -- are delayed till now, since it is perfectly possible for gigi to + -- generate errors, modify the tree (in particular by setting flags + -- indicating that elaboration is required, and also to back annotate + -- representation information for List_Rep_Info. Errout.Finalize; List_Rep_Info; @@ -662,11 +670,11 @@ begin Write_ALI (Object => (Back_End_Mode = Generate_Object)); - -- Generate the ASIS tree after writing the ALI file, since in - -- ASIS mode, Write_ALI may in fact result in further tree - -- decoration from the original tree file. Note that we dump - -- the tree just before generating it, so that the dump will - -- exactly reflect what is written out. + -- Generate the ASIS tree after writing the ALI file, since in ASIS + -- mode, Write_ALI may in fact result in further tree decoration from + -- the original tree file. Note that we dump the tree just before + -- generating it, so that the dump will exactly reflect what is written + -- out. Treepr.Tree_Dump; Tree_Gen; @@ -689,8 +697,8 @@ begin when Storage_Error => - -- Assume this is a bug. If it is real, the message will in - -- any case say Storage_Error, giving a strong hint! + -- Assume this is a bug. If it is real, the message will in any case + -- say Storage_Error, giving a strong hint! Comperr.Compiler_Abort ("Storage_Error"); end; diff --git a/gcc/ada/gnatfind.adb b/gcc/ada/gnatfind.adb index 980f31f..bd8a22a 100644 --- a/gcc/ada/gnatfind.adb +++ b/gcc/ada/gnatfind.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2005 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- -- @@ -87,10 +87,8 @@ procedure Gnatfind is when 'a' => if GNAT.Command_Line.Full_Switch = "a" then Read_Only := True; - elsif GNAT.Command_Line.Full_Switch = "aI" then Osint.Add_Src_Search_Dir (GNAT.Command_Line.Parameter); - else Osint.Add_Lib_Search_Dir (GNAT.Command_Line.Parameter); end if; @@ -117,7 +115,6 @@ procedure Gnatfind is when 'n' => if GNAT.Command_Line.Full_Switch = "nostdinc" then Opt.No_Stdinc := True; - elsif GNAT.Command_Line.Full_Switch = "nostlib" then Opt.No_Stdlib := True; end if; @@ -125,7 +122,6 @@ procedure Gnatfind is when 'p' => declare S : constant String := GNAT.Command_Line.Parameter; - begin Prj_File_Length := S'Length; Prj_File (1 .. Prj_File_Length) := S; @@ -241,7 +237,7 @@ procedure Gnatfind is procedure Write_Usage is begin Put_Line ("GNATFIND " & Gnatvsn.Gnat_Version_String); - Put_Line ("Copyright 1998-2004, Ada Core Technologies Inc."); + Put_Line ("Copyright 1998-2005, Ada Core Technologies Inc."); Put_Line ("Usage: gnatfind pattern[:sourcefile[:line[:column]]] " & "[file1 file2 ...]"); New_Line; diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index 19728a8..5a4a57f 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2005 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- -- @@ -172,28 +172,28 @@ procedure Gnatlink is -- Set to True to force generation of a response file function Base_Name (File_Name : in String) return String; - -- Return just the file name part without the extension (if present). + -- Return just the file name part without the extension (if present) procedure Delete (Name : in String); - -- Wrapper to unlink as status is ignored by this application. + -- Wrapper to unlink as status is ignored by this application procedure Error_Msg (Message : in String); -- Output the error or warning Message procedure Exit_With_Error (Error : in String); - -- Output Error and exit program with a fatal condition. + -- Output Error and exit program with a fatal condition procedure Process_Args; - -- Go through all the arguments and build option tables. + -- Go through all the arguments and build option tables procedure Process_Binder_File (Name : in String); - -- Reads the binder file and extracts linker arguments. + -- Reads the binder file and extracts linker arguments procedure Write_Header; - -- Show user the program name, version and copyright. + -- Show user the program name, version and copyright procedure Write_Usage; - -- Show user the program options. + -- Show user the program options --------------- -- Base_Name -- @@ -514,7 +514,7 @@ procedure Gnatlink is new String'(Arg); end if; - -- Pass to gcc for linking program. + -- Pass to gcc for linking program Gcc_Linker_Options.Increment_Last; Gcc_Linker_Options.Table @@ -639,10 +639,10 @@ procedure Gnatlink is -- For call to Close GNAT_Static : Boolean := False; - -- Save state of -static option. + -- Save state of -static option GNAT_Shared : Boolean := False; - -- Save state of -shared option. + -- Save state of -shared option Xlinker_Was_Previous : Boolean := False; -- Indicate that "-Xlinker" was the option preceding the current @@ -704,7 +704,7 @@ procedure Gnatlink is -- terminator. function Index (S, Pattern : String) return Natural; - -- Return the last occurrence of Pattern in S, or 0 if none. + -- Return the last occurrence of Pattern in S, or 0 if none function Is_Option_Present (Opt : in String) return Boolean; -- Return true if the option Opt is already present in @@ -1279,7 +1279,7 @@ procedure Gnatlink is Write_Str ("GNATLINK "); Write_Str (Gnat_Version_String); Write_Eol; - Write_Str ("Copyright 1995-2004 Free Software Foundation, Inc"); + Write_Str ("Copyright 1995-2005 Free Software Foundation, Inc"); Write_Eol; end if; end Write_Header; @@ -1663,7 +1663,7 @@ begin end Bind_Step; end if; - -- Now, actually link the program. + -- Now, actually link the program -- Skip this step for now on the JVM since the Java interpreter will do -- the actual link at run time. We might consider packing all class files diff --git a/gcc/ada/gnatmem.adb b/gcc/ada/gnatmem.adb index f2a1377..1957594 100644 --- a/gcc/ada/gnatmem.adb +++ b/gcc/ada/gnatmem.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1997-2004, Ada Core Technologies, Inc. -- +-- Copyright (C) 1997-2005, Ada Core Technologies, 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- -- @@ -37,9 +37,9 @@ -- The running my_prog will produce a file named gmem.out that will be -- parsed by gnatmem. --- - Record a reference to the allocated memory on each allocation call. +-- - Record a reference to the allocated memory on each allocation call --- - Suppress this reference on deallocation. +-- - Suppress this reference on deallocation -- - At the end of the program, remaining references are potential leaks. -- sort them out the best possible way in order to locate the root of @@ -89,7 +89,7 @@ procedure Gnatmem is -- These need comments, and should be on separate lines ??? function Read_Next return Storage_Elmt; - -- Reads next dynamic storage operation from the log file. + -- Reads next dynamic storage operation from the log file function Mem_Image (X : Storage_Count) return String; -- X is a size in storage_element. Returns a value @@ -233,7 +233,7 @@ procedure Gnatmem is New_Line; Put ("GNATMEM "); Put_Line (Gnat_Version_String); - Put_Line ("Copyright 1997-2004 Free Software Foundation, Inc."); + Put_Line ("Copyright 1997-2005 Free Software Foundation, Inc."); New_Line; Put_Line ("Usage: gnatmem switches [depth] exename"); diff --git a/gcc/ada/gnatname.adb b/gcc/ada/gnatname.adb index bdce127..dfb2a29 100644 --- a/gcc/ada/gnatname.adb +++ b/gcc/ada/gnatname.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005 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- -- @@ -172,7 +172,7 @@ procedure Gnatname is Output.Write_Str ("GNATNAME "); Output.Write_Line (Gnatvsn.Gnat_Version_String); Output.Write_Line - ("Copyright 2001-2004 Free Software Foundation, Inc."); + ("Copyright 2001-2005 Free Software Foundation, Inc."); end if; end Output_Version; @@ -231,7 +231,6 @@ procedure Gnatname is when 'v' => if Opt.Verbose_Mode then Very_Verbose := True; - else Opt.Verbose_Mode := True; end if; diff --git a/gcc/ada/i-cobol.adb b/gcc/ada/i-cobol.adb index 38de23d..025e6b2 100644 --- a/gcc/ada/i-cobol.adb +++ b/gcc/ada/i-cobol.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2002 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -107,8 +107,7 @@ package body Interfaces.COBOL is function To_Display (Item : Integer_64; Format : Display_Format; - Length : Natural) - return Numeric; + Length : Natural) return Numeric; -- This function converts the given integer value into display format, -- using the given format, with the length in bytes of the result given -- by the last parameter. This is the non-generic implementation of @@ -118,8 +117,7 @@ package body Interfaces.COBOL is function To_Packed (Item : Integer_64; Format : Packed_Format; - Length : Natural) - return Packed_Decimal; + Length : Natural) return Packed_Decimal; -- This function converts the given integer value into packed format, -- using the given format, with the length in digits of the result given -- by the last parameter. This is the non-generic implementation of @@ -128,15 +126,13 @@ package body Interfaces.COBOL is function Valid_Numeric (Item : Numeric; - Format : Display_Format) - return Boolean; + Format : Display_Format) return Boolean; -- This is the non-generic implementation of Decimal_Conversions.Valid -- for the display case. function Valid_Packed (Item : Packed_Decimal; - Format : Packed_Format) - return Boolean; + Format : Packed_Format) return Boolean; -- This is the non-generic implementation of Decimal_Conversions.Valid -- for the packed case. @@ -146,8 +142,7 @@ package body Interfaces.COBOL is function Binary_To_Decimal (Item : Byte_Array; - Format : Binary_Format) - return Integer_64 + Format : Binary_Format) return Integer_64 is Len : constant Natural := Item'Length; @@ -229,8 +224,7 @@ package body Interfaces.COBOL is function Numeric_To_Decimal (Item : Numeric; - Format : Display_Format) - return Integer_64 + Format : Display_Format) return Integer_64 is pragma Unsuppress (Range_Check); Sign : COBOL_Character := COBOL_Plus; @@ -288,8 +282,7 @@ package body Interfaces.COBOL is function Packed_To_Decimal (Item : Packed_Decimal; - Format : Packed_Format) - return Integer_64 + Format : Packed_Format) return Integer_64 is pragma Unsuppress (Range_Check); Result : Integer_64 := 0; @@ -449,8 +442,7 @@ package body Interfaces.COBOL is function To_Display (Item : Integer_64; Format : Display_Format; - Length : Natural) - return Numeric + Length : Natural) return Numeric is Result : Numeric (1 .. Length); Val : Integer_64 := Item; @@ -560,8 +552,7 @@ package body Interfaces.COBOL is function To_Packed (Item : Integer_64; Format : Packed_Format; - Length : Natural) - return Packed_Decimal + Length : Natural) return Packed_Decimal is Result : Packed_Decimal (1 .. Length); Val : Integer_64; @@ -628,8 +619,7 @@ package body Interfaces.COBOL is function Valid_Numeric (Item : Numeric; - Format : Display_Format) - return Boolean + Format : Display_Format) return Boolean is begin if Item'Length = 0 then @@ -681,8 +671,7 @@ package body Interfaces.COBOL is function Valid_Packed (Item : Packed_Decimal; - Format : Packed_Format) - return Boolean + Format : Packed_Format) return Boolean is begin case Packed_Representation is @@ -720,17 +709,13 @@ package body Interfaces.COBOL is function Length (Format : Binary_Format) return Natural is pragma Warnings (Off, Format); - begin if Num'Digits <= 2 then return 1; - elsif Num'Digits <= 4 then return 2; - elsif Num'Digits <= 9 then return 4; - else -- Num'Digits in 10 .. 18 return 8; end if; @@ -756,8 +741,7 @@ package body Interfaces.COBOL is -- Note that the tests here are all compile time checks function Length - (Format : Packed_Format) - return Natural + (Format : Packed_Format) return Natural is pragma Warnings (Off, Format); @@ -774,8 +758,7 @@ package body Interfaces.COBOL is function To_Binary (Item : Num; - Format : Binary_Format) - return Byte_Array + Format : Binary_Format) return Byte_Array is begin -- Note: all these tests are compile time tests @@ -824,7 +807,6 @@ package body Interfaces.COBOL is pragma Unsuppress (Range_Check); begin return Binary'Integer_Value (Item); - exception when Constraint_Error => raise Conversion_Error; @@ -836,14 +818,11 @@ package body Interfaces.COBOL is function To_Decimal (Item : Byte_Array; - Format : Binary_Format) - return Num + Format : Binary_Format) return Num is pragma Unsuppress (Range_Check); - begin return Num'Fixed_Value (Binary_To_Decimal (Item, Format)); - exception when Constraint_Error => raise Conversion_Error; @@ -855,10 +834,8 @@ package body Interfaces.COBOL is function To_Decimal (Item : Binary) return Num is pragma Unsuppress (Range_Check); - begin return Num'Fixed_Value (Item); - exception when Constraint_Error => raise Conversion_Error; @@ -889,10 +866,8 @@ package body Interfaces.COBOL is function To_Decimal (Item : Long_Binary) return Num is pragma Unsuppress (Range_Check); - begin return Num'Fixed_Value (Item); - exception when Constraint_Error => raise Conversion_Error; @@ -904,14 +879,11 @@ package body Interfaces.COBOL is function To_Decimal (Item : Packed_Decimal; - Format : Packed_Format) - return Num + Format : Packed_Format) return Num is pragma Unsuppress (Range_Check); - begin return Num'Fixed_Value (Packed_To_Decimal (Item, Format)); - exception when Constraint_Error => raise Conversion_Error; @@ -923,18 +895,15 @@ package body Interfaces.COBOL is function To_Display (Item : Num; - Format : Display_Format) - return Numeric + Format : Display_Format) return Numeric is pragma Unsuppress (Range_Check); - begin return To_Display (Integer_64'Integer_Value (Item), Format, Length (Format)); - exception when Constraint_Error => raise Conversion_Error; @@ -946,10 +915,8 @@ package body Interfaces.COBOL is function To_Long_Binary (Item : Num) return Long_Binary is pragma Unsuppress (Range_Check); - begin return Long_Binary'Integer_Value (Item); - exception when Constraint_Error => raise Conversion_Error; @@ -961,18 +928,15 @@ package body Interfaces.COBOL is function To_Packed (Item : Num; - Format : Packed_Format) - return Packed_Decimal + Format : Packed_Format) return Packed_Decimal is pragma Unsuppress (Range_Check); - begin return To_Packed (Integer_64'Integer_Value (Item), Format, Length (Format)); - exception when Constraint_Error => raise Conversion_Error; @@ -984,16 +948,13 @@ package body Interfaces.COBOL is function Valid (Item : Byte_Array; - Format : Binary_Format) - return Boolean + Format : Binary_Format) return Boolean is Val : Num; pragma Unreferenced (Val); - begin Val := To_Decimal (Item, Format); return True; - exception when Conversion_Error => return False; @@ -1005,8 +966,7 @@ package body Interfaces.COBOL is function Valid (Item : Numeric; - Format : Display_Format) - return Boolean + Format : Display_Format) return Boolean is begin return Valid_Numeric (Item, Format); @@ -1018,8 +978,7 @@ package body Interfaces.COBOL is function Valid (Item : Packed_Decimal; - Format : Packed_Format) - return Boolean + Format : Packed_Format) return Boolean is begin return Valid_Packed (Item, Format); diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads index 0945a4d..c7b9e90 100644 --- a/gcc/ada/sem_eval.ads +++ b/gcc/ada/sem_eval.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -411,7 +411,6 @@ private pragma Inline (Eval_Character_Literal); pragma Inline (Eval_Conditional_Expression); pragma Inline (Eval_Indexed_Component); - pragma Inline (Eval_Integer_Literal); pragma Inline (Eval_Named_Integer); pragma Inline (Eval_Named_Real); pragma Inline (Eval_Real_Literal); diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index 44d8df7..4441490 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005, 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- -- @@ -422,8 +422,7 @@ begin -- Lines for -gnaty switch Write_Switch_Char ("y"); - Write_Line ("Enable all style checks except 'o', indent=3"); - + Write_Line ("Enable default style checks (same as -gnaty3abcefhiklmnprst)"); Write_Switch_Char ("yxx"); Write_Line ("Enable selected style checks xx = list of parameters:"); Write_Line (" 1-9 check indentation"); @@ -467,4 +466,9 @@ begin Write_Switch_Char ("83"); Write_Line ("Enforce Ada 83 restrictions"); + -- Line for -gnat05 switch + + Write_Switch_Char ("05"); + Write_Line ("Allow Ada 2005 extensions"); + end Usage; diff --git a/gcc/ada/xr_tabls.ads b/gcc/ada/xr_tabls.ads index 2b19944..effdd8a 100644 --- a/gcc/ada/xr_tabls.ads +++ b/gcc/ada/xr_tabls.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1998-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2005 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- -- @@ -24,6 +24,8 @@ -- -- ------------------------------------------------------------------------------ +-- We need comment here saying what this package is??? + with GNAT.OS_Lib; package Xr_Tabls is diff --git a/gcc/ada/xsinfo.adb b/gcc/ada/xsinfo.adb index 011a275..c6ade51 100644 --- a/gcc/ada/xsinfo.adb +++ b/gcc/ada/xsinfo.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2002 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -24,7 +24,7 @@ -- -- ------------------------------------------------------------------------------ --- Program to construct C header file a-sinfo.h (C version of sinfo.ads spec, +-- Program to construct C header file sinfo.h (C version of sinfo.ads spec, -- for use by Gigi, contains all definitions and access functions, but does -- not contain set procedures, since Gigi never modifies the GNAT tree) @@ -34,14 +34,14 @@ -- Output files: --- a-sinfo.h Corresponding c header file +-- sinfo.h Corresponding c header file -- Note: this program assumes that sinfo.ads has passed the error checks -- which are carried out by the CSinfo utility, so it does not duplicate -- these checks and assumes the soruce is correct. -- An optional argument allows the specification of an output file name to --- override the default a-sinfo.h file name for the generated output file. +-- override the default sinfo.h file name for the generated output file. with Ada.Command_Line; use Ada.Command_Line; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; @@ -118,7 +118,7 @@ begin if Argument_Count > 0 then Create (Ofile, Out_File, Argument (1)); else - Create (Ofile, Out_File, "a-sinfo.h"); + Create (Ofile, Out_File, "sinfo.h"); end if; Open (InS, In_File, "sinfo.ads"); diff --git a/gcc/ada/xsnames.adb b/gcc/ada/xsnames.adb index 60368ed..d93cfbd 100644 --- a/gcc/ada/xsnames.adb +++ b/gcc/ada/xsnames.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2002 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005 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- -- @@ -138,7 +138,7 @@ begin loop Line := Get_Line (InB); - exit when Match (Line, " ""#"";"); + exit when Match (Line, " ""#"";"); end loop; Put_Line (OutB, Line); |