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 | 33 | |
| 34 | 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 | 37 | exit 0; |
| 38 | 38 | } |
| 39 | 39 | if ((@ARGV == 1) && ($ARGV[0] eq '--print-path')) |
| ... | ... | @@ -538,41 +538,45 @@ sub tc_do_initial_checks |
| 538 | 538 | my %seen_cases = (); |
| 539 | 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 | 582 | my %wanted_cases = %tc_cases; | ... | ... |