[multiple changes]

2009-06-25  Emmanuel Briot  <briot@adacore.com>

	* gnatcmd.adb, prj-proc.adb, make.adb, prj.adb, prj.ads, prj-nmsc.adb,
	prj-util.adb, prj-env.adb, prj-env.ads: Merge handling of naming_data
	between gnatmake and gprbuild.
	(Naming_Data): Removed, no longer used
	(Naming_Table, Project_Tree_Ref.Namings): Removed, since this is only
	needed locally in one subprogram, no need to store forever in the
	structure.
	(Check_Naming_Scheme, Check_Package_Naming): Merged, since they play
	a similar role.
	(Body_Suffix_Of, Body_Suffix_Id_Of, Register_Default_Naming_Scheme,
	Same_Naming_Scheme, Set_Body_Suffix, Set_Spec_Suffix, Spec_Suffix_Of,
	Spec_Suffix_Id_Of): removed, no longer used.

2009-06-25  Javier Miranda  <miranda@adacore.com>

	* sem_res.adb (Resolve_Allocator): Skip test requiring exact match of
	types on qualified expression in calls to imported C++ constructors.

	* exp_ch4.adb (Expand_Allocator_Expression): Add missing support for
	imported C++ constructors.

2009-06-25  Sergey Rybin  <rybin@adacore.com>

	* vms_data.ads: Add qualifier for new gnatcheck '-t' option.

From-SVN: r148937

gcc/ada/ChangeLog

+2009-06-25  Emmanuel Briot  <briot@adacore.com>
+
+	* gnatcmd.adb, prj-proc.adb, make.adb, prj.adb, prj.ads, prj-nmsc.adb,
+	prj-util.adb, prj-env.adb, prj-env.ads: Merge handling of naming_data
+	between gnatmake and gprbuild.
+	(Naming_Data): Removed, no longer used
+	(Naming_Table, Project_Tree_Ref.Namings): Removed, since this is only
+	needed locally in one subprogram, no need to store forever in the
+	structure.
+	(Check_Naming_Scheme, Check_Package_Naming): Merged, since they play
+	a similar role.
+	(Body_Suffix_Of, Body_Suffix_Id_Of, Register_Default_Naming_Scheme,
+	Same_Naming_Scheme, Set_Body_Suffix, Set_Spec_Suffix, Spec_Suffix_Of,
+	Spec_Suffix_Id_Of): removed, no longer used.
+
+2009-06-25  Javier Miranda  <miranda@adacore.com>
+
+	* sem_res.adb (Resolve_Allocator): Skip test requiring exact match of
+	types on qualified expression in calls to imported C++ constructors.
+
+	* exp_ch4.adb (Expand_Allocator_Expression): Add missing support for
+	imported C++ constructors.
+
+2009-06-25  Sergey Rybin  <rybin@adacore.com>
+
+	* vms_data.ads: Add qualifier for new gnatcheck '-t' option.
+
 2009-06-25  Vincent Celier  <celier@adacore.com>
 
 	* s-os_lib.adb (Normalize_Pathname.Get_Directory): If directory
@@ -12,6 +39,7 @@
 2009-06-25  Quentin Ochem  <ochem@adacore.com>
 
 	* prj.ads (Unit_Index): Now general access type.
+
 2009-06-25  Pascal Obry  <obry@adacore.com>
 
 	* a-stwise.adb, a-stzsea.adb: Fix confusion between 'Length and 'Last.

gcc/ada/exp_ch4.adb

@@ -572,6 +572,57 @@ package body Exp_Ch4 is
    begin
       if Is_Tagged_Type (T) or else Needs_Finalization (T) then
 
