[multiple changes]

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

	* exp_ch4.adb (Displace_Allocator_Pointer, Expand_N_Allocator): Handle
	designated types referencing entities from the limited view.

2009-06-23  Matthew Gingell  <gingell@adacore.com>

	* a-stzhas.ads, a-szfzha.ads: Fix typo.

	* Makefile.rtl: Ada.Strings.Wide_Wide_Fixed.Wide_Wide_Hash depends on
	Ada.Strings.Wide_Wide_Hash. So we need to include a-stzhas in
	the list of RTS files.

2009-06-23  Thomas Quinot  <quinot@adacore.com>

	* ali.adb: Minor reformatting

2009-06-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb: Improve error message.

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

	* prj-nmsc.adb: Minor reformating

	* prj-conf.adb, prj-conf.ads: Remove use of Osint.Fail everywhere
	(Do_Autoconf): accepts an empty Normalized_Hostname
	(Process_Project_And_Apply_Config): New subprogram
	(Parse_Project_And_Apply_Config): On_Load_Config now applies to the
	project tree rather than the project view.

	* prj-part.adb, prj.ads (Project_Qualifier): New possible value
	Configuration.

From-SVN: r148838

gcc/ada/ChangeLog

+2009-06-23  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch4.adb (Displace_Allocator_Pointer, Expand_N_Allocator): Handle
+	designated types referencing entities from the limited view.
+
 2009-06-23  Robert Dewar  <dewar@adacore.com>
 
 	* s-strhas.adb, s-strhas.ads: Restrict to 32-bit modular types

gcc/ada/Makefile.rtl

@@ -220,6 +220,7 @@ GNATRTL_NONTASKING_OBJS= \
   a-stwiun$(objext) \
   a-stzbou$(objext) \
   a-stzfix$(objext) \
+  a-stzhas$(objext) \
   a-stzmap$(objext) \
   a-stzsea$(objext) \
   a-stzsup$(objext) \

gcc/ada/a-stzhas.ads

@@ -16,8 +16,10 @@
 --  Is this really an RM unit? Doc needed???
 
 with Ada.Containers;
+with System.String_Hash;
 
 function Ada.Strings.Wide_Wide_Hash
-  (Key : Wide_Wide_String) return Containers.Hash_Type;
+is new System.String_Hash.Hash
+  (Wide_Wide_Character, Wide_Wide_String, Containers.Hash_Type);
 
 pragma Pure (Ada.Strings.Wide_Wide_Hash);

gcc/ada/a-szfzha.ads

@@ -14,7 +14,8 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Ada.Containers, Ada.Strings.Wide_Wide_Hash;
+with Ada.Containers;
+with Ada.Strings.Wide_Wide_Hash;
 
 function Ada.Strings.Wide_Wide_Fixed.Wide_Wide_Hash
  (Key : Wide_Wide_String) return Containers.Hash_Type

gcc/ada/ali.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- --
@@ -532,7 +532,7 @@ package body ALI is
       begin
          Skip_Space;
 
-         --  Check if we are on a number. In the case of bas ALI files, this
+         --  Check if we are on a number. In the case of bad ALI files, this
          --  may not be true.
 
          if not (Nextc in '0' .. '9') then

gcc/ada/exp_ch4.adb

@@ -386,7 +386,7 @@ package body Exp_Ch4 is
         and then Nkind (Orig_Node) = N_Allocator);
 
       PtrT := Etype (Orig_Node);
-      Dtyp := Designated_Type (PtrT);
+      Dtyp := Available_View (Designated_Type (PtrT));
       Etyp := Etype (Expression (Orig_Node));
 
       if Is_Class_Wide_Type (Dtyp)
@@ -2999,7 +2999,7 @@ package body Exp_Ch4 is
 
    procedure Expand_N_Allocator (N : Node_Id) is
       PtrT  : constant Entity_Id  := Etype (N);
-      Dtyp  : constant Entity_Id  := Designated_Type (PtrT);
+      Dtyp  : constant Entity_Id  := Available_View (Designated_Type (PtrT));
       Etyp  : constant Entity_Id  := Etype (Expression (N));
       Loc   : constant Source_Ptr := Sloc (N);
       Desig : Entity_Id;

