From 57d22af251655cc429d5dec2f6234f33a3c2d8c9 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 22 May 2015 14:50:35 +0200 Subject: [PATCH] [multiple changes] 2015-05-22 Eric Botcazou * sprint.adb (Source_Dump): When generating debug files, deal with the case of a stand-alone package instantiation by dumping together the spec and the body in the common debug file. 2015-05-22 Robert Dewar * sem_ch13.adb (Minimum_Size): Size is zero for null range discrete subtype. 2015-05-22 Hristian Kirtchev * einfo.adb (Anonymous_Master): This attribute now applies to package and subprogram bodies. (Set_Anonymous_Master): This attribute now applies to package and subprogram bodies. (Write_Field36_Name): Add output for package and subprogram bodies. * einfo.ads Update the documentation on attribute Anonymous_Master along with occurrences in entities. * exp_ch4.adb (Create_Anonymous_Master): Reimplemented to handle spec and body anonymous masters of the same unit. (Current_Anonymous_Master): Reimplemented. Handle a package instantiation that acts as a compilation unit. (Insert_And_Analyze): Reimplemented. 2015-05-22 Ed Schonberg * sem_ch10.adb (Analyze_With_Clause): A limited_with_clause on a predefined unit is treated as a regular with_clause. From-SVN: r223557 --- gcc/ada/ChangeLog | 31 ++++++++ gcc/ada/einfo.adb | 16 +++- gcc/ada/einfo.ads | 10 ++- gcc/ada/exp_ch4.adb | 171 ++++++++++++++++++++++++++----------------- gcc/ada/sem_ch10.adb | 15 +++- gcc/ada/sem_ch13.adb | 11 ++- gcc/ada/sprint.adb | 23 +++++- 7 files changed, 200 insertions(+), 77 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index bb5f5e73202..9c8ddbfaf3a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,34 @@ +2015-05-22 Eric Botcazou + + * sprint.adb (Source_Dump): When generating debug files, deal + with the case of a stand-alone package instantiation by dumping + together the spec and the body in the common debug file. + +2015-05-22 Robert Dewar + + * sem_ch13.adb (Minimum_Size): Size is zero for null range + discrete subtype. + +2015-05-22 Hristian Kirtchev + + * einfo.adb (Anonymous_Master): This attribute now applies + to package and subprogram bodies. + (Set_Anonymous_Master): This attribute now applies to package and + subprogram bodies. + (Write_Field36_Name): Add output for package and subprogram bodies. + * einfo.ads Update the documentation on attribute Anonymous_Master + along with occurrences in entities. + * exp_ch4.adb (Create_Anonymous_Master): Reimplemented to + handle spec and body anonymous masters of the same unit. + (Current_Anonymous_Master): Reimplemented. Handle a + package instantiation that acts as a compilation unit. + (Insert_And_Analyze): Reimplemented. + +2015-05-22 Ed Schonberg + + * sem_ch10.adb (Analyze_With_Clause): A limited_with_clause on a + predefined unit is treated as a regular with_clause. + 2015-05-22 Robert Dewar * sem_ch12.adb, prj.ads, makeutl.ads, sem_ch6.adb, prj-nmsc.adb, diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index bcbf20f5409..9b7cced24cb 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -757,7 +757,11 @@ package body Einfo is function Anonymous_Master (Id : E) return E is begin - pragma Assert (Ekind_In (Id, E_Function, E_Package, E_Procedure)); + pragma Assert (Ekind_In (Id, E_Function, + E_Package, + E_Package_Body, + E_Procedure, + E_Subprogram_Body)); return Node36 (Id); end Anonymous_Master; @@ -3586,7 +3590,11 @@ package body Einfo is procedure Set_Anonymous_Master (Id : E; V : E) is begin - pragma Assert (Ekind_In (Id, E_Function, E_Package, E_Procedure)); + pragma Assert (Ekind_In (Id, E_Function, + E_Package, + E_Package_Body, + E_Procedure, + E_Subprogram_Body)); Set_Node36 (Id, V); end Set_Anonymous_Master; @@ -10141,7 +10149,9 @@ package body Einfo is when E_Function | E_Operator | E_Package | - E_Procedure => + E_Package_Body | + E_Procedure | + E_Subprogram_Body => Write_Str ("Anonymous_Master"); when others => diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 550294f1c15..76a8ff7e098 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -437,10 +437,10 @@ package Einfo is -- into an attribute definition clause for this purpose. -- Anonymous_Master (Node36) --- Defined in the entities of non-generic subprogram and package units. --- Contains the entity of a special heterogeneous finalization master --- that services most anonymous access-to-controlled allocations that --- occur within the unit. +-- Defined in the entities of non-generic packages, subprograms and their +-- corresponding bodies. Contains the entity of a special heterogeneous +-- finalization master that services most anonymous access-to-controlled +-- allocations that occur within the unit. -- Associated_Entity (Node37) -- Defined in all entities. This field is similar to Associated_Node, but @@ -6096,6 +6096,7 @@ package Einfo is -- SPARK_Pragma (Node32) -- SPARK_Aux_Pragma (Node33) -- Contract (Node34) + -- Anonymous_Master (Node36) -- Contains_Ignored_Ghost_Code (Flag279) -- Delay_Subprogram_Descriptors (Flag50) -- SPARK_Aux_Pragma_Inherited (Flag266) @@ -6320,6 +6321,7 @@ package Einfo is -- Extra_Formals (Node28) -- SPARK_Pragma (Node32) -- Contract (Node34) + -- Anonymous_Master (Node36) -- Contains_Ignored_Ghost_Code (Flag279) -- SPARK_Pragma_Inherited (Flag265) -- Scope_Depth (synth) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index c268968dd03..9f3be7eb272 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -416,82 +416,134 @@ package body Exp_Ch4 is function Current_Anonymous_Master return Entity_Id is function Create_Anonymous_Master - (Unit_Id : Entity_Id; - Decls : List_Id) return Entity_Id; - -- Create a new anonymous finalization master for a unit denoted by - -- Unit_Id. The declaration of the master along with any specialized - -- initialization is inserted at the top of declarative list Decls. - -- Return the entity of the anonymous master. + (Unit_Id : Entity_Id; + Unit_Decl : Node_Id) return Entity_Id; + -- Create a new anonymous master for a compilation unit denoted by its + -- entity Unit_Id and declaration Unit_Decl. The declaration of the new + -- master along with any specialized initialization is inserted at the + -- top of the unit's declarations (see body for special cases). Return + -- the entity of the anonymous master. ----------------------------- -- Create_Anonymous_Master -- ----------------------------- function Create_Anonymous_Master - (Unit_Id : Entity_Id; - Decls : List_Id) return Entity_Id + (Unit_Id : Entity_Id; + Unit_Decl : Node_Id) return Entity_Id is - First_Decl : Node_Id := Empty; - -- The first declaration of list Decls. This variable is used when - -- inserting various actions. + Insert_Nod : Node_Id := Empty; + -- The point of insertion into the declarative list of the unit. All + -- nodes are inserted before Insert_Nod. - procedure Insert_And_Analyze (Action : Node_Id); - -- Insert arbitrary node Action in declarative list Decl and analyze - -- it. + procedure Insert_And_Analyze (Decls : List_Id; N : Node_Id); + -- Insert arbitrary node N in declarative list Decls and analyze it ------------------------ -- Insert_And_Analyze -- ------------------------ - procedure Insert_And_Analyze (Action : Node_Id) is + procedure Insert_And_Analyze (Decls : List_Id; N : Node_Id) is begin - -- The list is already populated, the actions are inserted at the - -- top of the list, preserving their order. + -- The declarative list is already populated, the nodes are + -- inserted at the top of the list, preserving their order. - if Present (First_Decl) then - Insert_Before_And_Analyze (First_Decl, Action); + if Present (Insert_Nod) then + Insert_Before (Insert_Nod, N); -- Otherwise append to the declarations to preserve order else - Append_To (Decls, Action); - Analyze (Action); + Append_To (Decls, N); end if; + + Analyze (N); end Insert_And_Analyze; -- Local variables - Loc : constant Source_Ptr := Sloc (Unit_Id); - FM_Id : Entity_Id; + Loc : constant Source_Ptr := Sloc (Unit_Id); + Spec_Id : constant Entity_Id := Corresponding_Spec_Of (Unit_Decl); + Decls : List_Id; + FM_Id : Entity_Id; + Pref : Character; + Unit_Spec : Node_Id; -- Start of processing for Create_Anonymous_Master begin - if Present (Decls) then - First_Decl := First (Decls); + -- Find the declarative list of the unit + + if Nkind (Unit_Decl) = N_Package_Declaration then + Unit_Spec := Specification (Unit_Decl); + Decls := Visible_Declarations (Unit_Spec); + + if No (Decls) then + Decls := New_List (Make_Null_Statement (Loc)); + Set_Visible_Declarations (Unit_Spec, Decls); + end if; + + -- Package or subprogram body + + -- ??? A subprogram declaration that acts as a compilation unit may + -- contain a formal parameter of an anonymous access-to-controlled + -- type initialized by an allocator. + + -- procedure Comp_Unit_Proc (Param : access Ctrl := new Ctrl); + + -- There is no suitable place to create the anonymous master as the + -- subprogram is not in a declarative list. + + else + Decls := Declarations (Unit_Decl); + + if No (Decls) then + Decls := New_List (Make_Null_Statement (Loc)); + Set_Declarations (Unit_Decl, Decls); + end if; end if; + -- The anonymous master and all initialization actions are inserted + -- before the first declaration (if any). + + Insert_Nod := First (Decls); + -- Since the anonymous master and all its initialization actions are -- inserted at top level, use the scope of the unit when analyzing. - Push_Scope (Unit_Id); + Push_Scope (Spec_Id); - -- Create the anonymous master + -- Step 1: Anonymous master creation + + -- Use a unique prefix in case the same unit requires two anonymous + -- masters, one for the spec (S) and one for the body (B). + + if Ekind_In (Unit_Id, E_Function, E_Package, E_Procedure) then + Pref := 'S'; + else + Pref := 'B'; + end if; FM_Id := Make_Defining_Identifier (Loc, - Chars => New_External_Name (Chars (Unit_Id), "AM")); + New_External_Name + (Related_Id => Chars (Unit_Id), + Suffix => "AM", + Prefix => Pref)); + Set_Anonymous_Master (Unit_Id, FM_Id); -- Generate: -- : Finalization_Master; - Insert_And_Analyze - (Make_Object_Declaration (Loc, + Insert_And_Analyze (Decls, + Make_Object_Declaration (Loc, Defining_Identifier => FM_Id, Object_Definition => New_Occurrence_Of (RTE (RE_Finalization_Master), Loc))); + -- Step 2: Initialization actions + -- Do not set the base pool and mode of operation on .NET/JVM since -- those targets do not support pools and all VM masters defaulted to -- heterogeneous. @@ -502,8 +554,8 @@ package body Exp_Ch4 is -- Set_Base_Pool -- (, Global_Pool_Object'Unrestricted_Access); - Insert_And_Analyze - (Make_Procedure_Call_Statement (Loc, + Insert_And_Analyze (Decls, + Make_Procedure_Call_Statement (Loc, Name => New_Occurrence_Of (RTE (RE_Set_Base_Pool), Loc), Parameter_Associations => New_List ( @@ -516,8 +568,8 @@ package body Exp_Ch4 is -- Generate: -- Set_Is_Heterogeneous (); - Insert_And_Analyze - (Make_Procedure_Call_Statement (Loc, + Insert_And_Analyze (Decls, + Make_Procedure_Call_Statement (Loc, Name => New_Occurrence_Of (RTE (RE_Set_Is_Heterogeneous), Loc), Parameter_Associations => New_List ( @@ -530,48 +582,35 @@ package body Exp_Ch4 is -- Local declarations - Unit_Decl : constant Node_Id := Unit (Cunit (Current_Sem_Unit)); - Unit_Id : constant Entity_Id := Corresponding_Spec_Of (Unit_Decl); - Decls : List_Id; - FM_Id : Entity_Id; - Unit_Spec : Node_Id; + Unit_Decl : Node_Id; + Unit_Id : Entity_Id; -- Start of processing for Current_Anonymous_Master begin - FM_Id := Anonymous_Master (Unit_Id); - - -- Create a new anonymous master when allocating an object of anonymous - -- access-to-controlled type for the first time. - - if No (FM_Id) then + Unit_Decl := Unit (Cunit (Current_Sem_Unit)); + Unit_Id := Defining_Entity (Unit_Decl); - -- Find the declarative list of the current unit + -- The compilation unit is a package instantiation. In this case the + -- anonymous master is associated with the package spec as both the + -- spec and body appear at the same level. - if Nkind (Unit_Decl) = N_Package_Declaration then - Unit_Spec := Specification (Unit_Decl); - Decls := Visible_Declarations (Unit_Spec); - - if No (Decls) then - Decls := New_List; - Set_Visible_Declarations (Unit_Spec, Decls); - end if; + if Nkind (Unit_Decl) = N_Package_Body + and then Nkind (Original_Node (Unit_Decl)) = N_Package_Instantiation + then + Unit_Id := Corresponding_Spec (Unit_Decl); + Unit_Decl := Unit_Declaration_Node (Unit_Id); + end if; - -- Package or subprogram body + if Present (Anonymous_Master (Unit_Id)) then + return Anonymous_Master (Unit_Id); - else - Decls := Declarations (Unit_Decl); - - if No (Decls) then - Decls := New_List; - Set_Declarations (Unit_Decl, Decls); - end if; - end if; + -- Create a new anonymous master when allocating an object of anonymous + -- access-to-controlled type for the first time. - FM_Id := Create_Anonymous_Master (Unit_Id, Decls); + else + return Create_Anonymous_Master (Unit_Id, Unit_Decl); end if; - - return FM_Id; end Current_Anonymous_Master; -------------------------------- diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 97933bbda36..5824154b49c 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -2551,8 +2551,21 @@ package body Sem_Ch10 is -- Ada 2005 (AI-50217): Build visibility structures but do not -- analyze the unit. + -- If the designated unit is a predefined unit, which might be used + -- implicitly through the rtsfind machinery, a limited with clause + -- on such a unit is usually pointless, because run-time units are + -- unlikely to appear in mutually dependent units, and because this + -- disables the rtsfind mechanism. We transform such limited with + -- clauses into regular with clauses. + if Sloc (U) /= No_Location then - Build_Limited_Views (N); + if Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (U))) + then + Set_Limited_Present (N, False); + Analyze_With_Clause (N); + else + Build_Limited_Views (N); + end if; end if; return; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 7f951bcb729..8a513833cb5 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -11718,11 +11718,20 @@ package body Sem_Ch13 is Lo := Uint_0; end if; + -- Null range case, size is always zero. We only do this in the discrete + -- type case, since that's the odd case that came up. Probably we should + -- also do this in the fixed-point case, but doing so causes peculiar + -- gigi failures, and it is not worth worrying about this incredibly + -- marginal case (explicit null-range fixed-point type declarations)??? + + if Lo > Hi and then Is_Discrete_Type (T) then + S := 0; + -- Signed case. Note that we consider types like range 1 .. -1 to be -- signed for the purpose of computing the size, since the bounds have -- to be accommodated in the base type. - if Lo < 0 or else Hi < 0 then + elsif Lo < 0 or else Hi < 0 then S := 1; B := Uint_1; diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index bd772f3ab35..9e3dca627b3 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -624,11 +624,16 @@ package body Sprint is for U in Main_Unit .. Last_Unit loop Current_Source_File := Source_Index (U); - -- Dump all units if -gnatdf set, otherwise we dump only - -- the source files that are in the extended main source. + -- Dump all units if -gnatdf set, otherwise dump only the source + -- files that are in the extended main source. Note that, if we + -- are generating debug files, generating that of the main unit + -- has an effect on the outcome of In_Extended_Main_Source_Unit + -- because slocs are rewritten, so we also test for equality of + -- Cunit_Entity to work around this effect. if Debug_Flag_F or else In_Extended_Main_Source_Unit (Cunit_Entity (U)) + or else Cunit_Entity (U) = Cunit_Entity (Main_Unit) then -- If we are generating debug files, setup to write them @@ -638,6 +643,20 @@ package body Sprint is First_Debug_Sloc := Debug_Sloc; Write_Source_Line (1); Last_Line_Printed := 1; + + -- If this unit has the same entity as the main unit, for + -- example is the spec of a stand-alone instantiation of + -- a package and the main unit is the body, its debug file + -- will also be the same. Therefore, we need to print again + -- the main unit to have both units in the debug file. + + if U /= Main_Unit + and then Cunit_Entity (U) = Cunit_Entity (Main_Unit) + then + Sprint_Node (Cunit (Main_Unit)); + Write_Eol; + end if; + Sprint_Node (Cunit (U)); Write_Source_Lines (Last_Source_Line (Current_Source_File)); Write_Eol; -- 2.30.2