+         if Is_CPP_Constructor_Call (Exp) then
+
+            --  Generate:
+            --  Pnnn : constant ptr_T := new (T); Init (Pnnn.all,...); Pnnn
+
+            --  Allocate the object with no expression
+
+            Node := Relocate_Node (N);
+            Set_Expression (Node,
+              New_Reference_To (Root_Type (Etype (Exp)), Loc));
+
+            --  Avoid its expansion to avoid generating a call to the default
+            --  C++ constructor
+
+            Set_Analyzed (Node);
+
+            Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
+
+            Insert_Action (N,
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Temp,
+                Constant_Present    => True,
+                Object_Definition   => New_Reference_To (PtrT, Loc),
+                Expression          => Node));
+
+            Apply_Accessibility_Check (Temp);
+
+            --  Locate the enclosing list to insert the C++ constructor call
+
+            declare
+               P : Node_Id := Parent (Node);
+
+            begin
+               while not Is_List_Member (P) loop
+                  P := Parent (P);
+               end loop;
+
+               Insert_List_After_And_Analyze (P,
+                 Build_Initialization_Call (Loc,
+                   Id_Ref => Make_Explicit_Dereference (Loc,
+                               New_Reference_To (Temp, Loc)),
+                   Typ => Root_Type (Etype (Exp)),
+                   Constructor_Ref => Exp));
+            end;
+
+            Rewrite (N, New_Reference_To (Temp, Loc));
+            Analyze_And_Resolve (N, PtrT);
+
+            return;
+         end if;
+
          --  Ada 2005 (AI-318-02): If the initialization expression is a call
          --  to a build-in-place function, then access to the allocated object
          --  must be passed to the function. Currently we limit such functions

gcc/ada/gnatcmd.adb

@@ -662,8 +662,7 @@ procedure GNATCmd is
 
    function Configuration_Pragmas_File return Path_Name_Type is
    begin
-      Prj.Env.Create_Config_Pragmas_File
-        (Project, Project, Project_Tree, Include_Config_Files => False);
+      Prj.Env.Create_Config_Pragmas_File (Project, Project_Tree);
       return Project.Config_File_Name;
    end Configuration_Pragmas_File;
 
@@ -2122,6 +2121,8 @@ begin
                File_Index : Integer := 0;
                Dir_Index  : Integer := 0;
                Last       : constant Integer := Last_Switches.Last;
+               Lang       : constant Language_Ptr :=
+                 Get_Language_From_Name (Project, "ada");
 
             begin
                for Index in 1 .. Last loop
@@ -2138,7 +2139,7 @@ begin
                --  indicate to gnatstub the name of the body file with
                --  a -o switch.
 
-               if Body_Suffix_Id_Of (Project_Tree, Name_Ada, Project.Naming) /=
+               if Lang.Config.Naming_Data.Body_Suffix /=
                     Prj.Default_Ada_Spec_Suffix
                then
                   if File_Index /= 0 then
@@ -2148,9 +2149,7 @@ begin
                         Last : Natural := Spec'Last;
 
                      begin
-                        Get_Name_String
-                          (Spec_Suffix_Id_Of
-                             (Project_Tree, Name_Ada, Project.Naming));
+                        Get_Name_String (Lang.Config.Naming_Data.Spec_Suffix);
 
                         if Spec'Length > Name_Len
                           and then Spec (Last - Name_Len + 1 .. Last) =
@@ -2158,8 +2157,7 @@ begin
                         then
                            Last := Last - Name_Len;
                            Get_Name_String
-                             (Body_Suffix_Id_Of
-                                (Project_Tree, Name_Ada, Project.Naming));
+                             (Lang.Config.Naming_Data.Body_Suffix);
                            Last_Switches.Increment_Last;
                            Last_Switches.Table (Last_Switches.Last) :=
                              new String'("-o");

gcc/ada/make.adb

@@ -644,7 +644,7 @@ package body Make is
      (Source_File      : File_Name_Type;
       Source_File_Name : String;
       Source_Index     : Int;
-      Naming           : Naming_Data;
+      Project          : Project_Id;
       In_Package       : Package_Id;
       Allow_ALI        : Boolean) return Variable_Value;
    --  Return the switches for the source file in the specified package of a
@@ -1274,7 +1274,7 @@ package body Make is
              (Source_File      => Name_Find,
               Source_File_Name => File_Name,
               Source_Index     => Index,
-              Naming           => Main_Project.Naming,
+              Project          => Main_Project,
               In_Package       => The_Package,
               Allow_ALI        => Program = Binder or else Program = Linker);
 
@@ -2388,7 +2388,7 @@ package body Make is
                       (Source_File      => Source_File,
                        Source_File_Name => Source_File_Name,
                        Source_Index     => Source_Index,
-                       Naming           => Arguments_Project.Naming,
+                       Project          => Arguments_Project,
                        In_Package       => Compiler_Package,
                        Allow_ALI        => False);
 
