1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
#!/usr/bin/perl -w
#
# Copyright (C) 2011 Google Inc. All rights reserved.
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public License
# along with this library; see the file COPYING.LIB. If not, write to
# the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
# Boston, MA 02110-1301, USA.
# This script tests the parser of prepare-ChangeLog (i.e. get_function_line_ranges_for_XXXX()).
# This script runs the unittests specified in @testFiles.
use strict;
use warnings;
use Data::Dumper;
use File::Basename;
use File::Spec;
use File::Temp qw(tempfile);
use FindBin;
use Getopt::Long;
use Test::More;
use lib File::Spec->catdir($FindBin::Bin, "..");
use LoadAsModule qw(PrepareChangeLog prepare-ChangeLog);
sub captureOutput($);
sub convertAbsolutepathToWebKitPath($);
my %testFiles = ("perl_unittests.pl" => "get_function_line_ranges_for_perl",
"python_unittests.py" => "get_function_line_ranges_for_python",
"java_unittests.java" => "get_function_line_ranges_for_java",
"cpp_unittests.cpp" => "get_function_line_ranges_for_cpp",
"javascript_unittests.js" => "get_function_line_ranges_for_javascript",
"css_unittests.css" => "get_selector_line_ranges_for_css",
"css_unittests_warning.css" => "get_selector_line_ranges_for_css",
);
my $resetResults;
GetOptions('reset-results' => \$resetResults);
my @testSet;
foreach my $testFile (sort keys %testFiles) {
my $basename = $testFile;
$basename = $1 if $basename =~ /^(.*)\.[^\.]*$/;
push @testSet, {method => $testFiles{$testFile},
inputFile => File::Spec->catdir($FindBin::Bin, "resources", $testFile),
expectedFile => File::Spec->catdir($FindBin::Bin, "resources", $basename . "-expected.txt")};
}
plan(tests => scalar @testSet);
foreach my $test (@testSet) {
open FH, "< $test->{inputFile}" or die "Cannot open $test->{inputFile}: $!";
my $parser = eval "\\&PrepareChangeLog::$test->{method}";
my @ranges;
my ($stdout, $stderr) = captureOutput(sub { @ranges = $parser->(\*FH, $test->{inputFile}); });
close FH;
$stdout = convertAbsolutepathToWebKitPath($stdout);
$stderr = convertAbsolutepathToWebKitPath($stderr);
my %actualOutput = (ranges => \@ranges, stdout => $stdout, stderr => $stderr);
if ($resetResults) {
open FH, "> $test->{expectedFile}" or die "Cannot open $test->{expectedFile}: $!";
print FH Data::Dumper->new([\%actualOutput])->Terse(1)->Indent(1)->Dump();
close FH;
next;
}
open FH, "< $test->{expectedFile}" or die "Cannot open $test->{expectedFile}: $!";
local $/ = undef;
my $expectedOutput = eval <FH>;
close FH;
is_deeply(\%actualOutput, $expectedOutput, "Tests $test->{inputFile}");
}
sub captureOutput($)
{
my ($targetMethod) = @_;
my ($stdoutFH, $stdoutFileName) = tempfile();
my ($stderrFH, $stderrFileName) = tempfile();
open OLDSTDOUT, ">&", \*STDOUT or die "Cannot dup STDOUT: $!";
open OLDSTDERR, ">&", \*STDERR or die "Cannot dup STDERR: $!";
open STDOUT, ">&", $stdoutFH or die "Cannot redirect STDOUT: $!";
open STDERR, ">&", $stderrFH or die "Cannot redirect STDERR: $!";
&$targetMethod();
close STDOUT;
close STDERR;
open STDOUT, ">&OLDSTDOUT" or die "Cannot dup OLDSTDOUT: $!";
open STDERR, ">&OLDSTDERR" or die "Cannot dup OLDSTDERR: $!";
close OLDSTDOUT;
close OLDSTDERR;
seek $stdoutFH, 0, 0;
seek $stderrFH, 0, 0;
local $/ = undef;
my $stdout = <$stdoutFH>;
my $stderr = <$stderrFH>;
close $stdoutFH;
close $stderrFH;
unlink $stdoutFileName or die "Cannot unlink $stdoutFileName: $!";
unlink $stderrFileName or die "Cannot unlink $stderrFileName: $!";
return ($stdout, $stderr);
}
sub convertAbsolutepathToWebKitPath($)
{
my $string = shift;
my $sourceDir = LoadAsModule::sourceDir();
$sourceDir .= "/" unless $sourceDir =~ m-/$-;
$string =~ s/$sourceDir//g;
return $string;
}
|
