From 54ecb428e7c408f1d8e018be6bb35147756ae0a4 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 7 Jul 2009 15:12:32 +0200 Subject: [PATCH] [multiple changes] 2009-07-07 Emmanuel Briot * prj-nmsc.adb (Process_Naming): canonicalize file suffixes read in the project file. 2009-07-07 Ed Schonberg * 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 --- gcc/ada/ChangeLog | 11 ++++++++++ gcc/ada/exp_ch3.adb | 24 ++++++++++++++++++++++ gcc/ada/prj-nmsc.adb | 48 +++++++++++++++++++++++++++++++++++++------- 3 files changed, 76 insertions(+), 7 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c8c03216382..42a63317015 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2009-07-07 Emmanuel Briot + + * prj-nmsc.adb (Process_Naming): canonicalize file suffixes read in the + project file. + +2009-07-07 Ed Schonberg + + * 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 * a-calend.adb: Minor code reorganization (use conditional expressions) diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 5aa5b644539..bb5d1f13880 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -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; diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 4e49b50abd9..be323be1e08 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -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 () + 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 () 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 -- 2.30.2