From: charlet Date: Mon, 5 Sep 2005 07:59:10 +0000 (+0000) Subject: 2005-09-01 Ed Schonberg X-Git-Tag: upstream/4.9.2~58830 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=31f4099f03ed4fb233943dd9c933b5ae3844addb;p=platform%2Fupstream%2Flinaro-gcc.git 2005-09-01 Ed Schonberg Javier Miranda Gary Dismukes * sem_ch12.adb (Instantiate_Subprogram_Body): When creating the defining entity for the instance body, make a new defining identifier rather than copying the entity of the spec, to prevent accidental sharing of the entity list. (Check_Private_View): When exchanging views of private types, build the list of exchanged views as a stack, to ensure that on exit the exchanges are undone in the proper order. (Analyze_Package_Instantiation, Analyze_Subprogram_Instantiation): Restore the compilation environment in case of instantiation_error. (Analyze_Generic_Subprogram_Declaration): Handle creation of type entity for an anonymous access result. (Instantiate_Generic_Subprogram): Subtype_Mark => Result_Definition (Formal_Entity): Handle properly the case of a formal package that denotes a generic package renaming. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@103879 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 35d16ec..05f89f6 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -33,7 +33,6 @@ with Fname; use Fname; with Fname.UF; use Fname.UF; with Freeze; use Freeze; with Hostparm; -with Inline; use Inline; with Lib; use Lib; with Lib.Load; use Lib.Load; with Lib.Xref; use Lib.Xref; @@ -2240,6 +2239,7 @@ package body Sem_Ch12 is Id : Entity_Id; Formals : List_Id; New_N : Node_Id; + Result_Type : Entity_Id; Save_Parent : Node_Id; begin @@ -2283,17 +2283,23 @@ package body Sem_Ch12 is if Nkind (Spec) = N_Function_Specification then Set_Ekind (Id, E_Generic_Function); - Find_Type (Subtype_Mark (Spec)); - Set_Etype (Id, Entity (Subtype_Mark (Spec))); + + if Nkind (Result_Definition (Spec)) = N_Access_Definition then + Result_Type := Access_Definition (Spec, Result_Definition (Spec)); + Set_Etype (Id, Result_Type); + else + Find_Type (Result_Definition (Spec)); + Set_Etype (Id, Entity (Result_Definition (Spec))); + end if; + else Set_Ekind (Id, E_Generic_Procedure); Set_Etype (Id, Standard_Void_Type); end if; - -- For a library unit, we have reconstructed the entity for the - -- unit, and must reset it in the library tables. We also need - -- to make sure that Body_Required is set properly in the original - -- compilation unit node. + -- For a library unit, we have reconstructed the entity for the unit, + -- and must reset it in the library tables. We also make sure that + -- Body_Required is set properly in the original compilation unit node. if Nkind (Parent (N)) = N_Compilation_Unit then Set_Cunit_Entity (Current_Sem_Unit, Id); @@ -2315,9 +2321,9 @@ package body Sem_Ch12 is -- Analyze_Package_Instantiation -- ----------------------------------- - -- Note: this procedure is also used for formal package declarations, - -- in which case the argument N is an N_Formal_Package_Declaration - -- node. This should really be noted in the spec! ??? + -- Note: this procedure is also used for formal package declarations, in + -- which case the argument N is an N_Formal_Package_Declaration node. + -- This should really be noted in the spec! ??? procedure Analyze_Package_Instantiation (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); @@ -2335,6 +2341,7 @@ package body Sem_Ch12 is Is_Actual_Pack : constant Boolean := Is_Internal (Defining_Entity (N)); + Env_Installed : Boolean := False; Parent_Installed : Boolean := False; Renaming_List : List_Id; Unit_Renaming : Node_Id; @@ -2428,6 +2435,7 @@ package body Sem_Ch12 is Pre_Analyze_Actuals (N); Init_Env; + Env_Installed := True; Check_Generic_Child_Unit (Gen_Id, Parent_Installed); Gen_Unit := Entity (Gen_Id); @@ -2900,6 +2908,7 @@ package body Sem_Ch12 is end if; Restore_Env; + Env_Installed := False; end if; Validate_Categorization_Dependency (N, Act_Decl_Id); @@ -2933,6 +2942,10 @@ package body Sem_Ch12 is if Parent_Installed then Remove_Parent; end if; + + if Env_Installed then + Restore_Env; + end if; end Analyze_Package_Instantiation; -------------------------- @@ -3188,6 +3201,7 @@ package body Sem_Ch12 is Act_Spec : Node_Id; Act_Tree : Node_Id; + Env_Installed : Boolean := False; Gen_Unit : Entity_Id; Gen_Decl : Node_Id; Pack_Id : Entity_Id; @@ -3364,6 +3378,7 @@ package body Sem_Ch12 is Pre_Analyze_Actuals (N); Init_Env; + Env_Installed := True; Check_Generic_Child_Unit (Gen_Id, Parent_Installed); Gen_Unit := Entity (Gen_Id); @@ -3598,6 +3613,7 @@ package body Sem_Ch12 is end if; Restore_Env; + Env_Installed := False; Generic_Renamings.Set_Last (0); Generic_Renamings_HTable.Reset; end if; @@ -3607,6 +3623,10 @@ package body Sem_Ch12 is if Parent_Installed then Remove_Parent; end if; + + if Env_Installed then + Restore_Env; + end if; end Analyze_Subprogram_Instantiation; ------------------------- @@ -4599,7 +4619,7 @@ package body Sem_Ch12 is elsif Nkind (Parent (N)) = N_Subtype_Declaration or else not In_Private_Part (Scope (Base_Type (T))) then - Append_Elmt (T, Exchanged_Views); + Prepend_Elmt (T, Exchanged_Views); Exchange_Declarations (Etype (Get_Associated_Node (N))); end if; @@ -4640,7 +4660,7 @@ package body Sem_Ch12 is and then not Is_Generic_Type (BT) and then not In_Open_Scopes (BT) then - Append_Elmt (Full_View (BT), Exchanged_Views); + Prepend_Elmt (Full_View (BT), Exchanged_Views); Exchange_Declarations (BT); end if; end if; @@ -6542,14 +6562,25 @@ package body Sem_Ch12 is Formal_Node : Node_Id; Formal_Ent : Entity_Id; - Gen_Decl : constant Node_Id := - Unit_Declaration_Node - (Entity (Name (Orig_Node))); - - Formals : constant List_Id := - Generic_Formal_Declarations (Gen_Decl); + Gen_Decl : Node_Id; + Formals : List_Id; begin + -- The actual may be a renamed generic package, in which + -- case we want to retrieve the original generic in order + -- to traverse its formal part. + + if Present (Renamed_Entity (Entity (Name (Orig_Node)))) then + Gen_Decl := + Unit_Declaration_Node ( + Renamed_Entity (Entity (Name (Orig_Node)))); + else + Gen_Decl := + Unit_Declaration_Node (Entity (Name (Orig_Node))); + end if; + + Formals := Generic_Formal_Declarations (Gen_Decl); + if Present (Formals) then Formal_Node := First_Non_Pragma (Formals); else @@ -7260,7 +7291,7 @@ package body Sem_Ch12 is Prepend (Subt_Decl, List); - Append_Elmt (Full_View (Ftyp), Exchanged_Views); + Prepend_Elmt (Full_View (Ftyp), Exchanged_Views); Exchange_Declarations (Ftyp); end if; @@ -7834,7 +7865,8 @@ package body Sem_Ch12 is Make_Subprogram_Body (Loc, Specification => Make_Procedure_Specification (Loc, - Defining_Unit_Name => New_Copy (Anon_Id), + Defining_Unit_Name => + Make_Defining_Identifier (Loc, Chars (Anon_Id)), Parameter_Specifications => New_Copy_List (Parameter_Specifications (Parent (Anon_Id)))), @@ -7860,11 +7892,12 @@ package body Sem_Ch12 is Make_Subprogram_Body (Loc, Specification => Make_Function_Specification (Loc, - Defining_Unit_Name => New_Copy (Anon_Id), + Defining_Unit_Name => + Make_Defining_Identifier (Loc, Chars (Anon_Id)), Parameter_Specifications => New_Copy_List (Parameter_Specifications (Parent (Anon_Id))), - Subtype_Mark => + Result_Definition => New_Occurrence_Of (Etype (Anon_Id), Loc)), Declarations => Empty_List, @@ -10165,7 +10198,7 @@ package body Sem_Ch12 is Priv_Elmt := First_Elmt (Private_Dependents (BT)); if Present (Full_View (BT)) then - Append_Elmt (Full_View (BT), Exchanged_Views); + Prepend_Elmt (Full_View (BT), Exchanged_Views); Exchange_Declarations (BT); end if; @@ -10184,7 +10217,7 @@ package body Sem_Ch12 is if Present (Full_View (Priv_Sub)) and then not Is_Private_Type (Etype (Full_View (Priv_Sub))) then - Append_Elmt (Full_View (Priv_Sub), Exchanged_Views); + Prepend_Elmt (Full_View (Priv_Sub), Exchanged_Views); Exchange_Declarations (Priv_Sub); end if;