+2009-05-06 Gary Dismukes <dismukes@adacore.com>
+
+ * sem_aggr.adb (Resolve_Record_Aggregate): In step 5, get the
+ Underlying_Type before retrieving the type definition for gathering
+ components, to account for the case where the type is private.
+
+2009-05-06 Tristan Gingold <gingold@adacore.com>
+
+ * g-comlin.ads: Fix minor typos (Getopt instead of Get_Opt).
+
+2009-05-06 Thomas Quinot <quinot@adacore.com>
+
+ * g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb,
+ g-socthi-vxworks.ads, g-socthi-mingw.adb g-socthi-mingw.ads,
+ g-socthi.adb, g-stsifd-sockets.adb, g-socthi.ads, g-socket.adb
+ (GNAT.Sockets.Thin.C_Sendmsg, GNAT.Sockets.Thin.C_Recvmsg,
+ Windows versions): Fix incorrect base
+ address of Iovec (it's Msg_Iov, not Msg_Iov'Address).
+ (GNAT.Sockets.Thin.C_Sendto, GNAT.Sockets.Thin.C_Recvfrom): Use a
+ System.Address for the To parameter instead of a Sockaddr_In_Access, to
+ achieve independance from AF_INET family, and also to allow this
+ parameter to be retrieved from a Msghdr for the Windows case where
+ these routines are used to implement C_Sendmsg and C_Recvmsg.
+
+2009-05-06 Bob Duff <duff@adacore.com>
+
+ * g-expect.adb, g-expect.ads: Minor reformatting
+
+ * sdefault.ads: Minor comment fix
+
+ * g-expect-vms.adb: Minor reformatting
+
+ * table.ads, table.adb (Append_All): New convenience procedure for
+ appending a whole array.
+
+ * comperr.adb (Compiler_Abort): Mention the -gnatd.n switch in the bug
+ box message. Call Osint.Dump_Source_File_Names to print out the file
+ list, instead of rummaging around in various data structures.
+
+ * debug.adb: New switch -gnatd.n, to print source file names as they
+ are read.
+
+ * alloc.ads: Add parameters for Osint.File_Name_Chars.
+
+ * osint.ads, osint.adb (Dump_Source_File_Names): New procedure to print
+ out source file names during a "bug box".
+ (Include_Dir_Default_Prefix): Use memo-izing to avoid repeated new/free.
+ (Read_Source_File): Print out the file name, if requested via -gnatd.n.
+ If it's not part of the runtimes, store it for later printing by
+ Dump_Source_File_Names.
+
+2009-05-06 Javier Miranda <miranda@adacore.com>
+
+ * gnat_rm.texi (CPP_Constructor): Avoid duplication of the
+ documentation and add reference to the GNAT user guide for further
+ details.
+
+2009-05-06 Javier Miranda <miranda@adacore.com>
+
+ * gnat_ugn.texi: Complete documentation for CPP_Constructor and remove
+ also wrong examples that use extension aggregates.
+
+2009-05-06 Albert Lee <lee@adacore.com>
+
+ * s-oscons-tmplt.c (System.OS_Constants): Do not use special definition
+ of Msg_Iovlen_T for VMS.
+
2009-05-04 Laurent GUERBY <laurent@guerby.net>
PR ada/38874
Elmts_Initial : constant := 1_200; -- Elists
Elmts_Increment : constant := 100;
+ File_Name_Chars_Initial : constant := 10_000; -- Osint
+ File_Name_Chars_Increment : constant := 100;
+
Inlined_Bodies_Initial : constant := 50; -- Inline
Inlined_Bodies_Increment : constant := 200;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
with Atree; use Atree;
with Debug; use Debug;
with Errout; use Errout;
-with Fname; use Fname;
with Gnatvsn; use Gnatvsn;
-with Lib; use Lib;
with Namet; use Namet;
with Osint; use Osint;
with Output; use Output;
Write_Line ("Note that list may not be accurate in some cases, ");
Write_Line ("so please double check that the problem can still ");
Write_Line ("be reproduced with the set of files listed.");
+ Write_Line ("Consider also -gnatd.n switch (see debug.adb).");
Write_Eol;
- for U in Main_Unit .. Last_Unit loop
- begin
- if not Is_Internal_File_Name
- (File_Name (Source_Index (U)))
- then
- Write_Name (Full_File_Name (Source_Index (U)));
- Write_Eol;
- end if;
+ begin
+ Dump_Source_File_Names;
- -- No point in double bug box if we blow up trying to print
- -- the list of file names! Output informative msg and quit.
+ -- If we blow up trying to print the list of file names, just output
+ -- informative msg and continue.
- exception
- when others =>
- Write_Str ("list may be incomplete");
- exit;
- end;
- end loop;
+ exception
+ when others =>
+ Write_Str ("list may be incomplete");
+ end;
Write_Eol;
Set_Standard_Output;
-- d.k
-- d.l Use Ada 95 semantics for limited function returns
-- d.m For -gnatl, print full source only for main unit
- -- d.n
+ -- d.n Print source file names
-- d.o
-- d.p
-- d.q
-- main source (this corresponds to a previous behavior of -gnatl and
-- is used for running the ACATS tests).
+ -- d.n Print source file names as they are loaded. This is useful if the
+ -- compiler has a bug -- these are the files that need to be included
+ -- in a bug report.
+
-- d.r Forces the flag OK_To_Reorder_Components to be set in all record
-- base types that have no discriminants.
-- --
-- S p e c --
-- --
--- Copyright (C) 1999-2008, AdaCore --
+-- Copyright (C) 1999-2009, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- Goto_Section ("bargs");
-- loop
-- -- Same loop as above to get switches and arguments
--- -- The supported switches in Get_Opt might be different
+-- -- The supported switches in Getopt might be different
-- end loop;
-- Goto_Section ("cargs");
-- loop
-- -- Same loop as above to get switches and arguments
--- -- The supported switches in Get_Opt might be different
+-- -- The supported switches in Getopt might be different
-- end loop;
-- end;
-- GNAT.OS_Lib.Argument_String_To_List ("-g -O1 -Ipath");
-- begin
-- Initialize_Option_Scan (Parser, Args);
--- while Get_Opt ("* g O! I=", Parser) /= ASCII.NUL loop
+-- while Getopt ("* g O! I=", Parser) /= ASCII.NUL loop
-- Put_Line ("Switch " & Full_Switch (Parser)
-- & " param=" & Parameter (Parser));
-- end loop;
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2008, AdaCore --
+-- Copyright (C) 2002-2009, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
(Descriptor : in out Process_Descriptor;
Result : out Expect_Match;
Regexp : String;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
begin
Result : out Expect_Match;
Regexp : String;
Matched : out GNAT.Regpat.Match_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
begin
(Descriptor : in out Process_Descriptor;
Result : out Expect_Match;
Regexp : GNAT.Regpat.Pattern_Matcher;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
Matched : GNAT.Regpat.Match_Array (0 .. 0);
Result : out Expect_Match;
Regexp : GNAT.Regpat.Pattern_Matcher;
Matched : out GNAT.Regpat.Match_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
N : Expect_Match;
(Descriptor : in out Process_Descriptor;
Result : out Expect_Match;
Regexps : Regexp_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
Patterns : Compiled_Regexp_Array (Regexps'Range);
(Descriptor : in out Process_Descriptor;
Result : out Expect_Match;
Regexps : Compiled_Regexp_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
Matched : GNAT.Regpat.Match_Array (0 .. 0);
procedure Expect
(Result : out Expect_Match;
Regexps : Multiprocess_Regexp_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
Matched : GNAT.Regpat.Match_Array (0 .. 0);
Result : out Expect_Match;
Regexps : Regexp_Array;
Matched : out GNAT.Regpat.Match_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
Patterns : Compiled_Regexp_Array (Regexps'Range);
Result : out Expect_Match;
Regexps : Compiled_Regexp_Array;
Matched : out GNAT.Regpat.Match_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
N : Expect_Match;
(Result : out Expect_Match;
Regexps : Multiprocess_Regexp_Array;
Matched : out GNAT.Regpat.Match_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
N : Expect_Match;
else
-- Add what we read to the buffer
- if Descriptors (J).Buffer_Index + N - 1 >
+ if Descriptors (J).Buffer_Index + N >
Descriptors (J).Buffer_Size
then
-- If the user wants to know when we have
(Descriptor : in out Process_Descriptor;
Result : out Expect_Match;
Regexp : String;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
begin
Result : out Expect_Match;
Regexp : String;
Matched : out GNAT.Regpat.Match_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
begin
(Descriptor : in out Process_Descriptor;
Result : out Expect_Match;
Regexp : GNAT.Regpat.Pattern_Matcher;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
Matched : GNAT.Regpat.Match_Array (0 .. 0);
Result : out Expect_Match;
Regexp : GNAT.Regpat.Pattern_Matcher;
Matched : out GNAT.Regpat.Match_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
N : Expect_Match;
(Descriptor : in out Process_Descriptor;
Result : out Expect_Match;
Regexps : Regexp_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
Patterns : Compiled_Regexp_Array (Regexps'Range);
(Descriptor : in out Process_Descriptor;
Result : out Expect_Match;
Regexps : Compiled_Regexp_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
Matched : GNAT.Regpat.Match_Array (0 .. 0);
procedure Expect
(Result : out Expect_Match;
Regexps : Multiprocess_Regexp_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
Matched : GNAT.Regpat.Match_Array (0 .. 0);
Result : out Expect_Match;
Regexps : Regexp_Array;
Matched : out GNAT.Regpat.Match_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
Patterns : Compiled_Regexp_Array (Regexps'Range);
Result : out Expect_Match;
Regexps : Compiled_Regexp_Array;
Matched : out GNAT.Regpat.Match_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
N : Expect_Match;
(Result : out Expect_Match;
Regexps : Multiprocess_Regexp_Array;
Matched : out GNAT.Regpat.Match_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
N : Expect_Match;
-- Non_Blocking_Spawn
-- (Fd, "ftp",
-- (1 => new String' ("machine@domain")));
--- Timeout := 10000; -- 10 seconds
+-- Timeout := 10_000; -- 10 seconds
-- Expect (Fd, Result, Regexp_Array'(+"\(user\)", +"\(passwd\)"),
-- Timeout);
-- case Result is
(Descriptor : in out Process_Descriptor;
Result : out Expect_Match;
Regexp : String;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False);
-- Wait till a string matching Fd can be read from Fd, and return 1
-- if a match was found.
(Descriptor : in out Process_Descriptor;
Result : out Expect_Match;
Regexp : GNAT.Regpat.Pattern_Matcher;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False);
-- Same as the previous one, but with a precompiled regular expression.
-- This is more efficient however, especially if you are using this
Result : out Expect_Match;
Regexp : String;
Matched : out GNAT.Regpat.Match_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False);
-- Same as above, but it is now possible to get the indexes of the
-- substrings for the parentheses in the regexp (see the example at the
Result : out Expect_Match;
Regexp : GNAT.Regpat.Pattern_Matcher;
Matched : out GNAT.Regpat.Match_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False);
-- Same as above, but with a precompiled regular expression
(Descriptor : in out Process_Descriptor;
Result : out Expect_Match;
Regexps : Regexp_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False);
-- Wait till a string matching one of the regular expressions in Regexps
-- is found. This function returns the index of the regexp that matched.
(Descriptor : in out Process_Descriptor;
Result : out Expect_Match;
Regexps : Compiled_Regexp_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False);
-- Same as the previous one, but with precompiled regular expressions.
-- This can be much faster if you are using them multiple times.
Result : out Expect_Match;
Regexps : Regexp_Array;
Matched : out GNAT.Regpat.Match_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False);
-- Same as above, except that you can also access the parenthesis
-- groups inside the matching regular expression.
Result : out Expect_Match;
Regexps : Compiled_Regexp_Array;
Matched : out GNAT.Regpat.Match_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False);
-- Same as above, but with precompiled regular expressions.
-- The first index in Matched must be 0, or Constraint_Error will be
(Result : out Expect_Match;
Regexps : Multiprocess_Regexp_Array;
Matched : out GNAT.Regpat.Match_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False);
-- Same as above, but for multi processes
procedure Expect
(Result : out Expect_Match;
Regexps : Multiprocess_Regexp_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False);
-- Same as the previous one, but for multiple processes.
-- This procedure finds the first regexp that match the associated process.
Item'Address,
Item'Length,
To_Int (Flags),
- Sin'Unchecked_Access,
+ Sin'Address,
Len'Access);
if Res = Failure then
Res : C.int;
Sin : aliased Sockaddr_In;
- C_To : Sockaddr_In_Access;
+ C_To : System.Address;
Len : C.int;
begin
Set_Port
(Sin'Unchecked_Access,
Short_To_Network (C.unsigned_short (To.Port)));
- C_To := Sin'Unchecked_Access;
+ C_To := Sin'Address;
Len := Sin'Size / 8;
else
- C_To := null;
+ C_To := System.Null_Address;
Len := 0;
end if;
for MH'Address use Msg;
Iovec : array (0 .. MH.Msg_Iovlen - 1) of Vector_Element;
- for Iovec'Address use MH.Msg_Iov'Address;
+ for Iovec'Address use MH.Msg_Iov;
pragma Import (Ada, Iovec);
- pragma Unreferenced (Flags);
-
begin
- -- Windows does not provide an implementation of recvmsg(). The
- -- spec for WSARecvMsg() is incompatible with the data types we
- -- define, and is not available in all versions of Windows. So,
- -- we'll use C_Recv instead. Note that this means the Flags
- -- argument is ignored.
+ -- Windows does not provide an implementation of recvmsg(). The spec for
+ -- WSARecvMsg() is incompatible with the data types we define, and is
+ -- not available in all versions of Windows. So, we use C_Recv instead.
for J in Iovec'Range loop
Res := C_Recv
(S,
Iovec (J).Base.all'Address,
C.int (Iovec (J).Length),
- 0);
+ Flags);
if Res < 0 then
return ssize_t (Res);
-- Check out-of-band data
Length := C_Recvfrom
- (S, Buffer'Address, 1, Flag, null, Fromlen'Unchecked_Access);
+ (S, Buffer'Address, 1, Flag,
+ From => System.Null_Address,
+ Fromlen => Fromlen'Unchecked_Access);
+ -- Is Fromlen necessary if From is Null_Address???
-- If the signal is not an out-of-band data, then it
-- is a connection failure notification.
for MH'Address use Msg;
Iovec : array (0 .. MH.Msg_Iovlen - 1) of Vector_Element;
- for Iovec'Address use MH.Msg_Iov'Address;
+ for Iovec'Address use MH.Msg_Iov;
pragma Import (Ada, Iovec);
- pragma Unreferenced (Flags);
-
begin
- -- Windows does not provide an implementation of sendmsg(). The
- -- spec for WSASendMsg() is incompatible with the data types we
- -- define, and is not available in all versions of Windows. So,
- -- we'll use C_Sendto instead. Note that this means the Flags
- -- argument is ignored.
+ -- Windows does not provide an implementation of sendmsg(). The spec for
+ -- WSASendMsg() is incompatible with the data types we define, and is
+ -- not available in all versions of Windows. So, we'll use C_Sendto
+ -- instead.
for J in Iovec'Range loop
Res := C_Sendto
(S,
Iovec (J).Base.all'Address,
C.int (Iovec (J).Length),
- Flags => 0,
- To => null,
- Tolen => 0);
+ Flags => Flags,
+ To => MH.Msg_Name,
+ Tolen => C.int (MH.Msg_Namelen));
if Res < 0 then
return ssize_t (Res);
Msg : System.Address;
Len : C.int;
Flags : C.int;
- From : Sockaddr_In_Access;
+ From : System.Address;
Fromlen : not null access C.int) return C.int;
function C_Recvmsg
Msg : System.Address;
Len : C.int;
Flags : C.int;
- To : Sockaddr_In_Access;
+ To : System.Address;
Tolen : C.int) return C.int;
function C_Setsockopt
Msg : System.Address;
Len : C.int;
Flags : C.int;
- From : Sockaddr_In_Access;
+ From : System.Address;
Fromlen : not null access C.int) return C.int;
pragma Import (C, Syscall_Recvfrom, "recvfrom");
Msg : System.Address;
Len : C.int;
Flags : C.int;
- To : Sockaddr_In_Access;
+ To : System.Address;
Tolen : C.int) return C.int;
pragma Import (C, Syscall_Sendto, "sendto");
Msg : System.Address;
Len : C.int;
Flags : C.int;
- From : Sockaddr_In_Access;
+ From : System.Address;
Fromlen : not null access C.int) return C.int
is
Res : C.int;
Msg : System.Address;
Len : C.int;
Flags : C.int;
- To : Sockaddr_In_Access;
+ To : System.Address;
Tolen : C.int) return C.int
is
Res : C.int;
Msg : System.Address;
Len : C.int;
Flags : C.int;
- From : Sockaddr_In_Access;
+ From : System.Address;
Fromlen : not null access C.int) return C.int;
function C_Recvmsg
Msg : System.Address;
Len : C.int;
Flags : C.int;
- To : Sockaddr_In_Access;
+ To : System.Address;
Tolen : C.int) return C.int;
function C_Setsockopt
Msg : System.Address;
Len : C.int;
Flags : C.int;
- From : Sockaddr_In_Access;
+ From : System.Address;
Fromlen : not null access C.int) return C.int;
pragma Import (C, Syscall_Recvfrom, "recvfrom");
Msg : System.Address;
Len : C.int;
Flags : C.int;
- To : Sockaddr_In_Access;
+ To : System.Address;
Tolen : C.int) return C.int;
pragma Import (C, Syscall_Sendto, "sendto");
Msg : System.Address;
Len : C.int;
Flags : C.int;
- From : Sockaddr_In_Access;
+ From : System.Address;
Fromlen : not null access C.int) return C.int
is
Res : C.int;
Msg : System.Address;
Len : C.int;
Flags : C.int;
- To : Sockaddr_In_Access;
+ To : System.Address;
Tolen : C.int) return C.int
is
Res : C.int;
Msg : System.Address;
Len : C.int;
Flags : C.int;
- From : Sockaddr_In_Access;
+ From : System.Address;
Fromlen : not null access C.int) return C.int;
function C_Recvmsg
Msg : System.Address;
Len : C.int;
Flags : C.int;
- To : Sockaddr_In_Access;
+ To : System.Address;
Tolen : C.int) return C.int;
function C_Setsockopt
Msg : System.Address;
Len : C.int;
Flags : C.int;
- From : Sockaddr_In_Access;
+ From : System.Address;
Fromlen : not null access C.int) return C.int;
pragma Import (C, Syscall_Recvfrom, "recvfrom");
Msg : System.Address;
Len : C.int;
Flags : C.int;
- To : Sockaddr_In_Access;
+ To : System.Address;
Tolen : C.int) return C.int;
pragma Import (C, Syscall_Sendto, "sendto");
Msg : System.Address;
Len : C.int;
Flags : C.int;
- From : Sockaddr_In_Access;
+ From : System.Address;
Fromlen : not null access C.int) return C.int
is
Res : C.int;
Msg : System.Address;
Len : C.int;
Flags : C.int;
- To : Sockaddr_In_Access;
+ To : System.Address;
Tolen : C.int) return C.int
is
Res : C.int;
Msg : System.Address;
Len : C.int;
Flags : C.int;
- From : Sockaddr_In_Access;
+ From : System.Address;
Fromlen : not null access C.int) return C.int;
function C_Recvmsg
Msg : System.Address;
Len : C.int;
Flags : C.int;
- To : Sockaddr_In_Access;
+ To : System.Address;
Tolen : C.int) return C.int;
function C_Setsockopt
return C_Sendto
(Wsig, Buf'Address, 1,
Flags => SOSC.MSG_Forced_Flags,
- To => null,
- Tolen => 0);
+ To => System.Null_Address,
+ Tolen => 0);
end Write;
end Signalling_Fds;
as subprograms as required). Initialization is allowed only by constructor
functions (see pragma @code{CPP_Constructor}). Such types are implicitly
limited if not explicitly declared as limited or derived from a limited
-type, and a warning is issued in that case.
+type, and an error is issued in that case.
Pragma @code{CPP_Class} is intended primarily for automatic generation
using an automatic binding generator tool.
The first form is the default constructor, used when an object of type
@var{T} is created on the Ada side with no explicit constructor. The
-second form covers all the non-default constructors of the type.
-Constructors (including the copy constructor, which is simply a special
-case of the second form in which the one and only argument is of type
-@var{T}), can only appear in the following contexts:
-
-@itemize @bullet
-@item
-On the right side of an initialization of an object of type @var{T}.
-@item
-On the right side of an initialization of a record component of type @var{T}.
-@item
-In an extension aggregate for an object of a type derived from @var{T}.
-@item
-In an Ada 2005 limited aggregate.
-@item
-In an Ada 2005 nested limited aggregate.
-@item
-In an Ada 2005 limited aggregate that initializes an object built in
-place by an extended return statement.
-@end itemize
-
-@noindent
-Although the constructor is described as a function that returns a value
-on the Ada side, it is typically a procedure with an extra implicit
-argument (the object being initialized) at the implementation
-level. GNAT issues the appropriate call, whatever it is, to get the
-object properly initialized.
-
-In the case of objects of derived types, in addition to the use of Ada
-2005 limited aggregates and extended return statements, you may also
-use one of the following two possible forms for declaring and creating
-an object:
-
-@itemize @bullet
-@item @code{New_Object : Derived_T}
-@item @code{New_Object : Derived_T := (@var{constructor-call with} @dots{})}
-@end itemize
-
-@noindent
-In the first case the default constructor is called and extension fields
-if any are initialized according to the default initialization
-expressions in the Ada declaration. In the second case, the given
-constructor is called and the extension aggregate indicates the explicit
-values of the extension fields.
+second form covers all the non-default constructors of the type. See
+the GNAT users guide for details.
If no constructors are imported, it is impossible to create any objects
on the Ada side and the type is implicitly declared abstract.
On the Ada side the constructor is represented by a function (whose
name is arbitrary) that returns the classwide type corresponding to
-the imported C++ class.
+the imported C++ class. Although the constructor is described as a
+function, it is typically a procedure with an extra implicit argument
+(the object being initialized) at the implementation level. GNAT
+issues the appropriate call, whatever it is, to get the object
+properly initialized.
+Constructors can only appear in the following contexts:
+
+@itemize @bullet
+@item
+On the right side of an initialization of an object of type @var{T}.
+@item
+On the right side of an initialization of a record component of type @var{T}.
+@item
+In an Ada 2005 limited aggregate.
+@item
+In an Ada 2005 nested limited aggregate.
+@item
+In an Ada 2005 limited aggregate that initializes an object built in
+place by an extended return statement.
+@end itemize
+
+@noindent
In a declaration of an object whose type is a class imported from C++,
either the default C++ constructor is implicitly called by GNAT, or
else the required C++ constructor must be explicitly called in the
initialized by a C++ constructor, and the additional Ada components
of type DT are initialized by GNAT. The initialization of such an
object is done either by default, or by means of a function returning
-an aggregate of type DT, or by means of an extended aggregate.
+an aggregate of type DT.
@smallexample @c ada
Obj5 : DT;
Obj6 : DT := Function_Returning_DT (50);
- Obj7 : DT := (Constructor (30,40) with (C_Value => 50));
@end smallexample
The declaration of @code{Obj5} invokes the default constructors: the
For example:
@smallexample @c ada
- Obj8 : Rec2 (40);
+ Obj7 : Rec2 (40);
@end smallexample
Using Ada 2005 we can use limited aggregates to initialize an object
declarations. For example:
@smallexample @c ada
- Obj9 : Rec2 := (Rec => (Data1 => Constructor (15, 16),
+ Obj8 : Rec2 := (Rec => (Data1 => Constructor (15, 16),
others => <>),
others => <>);
@end smallexample
The above declaration uses an Ada 2005 limited aggregate to
-initialize @code{Obj9}, and the C++ constructor that has two integer
+initialize @code{Obj8}, and the C++ constructor that has two integer
arguments is invoked to initialize the @code{Data1} component instead
of the constructor specified in the declaration of type @code{Rec1}. In
Ada 2005 the box in the aggregate indicates that unspecified components
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
with GNAT.HTable;
+with Alloc;
+with Debug;
with Fmap; use Fmap;
with Gnatvsn; use Gnatvsn;
with Hostparm;
-- Converts a C String to an Ada String. Are we doing this to avoid withing
-- Interfaces.C.Strings ???
+ function Include_Dir_Default_Prefix return String_Access;
+ -- Same as exported version, except returns a String_Access
+
------------------------------
-- Other Local Declarations --
------------------------------
-- latest source, library and object files opened by Read_Source_File and
-- Read_Library_Info.
+ package File_Name_Chars is new Table.Table (
+ Table_Component_Type => Character,
+ Table_Index_Type => Int,
+ Table_Low_Bound => 1,
+ Table_Initial => Alloc.File_Name_Chars_Initial,
+ Table_Increment => Alloc.File_Name_Chars_Increment,
+ Table_Name => "File_Name_Chars");
+ -- Table to store text to be printed by Dump_Source_File_Names
+
+ The_Include_Dir_Default_Prefix : String_Access := null;
+ -- Value returned by Include_Dir_Default_Prefix. We don't initialize it
+ -- here, because that causes an elaboration cycle with Sdefault; we
+ -- initialize it lazily instead.
+
------------------
-- Search Paths --
------------------
end if;
end Dir_In_Src_Search_Path;
+ ----------------------------
+ -- Dump_Source_File_Names --
+ ----------------------------
+
+ procedure Dump_Source_File_Names is
+ subtype Rng is Int range File_Name_Chars.First .. File_Name_Chars.Last;
+ begin
+ Write_Str (String (File_Name_Chars.Table (Rng)));
+ end Dump_Source_File_Names;
+
---------------------
-- Executable_Name --
---------------------
-- Include_Dir_Default_Prefix --
--------------------------------
- function Include_Dir_Default_Prefix return String is
- Include_Dir : String_Access :=
- String_Access (Update_Path (Include_Dir_Default_Name));
-
+ function Include_Dir_Default_Prefix return String_Access is
begin
- if Include_Dir = null then
- return "";
-
- else
- declare
- Result : constant String := Include_Dir.all;
- begin
- Free (Include_Dir);
- return Result;
- end;
+ if The_Include_Dir_Default_Prefix = null then
+ The_Include_Dir_Default_Prefix :=
+ String_Access (Update_Path (Include_Dir_Default_Name));
end if;
+
+ return The_Include_Dir_Default_Prefix;
+ end Include_Dir_Default_Prefix;
+
+ function Include_Dir_Default_Prefix return String is
+ begin
+ return Include_Dir_Default_Prefix.all;
end Include_Dir_Default_Prefix;
----------------
return;
end if;
+ -- Print out the file name, if requested, and if it's not part of the
+ -- runtimes, store it in File_Name_Chars.
+
+ declare
+ Name : String renames Name_Buffer (1 .. Name_Len);
+ Inc : String renames Include_Dir_Default_Prefix.all;
+ begin
+ if Debug.Debug_Flag_Dot_N then
+ Write_Line (Name);
+ end if;
+
+ if Inc /= ""
+ and then Inc'Length < Name_Len
+ and then Name_Buffer (1 .. Inc'Length) = Inc
+ then
+ null; -- Part of runtimes, so ignore it
+
+ else
+ File_Name_Chars.Append_All (File_Name_Chars.Table_Type (Name));
+ File_Name_Chars.Append (ASCII.LF);
+ end if;
+ end;
+
-- Prepare to read data from the file
Len := Integer (File_Length (Source_File_FD));
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
-- Cache => True access to source file data does not incur a penalty if
-- this data was previously retrieved.
+ procedure Dump_Source_File_Names;
+ -- Prints out the names of all source files that have been read by
+ -- Read_Source_File, except those that come from the run-time library
+ -- (i.e. Include_Dir_Default_Prefix). The text is sent to whatever Output
+ -- is currently using (e.g. standard output or standard error).
+
-------------------------------------------
-- Representation of Library Information --
-------------------------------------------
-- Fields of struct msghdr
*/
-#if defined (__VMS) || defined (__sun__) || defined (__hpux__)
+#if defined (__sun__) || defined (__hpux__)
# define msg_iovlen_t "int"
#else
# define msg_iovlen_t "size_t"
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
-- This package contains functions that return the default values for the
-- include and object file directories, target name, default library
--- subdirectory (libsubdir) prefix, and the target OS.
+-- subdirectory (libsubdir) prefix, and the target OS. The body is generated
+-- automatically by the build process.
with Types; use Types;
end loop;
else
- Record_Def := Type_Definition (Parent (Base_Type (Typ)));
+ -- We take the underlying type to account for private types when
+ -- the original association had a box default.
+
+ Record_Def :=
+ Type_Definition (Parent (Underlying_Type (Base_Type (Typ))));
if Null_Present (Record_Def) then
null;
Set_Item (Table_Index_Type (Last_Val + 1), New_Val);
end Append;
+ ----------------
+ -- Append_All --
+ ----------------
+
+ procedure Append_All (New_Vals : Table_Type) is
+ begin
+ for J in New_Vals'Range loop
+ Append (New_Vals (J));
+ end loop;
+ end Append_All;
+
--------------------
-- Decrement_Last --
--------------------
-- i.e. the table size is increased by one, and the given new item
-- stored in the newly created table element.
+ procedure Append_All (New_Vals : Table_Type);
+ -- Appends all components of New_Vals
+
procedure Set_Item
(Index : Table_Index_Type;
Item : Table_Component_Type);
projects / gcc.git / commitdiff