[multiple changes]

2009-04-29  Vincent Celier  <celier@adacore.com>

	* sinput-l.adb (Load_File): When preprocessing, set temporarily the
	Source_File_Index_Table entries for the source, to avoid crash when
	reporting an error.

	* gnatcmd.adb (Test_If_Relative_Path): Use
	Makeutl.Test_If_Relative_Path.
	
	* makeutl.adb:(Test_If_Relative_Path): Process switches --RTS= only if
	Including_RTS is True.

	* makeutl.ads (Test_If_Relative_Path): New Boolean parameter
	Including_RTS defaulted to False.

	* sinput.ads, scans.ads, err_vars.ads: Initialize some variables with
	a default value.

2009-04-29  Javier Miranda  <miranda@adacore.com>

	* gnat_ugn.texi: Adding documentation for non-default C++ constructors.

From-SVN: r146967

9 files changed, 253 insertions, 75 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7b3f1fb..8e69ece 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,25 @@
+2009-04-29  Vincent Celier  <celier@adacore.com>
+
+	* sinput-l.adb (Load_File): When preprocessing, set temporarily the
+	Source_File_Index_Table entries for the source, to avoid crash when
+	reporting an error.
+
+	* gnatcmd.adb (Test_If_Relative_Path): Use
+	Makeutl.Test_If_Relative_Path.
+	
+	* makeutl.adb:(Test_If_Relative_Path): Process switches --RTS= only if
+	Including_RTS is True.
+
+	* makeutl.ads (Test_If_Relative_Path): New Boolean parameter
+	Including_RTS defaulted to False.
+
+	* sinput.ads, scans.ads, err_vars.ads: Initialize some variables with
+	a default value.
+
+2009-04-29  Javier Miranda  <miranda@adacore.com>
+
+	* gnat_ugn.texi: Adding documentation for non-default C++ constructors.
+
 2009-04-29  Javier Miranda  <miranda@adacore.com>
 
 	* sem_ch3.adb (Analyze_Object_Declaration): Disable error message
diff --git a/gcc/ada/err_vars.ads b/gcc/ada/err_vars.ads
index ac4860e..1ec6e3d 100644
--- a/gcc/ada/err_vars.ads
+++ b/gcc/ada/err_vars.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 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- --
@@ -32,22 +32,26 @@ with Uintp; use Uintp;
 
 package Err_Vars is
 
+   --  Some variables are initialized so that some tools (such as gprbuild)
+   --  can be built with -gnatVa and pragma Initialized_Scalars without
+   --  problems.
+
    ------------------
    -- Error Counts --
    ------------------
 
-   Serious_Errors_Detected : Nat;
+   Serious_Errors_Detected : Nat := 0;
    --  This is a count of errors that are serious enough to stop expansion,
    --  and hence to prevent generation of an object file even if the
    --  switch -gnatQ is set. Initialized to zero at the start of compilation.
 
-   Total_Errors_Detected : Nat;
+   Total_Errors_Detected : Nat := 0;
    --  Number of errors detected so far. Includes count of serious errors and
    --  non-serious errors, so this value is always greater than or equal to the
    --  Serious_Errors_Detected value. Initialized to zero at the start of
    --  compilation.
 
-   Warnings_Detected : Nat;
+   Warnings_Detected : Nat := 0;
    --  Number of warnings detected. Initialized to zero at the start of
    --  compilation.
 
@@ -75,7 +79,7 @@ package Err_Vars is
    --  generated on the instantiation (referring to the template) rather
    --  than on the template itself.
 
-   Raise_Exception_On_Error : Nat;
+   Raise_Exception_On_Error : Nat := 0;
    --  If this value is non-zero, then any attempt to generate an error
    --  message raises the exception Error_Msg_Exception, and the error
    --  message is not output. This is used for defending against junk
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 521f8a9..31e7080 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -2976,6 +2976,7 @@ with a new C++ compiler.
 * Interfacing to C++::
 * Linking a Mixed C++ & Ada Program::
 * A Simple Example::
+* Interfacing with C++ constructors::
 * Interfacing with C++ at the Class Level::
 @end menu
 
@@ -3228,6 +3229,176 @@ package Simple_Cpp_Interface is
 end Simple_Cpp_Interface;
 @end smallexample
 
