Commit dffd30ccbde8c0b9f07e7b78880ba91111cba076
1 parent
99393e6a
Update qtest to 1.8
Version 1.8 allows QTC::TC to break across lines.
Showing
1 changed file
with
40 additions
and
36 deletions
qtest/bin/qtest-driver
| @@ -33,7 +33,7 @@ require TestDriver; | @@ -33,7 +33,7 @@ require TestDriver; | ||
| 33 | 33 | ||
| 34 | if ((@ARGV == 1) && ($ARGV[0] eq '--version')) | 34 | if ((@ARGV == 1) && ($ARGV[0] eq '--version')) |
| 35 | { | 35 | { |
| 36 | - print "$whoami version 1.7\n"; | 36 | + print "$whoami version 1.8\n"; |
| 37 | exit 0; | 37 | exit 0; |
| 38 | } | 38 | } |
| 39 | if ((@ARGV == 1) && ($ARGV[0] eq '--print-path')) | 39 | if ((@ARGV == 1) && ($ARGV[0] eq '--print-path')) |
| @@ -538,41 +538,45 @@ sub tc_do_initial_checks | @@ -538,41 +538,45 @@ sub tc_do_initial_checks | ||
| 538 | my %seen_cases = (); | 538 | my %seen_cases = (); |
| 539 | foreach my $src (@tc_srcs) | 539 | foreach my $src (@tc_srcs) |
| 540 | { | 540 | { |
| 541 | - my $s = new IO::File("<$src") or die "$whoami: open $src: $!\n"; | ||
| 542 | - binmode $s; | ||
| 543 | - while (<$s>) | ||
| 544 | - { | ||
| 545 | - # Look for coverage calls in the source subject to certain | ||
| 546 | - # lexical constraints | ||
| 547 | - my ($lscope, $case); | ||
| 548 | - if (m/^\s*\&?(?:QTC|qtc)(?:::|\.)TC\(\"([^\"]+)\",\s*\"([^\"]+)\"/) | ||
| 549 | - { | ||
| 550 | - # C++, Java, Perl, etc. | ||
| 551 | - ($lscope, $case) = ($1, $2); | ||
| 552 | - } | ||
| 553 | - elsif (m/^[^\#]*\$\(call QTC.TC,([^,]+),([^,\)]+)/) | ||
| 554 | - { | ||
| 555 | - # make | ||
| 556 | - ($lscope, $case) = ($1, $2); | ||
| 557 | - } | ||
| 558 | - if ((defined $lscope) && (defined $case)) | ||
| 559 | - { | ||
| 560 | - if ($lscope eq $tc_scope) | ||
| 561 | - { | ||
| 562 | - push(@{$seen_cases{$case}}, [$src, $.]); | ||
| 563 | - } | ||
| 564 | - elsif (exists $tc_ignored_scopes{$lscope}) | ||
| 565 | - { | ||
| 566 | - &QTC::TC("testdriver", "driver ignored scope"); | ||
| 567 | - } | ||
| 568 | - else | ||
| 569 | - { | ||
| 570 | - &QTC::TC("testdriver", "driver out-of-scope case"); | ||
| 571 | - error("$src:$.: out-of-scope coverage case"); | ||
| 572 | - } | ||
| 573 | - } | ||
| 574 | - } | ||
| 575 | - $s->close(); | 541 | + local $/ = undef; |
| 542 | + my $s = new IO::File("<$src") or die "$whoami: open $src: $!\n"; | ||
| 543 | + binmode $s; | ||
| 544 | + my $content = <$s>; | ||
| 545 | + $s->close(); | ||
| 546 | + my @found = (); | ||
| 547 | + # Look for coverage calls in the source subject to certain lexical | ||
| 548 | + # constraints. Count newlines in $` to get the line number. | ||
| 549 | + while ($content =~ | ||
| 550 | + m/^\s*\&?(?:QTC|qtc)(?:::|\.)(?:TC|tc)\(\s*\"([^\"]+)\",\s*\"([^\"]+)\"/mg) | ||
| 551 | + { | ||
| 552 | + # C++, Java, Perl, etc. | ||
| 553 | + push(@found, [$1, $2, 1+scalar(split('\n', $`))]); | ||
| 554 | + } | ||
| 555 | + while ($content =~ m/^[^\#\n]*\$\(call QTC.TC,([^,]+),([^,\)]+)/mg) | ||
| 556 | + { | ||
| 557 | + # make | ||
| 558 | + push(@found, [$1, $2, 1+scalar(split('\n', $`))]); | ||
| 559 | + } | ||
| 560 | + foreach my $i (@found) | ||
| 561 | + { | ||
| 562 | + my ($lscope, $case, $line) = @$i; | ||
| 563 | + if ((defined $lscope) && (defined $case)) | ||
| 564 | + { | ||
| 565 | + if ($lscope eq $tc_scope) | ||
| 566 | + { | ||
| 567 | + push(@{$seen_cases{$case}}, [$src, $line]); | ||
| 568 | + } | ||
| 569 | + elsif (exists $tc_ignored_scopes{$lscope}) | ||
| 570 | + { | ||
| 571 | + &QTC::TC("testdriver", "driver ignored scope"); | ||
| 572 | + } | ||
| 573 | + else | ||
| 574 | + { | ||
| 575 | + &QTC::TC("testdriver", "driver out-of-scope case"); | ||
| 576 | + error("$src:$line: out-of-scope coverage case"); | ||
| 577 | + } | ||
| 578 | + } | ||
| 579 | + } | ||
| 576 | } | 580 | } |
| 577 | 581 | ||
| 578 | my %wanted_cases = %tc_cases; | 582 | my %wanted_cases = %tc_cases; |