diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-08-05 14:18:09 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-08-05 14:18:09 +0000 |
commit | cf365b48fc59b488e2cbf831dc2e9e8f59dfe0fa (patch) | |
tree | 1a26e8ca549a60121572a15150d39632dbafbb1a /gcc/ada/par_sco.adb | |
parent | 7947a43964decdb9632653e3afa1a07030cf7c8e (diff) | |
download | gcc-cf365b48fc59b488e2cbf831dc2e9e8f59dfe0fa.tar.gz |
2011-08-05 Javier Miranda <miranda@adacore.com>
* exp_disp.adb (Set_All_DT_Position): Cleanup code and improve support
for renamings of predefined primitives.
(In_Predef_Prims_DT): New subprogram.
2011-08-05 Ed Schonberg <schonberg@adacore.com>
* sem_util.adb, sem_util.ads (Check_Implicit_Dereference): If a
possible interpretation of name is a reference type, add an
interpretation that is the designated type of the reference
discriminant of that type.
* sem_res.adb (resolve): If the interpretation imposed by context is an
implicit dereference, rewrite the node as the deference of the
reference discriminant.
* sem_ch3.adb (Analyze_Subtype_Declaration, Build_Derived_Record_Type,
Build_Discriminated_Subtype): Inherit Has_Implicit_Dereference from
parent type or base type.
* sem_ch4.adb (Process_Indexed_Component,
Process_Overloaded_Indexed_Component, Indicate_Name_And_Type,
Analyze_Overloaded_Selected_Component, Analyze_Selected_Component):
Check for implicit dereference.
(List_Operand_Interps): Indicate when an implicit dereference is
ambiguous.
* sem_ch8.adb (Find_Direct_Name): Check for implicit dereference.
2011-08-05 Thomas Quinot <quinot@adacore.com>
* scos.ads: Update documentation of SCO table. Pragma statements can now
be marked as disabled (using 'p' instead of 'P' as the statement kind).
* par_sco.ads, par_sco.adb: Implement the above change.
(Process_Decisions_Defer): Generate a P decision for the first parameter
of a dyadic pragma Debug.
* sem_prag.adb (Analyze_Pragma, case Debug): Mark pragma as enabled if
necessary.
* put_scos.adb: Code simplification based on above change.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177442 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/par_sco.adb')
-rw-r--r-- | gcc/ada/par_sco.adb | 195 |
1 files changed, 115 insertions, 80 deletions
diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index 2feec9c4471..8f76dd25039 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -69,9 +69,9 @@ package body Par_SCO is -- We need to be able to get to conditions quickly for handling the calls -- to Set_SCO_Condition efficiently, and similarly to get to pragmas to - -- handle calls to Set_SCO_Pragma_Enabled. For this purpose we identify the - -- conditions and pragmas in the table by their starting sloc, and use this - -- hash table to map from these starting sloc values to SCO_Table indexes. + -- handle calls to Set_SCO_Pragma_Enabled. For this purpose we identify + -- the conditions and pragmas in the table by their starting sloc, and use + -- this hash table to map from these sloc values to SCO_Table indexes. type Header_Num is new Integer range 0 .. 996; -- Type for hash table headers @@ -101,7 +101,10 @@ package body Par_SCO is -- excluding OR and AND) and returns True if so, False otherwise, it does -- no other processing. - procedure Process_Decisions (N : Node_Id; T : Character); + procedure Process_Decisions + (N : Node_Id; + T : Character; + Pragma_Sloc : Source_Ptr); -- If N is Empty, has no effect. Otherwise scans the tree for the node N, -- to output any decisions it contains. T is one of IEGPWX (for context of -- expression: if/exit when/entry guard/pragma/while/expression). If T is @@ -109,7 +112,10 @@ package body Par_SCO is -- decision is always present (at the very least a simple decision is -- present at the top level). - procedure Process_Decisions (L : List_Id; T : Character); + procedure Process_Decisions + (L : List_Id; + T : Character; + Pragma_Sloc : Source_Ptr); -- Calls above procedure for each element of the list L procedure Set_Table_Entry @@ -316,13 +322,17 @@ package body Par_SCO is -- Version taking a list - procedure Process_Decisions (L : List_Id; T : Character) is + procedure Process_Decisions + (L : List_Id; + T : Character; + Pragma_Sloc : Source_Ptr) + is N : Node_Id; begin if L /= No_List then N := First (L); while Present (N) loop - Process_Decisions (N, T); + Process_Decisions (N, T, Pragma_Sloc); Next (N); end loop; end if; @@ -330,11 +340,14 @@ package body Par_SCO is -- Version taking a node - Pragma_Sloc : Source_Ptr := No_Location; - -- While processing decisions within a pragma Assert/Debug/PPC, this is set - -- to the sloc of the pragma. + Current_Pragma_Sloc : Source_Ptr := No_Location; + -- While processing a pragma, this is set to the sloc of the N_Pragma node - procedure Process_Decisions (N : Node_Id; T : Character) is + procedure Process_Decisions + (N : Node_Id; + T : Character; + Pragma_Sloc : Source_Ptr) + is Mark : Nat; -- This is used to mark the location of a decision sequence in the SCO -- table. We use it for backing out a simple decision in an expression @@ -466,14 +479,6 @@ package body Par_SCO is Loc := Sloc (Parent (Parent (N))); - if T = 'P' then - - -- Record sloc of pragma (pragmas don't nest) - - pragma Assert (Pragma_Sloc = No_Location); - Pragma_Sloc := Loc; - end if; - when 'X' => -- For an expression, no Sloc @@ -493,17 +498,6 @@ package body Par_SCO is To => No_Location, Last => False, Pragma_Sloc => Pragma_Sloc); - - if T = 'P' then - - -- For pragmas we also must make an entry in the hash table for - -- later access by Set_SCO_Pragma_Enabled. We set the pragma as - -- disabled now, the call will change C2 to 'e' to enable the - -- pragma header entry. - - SCO_Table.Table (SCO_Table.Last).C2 := 'd'; - Condition_Pragma_Hash_Table.Set (Loc, SCO_Table.Last); - end if; end Output_Header; ------------------------------ @@ -521,7 +515,7 @@ package body Par_SCO is Process_Decision_Operand (Right_Opnd (N)); else - Process_Decisions (N, 'X'); + Process_Decisions (N, 'X', Pragma_Sloc); end if; end Process_Decision_Operand; @@ -595,9 +589,9 @@ package body Par_SCO is Thnx : constant Node_Id := Next (Cond); Elsx : constant Node_Id := Next (Thnx); begin - Process_Decisions (Cond, 'I'); - Process_Decisions (Thnx, 'X'); - Process_Decisions (Elsx, 'X'); + Process_Decisions (Cond, 'I', Pragma_Sloc); + Process_Decisions (Thnx, 'X', Pragma_Sloc); + Process_Decisions (Elsx, 'X', Pragma_Sloc); return Skip; end; @@ -635,12 +629,6 @@ package body Par_SCO is end if; Traverse (N); - - -- Reset Pragma_Sloc after full subtree traversal - - if T = 'P' then - Pragma_Sloc := No_Location; - end if; end Process_Decisions; ----------- @@ -771,8 +759,12 @@ package body Par_SCO is -- disabled. if Index /= 0 then - pragma Assert (SCO_Table.Table (Index).C1 = 'P'); - return SCO_Table.Table (Index).C2 = 'd'; + declare + T : SCO_Table_Entry renames SCO_Table.Table (Index); + begin + pragma Assert (T.C1 = 'S' or else T.C1 = 's'); + return T.C2 = 'p'; + end; else return False; @@ -899,8 +891,17 @@ package body Par_SCO is -- The test here for zero is to deal with possible previous errors if Index /= 0 then - pragma Assert (SCO_Table.Table (Index).C1 = 'P'); - SCO_Table.Table (Index).C2 := 'e'; + declare + T : SCO_Table_Entry renames SCO_Table.Table (Index); + begin + -- Called multiple times for the same sloc (need to allow for + -- C2 = 'P') ??? + + pragma Assert ((T.C1 = 'S' or else T.C1 = 's') + and then + (T.C2 = 'p' or else T.C2 = 'P')); + T.C2 := 'P'; + end; end if; end Set_SCO_Pragma_Enabled; @@ -987,12 +988,14 @@ package body Par_SCO is Nod : Node_Id; Lst : List_Id; Typ : Character; + Plo : Source_Ptr; end record; -- Used to store a single entry in the following table. Nod is the node to -- be searched for decisions for the case of Process_Decisions_Defer with a -- node argument (with Lst set to No_List. Lst is the list to be searched -- for decisions for the case of Process_Decisions_Defer with a List - -- argument (in which case Nod is set to Empty). + -- argument (in which case Nod is set to Empty). Plo is the sloc of the + -- enclosing pragma, if any. package SD is new Table.Table ( Table_Component_Type => SD_Entry, @@ -1077,11 +1080,15 @@ package body Par_SCO is SCE : SC_Entry renames SC.Table (J); Pragma_Sloc : Source_Ptr := No_Location; begin - -- For the statement SCO for a pragma, set Pragma_Sloc so that - -- the SCO can be omitted if the pragma is disabled. + -- For the statement SCO for a pragma controlled by + -- Set_SCO_Pragma_Enable, set Pragma_Sloc so that the SCO (and + -- those of any nested decision) is emitted only if the pragma + -- is enabled. - if SCE.Typ = 'P' then + if SCE.Typ = 'p' then Pragma_Sloc := SCE.From; + Condition_Pragma_Hash_Table.Set + (Pragma_Sloc, SCO_Table.Last + 1); end if; Set_Table_Entry @@ -1105,9 +1112,9 @@ package body Par_SCO is SDE : SD_Entry renames SD.Table (J); begin if Present (SDE.Nod) then - Process_Decisions (SDE.Nod, SDE.Typ); + Process_Decisions (SDE.Nod, SDE.Typ, SDE.Plo); else - Process_Decisions (SDE.Lst, SDE.Typ); + Process_Decisions (SDE.Lst, SDE.Typ, SDE.Plo); end if; end; end loop; @@ -1148,12 +1155,12 @@ package body Par_SCO is procedure Process_Decisions_Defer (N : Node_Id; T : Character) is begin - SD.Append ((N, No_List, T)); + SD.Append ((N, No_List, T, Current_Pragma_Sloc)); end Process_Decisions_Defer; procedure Process_Decisions_Defer (L : List_Id; T : Character) is begin - SD.Append ((Empty, L, T)); + SD.Append ((Empty, L, T, Current_Pragma_Sloc)); end Process_Decisions_Defer; -- Start of processing for Traverse_Declarations_Or_Statements @@ -1391,42 +1398,70 @@ package body Par_SCO is -- Pragma when N_Pragma => - Extend_Statement_Sequence (N, 'P'); + + -- Record sloc of pragma (pragmas don't nest) + + pragma Assert (Current_Pragma_Sloc = No_Location); + Current_Pragma_Sloc := Sloc (N); -- Processing depends on the kind of pragma - case Pragma_Name (N) is - when Name_Assert | - Name_Check | - Name_Precondition | - Name_Postcondition => - - -- For Assert/Check/Precondition/Postcondition, we - -- must generate a P entry for the decision. Note that - -- this is done unconditionally at this stage. Output - -- for disabled pragmas is suppressed later on, when - -- we output the decision line in Put_SCOs. - - declare - Nam : constant Name_Id := - Chars (Pragma_Identifier (N)); - Arg : Node_Id := - First (Pragma_Argument_Associations (N)); - - begin + declare + Nam : constant Name_Id := Pragma_Name (N); + Arg : Node_Id := First (Pragma_Argument_Associations (N)); + Typ : Character; + + begin + case Nam is + when Name_Assert | + Name_Check | + Name_Precondition | + Name_Postcondition => + + -- For Assert/Check/Precondition/Postcondition, we + -- must generate a P entry for the decision. Note + -- that this is done unconditionally at this stage. + -- Output for disabled pragmas is suppressed later + -- on, when we output the decision line in + -- Put_SCOs, depending on marker sets by + -- Set_SCO_Pragma_Disabled. + if Nam = Name_Check then Next (Arg); end if; Process_Decisions_Defer (Expression (Arg), 'P'); - end; + Typ := 'p'; - -- For all other pragmas, we generate decision entries - -- for any embedded expressions. + when Name_Debug => + if Present (Arg) and then Present (Next (Arg)) then - when others => - Process_Decisions_Defer (N, 'X'); - end case; + -- Case of a dyadic pragma Debug: first argument + -- is a P decision, any nested decision in the + -- second argument is an X decision. + + Process_Decisions_Defer (Expression (Arg), 'P'); + Next (Arg); + end if; + + Process_Decisions_Defer (Expression (Arg), 'X'); + Typ := 'p'; + + -- For all other pragmas, we generate decision entries + -- for any embedded expressions, and the pragma is + -- never disabled. + + when others => + Process_Decisions_Defer (N, 'X'); + Typ := 'P'; + end case; + + -- Add statement SCO + + Extend_Statement_Sequence (N, Typ); + + Current_Pragma_Sloc := No_Location; + end; -- Object declaration. Ignored if Prev_Ids is set, since the -- parser generates multiple instances of the whole declaration @@ -1512,7 +1547,7 @@ package body Par_SCO is -- Now output any embedded decisions - Process_Decisions (N, 'X'); + Process_Decisions (N, 'X', No_Location); end Traverse_Generic_Instantiation; ------------------------------------------ @@ -1521,7 +1556,7 @@ package body Par_SCO is procedure Traverse_Generic_Package_Declaration (N : Node_Id) is begin - Process_Decisions (Generic_Formal_Declarations (N), 'X'); + Process_Decisions (Generic_Formal_Declarations (N), 'X', No_Location); Traverse_Package_Declaration (N); end Traverse_Generic_Package_Declaration; |