[multiple changes]

2004-01-12  Laurent Pautet  <pautet@act-europe.fr>

	* 3vsocthi.adb, 3vsocthi.ads, 3wsocthi.adb,
	3wsocthi.ads, 3zsocthi.adb, 3zsocthi.ads, g-socthi.adb,
	g-socthi.ads (Socket_Error_Message): Return C.Strings.chars_ptr
	instead of String.

	* g-socket.adb (Raise_Socket_Error): Use new Socket_Error_Message
	signature.

2004-01-12  Javier Miranda  <miranda@gnat.com>

	* cstand.adb, exp_aggr.adb, exp_ch3.adb, exp_ch9.adb, exp_dist.adb,
	exp_imgv.adb, exp_pakd.adb, exp_util.adb, par-ch3.adb, sem.adb,
	sem_ch3.adb, sem_dist.adb, sem_prag.adb, sem_res.adb,
	sem_util.adb, sinfo.adb, sinfo.ads, sprint.adb: Addition of
	Component_Definition node.

2004-01-12  Ed Falis  <falis@gnat.com>

	* impunit.adb: Add GNAT.Secondary_Stack_Info as user-visible unit

2004-01-12  Thomas Quinot  <quinot@act-europe.fr>

	* link.c: Change default libgnat kind to STATIC for FreeBSD.

2004-01-12  Ed Schonberg  <schonberg@gnat.com>

	* lib-xref.adb (Get_Type_Reference): If the type is the subtype entity
	generated to rename a generic actual, go to the actual itself, the
	subtype is not a user-visible entity.

	* sem_ch7.adb (Uninstall_Declarations): If an entity in the visible
	part is a private subtype, reset the visibility of its full view, if
	any, to be consistent.

2004-01-12  Robert Dewar  <dewar@gnat.com>

	* trans.c (Eliminate_Error_Msg): New procedure called to generate msg

	* usage.adb: Remove mention of obsolete -gnatwb switch
	Noticed during code reading

2004-01-12  Jerome Guitton  <guitton@act-europe.fr>

	* 1ssecsta.adb: Minor changes for -gnatwa warnings

2004-01-12  GNAT Script  <nobody@gnat.com>

	* Make-lang.in: Makefile automatically updated