gcc/ada/prj-conf.adb

@@ -28,9 +28,7 @@ with Ada.Directories;  use Ada.Directories;
 with GNAT.HTable;      use GNAT.HTable;
 with Makeutl;          use Makeutl;
 with Opt;              use Opt;
-with Osint;            use Osint;
 with Output;           use Output;
-with Prj.Err;          use Prj.Err;
 with Prj.Part;
 with Prj.Proc;         use Prj.Proc;
 with Prj.Tree;         use Prj.Tree;
@@ -83,12 +81,11 @@ package body Prj.Conf is
       Autoconf_Specified : Boolean;
       Project_Tree       : Prj.Project_Tree_Ref;
       Target             : String := "") return Boolean;
-   --  Check that the config file's target matches Target. Target should be
-   --  set to the empty string when the user did not specify a target. If the
-   --  target in the configuration file is invalid, this function will call
-   --  Osint.Fail to report a fatal error message and stop the program.
-   --  Autoconf_Specified should be set to True if the user has used
-   --  autoconf.
+   --  Check that the config file's target matches Target.
+   --  Target should be set to the empty string when the user did not specify
+   --  a target. If the target in the configuration file is invalid, this
+   --  function will raise Invalid_Config with an appropriate message.
+   --  Autoconf_Specified should be set to True if the user has used --autoconf
 
    --------------------
    -- Add_Attributes --
@@ -369,12 +366,13 @@ package body Prj.Conf is
 
          else
             if Tgt_Name /= No_Name then