@@ -3750,7 +3750,7 @@ package body Make is
 
    begin
       Prj.Env.Create_Config_Pragmas_File
-        (For_Project, Main_Project, Project_Tree);
+        (For_Project, Project_Tree);
 
       if For_Project.Config_File_Name /= No_Path then
          Temporary_Config_File := For_Project.Config_File_Temp;
@@ -4235,6 +4235,8 @@ package body Make is
                File_Name : constant String := Base_Name (Main);
                --  The simple file name of the current main
 
+               Lang : Language_Ptr;
+
             begin
                exit when Main = "";
 
@@ -4256,18 +4258,18 @@ package body Make is
                   --  is the actual path of a source of a project.
 
                   if Main /= File_Name then
+                     Lang := Get_Language_From_Name (Main_Project, "ada");
+
                      Real_Path :=
                        Locate_Regular_File
-                         (Main &
-                          Body_Suffix_Of
-                            (Project_Tree, "ada", Main_Project.Naming),
+                         (Main & Get_Name_String
+                              (Lang.Config.Naming_Data.Body_Suffix),
                           "");
                      if Real_Path = null then
                         Real_Path :=
                           Locate_Regular_File
-                            (Main &
-                             Spec_Suffix_Of
-                               (Project_Tree, "ada", Main_Project.Naming),
+                            (Main & Get_Name_String
+                                 (Lang.Config.Naming_Data.Spec_Suffix),
                              "");
                      end if;
 
@@ -8122,10 +8124,12 @@ package body Make is
      (Source_File      : File_Name_Type;
       Source_File_Name : String;
       Source_Index     : Int;
-      Naming           : Naming_Data;
+      Project          : Project_Id;
       In_Package       : Package_Id;
       Allow_ALI        : Boolean) return Variable_Value
    is
+      Lang : constant Language_Ptr := Get_Language_From_Name (Project, "ada");
+
       Switches : Variable_Value;
 
       Defaults : constant Array_Element_Id :=
@@ -8156,14 +8160,17 @@ package body Make is
 
       --  Check also without the suffix
 
-      if Switches = Nil_Variable_Value then
+      if Switches = Nil_Variable_Value
+        and then Lang /= null
+      then
          declare
+            Naming : Lang_Naming_Data renames Lang.Config.Naming_Data;
             Name        : String (1 .. Source_File_Name'Length + 3);
             Last        : Positive := Source_File_Name'Length;
             Spec_Suffix : constant String :=
-                            Spec_Suffix_Of (Project_Tree, "ada", Naming);
+              Get_Name_String (Naming.Spec_Suffix);
             Body_Suffix : constant String :=
-                            Body_Suffix_Of (Project_Tree, "ada", Naming);
+              Get_Name_String (Naming.Body_Suffix);
             Truncated   : Boolean := False;
 
          begin

gcc/ada/prj-env.ads

@@ -63,16 +63,9 @@ package Prj.Env is
 
    procedure Create_Config_Pragmas_File
      (For_Project          : Project_Id;
-      Main_Project         : Project_Id;
-      In_Tree              : Project_Tree_Ref;
-      Include_Config_Files : Boolean := True);
+      In_Tree              : Project_Tree_Ref);
    --  If there needs to have SFN pragmas, either for non standard naming
-   --  schemes or for individual units, or (when Include_Config_Files is True)
-   --  if Global_Configuration_Pragmas has been specified in package gnatmake
-   --  of the main project, or if Local_Configuration_Pragmas has been
-   --  specified in package Compiler of the main project, build (if needed)
-   --  a temporary file that contains all configuration pragmas, and specify
-   --  the configuration pragmas file in the project data.
+   --  schemes or for individual units.
 
    procedure Create_New_Path_File
      (In_Tree   : Project_Tree_Ref;

gcc/ada/prj-proc.adb

@@ -2336,6 +2336,7 @@ package body Prj.Proc is
 
    begin
       Error_Report := Report_Error;
+
       Success := True;
 
       if Project /= No_Project then
@@ -2581,7 +2582,7 @@ package body Prj.Proc is
                return;
             end if;
 
-            Project := new Project_Data'(Empty_Project (In_Tree));
+            Project := new Project_Data'(Empty_Project);
             In_Tree.Projects := new Project_List_Element'
               (Project => Project,
                Next    => In_Tree.Projects);

gcc/ada/prj-util.adb

@@ -134,7 +134,7 @@ package body Prj.Util is
 
       Executable_Suffix_Name : Name_Id := No_Name;
 
-      Naming : constant Naming_Data := Project.Naming;
+      Lang   : Language_Ptr;
 
       Spec_Suffix : Name_Id := No_Name;
       Body_Suffix : Name_Id := No_Name;
@@ -143,8 +143,8 @@ package body Prj.Util is
       Body_Suffix_Length : Natural := 0;
 
       procedure Get_Suffixes
-        (B_Suffix : String;
-         S_Suffix : String);
+        (B_Suffix : File_Name_Type;
+         S_Suffix : File_Name_Type);
       --  Get the non empty suffixes in variables Spec_Suffix and Body_Suffix
 
       ------------------
@@ -152,22 +152,18 @@ package body Prj.Util is
       ------------------
 
       procedure Get_Suffixes
-        (B_Suffix : String;
-         S_Suffix : String)
+        (B_Suffix : File_Name_Type;
+         S_Suffix : File_Name_Type)
       is
       begin
-         if B_Suffix'Length > 0 then
-            Name_Len := B_Suffix'Length;
-            Name_Buffer (1 .. Name_Len) := B_Suffix;
-            Body_Suffix := Name_Find;
-            Body_Suffix_Length := B_Suffix'Length;
+         if B_Suffix /= No_File then
+            Body_Suffix := Name_Id (B_Suffix);
+            Body_Suffix_Length := Natural (Length_Of_Name (Body_Suffix));
          end if;
 
-         if S_Suffix'Length > 0 then
-            Name_Len := S_Suffix'Length;
-            Name_Buffer (1 .. Name_Len) := S_Suffix;
-            Spec_Suffix := Name_Find;
-            Spec_Suffix_Length := S_Suffix'Length;
+         if S_Suffix /= No_File then
+            Spec_Suffix := Name_Id (S_Suffix);
+            Spec_Suffix_Length := Natural (Length_Of_Name (Spec_Suffix));
          end if;
       end Get_Suffixes;
 
@@ -175,14 +171,15 @@ package body Prj.Util is
 
    begin
       if Ada_Main then
-         Get_Suffixes
-           (B_Suffix => Body_Suffix_Of (In_Tree, "ada", Naming),
-            S_Suffix => Spec_Suffix_Of (In_Tree, "ada", Naming));
-
+         Lang := Get_Language_From_Name (Project, "ada");
       elsif Language /= "" then
+         Lang := Get_Language_From_Name (Project, Language);
+      end if;
+
+      if Lang /= null then
          Get_Suffixes
-           (B_Suffix => Body_Suffix_Of (In_Tree, Language, Naming),
-            S_Suffix => Spec_Suffix_Of (In_Tree, Language, Naming));
+           (B_Suffix => Lang.Config.Naming_Data.Body_Suffix,
+            S_Suffix => Lang.Config.Naming_Data.Spec_Suffix);
       end if;
 
       if Builder_Package /= No_Package then
@@ -217,7 +214,8 @@ package body Prj.Util is
                Truncated : Boolean := False;
 
             begin
-               if Last > Natural (Length_Of_Name (Body_Suffix))
+               if Body_Suffix /= No_Name
+                 and then Last > Natural (Length_Of_Name (Body_Suffix))
                  and then Name (Last - Body_Suffix_Length + 1 .. Last) =
                             Get_Name_String (Body_Suffix)
                then
@@ -225,7 +223,8 @@ package body Prj.Util is
                   Last := Last - Body_Suffix_Length;
                end if;
 
-               if not Truncated
+               if Spec_Suffix /= No_Name
+                 and then not Truncated
                  and then Last > Spec_Suffix_Length
                  and then Name (Last - Spec_Suffix_Length + 1 .. Last) =
                             Get_Name_String (Spec_Suffix)

gcc/ada/prj.ads

@@ -830,61 +830,6 @@ package Prj is
 
    --  The following record contains data for a naming scheme
 
-   type Naming_Data is record
-
-      Dot_Replacement : File_Name_Type := No_File;
-      --  The string to replace '.' in the source file name (for Ada)
-
-      Casing : Casing_Type := All_Lower_Case;
-      --  The casing of the source file name (for Ada)
-
-      Spec_Suffix : Array_Element_Id := No_Array_Element;
-      --  The string to append to the unit name for the
-      --  source file name of a spec.
-      --  Indexed by the programming language.
-
-      Body_Suffix : Array_Element_Id := No_Array_Element;
-      --  The string to append to the unit name for the
-      --  source file name of a body.
-      --  Indexed by the programming language.
-
-      Separate_Suffix : File_Name_Type := No_File;
-      --  String to append to unit name for source file name of an Ada subunit
-
-   end record;
-
-   function Spec_Suffix_Of
-     (In_Tree  : Project_Tree_Ref;
-      Language : String;
-      Naming   : Naming_Data) return String;
-
-   function Spec_Suffix_Id_Of
-     (In_Tree     : Project_Tree_Ref;
-      Language_Id : Name_Id;
-      Naming      : Naming_Data) return File_Name_Type;
-
-   procedure Set_Spec_Suffix
-     (In_Tree  : Project_Tree_Ref;
-      Language : String;
-      Naming   : in out Naming_Data;
-      Suffix   : File_Name_Type);
-
-   function Body_Suffix_Id_Of
-     (In_Tree     : Project_Tree_Ref;
-      Language_Id : Name_Id;
-      Naming      : Naming_Data) return File_Name_Type;
-
-   function Body_Suffix_Of
-     (In_Tree  : Project_Tree_Ref;
-      Language : String;
-      Naming   : Naming_Data) return String;
-
-   procedure Set_Body_Suffix
-     (In_Tree  : Project_Tree_Ref;
-      Language : String;
-      Naming   : in out Naming_Data;
-      Suffix   : File_Name_Type);
-
    function Get_Object_Directory
      (Project             : Project_Id;
       Including_Libraries : Boolean;
@@ -906,18 +851,6 @@ package Prj is
    --  Returns the ultimate extending project of project Proj. If project Proj
    --  is not extended, returns Proj.
 
-   function Standard_Naming_Data
-     (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data;
-   pragma Inline (Standard_Naming_Data);
-   --  The standard GNAT naming scheme when Tree is No_Project_Tree.
-   --  Otherwise, return the default naming scheme for the project tree Tree,
-   --  which must have been Initialized.
-
-   function Same_Naming_Scheme
-     (Left, Right : Naming_Data) return Boolean;
-   --  Returns True if Left and Right are the same naming scheme
-   --  not considering Specs and Bodies.
-
    type Project_List_Element;
    type Project_List is access all Project_List_Element;
    type Project_List_Element is record
@@ -1121,9 +1054,6 @@ package Prj is
       Location : Source_Ptr := No_Location;
       --  The location in the project file source of the reserved word project
 
-      Naming : Naming_Data := Standard_Naming_Data;
-      --  The naming scheme of this project file
-
       ---------------
       -- Languages --
       ---------------
@@ -1305,9 +1235,9 @@ package Prj is
 
    end record;
 
-   function Empty_Project (Tree : Project_Tree_Ref) return Project_Data;
-   --  Return the representation of an empty project in project Tree tree.
-   --  The project tree Tree must have been Initialized and/or Reset.
+   function Empty_Project return Project_Data;
+   --  Return the representation of an empty project.
+   --  In Ada-only mode, the Ada language is also partly initialized
 
    function Is_Extending
      (Extending : Project_Id;
@@ -1410,18 +1340,6 @@ package Prj is
    --  This procedure resets all the tables that are used when processing a
    --  project file tree. Initialize must be called before the call to Reset.
 
-   procedure Register_Default_Naming_Scheme
-     (Language            : Name_Id;
-      Default_Spec_Suffix : File_Name_Type;
-      Default_Body_Suffix : File_Name_Type;
-      In_Tree             : Project_Tree_Ref);
-   --  Register the default suffixes for a given language. These extensions
-   --  will be ignored if the user has specified a new naming scheme in a
-   --  project file.
-   --
-   --  Otherwise, this information will be automatically added to Naming_Data
-   --  when a project is processed, in the lists Spec_Suffix and Body_Suffix.
-
    package Project_Boolean_Htable is new Simple_HTable
      (Header_Num => Header_Num,
       Element    => Boolean,
@@ -1531,16 +1449,6 @@ private
       Last : in out Natural);
    --  Append a String to the Buffer
 
-   type Naming_Id is new Nat;
-
-   package Naming_Table is new GNAT.Dynamic_Tables
-     (Table_Component_Type => Naming_Data,
-      Table_Index_Type     => Naming_Id,
-      Table_Low_Bound      => 1,
-      Table_Initial        => 5,
-      Table_Increment      => 100);
-   --  Table storing the naming data for gnatmake/gprmake
-
    package Path_File_Table is new GNAT.Dynamic_Tables
      (Table_Component_Type => Path_Name_Type,
       Table_Index_Type     => Natural,
@@ -1567,26 +1475,28 @@ private
    --  A table to store the object dirs, before creating the object path file
 
    type Private_Project_Tree_Data is record
-      Namings        : Naming_Table.Instance;
       Path_Files     : Path_File_Table.Instance;
       Source_Paths   : Source_Path_Table.Instance;
       Object_Paths   : Object_Path_Table.Instance;
-      Default_Naming : Naming_Data;
 
       Current_Source_Path_File : Path_Name_Type := No_Path;
       --  Current value of project source path file env var. Used to avoid
       --  setting the env var to the same value.
+      --  gnatmake only
 
       Current_Object_Path_File : Path_Name_Type := No_Path;
       --  Current value of project object path file env var. Used to avoid
       --  setting the env var to the same value.
+      --  gnatmake only
 
       Ada_Path_Buffer : String_Access := new String (1 .. 1024);
       --  A buffer where values for ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are
       --  stored.
+      --  gnatmake only
 
       Ada_Path_Length : Natural := 0;
       --  Index of the last valid character in Ada_Path_Buffer
+      --  gnatmake only
 
       Ada_Prj_Include_File_Set : Boolean := False;
       Ada_Prj_Objects_File_Set : Boolean := False;
@@ -1596,8 +1506,10 @@ private
       --  effect on most platforms, except on VMS where the logical names are
       --  deassigned, thus avoiding the pollution of the environment of the
       --  caller.
+      --  gnatmake only
 
       Fill_Mapping_File : Boolean := True;
+      --  gnatmake only
 
    end record;
    --  Type to represent the part of a project tree which is private to the

gcc/ada/sem_res.adb

@@ -3979,9 +3979,17 @@ package body Sem_Res is
          Check_Unset_Reference (Expression (E));
 
          --  A qualified expression requires an exact match of the type,
-         --  class-wide matching is not allowed.
+         --  class-wide matching is not allowed. We skip this test in a call
+         --  to a CPP constructor because in such case, although the function
+         --  profile indicates that it returns a class-wide type, the object
+         --  returned by the C++ constructor has a concrete type.
 
-         if (Is_Class_Wide_Type (Etype (Expression (E)))
+         if Is_Class_Wide_Type (Etype (Expression (E)))
+           and then Is_CPP_Constructor_Call (Expression (E))
+         then
+            null;
+
+         elsif (Is_Class_Wide_Type (Etype (Expression (E)))
               or else Is_Class_Wide_Type (Etype (E)))
            and then Base_Type (Etype (Expression (E))) /= Base_Type (Etype (E))
          then

gcc/ada/vms_data.ads

@@ -820,6 +820,13 @@ package VMS_Data is
    --
    --   Work quietly, only output warnings and errors.
 
+   S_Check_Time  : aliased constant S := "/TIME "                        &
+                                            "-t";
+   --        /NOTIME (D)
+   --        /QUIET
+   --
+   --   Print  out execution time
+
    S_Check_Sections : aliased constant S := "/SECTIONS="                   &
                                             "DEFAULT "                     &
                                                "-s123 "                    &
@@ -893,6 +900,7 @@ package VMS_Data is
                        S_Check_Mess     'Access,
                        S_Check_Project  'Access,
                        S_Check_Quiet    'Access,
+                       S_Check_Time     'Access,
                        S_Check_Sections 'Access,
                        S_Check_Short    'Access,
                        S_Check_Subdirs  'Access,