From-SVN: r75714
This commit is contained in:
Arnaud Charlet 2004-01-12 12:45:26 +01:00
parent 16bf3959da
commit a397db9637
35 changed files with 889 additions and 763 deletions

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -94,7 +94,7 @@ package body System.Secondary_Stack is
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;
-------------

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -58,33 +58,32 @@ package body GNAT.Sockets.Thin is
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
@ -93,8 +92,7 @@ package body GNAT.Sockets.Thin is
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
@ -116,8 +114,7 @@ package body GNAT.Sockets.Thin is
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;
@ -130,8 +127,7 @@ package body GNAT.Sockets.Thin is
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;
@ -170,8 +166,7 @@ package body GNAT.Sockets.Thin is
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;
@ -231,10 +226,9 @@ package body GNAT.Sockets.Thin is
-------------
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
@ -256,8 +250,7 @@ package body GNAT.Sockets.Thin is
(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;
@ -284,8 +277,7 @@ package body GNAT.Sockets.Thin is
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;
@ -310,8 +302,7 @@ package body GNAT.Sockets.Thin is
(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;
@ -338,8 +329,7 @@ package body GNAT.Sockets.Thin is
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;
@ -363,8 +353,7 @@ package body GNAT.Sockets.Thin is
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;
@ -412,7 +401,6 @@ package body GNAT.Sockets.Thin is
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);
@ -424,10 +412,7 @@ package body GNAT.Sockets.Thin is
-- 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;
@ -436,10 +421,7 @@ package body GNAT.Sockets.Thin is
-- 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;
@ -448,13 +430,9 @@ package body GNAT.Sockets.Thin is
-- 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;
@ -480,10 +458,7 @@ package body GNAT.Sockets.Thin is
-- 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;
@ -492,7 +467,9 @@ package body GNAT.Sockets.Thin is
-- 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;
@ -501,10 +478,9 @@ package body GNAT.Sockets.Thin is
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;
@ -515,8 +491,7 @@ package body GNAT.Sockets.Thin is
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;
@ -548,8 +523,7 @@ package body GNAT.Sockets.Thin is
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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -60,7 +60,7 @@ package GNAT.Sockets.Thin is
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".

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -38,6 +38,7 @@
-- 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;
@ -71,6 +72,166 @@ package body GNAT.Sockets.Thin is
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 --
---------------
@ -366,165 +527,60 @@ package body GNAT.Sockets.Thin is
-- 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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -60,7 +60,9 @@ package GNAT.Sockets.Thin is
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".
@ -177,10 +179,10 @@ package GNAT.Sockets.Thin is
-- 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
@ -196,102 +198,85 @@ package GNAT.Sockets.Thin is
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;
@ -299,23 +284,20 @@ package GNAT.Sockets.Thin is
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;
@ -323,55 +305,46 @@ package GNAT.Sockets.Thin is
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
@ -391,8 +364,7 @@ package GNAT.Sockets.Thin is
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
@ -405,8 +377,7 @@ package GNAT.Sockets.Thin is
-- 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.

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -63,6 +63,9 @@ package body GNAT.Sockets.Thin is
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".
@ -588,7 +591,9 @@ package body GNAT.Sockets.Thin is
-- 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;
@ -597,9 +602,10 @@ package body GNAT.Sockets.Thin is
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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -59,7 +59,7 @@ package GNAT.Sockets.Thin is
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".

View File

@ -1391,14 +1391,14 @@ ada/checks.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.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/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 \
@ -1555,14 +1555,14 @@ ada/exp_aggr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.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/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 \
@ -1679,23 +1679,19 @@ ada/exp_ch2.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.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 \
@ -1749,16 +1745,17 @@ ada/exp_ch5.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.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 \
@ -1969,13 +1966,13 @@ ada/exp_fixd.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.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_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 \
@ -2132,14 +2129,14 @@ ada/exp_util.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.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 \
@ -2870,34 +2867,31 @@ ada/sem.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
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 \
@ -3010,36 +3004,33 @@ ada/sem_ch11.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
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 \
@ -3100,17 +3091,17 @@ ada/sem_ch3.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.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 \
@ -3142,65 +3133,61 @@ ada/sem_ch4.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.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 \

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -559,7 +559,14 @@ package body CStand is
-- 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);
@ -581,7 +588,15 @@ package body CStand is
-- 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);
@ -1119,7 +1134,11 @@ package body CStand is
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);

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -3062,8 +3062,11 @@ package body Exp_Aggr is
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);

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -1937,7 +1937,8 @@ package body Exp_Ch3 is
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);
@ -2725,7 +2726,10 @@ package body Exp_Ch3 is
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,
@ -3302,7 +3306,10 @@ package body Exp_Ch3 is
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))
@ -3393,8 +3400,10 @@ package body Exp_Ch3 is
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))
@ -3410,7 +3419,7 @@ package body Exp_Ch3 is
-- 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 =>
@ -3579,7 +3588,10 @@ package body Exp_Ch3 is
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,

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -2611,8 +2611,11 @@ package body Exp_Ch9 is
(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;
@ -2623,17 +2626,21 @@ package body Exp_Ch9 is
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);
@ -3265,14 +3272,19 @@ package body Exp_Ch9 is
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,
@ -4668,7 +4680,10 @@ package body Exp_Ch9 is
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;
@ -5227,8 +5242,10 @@ package body Exp_Ch9 is
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));
@ -5246,8 +5263,13 @@ package body Exp_Ch9 is
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);
@ -7175,7 +7197,11 @@ package body Exp_Ch9 is
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
@ -7216,7 +7242,11 @@ package body Exp_Ch9 is
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;
@ -7231,7 +7261,11 @@ package body Exp_Ch9 is
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),
@ -7249,8 +7283,11 @@ package body Exp_Ch9 is
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 (

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -1886,26 +1886,38 @@ package body Exp_Dist is
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);

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -140,7 +140,10 @@ package body Exp_Imgv is
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,

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -958,15 +958,21 @@ package body Exp_Pakd is
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 :=

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -2009,6 +2009,7 @@ package body Exp_Util is
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 |
@ -2813,13 +2814,22 @@ package body Exp_Util is
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);

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -1403,7 +1403,8 @@ package body GNAT.Sockets is
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;
----------

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -44,8 +44,8 @@ with Interfaces.C; use Interfaces.C;
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
@ -62,33 +62,32 @@ package body GNAT.Sockets.Thin is
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
@ -97,16 +96,14 @@ package body GNAT.Sockets.Thin is
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
@ -115,13 +112,13 @@ package body GNAT.Sockets.Thin is
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;
@ -134,8 +131,7 @@ package body GNAT.Sockets.Thin is
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;
@ -174,8 +170,7 @@ package body GNAT.Sockets.Thin is
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;
@ -235,10 +230,9 @@ package body GNAT.Sockets.Thin is
-------------
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
@ -260,8 +254,7 @@ package body GNAT.Sockets.Thin is
(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;
@ -288,8 +281,7 @@ package body GNAT.Sockets.Thin is
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;
@ -314,8 +306,7 @@ package body GNAT.Sockets.Thin is
(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;
@ -342,8 +333,7 @@ package body GNAT.Sockets.Thin is
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;
@ -367,8 +357,7 @@ package body GNAT.Sockets.Thin is
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;
@ -416,7 +405,6 @@ package body GNAT.Sockets.Thin is
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);
@ -433,7 +421,7 @@ package body GNAT.Sockets.Thin is
Address : In_Addr)
is
begin
Sin.Sin_Addr := Address;
Sin.Sin_Addr := Address;
end Set_Address;
----------------
@ -496,7 +484,9 @@ package body GNAT.Sockets.Thin is
-- 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;
@ -505,10 +495,10 @@ package body GNAT.Sockets.Thin is
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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -61,7 +61,7 @@ package GNAT.Sockets.Thin is
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".
@ -198,100 +198,85 @@ package GNAT.Sockets.Thin is
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;
@ -299,23 +284,20 @@ package GNAT.Sockets.Thin is
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;
@ -323,47 +305,39 @@ package GNAT.Sockets.Thin is
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);
@ -386,8 +360,7 @@ package GNAT.Sockets.Thin is
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
@ -400,8 +373,7 @@ package GNAT.Sockets.Thin is
-- 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.

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -229,6 +229,7 @@ package body Impunit is
"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

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -604,9 +604,7 @@ package body Lib.Xref is
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);
@ -651,6 +649,19 @@ package body Lib.Xref is
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;