-               Osint.Fail ("invalid target name """ &
-                           Get_Name_String (Tgt_Name) &
-                           """ in configuration");
+               raise Invalid_Config
+                 with "invalid target name """
+                   & Get_Name_String (Tgt_Name) & """ in configuration";
 
             else
-               Osint.Fail ("no target specified in configuration file");
+               raise Invalid_Config
+                 with "no target specified in configuration file";
             end if;
          end if;
       end if;
@@ -398,13 +396,16 @@ package body Prj.Conf is
       Packages_To_Check          : String_List_Access := null;
       Config                     : out Prj.Project_Id;
       Config_File_Path           : out String_Access;
-      Automatically_Generated    : out Boolean)
+      Automatically_Generated    : out Boolean;
+      On_Load_Config             : Config_File_Hook := null)
    is
       function Default_File_Name return String;
       --  Return the name of the default config file that should be tested
 
       procedure Do_Autoconf;
-      --  Generate a new config file through gprconfig
+      --  Generate a new config file through gprconfig.
+      --  In case of error, this raises the Invalid_Config exception with an
+      --  appropriate message
 
       function Get_Config_Switches return Argument_List_Access;
       --  Return the --config switches to use for gprconfig
@@ -656,7 +657,8 @@ package body Prj.Conf is
          Gprconfig_Path := Locate_Exec_On_Path (Gprconfig_Name);
 
          if Gprconfig_Path = null then
-            Fail ("could not locate gprconfig for auto-configuration");
+            raise Invalid_Config
+              with "could not locate gprconfig for auto-configuration";
          end if;
 
          --  First, find the object directory of the user's project
@@ -714,12 +716,14 @@ package body Prj.Conf is
 
                exception
                   when others =>
-                     Fail ("could not create object directory " & Obj_Dir);
+                     raise Invalid_Config
+                       with "could not create object directory " & Obj_Dir;
                end;
             end if;
 
             if not Is_Directory (Obj_Dir) then
-               Fail ("object directory " & Obj_Dir & " does not exist");
+               raise Invalid_Config
+                 with "object directory " & Obj_Dir & " does not exist";
             end if;
 
             --  Invoke gprconfig
@@ -736,6 +740,9 @@ package body Prj.Conf is
                Args (3) := new String'(Config_File_Name);
             end if;
 
+            if Normalized_Hostname = "" then
+               Arg_Last := 3;
+            else
                if Target_Name = "" then
                   Args (4) := new String'("--target=" & Normalized_Hostname);
                else
@@ -743,6 +750,7 @@ package body Prj.Conf is
                end if;
 
                Arg_Last := 4;
+            end if;
 
             if not Verbose_Mode then
                Arg_Last := Arg_Last + 1;
@@ -778,7 +786,8 @@ package body Prj.Conf is
             Config_File_Path := Locate_Config_File (Args (3).all);
 
             if Config_File_Path = null then
-               Fail ("could not create " & Args (3).all);
+               raise Invalid_Config
+                 with "could not create " & Args (3).all;
             end if;
 
             for F in Args'Range loop
@@ -803,9 +812,9 @@ package body Prj.Conf is
          if (not Allow_Automatic_Generation) and then
             Config_File_Name /= ""
          then
-            Osint.Fail
-              ("could not locate main configuration project " &
-               Config_File_Name);
+            raise Invalid_Config
+              with "could not locate main configuration project "
+                & Config_File_Name;
          end if;
       end if;
 
@@ -815,6 +824,7 @@ package body Prj.Conf is
       <<Process_Config_File>>
 
       if Automatically_Generated then
+         --  This might raise an Invalid_Config exception
          Do_Autoconf;
       end if;
 
@@ -835,6 +845,13 @@ package body Prj.Conf is
          Is_Config_File         => True);
 
       if Config_Project_Node /= Empty_Node then
+
+         if On_Load_Config /= null then
+            On_Load_Config
+              (Config_File       => Config_Project_Node,
+               Project_Node_Tree => Project_Node_Tree);
+         end if;
+
          Prj.Proc.Process_Project_Tree_Phase_1
            (In_Tree                => Project_Tree,
             Project                => Config,
@@ -848,9 +865,9 @@ package body Prj.Conf is
       if Config_Project_Node = Empty_Node
         or else Config = No_Project
       then
-         Osint.Fail
-           ("processing of configuration project """ &
-            Config_File_Path.all & """ failed");
+         raise Invalid_Config
+           with "processing of configuration project """
+             & Config_File_Path.all & """ failed";
       end if;
 
       --  Check that the target of the configuration file is the one the user
@@ -866,16 +883,15 @@ package body Prj.Conf is
       end if;
    end Get_Or_Create_Configuration_File;
 
-   ------------------------------------
-   -- Parse_Project_And_Apply_Config --
-   ------------------------------------
+   --------------------------------------
+   -- Process_Project_And_Apply_Config --
+   --------------------------------------
 
-   procedure Parse_Project_And_Apply_Config
+   procedure Process_Project_And_Apply_Config
      (Main_Project               : out Prj.Project_Id;
-      User_Project_Node          : out Prj.Tree.Project_Node_Id;
+      User_Project_Node          : Prj.Tree.Project_Node_Id;
       Config_File_Name           : String := "";
       Autoconf_Specified         : Boolean;
-      Project_File_Name          : String;
       Project_Tree               : Prj.Project_Tree_Ref;
       Project_Node_Tree          : Prj.Tree.Project_Node_Tree_Ref;
       Packages_To_Check          : String_List_Access;
@@ -884,41 +900,23 @@ package body Prj.Conf is
       Config_File_Path           : out String_Access;
       Target_Name                : String := "";
       Normalized_Hostname        : String;
+      Report_Error               : Put_Line_Access := null;
       On_Load_Config             : Config_File_Hook := null)
    is
       Main_Config_Project : Project_Id;
       Success : Boolean;
 
    begin
-      --  Parse the user project tree
-
-      Prj.Initialize (Project_Tree);
-      Prj.Tree.Initialize (Project_Node_Tree);
-
       Main_Project := No_Project;
       Automatically_Generated := False;
 
-      Prj.Part.Parse
-        (In_Tree                => Project_Node_Tree,
-         Project                => User_Project_Node,
-         Project_File_Name      => Project_File_Name,
-         Always_Errout_Finalize => False,
-         Packages_To_Check      => Packages_To_Check,
-         Current_Directory      => Current_Directory,
-         Is_Config_File         => False);
-
-      if User_Project_Node = Empty_Node then
-         User_Project_Node := Empty_Node;
-         return;
-      end if;
-
       Process_Project_Tree_Phase_1
         (In_Tree                => Project_Tree,
          Project                => Main_Project,
          Success                => Success,
          From_Project_Node      => User_Project_Node,
          From_Project_Node_Tree => Project_Node_Tree,
-         Report_Error           => null);
+         Report_Error           => Report_Error);
 
       if not Success then
          Main_Project := No_Project;
@@ -939,13 +937,8 @@ package body Prj.Conf is
          Normalized_Hostname        => Normalized_Hostname,
          Packages_To_Check          => Packages_To_Check,
          Config_File_Path           => Config_File_Path,
-         Automatically_Generated    => Automatically_Generated);
-
-      if On_Load_Config /= null then
-         On_Load_Config
-           (Config_File  => Main_Config_Project,
-            Project_Tree => Project_Tree);
-      end if;
+         Automatically_Generated    => Automatically_Generated,
+         On_Load_Config             => On_Load_Config);
 
       Apply_Config_File (Main_Config_Project, Project_Tree);
 
@@ -959,15 +952,75 @@ package body Prj.Conf is
          Success                => Success,
          From_Project_Node      => User_Project_Node,
          From_Project_Node_Tree => Project_Node_Tree,
-         Report_Error           => null,
+         Report_Error           => Report_Error,
          Current_Dir            => Current_Directory,
          When_No_Sources        => Warning,
          Is_Config_File         => False);
 
       if not Success then
-         Prj.Err.Finalize;
-         Osint.Fail ("""" & Project_File_Name & """ processing failed");
+         Main_Project := No_Project;
       end if;
+   end Process_Project_And_Apply_Config;
+
+   ------------------------------------
+   -- Parse_Project_And_Apply_Config --
+   ------------------------------------
+
+   procedure Parse_Project_And_Apply_Config
+     (Main_Project               : out Prj.Project_Id;
+      User_Project_Node          : out Prj.Tree.Project_Node_Id;
+      Config_File_Name           : String := "";
+      Autoconf_Specified         : Boolean;
+      Project_File_Name          : String;
+      Project_Tree               : Prj.Project_Tree_Ref;
+      Project_Node_Tree          : Prj.Tree.Project_Node_Tree_Ref;
+      Packages_To_Check          : String_List_Access;
+      Allow_Automatic_Generation : Boolean := True;
+      Automatically_Generated    : out Boolean;
+      Config_File_Path           : out String_Access;
+      Target_Name                : String := "";
+      Normalized_Hostname        : String;
+      Report_Error               : Put_Line_Access := null;
+      On_Load_Config             : Config_File_Hook := null)
+   is
+   begin
+      --  Parse the user project tree
+
+      Prj.Tree.Initialize (Project_Node_Tree);
+      Prj.Initialize (Project_Tree);
+
+      Main_Project      := No_Project;
+      Automatically_Generated := False;
+
+      Prj.Part.Parse
+        (In_Tree                => Project_Node_Tree,
+         Project                => User_Project_Node,
+         Project_File_Name      => Project_File_Name,
+         Always_Errout_Finalize => False,
+         Packages_To_Check      => Packages_To_Check,
+         Current_Directory      => Current_Directory,
+         Is_Config_File         => False);
+
+      if User_Project_Node = Empty_Node then
+         User_Project_Node := Empty_Node;
+         return;
+      end if;
+
+      Process_Project_And_Apply_Config
+        (Main_Project               => Main_Project,
+         User_Project_Node          => User_Project_Node,
+         Config_File_Name           => Config_File_Name,
+         Autoconf_Specified         => Autoconf_Specified,
+         Project_Tree               => Project_Tree,
+         Project_Node_Tree          => Project_Node_Tree,
+         Packages_To_Check          => Packages_To_Check,
+         Allow_Automatic_Generation => Allow_Automatic_Generation,
+         Automatically_Generated    => Automatically_Generated,
+         Config_File_Path           => Config_File_Path,
+         Target_Name                => Target_Name,
+         Normalized_Hostname        => Normalized_Hostname,
+         Report_Error               => Report_Error,
+         On_Load_Config             => On_Load_Config);
    end Parse_Project_And_Apply_Config;
 
    -----------------------

gcc/ada/prj-conf.ads

@@ -31,12 +31,12 @@ with Prj.Tree;
 package Prj.Conf is
 
    type Config_File_Hook is access procedure
-     (Config_File  : Prj.Project_Id;
-      Project_Tree : Prj.Project_Tree_Ref);
+     (Config_File       : Prj.Tree.Project_Node_Id;
+      Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref);
    --  Hook called after the config file has been parsed. This lets the
    --  application do last minute changes to it (GPS uses this to add the
-   --  default naming schemes for instance). At that point, the config file
-   --  has not been applied to the project yet.
+   --  default naming schemes for instance).
+   --  At that point, the config file has not been applied to the project yet.
 
    procedure Parse_Project_And_Apply_Config
      (Main_Project               : out Prj.Project_Id;
@@ -52,13 +52,14 @@ package Prj.Conf is
       Config_File_Path           : out String_Access;
       Target_Name                : String := "";
       Normalized_Hostname        : String;
+      Report_Error               : Put_Line_Access := null;
       On_Load_Config             : Config_File_Hook := null);
    --  Find the main configuration project and parse the project tree rooted at
    --  this configuration project.
    --
    --  If the processing fails, Main_Project is set to No_Project. If the error
    --  happend while parsing the project itself (ie creating the tree),
