diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 22 | ||||
| -rw-r--r-- | gcc/ada/a-coorma.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/g-expect.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.ads | 15 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 34 | ||||
| -rw-r--r-- | gcc/ada/sprint.adb | 73 |
7 files changed, 120 insertions, 57 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6283b245d84..1d2f349f056 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2009-07-20 Vadim Godunko <godunko@adacore.com> + + * a-coorma.adb: Minor reformatting. + +2009-07-20 Ed Schonberg <schonberg@adacore.com> + + * sem_ch3 (Build_Itype_Reference): Make public, for use on non-null + access return types. + * sem_ch6.adb (Analyze_Return_Type): If return is a not null subtype, + provide an itype reference to gigi to force elaboration of the subtype + at the proper point. + +2009-07-20 Tristan Gingold <gingold@adacore.com> + + * g-expect.adb: Avoid closeing already closed handle. + +2009-07-20 Robert Dewar <dewar@adacore.com> + + * sprint.adb (Write_Subprogram_Name): New procedure to output + subprogram name with possible preceding $ (replaces + Note_Implicit_Run_Time_Call). + 2009-07-20 Robert Dewar <dewar@adacore.com> * vms_data.ads: Minor reformatting diff --git a/gcc/ada/a-coorma.adb b/gcc/ada/a-coorma.adb index 4b79200c304..934d9de658c 100644 --- a/gcc/ada/a-coorma.adb +++ b/gcc/ada/a-coorma.adb @@ -545,6 +545,10 @@ package body Ada.Containers.Ordered_Maps is end if; end Include; + ------------ + -- Insert -- + ------------ + procedure Insert (Container : in out Map; Key : Key_Type; @@ -605,10 +609,6 @@ package body Ada.Containers.Ordered_Maps is end if; end Insert; - ------------ - -- Insert -- - ------------ - procedure Insert (Container : in out Map; Key : Key_Type; diff --git a/gcc/ada/g-expect.adb b/gcc/ada/g-expect.adb index 7ce2c89d771..405b0331275 100644 --- a/gcc/ada/g-expect.adb +++ b/gcc/ada/g-expect.adb @@ -814,7 +814,8 @@ package body GNAT.Expect is Send (Process, Input); end if; - GNAT.OS_Lib.Close (Get_Input_Fd (Process)); + Close (Process.Input_Fd); + Process.Input_Fd := Invalid_FD; declare Result : Expect_Match; @@ -1305,10 +1306,14 @@ package body GNAT.Expect is pragma Warnings (Off, Pipe1); pragma Warnings (Off, Pipe2); pragma Warnings (Off, Pipe3); + begin Close (Pipe1.Input); Close (Pipe2.Output); - Close (Pipe3.Output); + + if Pipe3.Output /= Pipe2.Output then + Close (Pipe3.Output); + end if; end Set_Up_Parent_Communications; ------------------ diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 992b87a340b..2050954cbe3 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -229,21 +229,6 @@ package body Sem_Ch3 is -- Needs a more complete spec--what are the parameters exactly, and what -- exactly is the returned value, and how is Bound affected??? - procedure Build_Itype_Reference - (Ityp : Entity_Id; - Nod : Node_Id); - -- Create a reference to an internal type, for use by Gigi. The back-end - -- elaborates itypes on demand, i.e. when their first use is seen. This - -- can lead to scope anomalies if the first use is within a scope that is - -- nested within the scope that contains the point of definition of the - -- itype. The Itype_Reference node forces the elaboration of the itype - -- in the proper scope. The node is inserted after Nod, which is the - -- enclosing declaration that generated Ityp. - -- - -- A related mechanism is used during expansion, for itypes created in - -- branches of conditionals. See Ensure_Defined in exp_util. - -- Could both mechanisms be merged ??? - procedure Build_Underlying_Full_View (N : Node_Id; Typ : Entity_Id; @@ -11149,6 +11134,7 @@ package body Sem_Ch3 is Set_Convention (T1, Convention (T2)); Set_Is_Limited_Composite (T1, Is_Limited_Composite (T2)); Set_Is_Private_Composite (T1, Is_Private_Composite (T2)); + Set_Packed_Array_Type (T1, Packed_Array_Type (T2)); end Copy_Array_Subtype_Attributes; ----------------------------------- diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads index c8fc885e771..6c7dbaae032 100644 --- a/gcc/ada/sem_ch3.ads +++ b/gcc/ada/sem_ch3.ads @@ -79,6 +79,21 @@ package Sem_Ch3 is procedure Access_Type_Declaration (T : Entity_Id; Def : Node_Id); -- Process an access type declaration + procedure Build_Itype_Reference + (Ityp : Entity_Id; + Nod : Node_Id); + -- Create a reference to an internal type, for use by Gigi. The back-end + -- elaborates itypes on demand, i.e. when their first use is seen. This + -- can lead to scope anomalies if the first use is within a scope that is + -- nested within the scope that contains the point of definition of the + -- itype. The Itype_Reference node forces the elaboration of the itype + -- in the proper scope. The node is inserted after Nod, which is the + -- enclosing declaration that generated Ityp. + -- + -- A related mechanism is used during expansion, for itypes created in + -- branches of conditionals. See Ensure_Defined in exp_util. + -- Could both mechanisms be merged ??? + procedure Check_Abstract_Overriding (T : Entity_Id); -- Check that all abstract subprograms inherited from T's parent type -- have been overridden as required, and that nonabstract subprograms diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 009af960a24..9de012f5db7 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -641,6 +641,11 @@ package body Sem_Ch6 is then null; + elsif Etype (Base_Type (R_Type)) = R_Stm_Type + and then Is_Null_Extension (Base_Type (R_Type)) + then + null; + else Error_Msg_N ("wrong type for return_subtype_indication", Subtype_Ind); @@ -1322,9 +1327,32 @@ package body Sem_Ch6 is then Set_Etype (Designator, Create_Null_Excluding_Itype - (T => Typ, - Related_Nod => N, - Scope_Id => Scope (Current_Scope))); + (T => Typ, + Related_Nod => N, + Scope_Id => Scope (Current_Scope))); + + -- The new subtype must be elaborated before use because + -- it is visible outside of the function. However its base + -- type may not be frozen yet, so the reference that will + -- force elaboration must be attached to the freezing of + -- the base type. + + if Is_Frozen (Typ) then + Build_Itype_Reference + (Etype (Designator), Parent (N)); + else + Ensure_Freeze_Node (Typ); + + declare + IR : constant Node_Id := + Make_Itype_Reference (Sloc (N)); + + begin + Set_Itype (IR, Etype (Designator)); + Append_Freeze_Actions (Typ, New_List (IR)); + end; + end if; + else Set_Etype (Designator, Typ); end if; diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index 86d95f3371b..ec042b9ed79 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -164,11 +164,6 @@ package body Sprint is procedure Indent_End; -- Decrease indentation level - procedure Note_Implicit_Run_Time_Call (N : Node_Id); - -- N is the Name field of a function call or procedure statement call. - -- The effect of the call is to output a $ if the call is identified as - -- an implicit call to a run time routine. - procedure Print_Debug_Line (S : String); -- Used to print output lines in Debug_Generated_Code mode (this is used -- as the argument for a call to Set_Special_Output in package Output). @@ -328,6 +323,11 @@ package body Sprint is -- Like Write_Str_With_Col_Check, but sets debug Sloc of current debug -- node to first non-blank character if a current debug node is active. + procedure Write_Subprogram_Name (N : Node_Id); + -- N is the Name field of a function call or procedure statement call. + -- The effect of the call is to output the name, preceded by a $ if the + -- call is identified as an implicit call to a run time routine. + procedure Write_Uint_With_Col_Check (U : Uint; Format : UI_Format); -- Write Uint (using UI_Write) with initial column check, and possible -- initial Write_Indent (to get new line) if current line is too full. @@ -395,30 +395,6 @@ package body Sprint is Indent := Indent - 3; end Indent_End; - --------------------------------- - -- Note_Implicit_Run_Time_Call -- - --------------------------------- - - procedure Note_Implicit_Run_Time_Call (N : Node_Id) is - begin - if not Comes_From_Source (N) - and then Is_Entity_Name (N) - then - declare - Ent : constant Entity_Id := Entity (N); - begin - if not In_Extended_Main_Source_Unit (Ent) - and then - Is_Predefined_File_Name - (Unit_File_Name (Get_Source_Unit (Ent))) - then - Col_Check (Length_Of_Name (Chars (Ent))); - Write_Char ('$'); - end if; - end; - end if; - end Note_Implicit_Run_Time_Call; - -------- -- pg -- -------- @@ -1749,8 +1725,7 @@ package body Sprint is when N_Function_Call => Set_Debug_Sloc; - Note_Implicit_Run_Time_Call (Name (Node)); - Sprint_Node (Name (Node)); + Write_Subprogram_Name (Name (Node)); Sprint_Opt_Paren_Comma_List (Parameter_Associations (Node)); when N_Function_Instantiation => @@ -2468,8 +2443,7 @@ package body Sprint is when N_Procedure_Call_Statement => Write_Indent; Set_Debug_Sloc; - Note_Implicit_Run_Time_Call (Name (Node)); - Sprint_Node (Name (Node)); + Write_Subprogram_Name (Name (Node)); Sprint_Opt_Paren_Comma_List (Parameter_Associations (Node)); Write_Char (';'); @@ -4266,6 +4240,39 @@ package body Sprint is end if; end Write_Str_With_Col_Check_Sloc; + --------------------------- + -- Write_Subprogram_Name -- + --------------------------- + + procedure Write_Subprogram_Name (N : Node_Id) is + begin + if not Comes_From_Source (N) + and then Is_Entity_Name (N) + then + declare + Ent : constant Entity_Id := Entity (N); + begin + if not In_Extended_Main_Source_Unit (Ent) + and then + Is_Predefined_File_Name + (Unit_File_Name (Get_Source_Unit (Ent))) + then + -- Run-time routine name, output name with a preceding dollar + -- making sure that we do not get a line split between them. + + Col_Check (Length_Of_Name (Chars (Ent)) + 1); + Write_Char ('$'); + Write_Name (Chars (Ent)); + return; + end if; + end; + end if; + + -- Normal case, not a run-time routine name + + Sprint_Node (N); + end Write_Subprogram_Name; + ------------------------------- -- Write_Uint_With_Col_Check -- ------------------------------- |