diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-07-16 10:52:21 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-07-16 10:52:21 +0000 |
| commit | cf88384257ed82cfdfd4e0e6959399691fd2c286 (patch) | |
| tree | fe8eec7db48cd1a7df5fca29ad7d51f10ab88bff | |
| parent | f50256f3bc97b421fccd9820df6e2e4039c36583 (diff) | |
| download | gcc-cf88384257ed82cfdfd4e0e6959399691fd2c286.tar.gz | |
2012-07-16 Vasiliy Fofanov <fofanov@adacore.com>
* ug_words, vms_data.ads: Document VMS qualifiers for -gnatn1/2
switches.
2012-07-16 Bob Duff <duff@adacore.com>
* sinfo.ads: Minor comment fix.
2012-07-16 Bob Duff <duff@adacore.com>
* sem_elab.adb (Within_Elaborate_All): Walk the with clauses to
find pragmas Elaborate_All that may be found in the transitive
closure of the dependences.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@189517 138bc75d-0d04-0410-961f-82ee72b054a4
| -rw-r--r-- | gcc/ada/ChangeLog | 15 | ||||
| -rw-r--r-- | gcc/ada/sem_elab.adb | 148 | ||||
| -rw-r--r-- | gcc/ada/sinfo.ads | 11 | ||||
| -rw-r--r-- | gcc/ada/ug_words | 2 | ||||
| -rw-r--r-- | gcc/ada/vms_data.ads | 7 |
5 files changed, 142 insertions, 41 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0ce604e82fa..7634f597427 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2012-07-16 Vasiliy Fofanov <fofanov@adacore.com> + + * ug_words, vms_data.ads: Document VMS qualifiers for -gnatn1/2 + switches. + +2012-07-16 Bob Duff <duff@adacore.com> + + * sinfo.ads: Minor comment fix. + +2012-07-16 Bob Duff <duff@adacore.com> + + * sem_elab.adb (Within_Elaborate_All): Walk the with clauses to + find pragmas Elaborate_All that may be found in the transitive + closure of the dependences. + 2012-07-16 Robert Dewar <dewar@adacore.com> * exp_pakd.adb, freeze.adb, sem_util.adb, vms_data.ads: Minor diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 4a98db6f1d9..d1b5f7c6b55 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -325,11 +325,13 @@ package body Sem_Elab is -- Given two scopes E1 and E2, returns True if E1 is equal to E2, or is one -- of its contained scopes, False otherwise. - function Within_Elaborate_All (E : Entity_Id) return Boolean; - -- Before emitting a warning on a scope E for a missing elaborate_all, - -- check whether E may be in the context of a directly visible unit U to - -- which the pragma applies. This prevents spurious warnings when the - -- called entity is renamed within U. + function Within_Elaborate_All + (Unit : Unit_Number_Type; + E : Entity_Id) return Boolean; + -- Return True if we are within the scope of an Elaborate_All for E, or if + -- we are within the scope of an Elaborate_All for some other unit U, and U + -- with's E. This prevents spurious warnings when the called entity is + -- renamed within U, or in case of generic instances. -------------------------------------- -- Activate_Elaborate_All_Desirable -- @@ -831,7 +833,7 @@ package body Sem_Elab is end loop; end if; - if Within_Elaborate_All (E_Scope) then + if Within_Elaborate_All (Current_Sem_Unit, E_Scope) then return; end if; @@ -1229,9 +1231,8 @@ package body Sem_Elab is P := Parent (N); while Present (P) loop - if Nkind (P) = N_Parameter_Specification - or else - Nkind (P) = N_Component_Declaration + if Nkind_In (P, N_Parameter_Specification, + N_Component_Declaration) then return; @@ -3282,46 +3283,121 @@ package body Sem_Elab is -- Within_Elaborate_All -- -------------------------- - function Within_Elaborate_All (E : Entity_Id) return Boolean is - Item : Node_Id; - Item2 : Node_Id; - Elab_Id : Entity_Id; - Par : Node_Id; + function Within_Elaborate_All + (Unit : Unit_Number_Type; + E : Entity_Id) return Boolean + is + type Unit_Number_Set is array (Main_Unit .. Last_Unit) of Boolean; + pragma Pack (Unit_Number_Set); - begin - Item := First (Context_Items (Cunit (Current_Sem_Unit))); - while Present (Item) loop - if Nkind (Item) = N_Pragma - and then Pragma_Name (Item) = Name_Elaborate_All - then - -- Return if some previous error on the pragma itself + Seen : Unit_Number_Set := (others => False); + -- Seen (X) is True after we have seen unit X in the walk. This is used + -- to prevent processing the same unit more than once. - if Error_Posted (Item) then - return False; + Result : Boolean := False; + + procedure Helper (Unit : Unit_Number_Type); + -- This helper procedure does all the work for Within_Elaborate_All. It + -- walks the dependency graph, and sets Result to True if it finds an + -- appropriate Elaborate_All. + + ------------ + -- Helper -- + ------------ + + procedure Helper (Unit : Unit_Number_Type) is + CU : constant Node_Id := Cunit (Unit); + + Item : Node_Id; + Item2 : Node_Id; + Elab_Id : Entity_Id; + Par : Node_Id; + + begin + if Seen (Unit) then + return; + else + Seen (Unit) := True; + end if; + + -- First, check for Elaborate_Alls on this unit + + Item := First (Context_Items (CU)); + while Present (Item) loop + if Nkind (Item) = N_Pragma + and then Pragma_Name (Item) = Name_Elaborate_All + then + -- Return if some previous error on the pragma itself + + if Error_Posted (Item) then + return; + end if; + + Elab_Id := + Entity + (Expression (First (Pragma_Argument_Associations (Item)))); + + if E = Elab_Id then + Result := True; + return; + end if; + + Par := Parent (Unit_Declaration_Node (Elab_Id)); + + Item2 := First (Context_Items (Par)); + while Present (Item2) loop + if Nkind (Item2) = N_With_Clause + and then Entity (Name (Item2)) = E + and then not Limited_Present (Item2) + then + Result := True; + return; + end if; + + Next (Item2); + end loop; end if; - Elab_Id := - Entity - (Expression (First (Pragma_Argument_Associations (Item)))); + Next (Item); + end loop; - Par := Parent (Unit_Declaration_Node (Elab_Id)); + -- Second, recurse on with's. We could do this as part of the above + -- loop, but it's probably more efficient to have two loops, because + -- the relevant Elaborate_All is likely to be on the initial unit. In + -- other words, we're walking the with's breadth-first. This part is + -- only necessary in the dynamic elaboration model. - Item2 := First (Context_Items (Par)); - while Present (Item2) loop - if Nkind (Item2) = N_With_Clause - and then Entity (Name (Item2)) = E + if Dynamic_Elaboration_Checks then + Item := First (Context_Items (CU)); + while Present (Item) loop + if Nkind (Item) = N_With_Clause + and then not Limited_Present (Item) then - return True; + -- Note: the following call to Get_Cunit_Unit_Number does a + -- linear search, which could be slow, but it's OK because + -- we're about to give a warning anyway. Also, there might + -- be hundreds of units, but not millions. If it turns out + -- to be a problem, we could store the Get_Cunit_Unit_Number + -- in each N_Compilation_Unit node, but that would involve + -- rearranging N_Compilation_Unit_Aux to make room. + + Helper (Get_Cunit_Unit_Number (Library_Unit (Item))); + + if Result then + return; + end if; end if; - Next (Item2); + Next (Item); end loop; end if; + end Helper; - Next (Item); - end loop; + -- Start of processing for Within_Elaborate_All - return False; + begin + Helper (Unit); + return Result; end Within_Elaborate_All; end Sem_Elab; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index cfaa82842c9..ec8e9aedeff 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -5796,9 +5796,11 @@ package Sinfo is -- Unreferenced_In_Spec (Flag7-Sem) -- No_Entities_Ref_In_Spec (Flag8-Sem) - -- Note: Limited_Present and Limited_View_Installed give support to - -- Ada 2005 (AI-50217). - -- Similarly, Private_Present gives support to AI-50262. + -- Note: Limited_Present and Limited_View_Installed are used to support + -- the implementation of Ada 2005 (AI-50217). + + -- Similarly, Private_Present is used to support the implementation of + -- Ada 2005 (AI-50262). ---------------------- -- With_Type clause -- @@ -5806,8 +5808,9 @@ package Sinfo is -- This is a GNAT extension, used to implement mutually recursive -- types declared in different packages. + -- Note: this is now obsolete. The functionality of this construct - -- is now implemented by the Ada 2005 Limited_with_Clause. + -- is now implemented by the Ada 2005 limited_with_clause. --------------------- -- 10.2 Body stub -- diff --git a/gcc/ada/ug_words b/gcc/ada/ug_words index 9901b8477a0..29c4ee0f21e 100644 --- a/gcc/ada/ug_words +++ b/gcc/ada/ug_words @@ -84,6 +84,8 @@ gcc -c ^ GNAT COMPILE -gnatm ^ /ERROR_LIMIT -gnatm2 ^ /ERROR_LIMIT=2 -gnatn ^ /INLINE=PRAGMA +-gnatn1 ^ /INLINE=PRAGMA_LEVEL_1 +-gnatn2 ^ /INLINE=PRAGMA_LEVEL_2 -gnatN ^ /INLINE=FULL -gnato ^ /CHECKS=OVERFLOW -gnatp ^ /CHECKS=SUPPRESS_ALL diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index e7d93fffd8c..80c6eaf641c 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -1826,8 +1826,13 @@ package VMS_Data is -- (/OPTIMIZE=SOME) or higher (/OPTIMIZE=UNROLL_LOOPS) -- levels of optimization. -- - -- PRAGMA_LEVEL_1/2 not documented ??? + -- PRAGMA_LEVEL_1 + -- Direct control of the level of "Inline" pragmas + -- optimization with moderate inlining across modules. -- + -- PRAGMA_LEVEL_2 + -- Direct control of the level of "Inline" pragmas + -- optimization with full inlining across modules. -- -- FULL Front end inlining. The front end inlining activated -- by this switch is generally more extensive, and quite |