~ubuntu-branches/ubuntu/raring/qtwebkit-source/raring-proposed

« back to all changes in this revision

Viewing changes to Tools/Scripts/webkitperl/prepare-ChangeLog_unittest/parser_unittests.pl

  • Committer: Package Import Robot
  • Author(s): Jonathan Riddell
  • Date: 2013-02-18 14:24:18 UTC
  • Revision ID: package-import@ubuntu.com-20130218142418-eon0jmjg3nj438uy
Tags: upstream-2.3
ImportĀ upstreamĀ versionĀ 2.3

Show diffs side-by-side

added added

removed removed

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