View File

@ -157,7 +157,7 @@ const char *object_library_extension = ".a";
#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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -2018,10 +2018,11 @@ package body Ch3 is
-- 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;
@ -2079,12 +2080,16 @@ package body Ch3 is
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;
@ -2728,11 +2733,12 @@ package body Ch3 is
-- 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
@ -2783,13 +2789,15 @@ package body Ch3 is
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
@ -2797,8 +2805,9 @@ package body Ch3 is
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);

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -574,6 +574,7 @@ package body Sem is
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 |

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -906,7 +906,8 @@ package body Sem_Ch3 is
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
@ -916,15 +917,16 @@ package body Sem_Ch3 is
-- 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
@ -944,7 +946,7 @@ package body Sem_Ch3 is
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)
@ -954,9 +956,9 @@ package body Sem_Ch3 is
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.
@ -2727,7 +2729,7 @@ package body Sem_Ch3 is
----------------------------
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;
@ -2764,7 +2766,8 @@ package body Sem_Ch3 is
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
@ -2830,7 +2833,7 @@ package body Sem_Ch3 is
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;
@ -2874,12 +2877,13 @@ package body Sem_Ch3 is
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;
@ -2900,15 +2904,15 @@ package body Sem_Ch3 is
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);
@ -5592,10 +5596,10 @@ package body Sem_Ch3 is
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;
@ -9525,11 +9529,18 @@ package body Sem_Ch3 is
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

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -1652,6 +1652,17 @@ package body Sem_Ch7 is
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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -427,44 +427,55 @@ package body Sem_Dist is
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);

View File

@ -9375,7 +9375,7 @@ package body Sem_Prag is
declare
Sindic : constant Node_Id :=
Subtype_Indication (Comp);
Subtype_Indication (Component_Definition (Comp));
begin
if Nkind (Sindic) = N_Subtype_Indication then

View File

@ -382,7 +382,7 @@ package body Sem_Res is
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);
@ -409,7 +409,7 @@ package body Sem_Res is
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
@ -559,7 +559,7 @@ package body Sem_Res is
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))

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -3219,8 +3219,9 @@ package body Sem_Util is
------------------------------
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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -170,10 +170,8 @@ package body Sinfo is
(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;
@ -376,6 +374,16 @@ package body Sinfo is
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
@ -2293,12 +2301,10 @@ package body Sinfo is
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;
@ -2612,10 +2618,8 @@ package body Sinfo is
(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;
@ -2818,6 +2822,16 @@ package body Sinfo is
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
@ -4725,12 +4739,10 @@ package body Sinfo is
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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -2275,8 +2275,7 @@ package Sinfo is
-- 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 --
@ -2304,8 +2303,7 @@ package Sinfo is
-- 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 --
@ -2320,16 +2318,17 @@ package Sinfo is
-- 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 --
-----------------------------
@ -2537,8 +2536,7 @@ package Sinfo is
-- 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)
@ -6651,6 +6649,7 @@ package Sinfo is
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,
@ -6968,6 +6967,9 @@ package Sinfo is
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
@ -7748,6 +7750,9 @@ package Sinfo is
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
@ -8471,6 +8476,7 @@ package Sinfo is
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);
@ -8728,6 +8734,7 @@ package Sinfo is
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);

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -949,15 +949,17 @@ package body Sprint is
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 (" := ");
@ -1010,11 +1012,7 @@ package body Sprint is
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 ");
@ -2439,12 +2437,7 @@ package body Sprint is
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 *****");

View File

@ -2805,9 +2805,8 @@ tree_transform (Node_Id gnat_node)
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);

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -339,7 +339,7 @@ begin
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");