-   --  User_Project_Node is also set to Empty_Node
+   --  User_Project_Node is also set to Empty_Node.
    --
    --  Autoconf_Specified indicates whether the user has specified --autoconf.
    --  If this is the case, the config file might be (re)generated, as
@@ -74,6 +75,31 @@ package Prj.Conf is
    --  If specified, On_Load_Config is called just after the config file has
    --  been created/loaded. You can then modify it before it is later applied
    --  to the project itself.
+   --
+   --  Any error in generating or parsing the config file is reported via the
+   --  Invalid_Config exception, with an appropriate message. Any error while
+   --  parsing the project file results in No_Project.
+
+   procedure Process_Project_And_Apply_Config
+     (Main_Project               : out Prj.Project_Id;
+      User_Project_Node          : Prj.Tree.Project_Node_Id;
+      Config_File_Name           : String := "";
+      Autoconf_Specified         : Boolean;
+      Project_Tree               : Prj.Project_Tree_Ref;
+      Project_Node_Tree          : Prj.Tree.Project_Node_Tree_Ref;
+      Packages_To_Check          : String_List_Access;
+      Allow_Automatic_Generation : Boolean := True;
+      Automatically_Generated    : out Boolean;
+      Config_File_Path           : out String_Access;
+      Target_Name                : String := "";
+      Normalized_Hostname        : String;
+      Report_Error               : Put_Line_Access := null;
+      On_Load_Config             : Config_File_Hook := null);
+   --  Same as above, except the project must already have been parsed through
+   --  Prj.Part.Parse, and only the processing of the project and the
+   --  configuration is done at this level.
+
+   Invalid_Config : exception;
 
    procedure Get_Or_Create_Configuration_File
      (Project                    : Prj.Project_Id;
@@ -87,11 +113,14 @@ package Prj.Conf is
       Packages_To_Check          : String_List_Access := null;
       Config                     : out Prj.Project_Id;
       Config_File_Path           : out String_Access;
-      Automatically_Generated    : out Boolean);
+      Automatically_Generated    : out Boolean;
+      On_Load_Config             : Config_File_Hook := null);
    --  Compute the name of the configuration file that should be used. If no
    --  default configuration file is found, a new one will be automatically
