@@ -62,6 +62,15 @@ package body SC_Obligations is
62
62
-- * properly ordered: if E1 and E2 are consecutive siblings, E1.To must be
63
63
-- smaller than E2.From.
64
64
65
+ function Covers_SCO (SE : Scope_Entity; SCO : SCO_Id) return Boolean
66
+ is (SCO in SE.From .. SE.To);
67
+ -- Return whether SCO is covered by SE's SCO range
68
+
69
+ function Covers_SCO
70
+ (Cur : Scope_Entities_Trees.Cursor; SCO : SCO_Id) return Boolean
71
+ is (Covers_SCO (Scope_Entities_Trees.Element (Cur), SCO));
72
+ -- Return whether SCO is covered by that element's SCO range
73
+
65
74
-- -------------
66
75
-- Instances --
67
76
-- -------------
@@ -658,13 +667,10 @@ package body SC_Obligations is
658
667
return No_Scope_Traversal;
659
668
end if ;
660
669
Result.It :=
661
- new Tree_Iterator'
662
- (Scope_Entities_Trees.Iterate
663
- (CU_Vector.Reference (CU).Element.Scope_Entities));
664
- Result.Scope_Stack := Scope_Stacks.Empty_List;
665
- Result.Active_Scopes := Scope_Id_Sets.Empty;
666
- Set_Active_Scope_Ent (Result, Result.It.First);
670
+ new Tree_Iterator'(CU_Vector.Reference (CU).Scope_Entities.Iterate);
667
671
Result.Last_SCO := No_SCO_Id;
672
+ Result.Current_SE := Scope_Entities_Trees.No_Element;
673
+ Result.Next_SE := Result.It.First;
668
674
return Result;
669
675
end Scope_Traversal ;
670
676
@@ -674,66 +680,30 @@ package body SC_Obligations is
674
680
675
681
procedure Traverse_SCO (ST : in out Scope_Traversal_Type; SCO : SCO_Id) is
676
682
use Scope_Entities_Trees;
683
+ Progressed : Boolean := False;
677
684
begin
678
685
ST.Last_SCO := SCO;
679
686
680
- -- In some cases (C metaprogramming instances), e.g.
681
- --
682
- -- foo.h:
683
- -- TYPE ret = 0;
684
- -- return (TYPE) ret + 1;
685
- --
686
- -- foo.c:
687
- -- int
688
- -- one_int (void)
689
- -- {
690
- -- #define TYPE int
691
- -- #include "foo.h"
692
- -- #undef TYPE
693
- -- }
694
- --
695
- -- Active_Scope_Ent is null in the aforementionned case, as the inner
696
- -- scope for the statements in foo.h is the `one_int` function defined
697
- -- in foo.c. The scope implementation assumes that scopes do not cross
698
- -- sources, which does not hold here.
699
- --
700
- -- TODO???: This should be fixed by dealing with metaprogramming
701
- -- instances in a more appropriate way, which should be done under
702
- -- eng/cov/gnatcoverage#103. For now, return early in that case.
703
-
704
- if ST.Active_Scope_Ent = No_Element then
705
- return ;
706
- end if ;
707
-
708
- -- Find the innermost scope featuring this SCO and update the list of
709
- -- active scopes as we go.
687
+ -- Move Next_SE forward in the iterator until we go past the deepest
688
+ -- scope that covers SCO. Update Current_SE along the way.
710
689
711
- while SCO > Element (ST.Active_Scope_Ent).To
712
- or else (ST.Next_Scope_Ent /= No_Element
713
- and then SCO >= Element (ST.Next_Scope_Ent).From)
714
- loop
715
- -- We can enter the next scope only when we have reached its parent
716
- -- scope. If the next scope is null, this means that we are in the
717
- -- last scope of the unit.
690
+ while Has_Element (ST.Next_SE) and then Covers_SCO (ST.Next_SE, SCO) loop
691
+ ST.Current_SE := ST.Next_SE;
692
+ ST.Next_SE := ST.It.Next (ST.Next_SE);
693
+ Progressed := True;
694
+ end loop ;
718
695
719
- if ST.Next_Scope_Ent /= No_Element
720
- and then ST.Active_Scope_Ent = Parent (ST.Next_Scope_Ent)
721
- and then SCO >= Element (ST.Next_Scope_Ent).From
722
- then
723
- Set_Active_Scope_Ent (ST, ST.Next_Scope_Ent);
724
- ST.Scope_Stack.Append (ST.Active_Scope_Ent);
725
- ST.Active_Scopes.Insert
726
- (Element (ST.Active_Scope_Ent).Identifier);
727
- else
728
- -- Otherwise, go up the parent chain and pop the last entry from
729
- -- the active scopes.
696
+ -- If we have not found a more specific scope for SCO, we still may need
697
+ -- to update Current_SE in case the requested SCO is not covered anymore
698
+ -- by Current_SE.
730
699
731
- ST.Active_Scope_Ent := Parent (ST.Active_Scope_Ent);
732
- ST.Active_Scopes.Delete
733
- (Element (ST.Scope_Stack.Last_Element).Identifier);
734
- ST.Scope_Stack.Delete_Last;
735
- end if ;
736
- end loop ;
700
+ if not Progressed then
701
+ while Has_Element (ST.Current_SE)
702
+ and then not Covers_SCO (ST.Current_SE, SCO)
703
+ loop
704
+ ST.Current_SE := Parent (ST.Current_SE);
705
+ end loop ;
706
+ end if ;
737
707
end Traverse_SCO ;
738
708
739
709
-- ------------
@@ -745,27 +715,32 @@ package body SC_Obligations is
745
715
return ST.Last_SCO;
746
716
end Last_SCO ;
747
717
748
- -- ------------------------
749
- -- Set_Active_Scope_Ent --
750
- -- ------------------------
751
-
752
- procedure Set_Active_Scope_Ent
753
- (ST : in out Scope_Traversal_Type;
754
- Scope_Ent : Scope_Entities_Trees.Cursor) is
755
- begin
756
- ST.Active_Scope_Ent := Scope_Ent;
757
- ST.Next_Scope_Ent := ST.It.Next (Scope_Ent);
758
- end Set_Active_Scope_Ent ;
759
-
760
718
-- ------------------------
761
719
-- In_Scope_Of_Interest --
762
720
-- ------------------------
763
721
764
722
function In_Scope_Of_Interest (ST : Scope_Traversal_Type) return Boolean is
723
+ use Scope_Entities_Trees;
724
+ Cur : Cursor;
765
725
begin
766
- return Subps_Of_Interest.Is_Empty
767
- or else not Scope_Id_Sets.Is_Empty
768
- (ST.Active_Scopes.Intersection (Subps_Of_Interest));
726
+ -- If no subprogram of interest was requested, consider that they are
727
+ -- all of interest.
728
+
729
+ if Subps_Of_Interest.Is_Empty then
730
+ return True;
731
+ end if ;
732
+
733
+ -- Otherwise, find at least one scope that covers SCO and that is a
734
+ -- subprogram of interest.
735
+
736
+ Cur := ST.Current_SE;
737
+ while Has_Element (Cur) loop
738
+ if Subps_Of_Interest.Contains (Element (Cur).Identifier) then
739
+ return True;
740
+ end if ;
741
+ Cur := Parent (Cur);
742
+ end loop ;
743
+ return False;
769
744
end In_Scope_Of_Interest ;
770
745
771
746
-- ---------------
0 commit comments