Skip to content

R
riscv-gcc-1
Commit fadcf313 by Arnaud Charlet
Options

[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
parent 5b900a45
Showing with 159 additions and 154 deletions
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,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment