@@ -35,8 +35,7 @@ public class IfStmtContextElementCollectorVisitor : CollectorVBAParserBaseVisito
3535 {
3636 public override IEnumerable < IfStmtContext > VisitIfStmt ( [ NotNull ] IfStmtContext context )
3737 {
38- base . VisitIfStmt ( context ) ;
39- return new List < IfStmtContext > { context } ;
38+ return base . VisitIfStmt ( context ) . Concat ( new List < IfStmtContext > { context } ) ;
4039 }
4140 }
4241
@@ -457,6 +456,7 @@ End If
457456
458457 [ TestMethod ]
459458 [ TestCategory ( "Grammar" ) ]
459+ [ TestCategory ( "Selection" ) ]
460460 public void Selection_Not_Contains_LastToken ( )
461461 {
462462 const string inputCode = @"
@@ -490,5 +490,125 @@ End If
490490
491491 Assert . IsFalse ( selection . Contains ( token ) ) ;
492492 }
493+
494+ [ TestMethod ]
495+ [ TestCategory ( "Grammar" ) ]
496+ [ TestCategory ( "Selection" ) ]
497+ public void Selection__Contains_Only_Innermost_Nested_Context ( )
498+ {
499+ const string inputCode = @"
500+ Option Explicit
501+
502+ Public Sub foo(Bar As Long, Baz As Long, FooBar As Long)
503+
504+ If Bar > Baz Then
505+ Debug.Print ""Yeah!""
506+ If FooBar Then
507+ Debug.Print ""Foo bar!""
508+ End If
509+ Else
510+ Debug.Print ""Boo!""
511+ End If
512+
513+ If Baz > Bar Then
514+ Debug.Print ""Boo!""
515+ Else
516+ Debug.Print ""Yeah!""
517+ End If
518+
519+ End Sub : 'Lame comment!
520+ " ;
521+
522+ var vbe = MockVbeBuilder . BuildFromSingleStandardModule ( inputCode , out var component ) ;
523+ var pane = component . CodeModule . CodePane ;
524+ var state = MockParser . CreateAndParse ( vbe . Object ) ;
525+ var tree = state . GetParseTree ( new QualifiedModuleName ( component ) ) ;
526+ var visitor = new IfStmtContextElementCollectorVisitor ( ) ;
527+ var context = visitor . Visit ( tree ) . First ( ) ; //returns innermost statement first then topmost consecutively
528+ var token = context . Stop ;
529+ var selection = new Selection ( 8 , 1 , 10 , 9 ) ;
530+
531+ Assert . IsTrue ( selection . Contains ( token ) ) ;
532+ }
533+
534+ [ TestMethod ]
535+ [ TestCategory ( "Grammar" ) ]
536+ [ TestCategory ( "Selection" ) ]
537+ public void Selection__Contains_Both_Nested_Context ( )
538+ {
539+ const string inputCode = @"
540+ Option Explicit
541+
542+ Public Sub foo(Bar As Long, Baz As Long, FooBar As Long)
543+
544+ If Bar > Baz Then
545+ Debug.Print ""Yeah!""
546+ If FooBar Then
547+ Debug.Print ""Foo bar!""
548+ End If
549+ Else
550+ Debug.Print ""Boo!""
551+ End If
552+
553+ If Baz > Bar Then
554+ Debug.Print ""Boo!""
555+ Else
556+ Debug.Print ""Yeah!""
557+ End If
558+
559+ End Sub : 'Lame comment!
560+ " ;
561+
562+ var vbe = MockVbeBuilder . BuildFromSingleStandardModule ( inputCode , out var component ) ;
563+ var pane = component . CodeModule . CodePane ;
564+ var state = MockParser . CreateAndParse ( vbe . Object ) ;
565+ var tree = state . GetParseTree ( new QualifiedModuleName ( component ) ) ;
566+ var visitor = new IfStmtContextElementCollectorVisitor ( ) ;
567+ var context = visitor . Visit ( tree ) . First ( ) ; //returns innermost statement first then topmost consecutively
568+ var token = context . Stop ;
569+ var selection = new Selection ( 6 , 1 , 13 , 7 ) ;
570+
571+ Assert . IsTrue ( selection . Contains ( token ) ) ;
572+ }
573+
574+ [ TestMethod ]
575+ [ TestCategory ( "Grammar" ) ]
576+ [ TestCategory ( "Selection" ) ]
577+ public void Selection_Not_Contained_In_Neither_Nested_Context ( )
578+ {
579+ const string inputCode = @"
580+ Option Explicit
581+
582+ Public Sub foo(Bar As Long, Baz As Long, FooBar As Long)
583+
584+ If Bar > Baz Then
585+ Debug.Print ""Yeah!""
586+ If FooBar Then
587+ Debug.Print ""Foo bar!""
588+ End If
589+ Else
590+ Debug.Print ""Boo!""
591+ End If
592+
593+ If Baz > Bar Then
594+ Debug.Print ""Boo!""
595+ Else
596+ Debug.Print ""Yeah!""
597+ End If
598+
599+ End Sub : 'Lame comment!
600+ " ;
601+
602+ var vbe = MockVbeBuilder . BuildFromSingleStandardModule ( inputCode , out var component ) ;
603+ var pane = component . CodeModule . CodePane ;
604+ var state = MockParser . CreateAndParse ( vbe . Object ) ;
605+ var tree = state . GetParseTree ( new QualifiedModuleName ( component ) ) ;
606+ var visitor = new IfStmtContextElementCollectorVisitor ( ) ;
607+ var context = visitor . Visit ( tree ) . First ( ) ; //returns innermost statement first then topmost consecutively
608+ var token = context . Stop ;
609+ var selection = new Selection ( 15 , 1 , 19 , 7 ) ;
610+
611+ Assert . IsFalse ( selection . Contains ( token ) ) ;
612+ }
493613 }
494614}
0 commit comments