diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/ada/Makefile.rtl | 1 | ||||
| -rw-r--r-- | gcc/ada/a-stzhas.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/a-szfzha.ads | 7 | ||||
| -rw-r--r-- | gcc/ada/ali.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/prj-conf.adb | 183 | ||||
| -rw-r--r-- | gcc/ada/prj-conf.ads | 45 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/prj-part.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/prj.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 38 |
12 files changed, 225 insertions, 86 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 453a2676fdd..2e143ceb418 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +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 diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 1288f788813..5f06d1cf2e8 100644 --- a/gcc/ada/Makefile.rtl +++ b/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) \ diff --git a/gcc/ada/a-stzhas.ads b/gcc/ada/a-stzhas.ads index f7060e76d56..0c87672b520 100644 --- a/gcc/ada/a-stzhas.ads +++ b/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); diff --git a/gcc/ada/a-szfzha.ads b/gcc/ada/a-szfzha.ads index fbc6e87908b..5deb5d7c32b 100644 --- a/gcc/ada/a-szfzha.ads +++ b/gcc/ada/a-szfzha.ads @@ -14,10 +14,11 @@ -- -- ------------------------------------------------------------------------------ -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 - renames Ada.Strings.Wide_Wide_Hash; + (Key : Wide_Wide_String) return Containers.Hash_Type + renames Ada.Strings.Wide_Wide_Hash; pragma Pure (Ada.Strings.Wide_Wide_Fixed.Wide_Wide_Hash); diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 5e5c660caa5..dd23a80399d 100644 --- a/gcc/ada/ali.adb +++ b/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 diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 6da8ff90e44..507ccad5005 100644 --- a/gcc/ada/exp_ch4.adb +++ b/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; diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index 86e7081e46b..2591e6d0853 100644 --- a/gcc/ada/prj-conf.adb +++ b/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,13 +740,17 @@ package body Prj.Conf is Args (3) := new String'(Config_File_Name); end if; - if Target_Name = "" then - Args (4) := new String'("--target=" & Normalized_Hostname); + if Normalized_Hostname = "" then + Arg_Last := 3; else - Args (4) := new String'("--target=" & Target_Name); - end if; + if Target_Name = "" then + Args (4) := new String'("--target=" & Normalized_Hostname); + else + Args (4) := new String'("--target=" & Target_Name); + end if; - Arg_Last := 4; + 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; ----------------------- diff --git a/gcc/ada/prj-conf.ads b/gcc/ada/prj-conf.ads index dace0b0ce88..51cb8b37340 100644 --- a/gcc/ada/prj-conf.ads +++ b/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). diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 24535b76c56..04f8ec5b476 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/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; diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index 871517cba66..3c203f05268 100644 --- a/gcc/ada/prj-part.adb +++ b/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); diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 3302e773df5..fb69b0ce632 100644 --- a/gcc/ada/prj.ads +++ b/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); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 4063b12397e..29363f87129 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -4759,7 +4759,43 @@ package body Sem_Ch8 is -- Here we have the case of an undefined component else - Error_Msg_NE ("& not declared in&", N, Selector); + + -- 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 |