-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 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- --
end if;
Address := Sec_Stack.Mem (Sec_Stack.Top)'Address;
- Sec_Stack.Top := Sec_Stack.Top + Mark_Id (Max_Size);
+ Sec_Stack.Top := Sec_Stack.Top + Max_Size;
end SS_Allocate;
-------------
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2003 Ada Core Technologies, Inc. --
+-- Copyright (C) 2001-2004 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- --
Thread_Blocking_IO : Boolean := True;
+ Unknown_System_Error : constant C.Strings.chars_ptr :=
+ C.Strings.New_String ("Unknown system error");
+
function Syscall_Accept
(S : C.int;
Addr : System.Address;
- Addrlen : access C.int)
- return C.int;
+ Addrlen : access C.int) return C.int;
pragma Import (C, Syscall_Accept, "accept");
function Syscall_Connect
(S : C.int;
Name : System.Address;
- Namelen : C.int)
- return C.int;
+ Namelen : C.int) return C.int;
pragma Import (C, Syscall_Connect, "connect");
function Syscall_Ioctl
(S : C.int;
Req : C.int;
- Arg : Int_Access)
- return C.int;
+ Arg : Int_Access) return C.int;
pragma Import (C, Syscall_Ioctl, "ioctl");
function Syscall_Recv
(S : C.int;
Msg : System.Address;
Len : C.int;
- Flags : C.int)
- return C.int;
+ Flags : C.int) return C.int;
pragma Import (C, Syscall_Recv, "recv");
function Syscall_Recvfrom
Len : C.int;
Flags : C.int;
From : Sockaddr_In_Access;
- Fromlen : access C.int)
- return C.int;
+ Fromlen : access C.int) return C.int;
pragma Import (C, Syscall_Recvfrom, "recvfrom");
function Syscall_Send
pragma Import (C, Syscall_Sendto, "sendto");
function Syscall_Socket
- (Domain, Typ, Protocol : C.int)
- return C.int;
+ (Domain, Typ, Protocol : C.int) return C.int;
pragma Import (C, Syscall_Socket, "socket");
function Non_Blocking_Socket (S : C.int) return Boolean;
function C_Accept
(S : C.int;
Addr : System.Address;
- Addrlen : access C.int)
- return C.int
+ Addrlen : access C.int) return C.int
is
R : C.int;
Val : aliased C.int := 1;
function C_Connect
(S : C.int;
Name : System.Address;
- Namelen : C.int)
- return C.int
+ Namelen : C.int) return C.int
is
Res : C.int;
-------------
function C_Ioctl
- (S : C.int;
- Req : C.int;
- Arg : Int_Access)
- return C.int
+ (S : C.int;
+ Req : C.int;
+ Arg : Int_Access) return C.int
is
begin
if not Thread_Blocking_IO
(S : C.int;
Msg : System.Address;
Len : C.int;
- Flags : C.int)
- return C.int
+ Flags : C.int) return C.int
is
Res : C.int;
Len : C.int;
Flags : C.int;
From : Sockaddr_In_Access;
- Fromlen : access C.int)
- return C.int
+ Fromlen : access C.int) return C.int
is
Res : C.int;
(S : C.int;
Msg : System.Address;
Len : C.int;
- Flags : C.int)
- return C.int
+ Flags : C.int) return C.int
is
Res : C.int;
Len : C.int;
Flags : C.int;
To : Sockaddr_In_Access;
- Tolen : C.int)
- return C.int
+ Tolen : C.int) return C.int
is
Res : C.int;
function C_Socket
(Domain : C.int;
Typ : C.int;
- Protocol : C.int)
- return C.int
+ Protocol : C.int) return C.int
is
R : C.int;
Val : aliased C.int := 1;
function Non_Blocking_Socket (S : C.int) return Boolean is
R : Boolean;
-
begin
Task_Lock.Lock;
R := Is_Socket_In_Set (Non_Blocking_Sockets, S);
-- Set_Address --
-----------------
- procedure Set_Address
- (Sin : Sockaddr_In_Access;
- Address : In_Addr)
- is
+ procedure Set_Address (Sin : Sockaddr_In_Access; Address : In_Addr) is
begin
Sin.Sin_Addr := Address;
end Set_Address;
-- Set_Family --
----------------
- procedure Set_Family
- (Sin : Sockaddr_In_Access;
- Family : C.int)
- is
+ procedure Set_Family (Sin : Sockaddr_In_Access; Family : C.int) is
begin
Sin.Sin_Family := C.unsigned_short (Family);
end Set_Family;
-- Set_Length --
----------------
- procedure Set_Length
- (Sin : Sockaddr_In_Access;
- Len : C.int)
- is
+ procedure Set_Length (Sin : Sockaddr_In_Access; Len : C.int) is
pragma Unreferenced (Sin);
pragma Unreferenced (Len);
-
begin
null;
end Set_Length;
-- Set_Port --
--------------
- procedure Set_Port
- (Sin : Sockaddr_In_Access;
- Port : C.unsigned_short)
- is
+ procedure Set_Port (Sin : Sockaddr_In_Access; Port : C.unsigned_short) is
begin
Sin.Sin_Port := Port;
end Set_Port;
-- Socket_Error_Message --
--------------------------
- function Socket_Error_Message (Errno : Integer) return String is
+ function Socket_Error_Message
+ (Errno : Integer) return C.Strings.chars_ptr
+ is
use type Interfaces.C.Strings.chars_ptr;
C_Msg : C.Strings.chars_ptr;
C_Msg := C_Strerror (C.int (Errno));
if C_Msg = C.Strings.Null_Ptr then
- return "Unknown system error";
-
+ return Unknown_System_Error;
else
- return C.Strings.Value (C_Msg);
+ return C_Msg;
end if;
end Socket_Error_Message;
function C_Readv
(Fd : C.int;
Iov : System.Address;
- Iovcnt : C.int)
- return C.int
+ Iovcnt : C.int) return C.int
is
Res : C.int;
Count : C.int := 0;
function C_Writev
(Fd : C.int;
Iov : System.Address;
- Iovcnt : C.int)
- return C.int
+ Iovcnt : C.int) return C.int
is
Res : C.int;
Count : C.int := 0;
-- --
-- S p e c --
-- --
--- Copyright (C) 2002-2003 Ada Core Technologies, Inc. --
+-- Copyright (C) 2002-2004 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- --
function Socket_Errno return Integer renames GNAT.OS_Lib.Errno;
-- Returns last socket error number.
- function Socket_Error_Message (Errno : Integer) return String;
+ function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr;
-- Returns the error message string for the error number Errno. If
-- Errno is not known it returns "Unknown system error".
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2003 Ada Core Technologies, Inc. --
+-- Copyright (C) 2001-2004 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- --
-- This version is for NT.
with GNAT.Sockets.Constants; use GNAT.Sockets.Constants;
+with Interfaces.C.Strings; use Interfaces.C.Strings;
with System; use System;
return C.int;
pragma Import (Stdcall, Standard_Select, "select");
+ type Error_Type is
+ (N_EINTR,
+ N_EBADF,
+ N_EACCES,
+ N_EFAULT,
+ N_EINVAL,
+ N_EMFILE,
+ N_EWOULDBLOCK,
+ N_EINPROGRESS,
+ N_EALREADY,
+ N_ENOTSOCK,
+ N_EDESTADDRREQ,
+ N_EMSGSIZE,
+ N_EPROTOTYPE,
+ N_ENOPROTOOPT,
+ N_EPROTONOSUPPORT,
+ N_ESOCKTNOSUPPORT,
+ N_EOPNOTSUPP,
+ N_EPFNOSUPPORT,
+ N_EAFNOSUPPORT,
+ N_EADDRINUSE,
+ N_EADDRNOTAVAIL,
+ N_ENETDOWN,
+ N_ENETUNREACH,
+ N_ENETRESET,
+ N_ECONNABORTED,
+ N_ECONNRESET,
+ N_ENOBUFS,
+ N_EISCONN,
+ N_ENOTCONN,
+ N_ESHUTDOWN,
+ N_ETOOMANYREFS,
+ N_ETIMEDOUT,
+ N_ECONNREFUSED,
+ N_ELOOP,
+ N_ENAMETOOLONG,
+ N_EHOSTDOWN,
+ N_EHOSTUNREACH,
+ N_SYSNOTREADY,
+ N_VERNOTSUPPORTED,
+ N_NOTINITIALISED,
+ N_EDISCON,
+ N_HOST_NOT_FOUND,
+ N_TRY_AGAIN,
+ N_NO_RECOVERY,
+ N_NO_DATA,
+ N_OTHERS);
+
+ Error_Messages : constant array (Error_Type) of chars_ptr :=
+ (N_EINTR =>
+ New_String ("Interrupted system call"),
+ N_EBADF =>
+ New_String ("Bad file number"),
+ N_EACCES =>
+ New_String ("Permission denied"),
+ N_EFAULT =>
+ New_String ("Bad address"),
+ N_EINVAL =>
+ New_String ("Invalid argument"),
+ N_EMFILE =>
+ New_String ("Too many open files"),
+ N_EWOULDBLOCK =>
+ New_String ("Operation would block"),
+ N_EINPROGRESS =>
+ New_String ("Operation now in progress. This error is "
+ & "returned if any Windows Sockets API "
+ & "function is called while a blocking "
+ & "function is in progress"),
+ N_EALREADY =>
+ New_String ("Operation already in progress"),
+ N_ENOTSOCK =>
+ New_String ("Socket operation on nonsocket"),
+ N_EDESTADDRREQ =>
+ New_String ("Destination address required"),
+ N_EMSGSIZE =>
+ New_String ("Message too long"),
+ N_EPROTOTYPE =>
+ New_String ("Protocol wrong type for socket"),
+ N_ENOPROTOOPT =>
+ New_String ("Protocol not available"),
+ N_EPROTONOSUPPORT =>
+ New_String ("Protocol not supported"),
+ N_ESOCKTNOSUPPORT =>
+ New_String ("Socket type not supported"),
+ N_EOPNOTSUPP =>
+ New_String ("Operation not supported on socket"),
+ N_EPFNOSUPPORT =>
+ New_String ("Protocol family not supported"),
+ N_EAFNOSUPPORT =>
+ New_String ("Address family not supported by protocol family"),
+ N_EADDRINUSE =>
+ New_String ("Address already in use"),
+ N_EADDRNOTAVAIL =>
+ New_String ("Cannot assign requested address"),
+ N_ENETDOWN =>
+ New_String ("Network is down. This error may be "
+ & "reported at any time if the Windows "
+ & "Sockets implementation detects an "
+ & "underlying failure"),
+ N_ENETUNREACH =>
+ New_String ("Network is unreachable"),
+ N_ENETRESET =>
+ New_String ("Network dropped connection on reset"),
+ N_ECONNABORTED =>
+ New_String ("Software caused connection abort"),
+ N_ECONNRESET =>
+ New_String ("Connection reset by peer"),
+ N_ENOBUFS =>
+ New_String ("No buffer space available"),
+ N_EISCONN =>
+ New_String ("Socket is already connected"),
+ N_ENOTCONN =>
+ New_String ("Socket is not connected"),
+ N_ESHUTDOWN =>
+ New_String ("Cannot send after socket shutdown"),
+ N_ETOOMANYREFS =>
+ New_String ("Too many references: cannot splice"),
+ N_ETIMEDOUT =>
+ New_String ("Connection timed out"),
+ N_ECONNREFUSED =>
+ New_String ("Connection refused"),
+ N_ELOOP =>
+ New_String ("Too many levels of symbolic links"),
+ N_ENAMETOOLONG =>
+ New_String ("File name too long"),
+ N_EHOSTDOWN =>
+ New_String ("Host is down"),
+ N_EHOSTUNREACH =>
+ New_String ("No route to host"),
+ N_SYSNOTREADY =>
+ New_String ("Returned by WSAStartup(), indicating that "
+ & "the network subsystem is unusable"),
+ N_VERNOTSUPPORTED =>
+ New_String ("Returned by WSAStartup(), indicating that "
+ & "the Windows Sockets DLL cannot support "
+ & "this application"),
+ N_NOTINITIALISED =>
+ New_String ("Winsock not initialized. This message is "
+ & "returned by any function except WSAStartup(), "
+ & "indicating that a successful WSAStartup() has "
+ & "not yet been performed"),
+ N_EDISCON =>
+ New_String ("Disconnect"),
+ N_HOST_NOT_FOUND =>
+ New_String ("Host not found. This message indicates "
+ & "that the key (name, address, and so on) was not found"),
+ N_TRY_AGAIN =>
+ New_String ("Nonauthoritative host not found. This error may "
+ & "suggest that the name service itself is not "
+ & "functioning"),
+ N_NO_RECOVERY =>
+ New_String ("Nonrecoverable error. This error may suggest that the "
+ & "name service itself is not functioning"),
+ N_NO_DATA =>
+ New_String ("Valid name, no data record of requested type. "
+ & "This error indicates that the key (name, address, "
+ & "and so on) was not found."),
+ N_OTHERS =>
+ New_String ("Unknown system error"));
+
---------------
-- C_Connect --
---------------
-- Socket_Error_Message --
--------------------------
- function Socket_Error_Message (Errno : Integer) return String is
+ function Socket_Error_Message
+ (Errno : Integer)
+ return C.Strings.chars_ptr
+ is
use GNAT.Sockets.Constants;
begin
case Errno is
- when EINTR =>
- return "Interrupted system call";
-
- when EBADF =>
- return "Bad file number";
-
- when EACCES =>
- return "Permission denied";
-
- when EFAULT =>
- return "Bad address";
-
- when EINVAL =>
- return "Invalid argument";
-
- when EMFILE =>
- return "Too many open files";
-
- when EWOULDBLOCK =>
- return "Operation would block";
-
- when EINPROGRESS =>
- return "Operation now in progress. This error is "
- & "returned if any Windows Sockets API "
- & "function is called while a blocking "
- & "function is in progress";
-
- when EALREADY =>
- return "Operation already in progress";
-
- when ENOTSOCK =>
- return "Socket operation on nonsocket";
-
- when EDESTADDRREQ =>
- return "Destination address required";
-
- when EMSGSIZE =>
- return "Message too long";
-
- when EPROTOTYPE =>
- return "Protocol wrong type for socket";
-
- when ENOPROTOOPT =>
- return "Protocol not available";
-
- when EPROTONOSUPPORT =>
- return "Protocol not supported";
-
- when ESOCKTNOSUPPORT =>
- return "Socket type not supported";
-
- when EOPNOTSUPP =>
- return "Operation not supported on socket";
-
- when EPFNOSUPPORT =>
- return "Protocol family not supported";
-
- when EAFNOSUPPORT =>
- return "Address family not supported by protocol family";
-
- when EADDRINUSE =>
- return "Address already in use";
-
- when EADDRNOTAVAIL =>
- return "Cannot assign requested address";
-
- when ENETDOWN =>
- return "Network is down. This error may be "
- & "reported at any time if the Windows "
- & "Sockets implementation detects an "
- & "underlying failure";
-
- when ENETUNREACH =>
- return "Network is unreachable";
-
- when ENETRESET =>
- return "Network dropped connection on reset";
-
- when ECONNABORTED =>
- return "Software caused connection abort";
-
- when ECONNRESET =>
- return "Connection reset by peer";
-
- when ENOBUFS =>
- return "No buffer space available";
-
- when EISCONN =>
- return "Socket is already connected";
-
- when ENOTCONN =>
- return "Socket is not connected";
-
- when ESHUTDOWN =>
- return "Cannot send after socket shutdown";
-
- when ETOOMANYREFS =>
- return "Too many references: cannot splice";
-
- when ETIMEDOUT =>
- return "Connection timed out";
-
- when ECONNREFUSED =>
- return "Connection refused";
-
- when ELOOP =>
- return "Too many levels of symbolic links";
-
- when ENAMETOOLONG =>
- return "File name too long";
-
- when EHOSTDOWN =>
- return "Host is down";
-
- when EHOSTUNREACH =>
- return "No route to host";
-
- when SYSNOTREADY =>
- return "Returned by WSAStartup(), indicating that "
- & "the network subsystem is unusable";
-
- when VERNOTSUPPORTED =>
- return "Returned by WSAStartup(), indicating that "
- & "the Windows Sockets DLL cannot support this application";
-
- when NOTINITIALISED =>
- return "Winsock not initialized. This message is "
- & "returned by any function except WSAStartup(), "
- & "indicating that a successful WSAStartup() has "
- & "not yet been performed";
-
- when EDISCON =>
- return "Disconnect";
-
- when HOST_NOT_FOUND =>
- return "Host not found. This message indicates "
- & "that the key (name, address, and so on) was not found";
-
- when TRY_AGAIN =>
- return "Nonauthoritative host not found. This error may "
- & "suggest that the name service itself is not functioning";
-
- when NO_RECOVERY =>
- return "Nonrecoverable error. This error may suggest that the "
- & "name service itself is not functioning";
-
- when NO_DATA =>
- return "Valid name, no data record of requested type. "
- & "This error indicates that the key (name, address, "
- & "and so on) was not found.";
-
- when others =>
- return "Unknown system error";
-
+ when EINTR => return Error_Messages (N_EINTR);
+ when EBADF => return Error_Messages (N_EBADF);
+ when EACCES => return Error_Messages (N_EACCES);
+ when EFAULT => return Error_Messages (N_EFAULT);
+ when EINVAL => return Error_Messages (N_EINVAL);
+ when EMFILE => return Error_Messages (N_EMFILE);
+ when EWOULDBLOCK => return Error_Messages (N_EWOULDBLOCK);
+ when EINPROGRESS => return Error_Messages (N_EINPROGRESS);
+ when EALREADY => return Error_Messages (N_EALREADY);
+ when ENOTSOCK => return Error_Messages (N_ENOTSOCK);
+ when EDESTADDRREQ => return Error_Messages (N_EDESTADDRREQ);
+ when EMSGSIZE => return Error_Messages (N_EMSGSIZE);
+ when EPROTOTYPE => return Error_Messages (N_EPROTOTYPE);
+ when ENOPROTOOPT => return Error_Messages (N_ENOPROTOOPT);
+ when EPROTONOSUPPORT => return Error_Messages (N_EPROTONOSUPPORT);
+ when ESOCKTNOSUPPORT => return Error_Messages (N_ESOCKTNOSUPPORT);
+ when EOPNOTSUPP => return Error_Messages (N_EOPNOTSUPP);
+ when EPFNOSUPPORT => return Error_Messages (N_EPFNOSUPPORT);
+ when EAFNOSUPPORT => return Error_Messages (N_EAFNOSUPPORT);
+ when EADDRINUSE => return Error_Messages (N_EADDRINUSE);
+ when EADDRNOTAVAIL => return Error_Messages (N_EADDRNOTAVAIL);
+ when ENETDOWN => return Error_Messages (N_ENETDOWN);
+ when ENETUNREACH => return Error_Messages (N_ENETUNREACH);
+ when ENETRESET => return Error_Messages (N_ENETRESET);
+ when ECONNABORTED => return Error_Messages (N_ECONNABORTED);
+ when ECONNRESET => return Error_Messages (N_ECONNRESET);
+ when ENOBUFS => return Error_Messages (N_ENOBUFS);
+ when EISCONN => return Error_Messages (N_EISCONN);
+ when ENOTCONN => return Error_Messages (N_ENOTCONN);
+ when ESHUTDOWN => return Error_Messages (N_ESHUTDOWN);
+ when ETOOMANYREFS => return Error_Messages (N_ETOOMANYREFS);
+ when ETIMEDOUT => return Error_Messages (N_ETIMEDOUT);
+ when ECONNREFUSED => return Error_Messages (N_ECONNREFUSED);
+ when ELOOP => return Error_Messages (N_ELOOP);
+ when ENAMETOOLONG => return Error_Messages (N_ENAMETOOLONG);
+ when EHOSTDOWN => return Error_Messages (N_EHOSTDOWN);
+ when EHOSTUNREACH => return Error_Messages (N_EHOSTUNREACH);
+ when SYSNOTREADY => return Error_Messages (N_SYSNOTREADY);
+ when VERNOTSUPPORTED => return Error_Messages (N_VERNOTSUPPORTED);
+ when NOTINITIALISED => return Error_Messages (N_NOTINITIALISED);
+ when EDISCON => return Error_Messages (N_EDISCON);
+ when HOST_NOT_FOUND => return Error_Messages (N_HOST_NOT_FOUND);
+ when TRY_AGAIN => return Error_Messages (N_TRY_AGAIN);
+ when NO_RECOVERY => return Error_Messages (N_NO_RECOVERY);
+ when NO_DATA => return Error_Messages (N_NO_DATA);
+ when others => return Error_Messages (N_OTHERS);
end case;
end Socket_Error_Message;
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2003 Ada Core Technologies, Inc. --
+-- Copyright (C) 2001-2004 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- --
procedure Set_Socket_Errno (Errno : Integer);
-- Set last socket error number.
- function Socket_Error_Message (Errno : Integer) return String;
+ function Socket_Error_Message
+ (Errno : Integer)
+ return C.Strings.chars_ptr;
-- Returns the error message string for the error number Errno. If
-- Errno is not known it returns "Unknown system error".
-- Access to host entry
type Servent is record
- S_Name : C.Strings.chars_ptr;
- S_Aliases : Chars_Ptr_Pointers.Pointer;
- S_Port : C.int;
- S_Proto : C.Strings.chars_ptr;
+ S_Name : C.Strings.chars_ptr;
+ S_Aliases : Chars_Ptr_Pointers.Pointer;
+ S_Port : C.int;
+ S_Proto : C.Strings.chars_ptr;
end record;
pragma Convention (C, Servent);
-- Service entry
function C_Accept
(S : C.int;
Addr : System.Address;
- Addrlen : access C.int)
- return C.int;
+ Addrlen : access C.int) return C.int;
function C_Bind
(S : C.int;
Name : System.Address;
- Namelen : C.int)
- return C.int;
+ Namelen : C.int) return C.int;
function C_Close
- (Fd : C.int)
- return C.int;
+ (Fd : C.int) return C.int;
function C_Connect
(S : C.int;
Name : System.Address;
- Namelen : C.int)
- return C.int;
+ Namelen : C.int) return C.int;
function C_Gethostbyaddr
(Addr : System.Address;
Length : C.int;
- Typ : C.int)
- return Hostent_Access;
+ Typ : C.int) return Hostent_Access;
function C_Gethostbyname
- (Name : C.char_array)
- return Hostent_Access;
+ (Name : C.char_array) return Hostent_Access;
function C_Gethostname
(Name : System.Address;
- Namelen : C.int)
- return C.int;
+ Namelen : C.int) return C.int;
function C_Getpeername
(S : C.int;
Name : System.Address;
- Namelen : access C.int)
- return C.int;
+ Namelen : access C.int) return C.int;
function C_Getservbyname
(Name : C.char_array;
- Proto : C.char_array)
- return Servent_Access;
+ Proto : C.char_array) return Servent_Access;
function C_Getservbyport
(Port : C.int;
- Proto : C.char_array)
- return Servent_Access;
+ Proto : C.char_array) return Servent_Access;
function C_Getsockname
(S : C.int;
Name : System.Address;
- Namelen : access C.int)
- return C.int;
+ Namelen : access C.int) return C.int;
function C_Getsockopt
(S : C.int;
Level : C.int;
Optname : C.int;
Optval : System.Address;
- Optlen : access C.int)
- return C.int;
+ Optlen : access C.int) return C.int;
function C_Inet_Addr
- (Cp : C.Strings.chars_ptr)
- return C.int;
+ (Cp : C.Strings.chars_ptr) return C.int;
function C_Ioctl
(S : C.int;
Req : C.int;
- Arg : Int_Access)
- return C.int;
+ Arg : Int_Access) return C.int;
function C_Listen
- (S, Backlog : C.int)
- return C.int;
+ (S : C.int;
+ Backlog : C.int) return C.int;
function C_Read
(Fildes : C.int;
Buf : System.Address;
- Nbyte : C.int)
- return C.int;
+ Nbyte : C.int) return C.int;
function C_Readv
(Socket : C.int;
Iov : System.Address;
- Iovcnt : C.int)
- return C.int;
+ Iovcnt : C.int) return C.int;
function C_Recv
(S : C.int;
Buf : System.Address;
Len : C.int;
- Flags : C.int)
- return C.int;
+ Flags : C.int) return C.int;
function C_Recvfrom
(S : C.int;
Len : C.int;
Flags : C.int;
From : Sockaddr_In_Access;
- Fromlen : access C.int)
- return C.int;
+ Fromlen : access C.int) return C.int;
function C_Select
(Nfds : C.int;
Readfds : Fd_Set_Access;
Writefds : Fd_Set_Access;
Exceptfds : Fd_Set_Access;
- Timeout : Timeval_Access)
- return C.int;
+ Timeout : Timeval_Access) return C.int;
function C_Send
(S : C.int;
Buf : System.Address;
Len : C.int;
- Flags : C.int)
- return C.int;
+ Flags : C.int) return C.int;
function C_Sendto
(S : C.int;
Len : C.int;
Flags : C.int;
To : Sockaddr_In_Access;
- Tolen : C.int)
- return C.int;
+ Tolen : C.int) return C.int;
function C_Setsockopt
(S : C.int;
Level : C.int;
Optname : C.int;
Optval : System.Address;
- Optlen : C.int)
- return C.int;
+ Optlen : C.int) return C.int;
function C_Shutdown
(S : C.int;
- How : C.int)
- return C.int;
+ How : C.int) return C.int;
function C_Socket
(Domain : C.int;
Typ : C.int;
- Protocol : C.int)
- return C.int;
+ Protocol : C.int) return C.int;
function C_Strerror
- (Errnum : C.int)
- return C.Strings.chars_ptr;
+ (Errnum : C.int) return C.Strings.chars_ptr;
function C_System
- (Command : System.Address)
- return C.int;
+ (Command : System.Address) return C.int;
function C_Write
(Fildes : C.int;
Buf : System.Address;
- Nbyte : C.int)
- return C.int;
+ Nbyte : C.int) return C.int;
function C_Writev
(Socket : C.int;
Iov : System.Address;
- Iovcnt : C.int)
- return C.int;
+ Iovcnt : C.int) return C.int;
function WSAStartup
(WS_Version : Interfaces.C.int;
- WSADataAddress : System.Address)
- return Interfaces.C.int;
+ WSADataAddress : System.Address) return Interfaces.C.int;
procedure Free_Socket_Set
- (Set : Fd_Set_Access);
+ (Set : Fd_Set_Access);
-- Free system-dependent socket set.
procedure Get_Socket_From_Set
function Is_Socket_In_Set
(Set : Fd_Set_Access;
- Socket : C.int)
- return Boolean;
+ Socket : C.int) return Boolean;
-- Check whether Socket is in the socket set
procedure Last_Socket_In_Set
-- set back to the real largest socket in the socket set.
function New_Socket_Set
- (Set : Fd_Set_Access)
- return Fd_Set_Access;
+ (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.
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2003 Ada Core Technologies, Inc. --
+-- Copyright (C) 2002-2004 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- --
Thread_Blocking_IO : Boolean := True;
+ Unknown_System_Error : constant C.Strings.chars_ptr :=
+ C.Strings.New_String ("Unknown system error");
+
-- The following types and variables are required to create a Hostent
-- record "by hand".
-- Socket_Error_Message --
--------------------------
- function Socket_Error_Message (Errno : Integer) return String is
+ function Socket_Error_Message
+ (Errno : Integer) return C.Strings.chars_ptr
+ is
use type Interfaces.C.Strings.chars_ptr;
C_Msg : C.Strings.chars_ptr;
C_Msg := C_Strerror (C.int (Errno));
if C_Msg = C.Strings.Null_Ptr then
- return "Unknown system error";
+ return Unknown_System_Error;
+
else
- return C.Strings.Value (C_Msg);
+ return C_Msg;
end if;
end Socket_Error_Message;
-- --
-- S p e c --
-- --
--- Copyright (C) 2002-2003 Ada Core Technologies, Inc. --
+-- Copyright (C) 2002-2004 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- --
function Socket_Errno return Integer renames GNAT.OS_Lib.Errno;
-- Returns last socket error number.
- function Socket_Error_Message (Errno : Integer) return String;
+ function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr;
-- Returns the error message string for the error number Errno. If
-- Errno is not known it returns "Unknown system error".
ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
ada/snames.ads ada/sprint.ads ada/stand.ads ada/stringt.ads \
- ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
- ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
- ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
- ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
- ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
- ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
- ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
- ada/urealp.ads ada/validsw.ads
+ ada/stringt.adb ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
+ ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
+ ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
+ ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
+ ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
+ ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
+ ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
+ ada/unchdeal.ads ada/urealp.ads ada/validsw.ads
ada/comperr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/comperr.ads ada/comperr.adb \
ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
ada/snames.ads ada/sprint.ads ada/stand.ads ada/stringt.ads \
- ada/system.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \
- ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
- ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
- ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
- ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
- ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
- ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
- ada/unchdeal.ads ada/urealp.ads ada/validsw.ads
+ ada/stringt.adb ada/system.ads ada/s-exctab.ads ada/s-exctab.adb \
+ ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
+ ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
+ ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
+ ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
+ ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
+ ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
+ ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads
ada/exp_attr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
ada/exp_ch3.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
- ada/debug.ads ada/debug_a.ads ada/einfo.ads ada/einfo.adb \
- ada/elists.ads ada/elists.adb ada/err_vars.ads ada/errout.ads \
- ada/erroutc.ads ada/exp_aggr.ads ada/exp_ch11.ads ada/exp_ch2.ads \
- ada/exp_ch3.ads ada/exp_ch3.adb ada/exp_ch4.ads ada/exp_ch7.ads \
- ada/exp_ch9.ads ada/exp_disp.ads ada/exp_dist.ads ada/exp_smem.ads \
- ada/exp_strm.ads ada/exp_tss.ads ada/exp_tss.adb ada/exp_util.ads \
- ada/expander.ads ada/fname.ads ada/fname-uf.ads ada/freeze.ads \
- ada/get_targ.ads ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads \
- ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/itypes.ads \
- ada/lib.ads ada/lib-xref.ads ada/namet.ads ada/nlists.ads \
- ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
- ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \
- ada/sem.ads ada/sem_aggr.ads ada/sem_attr.ads ada/sem_cat.ads \
- ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch6.ads ada/sem_ch8.ads \
- ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads ada/sem_eval.ads \
- ada/sem_intr.ads ada/sem_mech.ads ada/sem_res.ads ada/sem_res.adb \
- ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads \
+ ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
+ ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_aggr.ads \
+ ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch3.ads ada/exp_ch3.adb \
+ ada/exp_ch4.ads ada/exp_ch7.ads ada/exp_ch9.ads ada/exp_disp.ads \
+ ada/exp_dist.ads ada/exp_smem.ads ada/exp_strm.ads ada/exp_tss.ads \
+ ada/exp_tss.adb ada/exp_util.ads ada/fname.ads ada/fname-uf.ads \
+ ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \
+ ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
+ ada/lib.ads ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads \
+ ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
+ ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/sem.ads \
+ ada/sem_ch3.ads ada/sem_ch8.ads ada/sem_eval.ads ada/sem_mech.ads \
+ ada/sem_res.ads ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads \
ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/sprint.ads \
ada/stand.ads ada/stringt.ads ada/stringt.adb ada/system.ads \
ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
ada/sem_ch13.ads ada/sem_ch8.ads ada/sem_eval.ads ada/sem_res.ads \
ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \
ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads \
- ada/sprint.ads ada/stand.ads ada/stringt.ads ada/style.ads \
- ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
- ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \
- ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
- ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
- ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
- ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
- ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
- ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
- ada/unchdeal.ads ada/urealp.ads ada/validsw.ads ada/widechar.ads
+ ada/sprint.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \
+ ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
+ ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
+ ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
+ ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
+ ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
+ ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
+ ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
+ ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
+ ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads \
+ ada/widechar.ads
ada/exp_ch6.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
ada/sem_ch8.ads ada/sem_eval.ads ada/sem_eval.adb ada/sem_res.ads \
ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads \
ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
- ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
- ada/s-imgenu.ads ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads \
- ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
- ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
- ada/table.adb ada/tbuild.ads ada/tree_io.ads ada/types.ads \
- ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \
- ada/urealp.ads ada/urealp.adb
+ ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-exctab.ads \
+ ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-secsta.ads \
+ ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
+ ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
+ ada/table.ads ada/table.adb ada/tbuild.ads ada/tree_io.ads \
+ ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
+ ada/unchdeal.ads ada/urealp.ads ada/urealp.adb
ada/exp_imgv.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
ada/sem_eval.ads ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads \
ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
- ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
- ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
- ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
- ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
- ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
- ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
- ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
- ada/urealp.ads ada/urealp.adb ada/validsw.ads
+ ada/stringt.adb ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
+ ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
+ ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
+ ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
+ ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
+ ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
+ ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
+ ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/validsw.ads
ada/exp_vfpt.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
ada/sem_aggr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
- ada/csets.ads ada/debug.ads ada/debug_a.ads ada/einfo.ads ada/einfo.adb \
- ada/elists.ads ada/elists.adb ada/err_vars.ads ada/errout.ads \
- ada/erroutc.ads ada/eval_fat.ads ada/exp_ch11.ads ada/exp_ch2.ads \
- ada/exp_ch7.ads ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb \
- ada/expander.ads ada/fname.ads ada/freeze.ads ada/get_targ.ads \
- ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-speche.ads \
- ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads \
- ada/interfac.ads ada/itypes.ads ada/lib.ads ada/lib-xref.ads \
- ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
- ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
- ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \
- ada/scng.adb ada/sem.ads ada/sem_aggr.ads ada/sem_aggr.adb \
- ada/sem_attr.ads ada/sem_cat.ads ada/sem_ch13.ads ada/sem_ch4.ads \
- ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads \
- ada/sem_elab.ads ada/sem_eval.ads ada/sem_eval.adb ada/sem_intr.ads \
- ada/sem_res.ads ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads \
- ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
- ada/sinput.ads ada/snames.ads ada/sprint.ads ada/stand.ads \
- ada/stringt.ads ada/stringt.adb ada/style.ads ada/styleg.ads \
- ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \
- ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
- ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
- ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
- ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
- ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
- ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
- ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
- ada/validsw.ads ada/widechar.ads
+ ada/csets.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
+ ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
+ ada/eval_fat.ads ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch7.ads \
+ ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb ada/fname.ads \
+ ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \
+ ada/g-os_lib.ads ada/g-speche.ads ada/g-string.ads ada/gnatvsn.ads \
+ ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/itypes.ads \
+ ada/lib.ads ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
+ ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
+ ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \
+ ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads ada/sem_aggr.ads \
+ ada/sem_aggr.adb ada/sem_cat.ads ada/sem_ch13.ads ada/sem_ch8.ads \
+ ada/sem_eval.ads ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads \
+ ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads \
+ ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/sprint.ads \
+ ada/stand.ads ada/stringt.ads ada/stringt.adb ada/style.ads \
+ ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
+ ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \
+ ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
+ ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
+ ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
+ ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
+ ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
+ ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \
+ ada/urealp.ads ada/validsw.ads ada/widechar.ads
ada/sem_attr.o : ada/ada.ads ada/a-charac.ads ada/a-chlat1.ads \
ada/a-except.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
ada/sem_ch12.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads \
ada/alloc.ads ada/atree.ads ada/atree.adb ada/casing.ads ada/checks.ads \
- ada/csets.ads ada/debug.ads ada/debug_a.ads ada/einfo.ads ada/einfo.adb \
- ada/elists.ads ada/elists.adb ada/err_vars.ads ada/errout.ads \
- ada/erroutc.ads ada/exp_ch7.ads ada/exp_tss.ads ada/exp_util.ads \
- ada/expander.ads ada/fname.ads ada/fname-uf.ads ada/freeze.ads \
- ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads \
- ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
- ada/inline.ads ada/interfac.ads ada/itypes.ads ada/lib.ads ada/lib.adb \
- ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/lib-xref.ads \
- ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
- ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
- ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \
- ada/scng.adb ada/sem.ads ada/sem_aggr.ads ada/sem_attr.ads \
+ ada/csets.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
+ ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
+ ada/exp_tss.ads ada/exp_util.ads ada/expander.ads ada/fname.ads \
+ ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
+ ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
+ ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads ada/interfac.ads \
+ ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \
+ ada/lib-sort.adb ada/lib-xref.ads ada/namet.ads ada/namet.adb \
+ ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
+ ada/output.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \
+ ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
ada/sem_cat.ads ada/sem_ch10.ads ada/sem_ch12.ads ada/sem_ch12.adb \
- ada/sem_ch13.ads ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch6.ads \
- ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads \
- ada/sem_elab.ads ada/sem_elim.ads ada/sem_eval.ads ada/sem_intr.ads \
- ada/sem_res.ads ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads \
- ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
- ada/sinfo-cn.ads ada/sinput.ads ada/sinput-l.ads ada/snames.ads \
- ada/stand.ads ada/stringt.ads ada/style.ads ada/styleg.ads \
- ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \
- ada/s-crc32.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \
- ada/s-htable.adb ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
- ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
- ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
- ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
- ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
- ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
- ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \
- ada/widechar.ads
+ ada/sem_ch13.ads ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch7.ads \
+ ada/sem_ch8.ads ada/sem_elab.ads ada/sem_elim.ads ada/sem_eval.ads \
+ ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
+ ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinfo-cn.ads \
+ ada/sinput.ads ada/sinput-l.ads ada/snames.ads ada/stand.ads \
+ ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
+ ada/styleg-c.ads ada/stylesw.ads ada/system.ads ada/s-crc32.ads \
+ ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-htable.adb \
+ ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
+ ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
+ ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
+ ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
+ ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
+ ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
+ ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/widechar.ads
ada/sem_ch13.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
ada/sem_mech.ads ada/sem_res.ads ada/sem_res.adb ada/sem_smem.ads \
ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \
ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads \
- ada/sprint.ads ada/stand.ads ada/stringt.ads ada/style.ads \
- ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
- ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \
- ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
- ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
- ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
- ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
- ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
- ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
- ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/validsw.ads \
- ada/widechar.ads
+ ada/sprint.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \
+ ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
+ ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
+ ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
+ ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
+ ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
+ ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
+ ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
+ ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
+ ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \
+ ada/validsw.ads ada/widechar.ads
ada/sem_ch4.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
ada/sem_ch5.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
- ada/csets.ads ada/debug.ads ada/debug_a.ads ada/einfo.ads ada/einfo.adb \
- ada/elists.ads ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
- ada/eval_fat.ads ada/exp_ch2.ads ada/exp_ch7.ads ada/exp_tss.ads \
- ada/exp_util.ads ada/expander.ads ada/fname.ads ada/freeze.ads \
- ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads \
- ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
- ada/interfac.ads ada/itypes.ads ada/lib.ads ada/lib-xref.ads \
- ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
- ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
- ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \
- ada/scng.adb ada/sem.ads ada/sem_aggr.ads ada/sem_attr.ads \
- ada/sem_case.ads ada/sem_case.adb ada/sem_cat.ads ada/sem_ch3.ads \
- ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch5.adb ada/sem_ch6.ads \
- ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads \
- ada/sem_eval.ads ada/sem_eval.adb ada/sem_intr.ads ada/sem_res.ads \
- ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
- ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
- ada/snames.ads ada/sprint.ads ada/stand.ads ada/stringt.ads \
- ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
- ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
- ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
- ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
- ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
- ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
- ada/tbuild.ads ada/tree_io.ads ada/ttypes.ads ada/types.ads \
- ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \
- ada/urealp.ads ada/validsw.ads ada/widechar.ads
-
-ada/sem_ch6.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
- ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
- ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
- ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
- ada/exp_ch7.ads ada/exp_tss.ads ada/exp_util.ads ada/expander.ads \
+ ada/csets.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
+ ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/eval_fat.ads \
+ ada/exp_ch2.ads ada/exp_tss.ads ada/exp_util.ads ada/expander.ads \
ada/fname.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
- ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads ada/interfac.ads \
- ada/itypes.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
- ada/lib-sort.adb ada/lib-xref.ads ada/namet.ads ada/namet.adb \
- ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
- ada/output.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \
- ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
- ada/sem_aggr.ads ada/sem_attr.ads ada/sem_cat.ads ada/sem_ch12.ads \
- ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch6.ads \
- ada/sem_ch6.adb ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads \
- ada/sem_elab.ads ada/sem_elim.ads ada/sem_eval.ads ada/sem_intr.ads \
- ada/sem_mech.ads ada/sem_prag.ads ada/sem_res.ads ada/sem_res.adb \
- ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \
- ada/sinfo.ads ada/sinfo.adb ada/sinfo-cn.ads ada/sinput.ads \
- ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
- ada/stringt.adb ada/style.ads ada/styleg.ads ada/styleg.adb \
- ada/styleg-c.ads ada/stylesw.ads ada/system.ads ada/s-carun8.ads \
+ ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \
+ ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
+ ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
+ ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \
+ ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads ada/sem_case.ads \
+ ada/sem_case.adb ada/sem_cat.ads ada/sem_ch3.ads ada/sem_ch5.ads \
+ ada/sem_ch5.adb ada/sem_ch8.ads ada/sem_disp.ads ada/sem_eval.ads \
+ ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
+ ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
+ ada/sinput.ads ada/snames.ads ada/sprint.ads ada/stand.ads \
+ ada/stringt.ads ada/stringt.adb ada/style.ads ada/styleg.ads \
+ ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \
ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
- ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
- ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
- ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
- ada/urealp.ads ada/validsw.ads ada/widechar.ads
+ ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tree_io.ads \
+ ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
+ ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads \
+ ada/widechar.ads
+
+ada/sem_ch6.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
+ ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
+ ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
+ ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_ch7.ads \
+ ada/exp_tss.ads ada/exp_util.ads ada/expander.ads ada/fname.ads \
+ ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads \
+ ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
+ ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/lib.ads \
+ ada/lib.adb ada/lib-list.adb ada/lib-sort.adb ada/lib-xref.ads \
+ ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
+ ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
+ ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \
+ ada/scng.adb ada/sem.ads ada/sem_cat.ads ada/sem_ch12.ads \
+ ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch6.ads \
+ ada/sem_ch6.adb ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads \
+ ada/sem_elim.ads ada/sem_eval.ads ada/sem_mech.ads ada/sem_prag.ads \
+ ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
+ ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinfo-cn.ads \
+ ada/sinput.ads ada/sinput.adb ada/snames.ads ada/stand.ads \
+ ada/stringt.ads ada/stringt.adb ada/style.ads ada/styleg.ads \
+ ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \
+ ada/s-carun8.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \
+ ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
+ ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
+ ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
+ ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
+ ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
+ ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
+ ada/unchdeal.ads ada/urealp.ads ada/validsw.ads ada/widechar.ads
ada/sem_ch7.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 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- --
-- Create type definition node for type String
Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc);
- Set_Subtype_Indication (Tdef_Node, Identifier_For (S_Character));
+ declare
+ CompDef_Node : Node_Id;
+ begin
+ CompDef_Node := New_Node (N_Component_Definition, Stloc);
+ Set_Aliased_Present (CompDef_Node, False);
+ Set_Subtype_Indication (CompDef_Node, Identifier_For (S_Character));
+ Set_Component_Definition (Tdef_Node, CompDef_Node);
+ end;
Set_Subtype_Marks (Tdef_Node, New_List);
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
Set_Type_Definition (Parent (Standard_String), Tdef_Node);
-- Create type definition node for type Wide_String
Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc);
- Set_Subtype_Indication (Tdef_Node, Identifier_For (S_Wide_Character));
+ declare
+ CompDef_Node : Node_Id;
+ begin
+ CompDef_Node := New_Node (N_Component_Definition, Stloc);
+ Set_Aliased_Present (CompDef_Node, False);
+ Set_Subtype_Indication (CompDef_Node,
+ Identifier_For (S_Wide_Character));
+ Set_Component_Definition (Tdef_Node, CompDef_Node);
+ end;
Set_Subtype_Marks (Tdef_Node, New_List);
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
Set_Type_Definition (Parent (Standard_Wide_String), Tdef_Node);
Append (
Make_Component_Declaration (Stloc,
Defining_Identifier => Comp,
- Subtype_Indication => New_Occurrence_Of (Etype (Comp), Stloc)),
+ Component_Definition =>
+ Make_Component_Definition (Stloc,
+ Aliased_Present => False,
+ Subtype_Indication => New_Occurrence_Of (Etype (Comp),
+ Stloc))),
Comp_List);
Next_Entity (Comp);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 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- --
Type_Definition =>
Make_Constrained_Array_Definition (Loc,
Discrete_Subtype_Definitions => Indices,
- Subtype_Indication =>
- New_Occurrence_Of (Component_Type (Typ), Loc)));
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Occurrence_Of (Component_Type (Typ), Loc))));
Insert_Action (N, Decl);
Analyze (Decl);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 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- --
Decl := First_Non_Pragma (Component_Items (Comp_List));
while Present (Decl) loop
Loc := Sloc (Decl);
- Build_Record_Checks (Subtype_Indication (Decl), Check_List);
+ Build_Record_Checks
+ (Subtype_Indication (Component_Definition (Decl)), Check_List);
Id := Defining_Identifier (Decl);
Typ := Etype (Id);
Comp_Decl :=
Make_Component_Declaration (Loc,
Defining_Identifier => Parent_N,
- Subtype_Indication => New_Reference_To (Par_Subtype, Loc));
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication => New_Reference_To (Par_Subtype, Loc)));
if Null_Present (Rec_Ext_Part) then
Set_Component_List (Rec_Ext_Part,
Comp_Decl :=
Make_Component_Declaration (Loc,
Defining_Identifier => Ent,
- Subtype_Indication => New_Reference_To (Controller_Type, Loc));
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication => New_Reference_To (Controller_Type, Loc)));
if Null_Present (Comp_List)
or else Is_Empty_List (Component_Items (Comp_List))
Comp_Decl :=
Make_Component_Declaration (Sloc_N,
Defining_Identifier => Tag_Component (T),
- Subtype_Indication =>
- New_Reference_To (RTE (RE_Tag), Sloc_N));
+ Component_Definition =>
+ Make_Component_Definition (Sloc_N,
+ Aliased_Present => False,
+ Subtype_Indication => New_Reference_To (RTE (RE_Tag), Sloc_N)));
if Null_Present (Comp_List)
or else Is_Empty_List (Component_Items (Comp_List))
-- already been analyzed previously. Here we just insure that the
-- tree is coherent with the semantic decoration
- Find_Type (Subtype_Indication (Comp_Decl));
+ Find_Type (Subtype_Indication (Component_Definition (Comp_Decl)));
exception
when RE_Not_Available =>
High_Bound =>
Make_Integer_Literal (Loc, Num - 1))))),
- Subtype_Indication => New_Reference_To (Typ, Loc)),
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication => New_Reference_To (Typ, Loc))),
Expression =>
Make_Aggregate (Loc,
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, 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- --
(Etype (Discrete_Subtype_Definition
(Parent (Efam)))), Loc))),
- Subtype_Indication =>
- New_Reference_To (Standard_Character, Loc)));
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Reference_To (Standard_Character, Loc))));
Insert_After (Current_Node, Efam_Decl);
Current_Node := Efam_Decl;
Defining_Identifier =>
Make_Defining_Identifier (Loc, Chars (Efam)),
- Subtype_Indication =>
- Make_Subtype_Indication (Loc,
- Subtype_Mark =>
- New_Occurrence_Of (Efam_Type, Loc),
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ Make_Subtype_Indication (Loc,
+ Subtype_Mark =>
+ New_Occurrence_Of (Efam_Type, Loc),
+ Constraint =>
+ Make_Index_Or_Discriminant_Constraint (Loc,
+ Constraints => New_List (
+ New_Occurrence_Of
+ (Etype (Discrete_Subtype_Definition
+ (Parent (Efam))), Loc)))))));
+
- Constraint =>
- Make_Index_Or_Discriminant_Constraint (Loc,
- Constraints => New_List (
- New_Occurrence_Of
- (Etype (Discrete_Subtype_Definition
- (Parent (Efam))), Loc))))));
end if;
Next_Entity (Efam);
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, New_Internal_Name ('P')),
- Subtype_Indication =>
- New_Occurrence_Of (RTE (RE_Address), Loc)),
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Occurrence_Of (RTE (RE_Address), Loc))),
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, New_Internal_Name ('S')),
- Subtype_Indication =>
- New_Occurrence_Of (D_T2, Loc)));
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication => New_Occurrence_Of (D_T2, Loc))));
Decl2 :=
Make_Full_Type_Declaration (Loc,
Append_To (Components,
Make_Component_Declaration (Loc,
Defining_Identifier => Component,
- Subtype_Indication => New_Reference_To (Ctype, Loc)));
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication => New_Reference_To (Ctype, Loc))));
Next_Formal_With_Extras (Formal);
end loop;
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uObject),
- Aliased_Present => True,
- Subtype_Indication => Protection_Subtype);
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => True,
+ Subtype_Indication => Protection_Subtype));
end;
pragma Assert (Present (Pdef));
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Sloc (Pent), Chars (Pent)),
- Subtype_Indication =>
- New_Copy_Tree (Subtype_Indication (Priv), Discr_Map),
+ Component_Definition =>
+ Make_Component_Definition (Sloc (Pent),
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Copy_Tree (Subtype_Indication
+ (Component_Definition (Priv)),
+ Discr_Map)),
Expression => Expression (Priv));
Append_To (Cdecls, New_Priv);
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uTask_Id),
- Subtype_Indication => New_Reference_To (RTE (RO_ST_Task_ID), Loc)));
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication => New_Reference_To (RTE (RO_ST_Task_ID),
+ Loc))));
-- Add components for entry families
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uPriority),
- Subtype_Indication => New_Reference_To (Standard_Integer, Loc),
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication => New_Reference_To (Standard_Integer,
+ Loc)),
Expression => Expr));
end;
end if;
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uSize),
- Subtype_Indication => New_Reference_To (RTE (RE_Size_Type), Loc),
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication => New_Reference_To (RTE (RE_Size_Type),
+ Loc)),
Expression =>
Convert_To (RTE (RE_Size_Type),
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uTask_Info),
- Subtype_Indication =>
- New_Reference_To (RTE (RE_Task_Info_Type), Loc),
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Reference_To (RTE (RE_Task_Info_Type), Loc)),
Expression => New_Copy (
Expression (First (
Pragma_Argument_Associations (
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 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- --
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_Origin),
- Subtype_Indication =>
- New_Occurrence_Of (RTE (RE_Partition_ID), Loc)),
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Occurrence_Of (RTE (RE_Partition_ID), Loc))),
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_Receiver),
- Subtype_Indication =>
- New_Occurrence_Of (RTE (RE_Unsigned_64), Loc)),
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Occurrence_Of (RTE (RE_Unsigned_64), Loc))),
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_Addr),
- Subtype_Indication =>
- New_Occurrence_Of (RTE (RE_Unsigned_64), Loc)),
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Occurrence_Of (RTE (RE_Unsigned_64), Loc))),
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_Asynchronous),
- Subtype_Indication =>
- New_Occurrence_Of (Standard_Boolean, Loc))))));
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Occurrence_Of (Standard_Boolean, Loc)))))));
Append_To (Decls, Stub_Type_Declaration);
Analyze (Stub_Type_Declaration);
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2004 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- --
Make_Range (Loc,
Low_Bound => Make_Integer_Literal (Loc, 0),
High_Bound => Make_Integer_Literal (Loc, Nlit))),
- Subtype_Indication => New_Occurrence_Of (Ityp, Loc)),
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication => New_Occurrence_Of (Ityp, Loc))),
Expression =>
Make_Aggregate (Loc,
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 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- --
Typedef :=
Make_Unconstrained_Array_Definition (Loc,
Subtype_Marks => Indexes,
- Subtype_Indication =>
- New_Occurrence_Of (Ctyp, Loc));
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Occurrence_Of (Ctyp, Loc)));
else
Typedef :=
Make_Constrained_Array_Definition (Loc,
Discrete_Subtype_Definitions => Indexes,
- Subtype_Indication =>
- New_Occurrence_Of (Ctyp, Loc));
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Occurrence_Of (Ctyp, Loc)));
end if;
Decl :=
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, 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- --
N_Compilation_Unit_Aux |
N_Component_Clause |
N_Component_Declaration |
+ N_Component_Definition |
N_Component_List |
N_Constrained_Array_Definition |
N_Decimal_Fixed_Point_Definition |
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uParent),
- Subtype_Indication => New_Reference_To (Constr_Root, Loc)),
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Reference_To (Constr_Root, Loc))),
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('C')),
- Subtype_Indication => New_Reference_To (Str_Type, Loc))),
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Reference_To (Str_Type, Loc)))),
+
Variant_Part => Empty))));
Insert_Actions (E, List_Def);
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2003 Ada Core Technologies, Inc. --
+-- Copyright (C) 2001-2004 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- --
begin
Ada.Exceptions.Raise_Exception
- (Socket_Error'Identity, Image (Error) & Socket_Error_Message (Error));
+ (Socket_Error'Identity,
+ Image (Error) & C.Strings.Value (Socket_Error_Message (Error)));
end Raise_Socket_Error;
----------
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2003 Ada Core Technologies, Inc. --
+-- Copyright (C) 2001-2004 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- --
package body GNAT.Sockets.Thin is
- Non_Blocking_Sockets : constant Fd_Set_Access
- := New_Socket_Set (No_Socket_Set);
+ Non_Blocking_Sockets : constant Fd_Set_Access :=
+ New_Socket_Set (No_Socket_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
Thread_Blocking_IO : Boolean := True;
+ Unknown_System_Error : constant C.Strings.chars_ptr :=
+ C.Strings.New_String ("Unknown system error");
+
function Syscall_Accept
(S : C.int;
Addr : System.Address;
- Addrlen : access C.int)
- return C.int;
+ Addrlen : access C.int) return C.int;
pragma Import (C, Syscall_Accept, "accept");
function Syscall_Connect
(S : C.int;
Name : System.Address;
- Namelen : C.int)
- return C.int;
+ Namelen : C.int) return C.int;
pragma Import (C, Syscall_Connect, "connect");
function Syscall_Ioctl
(S : C.int;
Req : C.int;
- Arg : Int_Access)
- return C.int;
+ Arg : Int_Access) return C.int;
pragma Import (C, Syscall_Ioctl, "ioctl");
function Syscall_Recv
(S : C.int;
Msg : System.Address;
Len : C.int;
- Flags : C.int)
- return C.int;
+ Flags : C.int) return C.int;
pragma Import (C, Syscall_Recv, "recv");
function Syscall_Recvfrom
Len : C.int;
Flags : C.int;
From : Sockaddr_In_Access;
- Fromlen : access C.int)
- return C.int;
+ Fromlen : access C.int) return C.int;
pragma Import (C, Syscall_Recvfrom, "recvfrom");
function Syscall_Send
(S : C.int;
Msg : System.Address;
Len : C.int;
- Flags : C.int)
- return C.int;
+ Flags : C.int) return C.int;
pragma Import (C, Syscall_Send, "send");
function Syscall_Sendto
Len : C.int;
Flags : C.int;
To : Sockaddr_In_Access;
- Tolen : C.int)
- return C.int;
+ Tolen : C.int) return C.int;
pragma Import (C, Syscall_Sendto, "sendto");
function Syscall_Socket
- (Domain, Typ, Protocol : C.int)
- return C.int;
+ (Domain : C.int;
+ Typ : C.int;
+ Protocol : C.int) return C.int;
pragma Import (C, Syscall_Socket, "socket");
function Non_Blocking_Socket (S : C.int) return Boolean;
function C_Accept
(S : C.int;
Addr : System.Address;
- Addrlen : access C.int)
- return C.int
+ Addrlen : access C.int) return C.int
is
R : C.int;
Val : aliased C.int := 1;
function C_Connect
(S : C.int;
Name : System.Address;
- Namelen : C.int)
- return C.int
+ Namelen : C.int) return C.int
is
Res : C.int;
-------------
function C_Ioctl
- (S : C.int;
- Req : C.int;
- Arg : Int_Access)
- return C.int
+ (S : C.int;
+ Req : C.int;
+ Arg : Int_Access) return C.int
is
begin
if not Thread_Blocking_IO
(S : C.int;
Msg : System.Address;
Len : C.int;
- Flags : C.int)
- return C.int
+ Flags : C.int) return C.int
is
Res : C.int;
Len : C.int;
Flags : C.int;
From : Sockaddr_In_Access;
- Fromlen : access C.int)
- return C.int
+ Fromlen : access C.int) return C.int
is
Res : C.int;
(S : C.int;
Msg : System.Address;
Len : C.int;
- Flags : C.int)
- return C.int
+ Flags : C.int) return C.int
is
Res : C.int;
Len : C.int;
Flags : C.int;
To : Sockaddr_In_Access;
- Tolen : C.int)
- return C.int
+ Tolen : C.int) return C.int
is
Res : C.int;
function C_Socket
(Domain : C.int;
Typ : C.int;
- Protocol : C.int)
- return C.int
+ Protocol : C.int) return C.int
is
R : C.int;
Val : aliased C.int := 1;
function Non_Blocking_Socket (S : C.int) return Boolean is
R : Boolean;
-
begin
Task_Lock.Lock;
R := Is_Socket_In_Set (Non_Blocking_Sockets, S);
Address : In_Addr)
is
begin
- Sin.Sin_Addr := Address;
+ Sin.Sin_Addr := Address;
end Set_Address;
----------------
-- Socket_Error_Message --
--------------------------
- function Socket_Error_Message (Errno : Integer) return String is
+ function Socket_Error_Message
+ (Errno : Integer) return C.Strings.chars_ptr
+ is
use type Interfaces.C.Strings.chars_ptr;
C_Msg : C.Strings.chars_ptr;
C_Msg := C_Strerror (C.int (Errno));
if C_Msg = C.Strings.Null_Ptr then
- return "Unknown system error";
+ return Unknown_System_Error;
else
- return C.Strings.Value (C_Msg);
+ return C_Msg;
end if;
end Socket_Error_Message;
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2003 Ada Core Technologies, Inc. --
+-- Copyright (C) 2001-2004 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- --
function Socket_Errno return Integer renames GNAT.OS_Lib.Errno;
-- Returns last socket error number.
- function Socket_Error_Message (Errno : Integer) return String;
+ function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr;
-- Returns the error message string for the error number Errno. If
-- Errno is not known it returns "Unknown system error".
function C_Accept
(S : C.int;
Addr : System.Address;
- Addrlen : access C.int)
- return C.int;
+ Addrlen : access C.int) return C.int;
function C_Bind
(S : C.int;
Name : System.Address;
- Namelen : C.int)
- return C.int;
+ Namelen : C.int) return C.int;
function C_Close
- (Fd : C.int)
- return C.int;
+ (Fd : C.int) return C.int;
function C_Connect
(S : C.int;
Name : System.Address;
- Namelen : C.int)
- return C.int;
+ Namelen : C.int) return C.int;
function C_Gethostbyaddr
(Addr : System.Address;
Len : C.int;
- Typ : C.int)
- return Hostent_Access;
+ Typ : C.int) return Hostent_Access;
function C_Gethostbyname
- (Name : C.char_array)
- return Hostent_Access;
+ (Name : C.char_array) return Hostent_Access;
function C_Gethostname
(Name : System.Address;
- Namelen : C.int)
- return C.int;
+ Namelen : C.int) return C.int;
function C_Getpeername
(S : C.int;
Name : System.Address;
- Namelen : access C.int)
- return C.int;
+ Namelen : access C.int) return C.int;
function C_Getservbyname
(Name : C.char_array;
- Proto : C.char_array)
- return Servent_Access;
+ Proto : C.char_array) return Servent_Access;
function C_Getservbyport
(Port : C.int;
- Proto : C.char_array)
- return Servent_Access;
+ Proto : C.char_array) return Servent_Access;
function C_Getsockname
(S : C.int;
Name : System.Address;
- Namelen : access C.int)
- return C.int;
+ Namelen : access C.int) return C.int;
function C_Getsockopt
(S : C.int;
Level : C.int;
Optname : C.int;
Optval : System.Address;
- Optlen : access C.int)
- return C.int;
+ Optlen : access C.int) return C.int;
function C_Inet_Addr
- (Cp : C.Strings.chars_ptr)
- return C.int;
+ (Cp : C.Strings.chars_ptr) return C.int;
function C_Ioctl
(S : C.int;
Req : C.int;
- Arg : Int_Access)
- return C.int;
+ Arg : Int_Access) return C.int;
- function C_Listen (S, Backlog : C.int) return C.int;
+ function C_Listen
+ (S : C.int;
+ Backlog : C.int) return C.int;
function C_Read
(Fd : C.int;
Buf : System.Address;
- Count : C.int)
- return C.int;
+ Count : C.int) return C.int;
function C_Readv
(Fd : C.int;
Iov : System.Address;
- Iovcnt : C.int)
- return C.int;
+ Iovcnt : C.int) return C.int;
function C_Recv
(S : C.int;
Msg : System.Address;
Len : C.int;
- Flags : C.int)
- return C.int;
+ Flags : C.int) return C.int;
function C_Recvfrom
(S : C.int;
Len : C.int;
Flags : C.int;
From : Sockaddr_In_Access;
- Fromlen : access C.int)
- return C.int;
+ Fromlen : access C.int) return C.int;
function C_Select
(Nfds : C.int;
Readfds : Fd_Set_Access;
Writefds : Fd_Set_Access;
Exceptfds : Fd_Set_Access;
- Timeout : Timeval_Access)
- return C.int;
+ Timeout : Timeval_Access) return C.int;
function C_Send
(S : C.int;
Msg : System.Address;
Len : C.int;
- Flags : C.int)
- return C.int;
+ Flags : C.int) return C.int;
function C_Sendto
(S : C.int;
Len : C.int;
Flags : C.int;
To : Sockaddr_In_Access;
- Tolen : C.int)
- return C.int;
+ Tolen : C.int) return C.int;
function C_Setsockopt
(S : C.int;
Level : C.int;
Optname : C.int;
Optval : System.Address;
- Optlen : C.int)
- return C.int;
+ Optlen : C.int) return C.int;
function C_Shutdown
- (S : C.int;
- How : C.int)
- return C.int;
+ (S : C.int;
+ How : C.int) return C.int;
function C_Socket
(Domain : C.int;
Typ : C.int;
- Protocol : C.int)
- return C.int;
+ Protocol : C.int) return C.int;
function C_Strerror
- (Errnum : C.int)
- return C.Strings.chars_ptr;
+ (Errnum : C.int) return C.Strings.chars_ptr;
function C_System
- (Command : System.Address)
- return C.int;
+ (Command : System.Address) return C.int;
function C_Write
(Fd : C.int;
Buf : System.Address;
- Count : C.int)
- return C.int;
+ Count : C.int) return C.int;
function C_Writev
(Fd : C.int;
Iov : System.Address;
- Iovcnt : C.int)
- return C.int;
+ Iovcnt : C.int) return C.int;
procedure Free_Socket_Set
(Set : Fd_Set_Access);
function Is_Socket_In_Set
(Set : Fd_Set_Access;
- Socket : C.int)
- return Boolean;
+ Socket : C.int) return Boolean;
-- Check whether Socket is in the socket set
procedure Last_Socket_In_Set
-- set back to the real largest socket in the socket set.
function New_Socket_Set
- (Set : Fd_Set_Access)
- return Fd_Set_Access;
+ (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.
-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2004 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- --
"g-regist", -- GNAT.Registry
"g-regpat", -- GNAT.Regpat
"g-semaph", -- GNAT.Semaphores
+ "g-sestin", -- GNAT.Secondary_Stack_Info
"g-signal", -- GNAT.Signals
"g-socket", -- GNAT.Sockets
"g-souinf", -- GNAT.Source_Info
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2004, 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- --
exit;
end if;
- -- For a subtype, go to ancestor subtype. If it is a
- -- subtype created for a generic actual, not clear yet
- -- what is the right type to use ???
+ -- For a subtype, go to ancestor subtype.
else
Tref := Ancestor_Subtype (Tref);
if Sloc (Tref) = Standard_Location
or else Comes_From_Source (Tref)
then
+ -- If the reference is a subtype created for a generic
+ -- actual, go to actual directly, the inner subtype is
+ -- not user visible.
+
+ if Nkind (Parent (Tref)) = N_Subtype_Declaration
+ and then not Comes_From_Source (Parent (Tref))
+ and then
+ (Is_Wrapper_Package (Scope (Tref))
+ or else Is_Generic_Instance (Scope (Tref)))
+ then
+ Tref := Base_Type (Tref);
+ end if;
+
return;
end if;
end loop;
#elif defined (__FreeBSD__)
char *object_file_option = "";
char *run_path_option = "";
-char shared_libgnat_default = SHARED;
+char shared_libgnat_default = STATIC;
int link_max = 2147483647;
unsigned char objlist_file_supported = 0;
unsigned char using_gnu_linker = 0;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, 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- --
-- Error recovery: can raise Error_Resync
function P_Array_Type_Definition return Node_Id is
- Array_Loc : Source_Ptr;
- Def_Node : Node_Id;
- Subs_List : List_Id;
- Scan_State : Saved_Scan_State;
+ Array_Loc : Source_Ptr;
+ CompDef_Node : Node_Id;
+ Def_Node : Node_Id;
+ Subs_List : List_Id;
+ Scan_State : Saved_Scan_State;
begin
Array_Loc := Token_Ptr;
T_Right_Paren;
T_Of;
+ CompDef_Node := New_Node (N_Component_Definition, Token_Ptr);
+
if Token = Tok_Aliased then
- Set_Aliased_Present (Def_Node, True);
+ Set_Aliased_Present (CompDef_Node, True);
Scan; -- past ALIASED
end if;
- Set_Subtype_Indication (Def_Node, P_Subtype_Indication);
+ Set_Subtype_Indication (CompDef_Node, P_Subtype_Indication);
+ Set_Component_Definition (Def_Node, CompDef_Node);
+
return Def_Node;
end P_Array_Type_Definition;
-- items, do we need to add this capability sometime in the future ???
procedure P_Component_Items (Decls : List_Id) is
- Decl_Node : Node_Id;
- Scan_State : Saved_Scan_State;
- Num_Idents : Nat;
- Ident : Nat;
- Ident_Sloc : Source_Ptr;
+ CompDef_Node : Node_Id;
+ Decl_Node : Node_Id;
+ Scan_State : Saved_Scan_State;
+ Num_Idents : Nat;
+ Ident : Nat;
+ Ident_Sloc : Source_Ptr;
Idents : array (Int range 1 .. 4096) of Entity_Id;
-- This array holds the list of defining identifiers. The upper bound
Scan;
end if;
+ CompDef_Node := New_Node (N_Component_Definition, Token_Ptr);
+
if Token_Name = Name_Aliased then
Check_95_Keyword (Tok_Aliased, Tok_Identifier);
end if;
if Token = Tok_Aliased then
Scan; -- past ALIASED
- Set_Aliased_Present (Decl_Node, True);
+ Set_Aliased_Present (CompDef_Node, True);
end if;
if Token = Tok_Array then
raise Error_Resync;
end if;
- Set_Subtype_Indication (Decl_Node, P_Subtype_Indication);
- Set_Expression (Decl_Node, Init_Expr_Opt);
+ Set_Subtype_Indication (CompDef_Node, P_Subtype_Indication);
+ Set_Component_Definition (Decl_Node, CompDef_Node);
+ Set_Expression (Decl_Node, Init_Expr_Opt);
if Ident > 1 then
Set_Prev_Ids (Decl_Node, True);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, 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- --
N_Compilation_Unit_Aux |
N_Component_Association |
N_Component_Clause |
+ N_Component_Definition |
N_Component_List |
N_Constrained_Array_Definition |
N_Decimal_Fixed_Point_Definition |
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, 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- --
begin
Generate_Definition (Id);
Enter_Name (Id);
- T := Find_Type_Of_Object (Subtype_Indication (N), N);
+ T := Find_Type_Of_Object (Subtype_Indication (Component_Definition (N)),
+ N);
-- If the subtype is a constrained subtype of the enclosing record,
-- (which must have a partial view) the back-end does not handle
-- removed from discriminant constraints.
if Ekind (T) = E_Access_Subtype
- and then Is_Entity_Name (Subtype_Indication (N))
+ and then Is_Entity_Name (Subtype_Indication (Component_Definition (N)))
and then Comes_From_Source (T)
and then Nkind (Parent (T)) = N_Subtype_Declaration
and then Etype (Directly_Designated_Type (T)) = Current_Scope
then
Rewrite
- (Subtype_Indication (N),
+ (Subtype_Indication (Component_Definition (N)),
New_Copy_Tree (Subtype_Indication (Parent (T))));
- T := Find_Type_Of_Object (Subtype_Indication (N), N);
+ T := Find_Type_Of_Object
+ (Subtype_Indication (Component_Definition (N)), N);
end if;
-- If the component declaration includes a default expression, then we
if Is_Indefinite_Subtype (T) and then Chars (Id) /= Name_uParent then
Error_Msg_N
("unconstrained subtype in component declaration",
- Subtype_Indication (N));
+ Subtype_Indication (Component_Definition (N)));
-- Components cannot be abstract, except for the special case of
-- the _Parent field (case of extending an abstract tagged type)
end if;
Set_Etype (Id, T);
- Set_Is_Aliased (Id, Aliased_Present (N));
+ Set_Is_Aliased (Id, Aliased_Present (Component_Definition (N)));
- -- If the this component is private (or depends on a private type),
+ -- If this component is private (or depends on a private type),
-- flag the record type to indicate that some operations are not
-- available.
----------------------------
procedure Array_Type_Declaration (T : in out Entity_Id; Def : Node_Id) is
- Component_Def : constant Node_Id := Subtype_Indication (Def);
+ Component_Def : constant Node_Id := Component_Definition (Def);
Element_Type : Entity_Id;
Implicit_Base : Entity_Id;
Index : Node_Id;
Nb_Index := Nb_Index + 1;
end loop;
- Element_Type := Process_Subtype (Component_Def, P, Related_Id, 'C');
+ Element_Type := Process_Subtype (Subtype_Indication (Component_Def),
+ P, Related_Id, 'C');
-- Constrained array case
Set_Component_Type (Base_Type (T), Element_Type);
- if Aliased_Present (Def) then
+ if Aliased_Present (Component_Definition (Def)) then
Set_Has_Aliased_Components (Etype (T));
end if;
if Is_Indefinite_Subtype (Element_Type) then
Error_Msg_N
- ("unconstrained element type in array declaration ",
- Component_Def);
+ ("unconstrained element type in array declaration",
+ Subtype_Indication (Component_Def));
elsif Is_Abstract (Element_Type) then
- Error_Msg_N ("The type of a component cannot be abstract ",
- Component_Def);
+ Error_Msg_N
+ ("The type of a component cannot be abstract",
+ Subtype_Indication (Component_Def));
end if;
end Array_Type_Declaration;
Discr_Con_Elist : Elist_Id;
Discr_Con_El : Elmt_Id;
- Subt : Entity_Id;
+ Subt : Entity_Id;
begin
-- Set the designated type so it is available in case this is
-- an access to a self-referential type, e.g. a standard list
-- type with a next pointer. Will be reset after subtype is built.
- Set_Directly_Designated_Type (Derived_Type,
- Designated_Type (Parent_Type));
+ Set_Directly_Designated_Type
+ (Derived_Type, Designated_Type (Parent_Type));
Subt := Process_Subtype (S, N);
if Discrim_Present then
null;
- elsif Nkind (Parent (Def)) = N_Component_Declaration
+ elsif Nkind (Parent (Parent (Def))) = N_Component_Declaration
and then
Has_Per_Object_Constraint
- (Defining_Identifier (Parent (Def)))
+ (Defining_Identifier (Parent (Parent (Def))))
then
null;
Related_Nod : Node_Id) return Entity_Id
is
Def_Kind : constant Node_Kind := Nkind (Obj_Def);
- P : constant Node_Id := Parent (Obj_Def);
+ P : Node_Id := Parent (Obj_Def);
T : Entity_Id;
Nam : Name_Id;
begin
+ -- If the parent is a component_definition node we climb to the
+ -- component_declaration node
+
+ if Nkind (P) = N_Component_Definition then
+ P := Parent (P);
+ end if;
+
-- Case of an anonymous array subtype
if Def_Kind = N_Constrained_Array_Definition
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, 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- --
Set_Is_Immediately_Visible (Id, False);
+ -- If this is a private type with a full view (for example a local
+ -- subtype of a private type declared elsewhere), ensure that the
+ -- full view is also removed from visibility: it may be exposed when
+ -- swapping views in an instantiation.
+
+ if Is_Type (Id)
+ and then Present (Full_View (Id))
+ then
+ Set_Is_Immediately_Visible (Full_View (Id), False);
+ end if;
+
if Is_Tagged_Type (Id) and then Ekind (Id) = E_Record_Type then
Check_Abstract_Overriding (Id);
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, 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- --
Defining_Identifier =>
Make_Defining_Identifier (Loc,
Chars => Name_Ras),
- Subtype_Indication =>
- New_Occurrence_Of
- (RTE (RE_Unsigned_64), Loc)),
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Occurrence_Of (RTE (RE_Unsigned_64), Loc))),
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc,
Chars => Name_Origin),
- Subtype_Indication =>
- New_Reference_To
- (Standard_Integer,
- Loc)),
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Reference_To
+ (Standard_Integer, Loc))),
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc,
Chars => Name_Receiver),
- Subtype_Indication =>
- New_Reference_To
- (RTE (RE_Unsigned_64), Loc)),
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Reference_To
+ (RTE (RE_Unsigned_64), Loc))),
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc,
Chars => Name_Subp_Id),
- Subtype_Indication =>
- New_Reference_To
- (Standard_Natural,
- Loc)),
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Reference_To
+ (Standard_Natural, Loc))),
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc,
Chars => Name_Async),
- Subtype_Indication =>
- New_Reference_To
- (Standard_Boolean,
- Loc))))));
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Reference_To
+ (Standard_Boolean, Loc)))))));
Insert_After (N, New_Type_Decl);
Set_Equivalent_Type (User_Type, Fat_Type);
declare
Sindic : constant Node_Id :=
- Subtype_Indication (Comp);
+ Subtype_Indication (Component_Definition (Comp));
begin
if Nkind (Sindic) = N_Subtype_Indication then
if Nkind (P) = N_Range_Constraint
and then Nkind (Parent (P)) = N_Subtype_Indication
- and then Nkind (Parent (Parent (P))) = N_Component_Declaration
+ and then Nkind (Parent (Parent (P))) = N_Component_Definition
then
Error_Msg_N ("discriminant cannot constrain scalar type", N);
and then not
(Nkind (Parent (P)) = N_Subtype_Indication
and then
- (Nkind (Parent (Parent (P))) = N_Component_Declaration
+ (Nkind (Parent (Parent (P))) = N_Component_Definition
or else Nkind (Parent (Parent (P))) = N_Subtype_Declaration)
and then Paren_Count (N) = 0)
then
if (Nkind (P) = N_Subtype_Indication
and then
- (Nkind (Parent (P)) = N_Component_Declaration
+ (Nkind (Parent (P)) = N_Component_Definition
or else
Nkind (Parent (P)) = N_Derived_Type_Definition)
and then D = Constraint (P))
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, 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- --
------------------------------
function Has_Dependent_Constraint (Comp : Entity_Id) return Boolean is
- Comp_Decl : constant Node_Id := Parent (Comp);
- Subt_Indic : constant Node_Id := Subtype_Indication (Comp_Decl);
+ Comp_Decl : constant Node_Id := Parent (Comp);
+ Subt_Indic : constant Node_Id :=
+ Subtype_Indication (Component_Definition (Comp_Decl));
Constr : Node_Id;
Assn : Node_Id;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, 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- --
(N : Node_Id) return Boolean is
begin
pragma Assert (False
- or else NT (N).Nkind = N_Component_Declaration
- or else NT (N).Nkind = N_Constrained_Array_Definition
- or else NT (N).Nkind = N_Object_Declaration
- or else NT (N).Nkind = N_Unconstrained_Array_Definition);
+ or else NT (N).Nkind = N_Component_Definition
+ or else NT (N).Nkind = N_Object_Declaration);
return Flag4 (N);
end Aliased_Present;
return List3 (N);
end Component_Clauses;
+ function Component_Definition
+ (N : Node_Id) return Node_Id is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Component_Declaration
+ or else NT (N).Nkind = N_Constrained_Array_Definition
+ or else NT (N).Nkind = N_Unconstrained_Array_Definition);
+ return Node4 (N);
+ end Component_Definition;
+
function Component_Items
(N : Node_Id) return List_Id is
begin
begin
pragma Assert (False
or else NT (N).Nkind = N_Access_To_Object_Definition
- or else NT (N).Nkind = N_Component_Declaration
- or else NT (N).Nkind = N_Constrained_Array_Definition
+ or else NT (N).Nkind = N_Component_Definition
or else NT (N).Nkind = N_Derived_Type_Definition
or else NT (N).Nkind = N_Private_Extension_Declaration
- or else NT (N).Nkind = N_Subtype_Declaration
- or else NT (N).Nkind = N_Unconstrained_Array_Definition);
+ or else NT (N).Nkind = N_Subtype_Declaration);
return Node5 (N);
end Subtype_Indication;
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
- or else NT (N).Nkind = N_Component_Declaration
- or else NT (N).Nkind = N_Constrained_Array_Definition
- or else NT (N).Nkind = N_Object_Declaration
- or else NT (N).Nkind = N_Unconstrained_Array_Definition);
+ or else NT (N).Nkind = N_Component_Definition
+ or else NT (N).Nkind = N_Object_Declaration);
Set_Flag4 (N, Val);
end Set_Aliased_Present;
Set_List3_With_Parent (N, Val);
end Set_Component_Clauses;
+ procedure Set_Component_Definition
+ (N : Node_Id; Val : Node_Id) is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Component_Declaration
+ or else NT (N).Nkind = N_Constrained_Array_Definition
+ or else NT (N).Nkind = N_Unconstrained_Array_Definition);
+ Set_Node4_With_Parent (N, Val);
+ end Set_Component_Definition;
+
procedure Set_Component_Items
(N : Node_Id; Val : List_Id) is
begin
begin
pragma Assert (False
or else NT (N).Nkind = N_Access_To_Object_Definition
- or else NT (N).Nkind = N_Component_Declaration
- or else NT (N).Nkind = N_Constrained_Array_Definition
+ or else NT (N).Nkind = N_Component_Definition
or else NT (N).Nkind = N_Derived_Type_Definition
or else NT (N).Nkind = N_Private_Extension_Declaration
- or else NT (N).Nkind = N_Subtype_Declaration
- or else NT (N).Nkind = N_Unconstrained_Array_Definition);
+ or else NT (N).Nkind = N_Subtype_Declaration);
Set_Node5_With_Parent (N, Val);
end Set_Subtype_Indication;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, 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- --
-- N_Unconstrained_Array_Definition
-- Sloc points to ARRAY
-- Subtype_Marks (List2)
- -- Aliased_Present (Flag4) from component definition
- -- Subtype_Indication (Node5) from component definition
+ -- Component_Definition (Node4)
-----------------------------------
-- 3.6 Index Subtype Definition --
-- N_Constrained_Array_Definition
-- Sloc points to ARRAY
-- Discrete_Subtype_Definitions (List2)
- -- Aliased_Present (Flag4) from component definition
- -- Subtype_Indication (Node5) from component definition
+ -- Component_Definition (Node4)
--------------------------------------
-- 3.6 Discrete Subtype Definition --
-- COMPONENT_DEFINITION ::= [aliased] SUBTYPE_INDICATION
- -- There is no explicit node in the tree for a component definition.
- -- Instead the subtype indication appears directly, and the ALIASED
- -- indication (Aliased_Present flag) is in the parent node.
-
-- Note: although the syntax does not permit a component definition to
-- be an anonymous array (and the parser will diagnose such an attempt
-- with an appropriate message), it is possible for anonymous arrays
-- to appear as component definitions. The semantics and back end handle
-- this case properly, and the expander in fact generates such cases.
+ -- N_Component_Definition
+ -- Sloc points to ALIASED or to first token of subtype mark
+ -- Aliased_Present (Flag4)
+ -- Subtype_Indication (Node5)
+
-----------------------------
-- 3.6.1 Index Constraint --
-----------------------------
-- N_Component_Declaration
-- Sloc points to first identifier
-- Defining_Identifier (Node1)
- -- Aliased_Present (Flag4) from component definition
- -- Subtype_Indication (Node5) from component definition
+ -- Component_Definition (Node4)
-- Expression (Node3) (set to Empty if no default expression)
-- More_Ids (Flag5) (set to False if no more identifiers in list)
-- Prev_Ids (Flag6) (set to False if no previous identifiers in list)
N_Compilation_Unit,
N_Compilation_Unit_Aux,
N_Component_Association,
+ N_Component_Definition,
N_Component_List,
N_Derived_Type_Definition,
N_Decimal_Fixed_Point_Definition,
function Component_Clauses
(N : Node_Id) return List_Id; -- List3
+ function Component_Definition
+ (N : Node_Id) return Node_Id; -- Node4
+
function Component_Items
(N : Node_Id) return List_Id; -- List3
procedure Set_Component_Clauses
(N : Node_Id; Val : List_Id); -- List3
+ procedure Set_Component_Definition
+ (N : Node_Id; Val : Node_Id); -- Node4
+
procedure Set_Component_Items
(N : Node_Id; Val : List_Id); -- List3
pragma Inline (Compile_Time_Known_Aggregate);
pragma Inline (Component_Associations);
pragma Inline (Component_Clauses);
+ pragma Inline (Component_Definition);
pragma Inline (Component_Items);
pragma Inline (Component_List);
pragma Inline (Component_Name);
pragma Inline (Set_Compile_Time_Known_Aggregate);
pragma Inline (Set_Component_Associations);
pragma Inline (Set_Component_Clauses);
+ pragma Inline (Set_Component_Definition);
pragma Inline (Set_Component_Items);
pragma Inline (Set_Component_List);
pragma Inline (Set_Component_Name);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, 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- --
Sprint_Node (Last_Bit (Node));
Write_Char (';');
+ when N_Component_Definition =>
+ Set_Debug_Sloc;
+ if Aliased_Present (Node) then
+ Write_Str_With_Col_Check ("aliased ");
+ end if;
+ Sprint_Node (Subtype_Indication (Node));
+
when N_Component_Declaration =>
if Write_Indent_Identifiers_Sloc (Node) then
Write_Str (" : ");
-
- if Aliased_Present (Node) then
- Write_Str_With_Col_Check ("aliased ");
- end if;
-
- Sprint_Node (Subtype_Indication (Node));
+ Sprint_Node (Component_Definition (Node));
if Present (Expression (Node)) then
Write_Str (" := ");
Sprint_Paren_Comma_List (Discrete_Subtype_Definitions (Node));
Write_Str (" of ");
- if Aliased_Present (Node) then
- Write_Str_With_Col_Check ("aliased ");
- end if;
-
- Sprint_Node (Subtype_Indication (Node));
+ Sprint_Node (Component_Definition (Node));
when N_Decimal_Fixed_Point_Definition =>
Write_Str_With_Col_Check_Sloc (" delta ");
end;
Write_Str (") of ");
-
- if Aliased_Present (Node) then
- Write_Str_With_Col_Check ("aliased ");
- end if;
-
- Sprint_Node (Subtype_Indication (Node));
+ Sprint_Node (Component_Definition (Node));
when N_Unused_At_Start | N_Unused_At_End =>
Write_Indent_Str ("***** Error, unused node encountered *****");
case N_Expanded_Name:
case N_Attribute_Reference:
if (Is_Eliminated (Entity (Name (gnat_node))))
- post_error_ne ("cannot call eliminated subprogram &!",
- gnat_node, Entity (Name (gnat_node)));
- }
+ Eliminate_Error_Msg (gnat_node, Entity (Name (gnat_node)));
+ }
if (TREE_CODE (gnu_subprog_type) != FUNCTION_TYPE)
gigi_abort (317);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, 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- --
Write_Switch_Char ("wxx");
Write_Line ("Enable selected warning modes, xx = list of parameters:");
- Write_Line (" a turn on all optional warnings (except b,d,h,l)");
+ Write_Line (" a turn on all optional warnings (except d,h,l)");
Write_Line (" A turn off all optional warnings");
Write_Line (" c turn on warnings for constant conditional");
Write_Line (" C* turn off warnings for constant conditional");
projects / thirdparty / gcc.git / commitdiff
