diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 19 | ||||
| -rw-r--r-- | gcc/ada/errout.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/gnat1drv.adb | 17 | ||||
| -rw-r--r-- | gcc/ada/lib-load.adb | 24 | ||||
| -rw-r--r-- | gcc/ada/lib-load.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/lib.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/sem_ch10.adb | 6 |
7 files changed, 86 insertions, 12 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 22d4eef8656..064083ed720 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2009-04-22 Ed Schonberg <schonberg@adacore.com> + + * lib-load.ads, lib-load.adb (Make_Child_Decl_Unit): New subprogram, to + create a unit table entry for the subprogram declaration created for a + child suprogram body that has no separate specification. + + * sem_ch10.adb (Analyze_Compilation_Unit): For a child unit that is a + subprogram body, call Make_Child_Decl_Unit. + + * lib.adb (Get_Cunit_Unit_Number): Verify that an entry not yet in the + table can only be the created specification of a child subprogram body + that is the main unit, which has not been entered in the table yet. + + * errout.adb (Output_Messages): Ignore created specification of a + child subprogram body to prevent repeated listing of error messages. + + * gnat1drv.adb (gnat1drv): The generated specification for a child + subprogram body does not generate code. + 2009-04-22 Arnaud Charlet <charlet@adacore.com> * s-bitops.adb, s-bitops.ads (Raise_Error): Do not use Ada 05 syntax, diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index d2c1caed843..76d465a05f3 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1681,11 +1681,21 @@ package body Errout is -- First list extended main source file units with errors - -- Note: if debug flag d.m is set, only the main source is listed - for U in Main_Unit .. Last_Unit loop if In_Extended_Main_Source_Unit (Cunit_Entity (U)) + + -- If debug flag d.m is set, only the main source is listed + and then (U = Main_Unit or else not Debug_Flag_Dot_M) + + -- If the unit of the entity does not come from source, it is + -- an implicit subprogram declaration for a child subprogram. + -- Do not emit errors for it, they are listed with the body. + + and then + (No (Cunit_Entity (U)) + or else Comes_From_Source (Cunit_Entity (U)) + or else not Is_Subprogram (Cunit_Entity (U))) then declare Sfile : constant Source_File_Index := Source_Index (U); diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 1dbc6bbb4f5..3ae1d488428 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -510,14 +510,21 @@ begin Set_Generate_Code (Main_Unit); - -- If we have a corresponding spec, then we need object - -- code for the spec unit as well + -- If we have a corresponding spec, and it comes from source + -- or it is not a generated spec for a child subprogram body, + -- then we need object code for the spec unit as well if Nkind (Unit (Main_Unit_Node)) in N_Unit_Body and then not Acts_As_Spec (Main_Unit_Node) then - Set_Generate_Code - (Get_Cunit_Unit_Number (Library_Unit (Main_Unit_Node))); + if Nkind (Main_Unit_Node) = N_Subprogram_Body + and then not Comes_From_Source (Library_Unit (Main_Unit_Node)) + then + null; + else + Set_Generate_Code + (Get_Cunit_Unit_Number (Library_Unit (Main_Unit_Node))); + end if; end if; -- Case of no code required to be generated, exit indicating no error diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb index d93b3d04e33..dcd4e12773e 100644 --- a/gcc/ada/lib-load.adb +++ b/gcc/ada/lib-load.adb @@ -753,6 +753,30 @@ package body Lib.Load is end if; end Load_Unit; + -------------------------- + -- Make_Child_Decl_Unit -- + -------------------------- + + procedure Make_Child_Decl_Unit (N : Node_Id) is + Unit_Decl : constant Node_Id := Library_Unit (N); + + begin + Units.Increment_Last; + Units.Table (Units.Last) := Units.Table (Get_Cunit_Unit_Number (N)); + Units.Table (Units.Last).Unit_Name := + Get_Spec_Name (Unit_Name (Get_Cunit_Unit_Number (N))); + Units.Table (Units.Last).Cunit := Unit_Decl; + Units.Table (Units.Last).Cunit_Entity := + Defining_Identifier + (Defining_Unit_Name (Specification (Unit (Unit_Decl)))); + + -- The library unit created for of a child subprogram unit plays no + -- role in code generation and binding, so label it accordingly. + + Units.Table (Units.Last).Generate_Code := False; + Set_Has_No_Elaboration_Code (Unit_Decl); + end Make_Child_Decl_Unit; + ------------------------ -- Make_Instance_Unit -- ------------------------ diff --git a/gcc/ada/lib-load.ads b/gcc/ada/lib-load.ads index fe1fd6eaeb2..97abc71473a 100644 --- a/gcc/ada/lib-load.ads +++ b/gcc/ada/lib-load.ads @@ -169,6 +169,12 @@ package Lib.Load is -- creates a dummy package unit so that compilation can continue without -- blowing up when the missing unit is referenced. + procedure Make_Child_Decl_Unit (N : Node_Id); + -- For a child subprogram body without a spec, we create a subprogram + -- declaration in order to attach the required parent link. We create + -- a Units_Table entry for this declaration, in order to maintain a + -- one-to-one correspondence between compilation units and table entries. + procedure Make_Instance_Unit (N : Node_Id; In_Main : Boolean); -- When a compilation unit is an instantiation, it contains both the -- declaration and the body of the instance, each of which can have its diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index 2ad3a4c8895..a7c4128e0d4 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -602,10 +602,14 @@ package body Lib is end if; end loop; - -- If not in the table, must be the main source unit, and we just - -- have not got it put into the table yet. + -- If not in the table, must be a spec created for a main unit that is a + -- child subprogram body which we have not inserted into the table yet. - return Main_Unit; + if N /= Library_Unit (Cunit (Main_Unit)) then + raise Program_Error; + else + return Main_Unit; + end if; end Get_Cunit_Unit_Number; --------------------- diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 791601d77b1..82b221f1a21 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -731,7 +731,10 @@ package body Sem_Ch10 is -- it, and this must be indicated explicitly. We also mark -- the body entity as a child unit now, to prevent a -- cascaded error if the spec entity cannot be entered - -- in its scope. + -- in its scope. Finally we create a Units table entry for + -- the subprogram declaration, to maintain a one-to-one + -- correspondence with compilation unit nodes. This is + -- critical for the tree traversals performed by Inspector. declare Loc : constant Source_Ptr := Sloc (N); @@ -753,6 +756,7 @@ package body Sem_Ch10 is Set_Library_Unit (N, Lib_Unit); Set_Parent_Spec (Unit (Lib_Unit), Cunit (Unum)); + Make_Child_Decl_Unit (N); Semantics (Lib_Unit); -- Now that a separate declaration exists, the body |