mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-06 02:20:34 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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
This commit is contained in:
Arnaud Charlet 2009-06-23 11:49:38 +02:00
parent f91c36dc88
commit d6a24cdbbf
12 changed files with 225 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/ada/ChangeLog
View File

@ -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

1
gcc/ada/Makefile.rtl
View File

@ -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) \

4
gcc/ada/a-stzhas.ads
View File

@ -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);

7
gcc/ada/a-szfzha.ads
View File

@ -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);

4
gcc/ada/ali.adb
View File

@ -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

4
gcc/ada/exp_ch4.adb
View File

@ -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;

183
gcc/ada/prj-conf.adb
View File

@ -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;
-----------------------

45
gcc/ada/prj-conf.ads
View File

@ -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).

5
gcc/ada/prj-nmsc.adb
View File

@ -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;

13
gcc/ada/prj-part.adb
View File

@ -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);

2
gcc/ada/prj.ads
View File

@ -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);

38
gcc/ada/sem_ch8.adb
View File

@ -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