X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fada%2Fpar_sco.adb;h=82ab9d651a0cea55403d3b6a79cc258d5b03e6eb;hb=17052c8f8f63239deccec6d06ff1d9a9ebfc4640;hp=bee56cd540a5d4c0693df198868628f0a194f466;hpb=2d81aa8dbeb3697249cd39dd6d7a8318e70d1e1a;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index bee56cd540a..82ab9d651a0 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -35,6 +35,7 @@ with Put_SCOs; with SCOs; use SCOs; with Sinfo; use Sinfo; with Sinput; use Sinput; +with Snames; use Snames; with Table; with GNAT.HTable; use GNAT.HTable; @@ -101,10 +102,10 @@ package body Par_SCO is procedure Process_Decisions (N : Node_Id; T : Character); -- 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 IEWX (for context of - -- expresion: if/while/when-exit/expression). If T is other than X, then - -- the node is always a decision a decision is always present (at the very - -- least a simple decision is present at the top level). + -- to output any decisions it contains. T is one of IEPWX (for context of + -- expresion: if/exit when/pragma/while/expression). If T is other than X, + -- then a 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); -- Calls above procedure for each element of the list L @@ -766,7 +767,7 @@ package body Par_SCO is end record; -- Used to store a single entry in the following array - SC_Array : array (Nat range 1 .. 100) of SC_Entry; + SC_Array : array (Nat range 1 .. 10_000) of SC_Entry; SC_Last : Nat; -- Used to store statement components for a CS entry to be output -- as a result of the call to this procedure. SC_Last is the last @@ -777,11 +778,12 @@ package body Par_SCO is -- the temporary caching of results in this array is that we want -- the SCO table entries for a given CS line to be contiguous, and -- the processing may output intermediate entries such as decision - -- entries. Note that the limit of 100 here is arbitrary, but does - -- not cause any trouble, if we encounter more than 100 statements + -- entries. Note that the limit of 10_000 here is arbitrary, but does + -- not cause any trouble, if we encounter more than 10_000 statements -- we simply break the current CS sequence at that point, which is -- harmless, since this is only used for back annotation and it is - -- not critical that back annotation always work in all cases. + -- not critical that back annotation always work in all cases. Anyway + -- exceeding 10,000 statements in a basic block is very unlikely. procedure Extend_Statement_Sequence (N : Node_Id; Typ : Character); -- Extend the current statement sequence to encompass the node N. Typ @@ -941,15 +943,14 @@ package body Par_SCO is Set_Statement_Entry; Process_Decisions (Condition (N), 'E'); - -- Label, which breaks the current statement sequence, and then - -- we include the label in the subsequent statement sequence. + -- Label, which breaks the current statement sequence, but the + -- label itself is not included in the next statement sequence, + -- since it generates no code. when N_Label => Set_Statement_Entry; - Extend_Statement_Sequence (N, ' '); - -- Block statement, which breaks the current statement seqeunce - -- it probably does not need to, but for now it does. + -- Block statement, which breaks the current statement sequence when N_Block_Statement => Set_Statement_Entry; @@ -1043,13 +1044,76 @@ package body Par_SCO is when N_Loop_Statement => if Present (Iteration_Scheme (N)) then - Extend_Statement_Sequence (N, Iteration_Scheme (N), 'F'); - Process_Decisions (Condition (Iteration_Scheme (N)), 'W'); + + -- If iteration scheme present, extend the current + -- statement sequence to include the iteration scheme + -- and process any decisions it contains. + + declare + ISC : constant Node_Id := Iteration_Scheme (N); + + begin + -- While statement + + if Present (Condition (ISC)) then + Extend_Statement_Sequence (N, ISC, 'W'); + Process_Decisions (Condition (ISC), 'W'); + + -- For statement + + else + Extend_Statement_Sequence (N, ISC, 'F'); + Process_Decisions + (Loop_Parameter_Specification (ISC), 'X'); + end if; + end; end if; Set_Statement_Entry; Traverse_Declarations_Or_Statements (Statements (N)); + -- Pragma + + when N_Pragma => + Extend_Statement_Sequence (N, 'P'); + + -- For pragmas Assert, Check, Precondition, and + -- Postcondition, we generate decision entries for the + -- condition only if the pragma is enabled. For now, we just + -- check Assertions_Enabled, which will be set to reflect + -- the presence of -gnata. + + -- Later we should move processing of the relevant pragmas + -- to Par_Prag, and properly set the flag Pragma_Enabled at + -- parse time, so that we can check this flag instead ??? + + -- For all other pragmas, we always generate decision + -- entries for any embedded expressions. + + declare + Nam : constant Name_Id := + Chars (Pragma_Identifier (N)); + Arg : Node_Id := First (Pragma_Argument_Associations (N)); + begin + case Nam is + when Name_Assert | + Name_Check | + Name_Precondition | + Name_Postcondition => + + if Nam = Name_Check then + Next (Arg); + end if; + + if Assertions_Enabled then + Process_Decisions (Expression (Arg), 'P'); + end if; + + when others => + Process_Decisions (N, 'X'); + end case; + end; + -- All other cases, which extend the current statement sequence -- but do not terminate it, even if they have nested decisions. @@ -1080,9 +1144,6 @@ package body Par_SCO is when N_Generic_Instantiation => Typ := 'i'; - when N_Pragma => - Typ := 'P'; - when others => Typ := ' '; end case;