-   --  generated if Allow_Automatic_Generation is true (otherwise an error
-   --  reported to the user via Osint.Fail).
+   --  generated if Allow_Automatic_Generation is true.
+   --
+   --  Any error in generating or parsing the config file is reported via the
+   --  Invalid_Config exception, with an appropriate message.
    --
    --  On exit, Configuration_Project_Path is never null (if none could be
    --  found, Os.Fail was called and the program exited anyway).

gcc/ada/prj-nmsc.adb

@@ -5861,8 +5861,7 @@ package body Prj.Nmsc is
          --  No Source_Dirs specified: the single source directory is the one
          --  containing the project file
 
-         String_Element_Table.Increment_Last
-           (In_Tree.String_Elements);
+         String_Element_Table.Increment_Last (In_Tree.String_Elements);
          Project.Source_Dirs := String_Element_Table.Last
            (In_Tree.String_Elements);
          In_Tree.String_Elements.Table (Project.Source_Dirs) :=
@@ -5875,7 +5874,7 @@ package body Prj.Nmsc is
 
          if Current_Verbosity = High then
             Write_Attr
-              ("Single source directory",
+              ("Default source directory",
                Get_Name_String (Project.Directory.Display_Name));
          end if;
 

gcc/ada/prj-part.adb

@@ -1218,6 +1218,7 @@ package body Prj.Part is
                              Token_Ptr);
                end if;
 