+@node Interfacing with C++ constructors
+@subsection Interfacing with C++ constructors
+@noindent
+
+In order to interface with C++ constructors GNAT provides the
+@code{pragma CPP_Constructor} (@xref{Interfacing to C++,,,
+gnat_rm, GNAT Reference Manual}, for additional information).
+In this section we present some common uses of C++ constructors
+in mixed-languages programs in GNAT.
+
+Let us assume that we need to interface with the following
+C++ class:
+
+@smallexample
+@b{class} Root @{
+@b{public}:
+  int  a_value;
+  int  b_value;
+  @b{virtual} int Get_Value ();
+  Root();              // Default constructor
+  Root(int v);         // 1st non-default constructor
+  Root(int v, int w);  // 2nd non-default constructor
+@};
+@end smallexample
+
+For this purpose we can write the following package spec (further
+information on how to build this spec is available in
+@ref{Interfacing with C++ at the Class Level} and
+@ref{Generating Ada Bindings for C and C++ headers}).
+
+@smallexample @c ada
+with Interfaces.C; use Interfaces.C;
+package Pkg_Root is
+  type Root is tagged limited record
+     A_Value : int;
+     B_Value : int;
+  end record;
+  pragma Import (CPP, Root);
+
+  function Get_Value (Obj : Root) return int;
+  pragma Import (CPP, Get_Value);
+
+  function Constructor return Root'Class;
+  pragma Cpp_Constructor (Constructor, "_ZN4RootC1Ev");
+
+  function Constructor (v : Integer) return Root'Class;
+  pragma Cpp_Constructor (Constructor, "_ZN4RootC1Ei");
+
+  function Constructor (v, w : Integer) return Root'Class;
+  pragma Cpp_Constructor (Constructor, "_ZN4RootC1Eii");
+end Pkg_Root;
+@end smallexample
+
+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.
+
+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
+expression that initializes the object. For example:
+
+@smallexample @c ada
+  Obj1 : Root;
+  Obj2 : Root := Constructor;
+  Obj3 : Root := Constructor (v => 10);
+  Obj4 : Root := Constructor (30, 40);
+@end smallexample
+
+The first two declarations are equivalent: in both cases the default C++
+constructor is invoked (in the former case the call to the constructor is
+implicit, and in the latter case the call is explicit in the object
+declaration). @code{Obj3} is initialized by the C++ non-default constructor
+that takes an integer argument, and @code{Obj4} is initialized by the
+non-default C++ constructor that takes two integers.
+
+Let us derive the imported C++ class in the Ada side. For example:
+
+@smallexample @c ada
+  type DT is new Root with record
+     C_Value : Natural := 2009;
+  end record;
+@end smallexample
+
+In this case the components DT inherited from the C++ side must be
+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.
+
+@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
+C++ default constructor of the parent type takes care of the initialization
+of the components inherited from Root, and GNAT takes care of the default
+initialization of the additional Ada components of type DT (that is,
+@code{C_Value} is initialized to value 2009). The order of invocation of
+the constructors is consistent with the order of elaboration required by
+Ada and C++. That is, the constructor of the parent type is always called
+before the constructor of the derived type.
+
+Let us now consider a record that has components whose type is imported
+from C++. For example:
+
+@smallexample @c ada
+  type Rec1 is limited record
+     Data1 : Root := Constructor (10);
+     Value : Natural := 1000;
+  end record;
+
+  type Rec2 (D : Integer := 20) is limited record
+     Rec   : Rec1;
+     Data2 : Root := Constructor (D, 30);
+  end record;
+@end smallexample
+
+The initialization of an object of type @code{Rec2} will call the
+non-default C++ constructors specified for the imported components.
+For example:
+
+@smallexample @c ada
+  Obj8 : Rec2 (40);
+@end smallexample
+
+Using Ada 2005 we can use limited aggregates to initialize an object
+invoking C++ constructors that differ from those specified in the type
+declarations. For example:
+
+@smallexample @c ada
+  Obj9 : 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
+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
+are initialized using the expression (if any) available in the component
+declaration. That is, in this case discriminant @code{D} is initialized
+to value @code{20}, @code{Value} is initialized to value 1000, and the
+non-default C++ constructor that handles two integers takes care of
+initializing component @code{Data2} with values @code{20,30}.
+
+In Ada 2005 we can use the extended return statement to build the Ada
+equivalent to C++ non-default constructors. For example:
+
+@smallexample @c ada
+  function Constructor (V : Integer) return Rec2 is
+  begin
+     return Obj : Rec2 := (Rec => (Data1  => Constructor (V, 20),
+                                   others => <>),
+                           others => <>) do
+        --  Further actions required for construction of
+        --  objects of type Rec2
+        ...
+     end record;
+  end Constructor;
+@end smallexample
+
+In this example the extended return statement construct is used to
+build in place the returned object whose components are initialized
+by means of a limited aggregate. Any further action associated with
+the constructor can be placed inside the construct.
+
 @node Interfacing with C++ at the Class Level
 @subsection Interfacing with C++ at the Class Level
 @noindent
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index 81e9bc4..8310cd2 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -26,6 +26,7 @@
 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
 
 with Csets;
