[multiple changes]

2009-07-07  Emmanuel Briot  <briot@adacore.com>

	* prj-nmsc.adb (Process_Naming): canonicalize file suffixes read in the
	project file.

2009-07-07  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch3.adb (Expand_Freeze_Record_Type): Add extra formals to
	primitive operations, in case one of them is called in the
	initialization procedure for the type.

From-SVN: r149325
This commit is contained in:
Arnaud Charlet 2009-07-07 15:12:32 +02:00
parent 84157c9a3f
commit 54ecb428e7
3 changed files with 76 additions and 7 deletions

View File

@ -1,3 +1,14 @@
2009-07-07 Emmanuel Briot <briot@adacore.com>
* prj-nmsc.adb (Process_Naming): canonicalize file suffixes read in the
project file.
2009-07-07 Ed Schonberg <schonberg@adacore.com>
* exp_ch3.adb (Expand_Freeze_Record_Type): Add extra formals to
primitive operations, in case one of them is called in the
initialization procedure for the type.
2009-07-07 Robert Dewar <dewar@adacore.com>
* a-calend.adb: Minor code reorganization (use conditional expressions)

View File

@ -53,6 +53,7 @@ with Sem_Aux; use Sem_Aux;
with Sem_Attr; use Sem_Attr;
with Sem_Cat; use Sem_Cat;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Disp; use Sem_Disp;
with Sem_Eval; use Sem_Eval;
@ -6012,6 +6013,29 @@ package body Exp_Ch3 is
if Present (Wrapper_Body_List) then
Append_Freeze_Actions (Def_Id, Wrapper_Body_List);
end if;
-- Create extra actuals for the primitive operations of the type.
-- This must be done before analyzing the body of the initialization
-- procedure, because a self-referential type might call one of these
-- primitives in the body of the init_proc itself.
declare
Elmt : Elmt_Id;
Subp : Entity_Id;
begin
Elmt := First_Elmt (Primitive_Operations (Def_Id));
while Present (Elmt) loop
Subp := Node (Elmt);
if not Has_Foreign_Convention (Subp)
and then not Is_Predefined_Dispatching_Operation (Subp)
then
Create_Extra_Formals (Subp);
end if;
Next_Elmt (Elmt);
end loop;
end;
end if;
end Expand_Freeze_Record_Type;

View File

@ -1677,7 +1677,9 @@ package body Prj.Nmsc is
-- Attribute Separate_Suffix
Separate_Suffix := File_Name_Type (Attribute.Value.Value);
Get_Name_String (Attribute.Value.Value);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Separate_Suffix := Name_Find;
elsif Attribute.Name = Name_Casing then
@ -1736,18 +1738,24 @@ package body Prj.Nmsc is
-- Attribute Spec_Suffix (<language>)
Get_Name_String (Element.Value.Value);
Canonical_Case_File_Name
(Name_Buffer (1 .. Name_Len));
Lang_Index.Config.Naming_Data.Spec_Suffix :=
File_Name_Type (Element.Value.Value);
Name_Find;
when Name_Implementation_Suffix | Name_Body_Suffix =>
Get_Name_String (Element.Value.Value);
Canonical_Case_File_Name
(Name_Buffer (1 .. Name_Len));
-- Attribute Body_Suffix (<language>)
Lang_Index.Config.Naming_Data.Body_Suffix :=
File_Name_Type (Element.Value.Value);
Name_Find;
Lang_Index.Config.Naming_Data.Separate_Suffix :=
File_Name_Type (Element.Value.Value);
Lang_Index.Config.Naming_Data.Body_Suffix;
when others =>
null;
@ -3360,9 +3368,10 @@ package body Prj.Nmsc is
(Name_Body_Suffix,
Naming.Decl.Arrays,
In_Tree);
Lang : Language_Ptr;
Lang : Language_Ptr;
Lang_Name : Name_Id;
Value : Variable_Value;
Value : Variable_Value;
Extended : Project_Id;
begin
-- At this stage, the project already contains the default
@ -3375,6 +3384,31 @@ package body Prj.Nmsc is
Lang := Get_Language_From_Name
(Project, Name => Get_Name_String (Lang_Name));
-- An extending project inherits its parent projects' languages
-- so if needed we should create entries for those languages
if Lang = null then
Extended := Project.Extends;
while Extended /= null loop
Lang := Get_Language_From_Name
(Extended, Name => Get_Name_String (Lang_Name));
exit when Lang /= null;
Extended := Extended.Extends;
end loop;
if Lang /= null then
Lang := new Language_Data'(Lang.all);
Lang.First_Source := null;
Lang.Next := Project.Languages;
Project.Languages := Lang;
end if;
end if;
-- If the language was not found in project or the projects it
-- extends
if Lang = null then
if Current_Verbosity = High then
Write_Line