+               Proj_Qualifier := Configuration;
                Scan (In_Tree);
 
             when others =>
@@ -1225,8 +1226,18 @@ package body Prj.Part is
          end case;
       end if;
 
+      if Is_Config_File and then Proj_Qualifier = Unspecified then
+         --  Set the qualifier to Configuration, even if the token doesn't
+         --  exist in the source file itself, so that we can differentiate
+         --  project files and configuration files later on.
+
+         Proj_Qualifier := Configuration;
+      end if;
+
       if Proj_Qualifier /= Unspecified then
-         if Is_Config_File then
+         if Is_Config_File
+           and then Proj_Qualifier /= Configuration
+         then
             Error_Msg ("a configuration project cannot be qualified except " &
                        "as configuration project",
                        Qualifier_Location);

gcc/ada/prj.ads

@@ -67,6 +67,7 @@ package Prj is
      (Unspecified,
       Standard,
       Library,
+      Configuration,
       Dry,
       Aggregate,
       Aggregate_Library);
@@ -77,6 +78,7 @@ package Prj is
    --    Dry:                  abstract project is
    --    Aggregate:            aggregate project is
    --    Aggregate_Library:    aggregate library project is ...
+   --    Configuration:        configuration project is ...
 
    function Get_Mode return Mode;
    pragma Inline (Get_Mode);

gcc/ada/sem_ch8.adb

@@ -4759,7 +4759,43 @@ package body Sem_Ch8 is
                --  Here we have the case of an undefined component
 
                else
+
+                  --  The prefix may hide a homonym in the context that
+                  --  declares the desired entity. This error can use a
+                  --  specialized message.
+
+                  if In_Open_Scopes (P_Name)
+                    and then Present (Homonym (P_Name))
+                    and then Is_Compilation_Unit (Homonym (P_Name))
+                    and then
+                     (Is_Immediately_Visible (Homonym (P_Name))
+                        or else Is_Visible_Child_Unit (Homonym (P_Name)))
+                  then
+                     declare
+                        H : constant Entity_Id := Homonym (P_Name);
+                     begin
+                        Id := First_Entity (H);
+                        while Present (Id) loop
+
+                           if Chars (Id) = Chars (Selector) then
+                              Error_Msg_Qual_Level := 99;
+                              Error_Msg_Name_1 := Chars (Selector);
+                              Error_Msg_NE
+                                ("% not declared in&", N, P_Name);
+                              Error_Msg_NE
+                                ("\use fully qualified name starting with"
+                                  & " Standard to make& visible", N, H);
+                              Error_Msg_Qual_Level := 0;
+                              exit;
+                           end if;
+
+                           Next_Entity (Id);
+                        end loop;
+                     end;
+
+                  else
                      Error_Msg_NE ("& not declared in&", N, Selector);
+                  end if;
 
                   --  Check for misspelling of some entity in prefix