+with Makeutl;
 with MLib.Tgt; use MLib.Tgt;
 with MLib.Utl;
 with MLib.Fil;
@@ -1265,61 +1266,8 @@ procedure GNATCmd is
       Parent : String)
    is
    begin
-      if Switch /= null then
-
-         declare
-            Sw : String (1 .. Switch'Length);
-            Start : Positive := 1;
-
-         begin
-            Sw := Switch.all;
-
-            if Sw (1) = '-' then
-               if Sw'Length >= 3
-                 and then (Sw (2) = 'A' or else
-                           Sw (2) = 'I' or else
-                           Sw (2) = 'L')
-               then
-                  Start := 3;
-
-                  if Sw = "-I-" then
-                     return;
-                  end if;
-
-               elsif Sw'Length >= 4
-                 and then (Sw (2 .. 3) = "aL" or else
-                           Sw (2 .. 3) = "aO" or else
-                           Sw (2 .. 3) = "aI")
-               then
-                  Start := 4;
-
-               elsif Sw'Length >= 7
-                 and then Sw (2 .. 6) = "-RTS="
-               then
-                  Start := 7;
-               else
-                  return;
-               end if;
-            end if;
-
-            --  If the path is relative, test if it includes directory
-            --  information. If it does, prepend Parent to the path.
-
-            if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then
-               for J in Start .. Sw'Last loop
-                  if Sw (J) = Directory_Separator then
-                     Switch :=
-                        new String'
-                              (Sw (1 .. Start - 1) &
-                               Parent &
-                               Directory_Separator &
-                               Sw (Start .. Sw'Last));
-                     return;
-                  end if;
-               end loop;
-            end if;
-         end;
-      end if;
+      Makeutl.Test_If_Relative_Path
+        (Switch, Parent, Including_Non_Switch => False, Including_RTS => True);
    end Test_If_Relative_Path;
 
    -------------------
diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb
index 50b9fe2..17c34ff 100644
--- a/gcc/ada/makeutl.adb
+++ b/gcc/ada/makeutl.adb
@@ -598,7 +598,8 @@ package body Makeutl is
      (Switch               : in out String_Access;
       Parent               : String;
       Including_L_Switch   : Boolean := True;
-      Including_Non_Switch : Boolean := True)
+      Including_Non_Switch : Boolean := True;
+      Including_RTS        : Boolean := False)
    is
    begin
       if Switch /= null then
@@ -628,13 +629,20 @@ package body Makeutl is
                then
                   Start := 4;
 
+               elsif Including_RTS
+                 and then Sw'Length >= 7
+                 and then Sw (2 .. 6) = "-RTS="
+               then
+                  Start := 7;
+
                else
                   return;
                end if;
 
                --  Because relative path arguments to --RTS= may be relative
                --  to the search directory prefix, those relative path
-               --  arguments are not converted.
+               --  arguments are converted only when they include directory
+               --  information.
 
                if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then
                   if Parent'Length = 0 then
@@ -643,6 +651,19 @@ package body Makeutl is
                         & Sw
                         & """) are not allowed");
 
+                  elsif Including_RTS then
+                     for J in Start .. Sw'Last loop
+                        if Sw (J) = Directory_Separator then
+                           Switch :=
+                             new String'
+                               (Sw (1 .. Start - 1) &
+                                Parent &
+                                Directory_Separator &
+                                Sw (Start .. Sw'Last));
+                           return;
+                        end if;
+                     end loop;
+
                   else
                      Switch :=
                        new String'
diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads
index bb8ac84..3c9b4d9 100644
--- a/gcc/ada/makeutl.ads
+++ b/gcc/ada/makeutl.ads
@@ -130,12 +130,14 @@ package Makeutl is
      (Switch               : in out String_Access;
       Parent               : String;
       Including_L_Switch   : Boolean := True;
-      Including_Non_Switch : Boolean := True);
+      Including_Non_Switch : Boolean := True;
+      Including_RTS        : Boolean := False);
    --  Test if Switch is a relative search path switch.
    --  If it is, fail if Parent is the empty string, otherwise prepend the path
    --  with Parent. This subprogram is only called when using project files.
    --  For gnatbind switches, Including_L_Switch is False, because the
-   --  argument of the -L switch is not a path.
+   --  argument of the -L switch is not a path. If Including_RTS is True,
+   --  process also switches --RTS=.
 
    function Path_Or_File_Name (Path : Path_Name_Type) return String;
    --  Returns a file name if -df is used, otherwise return a path name
diff --git a/gcc/ada/scans.ads b/gcc/ada/scans.ads
index 1120f06..fbdc5ce 100644
--- a/gcc/ada/scans.ads
+++ b/gcc/ada/scans.ads
@@ -344,37 +344,40 @@ package Scans is
 
    --  Note: these variables can only be referenced during the parsing of a
    --  file. Reference to any of them from Sem or the expander is wrong.
+   --  Some of these variables are initialized so that some tools (such as
+   --  gprbuild) can be built with -gnatVa and pragma Initialized_Scalars
+   --  without problems.
 
-   Scan_Ptr : Source_Ptr;
+   Scan_Ptr : Source_Ptr := No_Location;
    --  Current scan pointer location. After a call to Scan, this points
    --  just past the end of the token just scanned.
 
-   Token : Token_Type;
+   Token : Token_Type := No_Token;
    --  Type of current token
 
-   Token_Ptr : Source_Ptr;
+   Token_Ptr : Source_Ptr := No_Location;
    --  Pointer to first character of current token
 
-   Current_Line_Start : Source_Ptr;
+   Current_Line_Start : Source_Ptr := No_Location;
    --  Pointer to first character of line containing current token
 
-   Start_Column : Column_Number;
+   Start_Column : Column_Number := No_Column_Number;
    --  Starting column number (zero origin) of the first non-blank character
    --  on the line containing the current token. This is used for error
    --  recovery circuits which depend on looking at the column line up.
 
-   Type_Token_Location : Source_Ptr;
+   Type_Token_Location : Source_Ptr := No_Location;
    --  Within a type declaration, gives the location of the TYPE keyword that
    --  opened the type declaration. Used in checking the end column of a record
    --  declaration, which can line up either with the TYPE keyword, or with the
    --  start of the line containing the RECORD keyword.
 
-   Checksum : Word;
+   Checksum : Word := 0;
    --  Used to accumulate a CRC representing the tokens in the source
    --  file being compiled. This CRC includes only program tokens, and
    --  excludes comments.
 
-   First_Non_Blank_Location : Source_Ptr;
+   First_Non_Blank_Location : Source_Ptr := No_Location;
    --  Location of first non-blank character on the line containing the
    --  current token (i.e. the location of the character whose column number
    --  is stored in Start_Column).
diff --git a/gcc/ada/sinput-l.adb b/gcc/ada/sinput-l.adb
index 08cc5f8..32f8bde 100644
--- a/gcc/ada/sinput-l.adb
+++ b/gcc/ada/sinput-l.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 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- --
@@ -453,6 +453,11 @@ package body Sinput.L is
          --  Preprocess the source if it needs to be preprocessed
 
          if Preprocessing_Needed then
+            --  Set temporarily the Source_File_Index_Table entries for the
+            --  source, to avoid crash when reporting an error.
+
+            Set_Source_File_Index_Table (X);
+
             if Opt.List_Preprocessing_Symbols then
                Get_Name_String (N);
 
diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads
index e2e4ec0..ca97716 100644
--- a/gcc/ada/sinput.ads
+++ b/gcc/ada/sinput.ads
@@ -423,8 +423,10 @@ package Sinput is
    -- Global Data --
    -----------------
 
-   Current_Source_File : Source_File_Index;
-   --  Source_File table index of source file currently being scanned
+   Current_Source_File : Source_File_Index := No_Source_File;
+   --  Source_File table index of source file currently being scanned.
+   --  Initialized so that some tools (such as gprbuild) can be built with
+   --  -gnatVa and pragma Initialized_Scalars without problems.
 
    Current_Source_Unit : Unit_Number_Type;
    --  Unit number of source file currently being scanned. The special value