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
132
133
134
135
136
137
138
139
140
141
|
#!/usr/bin/perl
use IO::File;
use Getopt::Long;
use File::Compare;
my (%opts);
GetOptions(\%opts, 'dir|d=s', 'compiler|g=s', 'help|h|?', 'icu|i', 'keep|k', 'output|o=s', 'preprocessor|p=s', 'verbose|v', 'testengine|r=s', 'version=i', 'warning|w=i@');
if ($opts{help})
{
die <<'EOT';
regtest [-g grcompiler] [-o logfile] [-p gdlpp] [-r regtest] [-v]
[-w number] [-k] [dir]
Searches for fonts to run tests on in [dir] (defaults to .) and runs them
storing log info in logfile and exiting with the number of errors
-d|--dir=dir Use dir for intermediate test files
-g|--compiler=grcompiler command to use to run grcompiler [grcompiler]
-h|--help print this help and exit
-i|--icu Gives icu version or uses icu-config * 10 to guess
-k|--keep keep temporary files
-o|--output= logfile file to log to [regtest.log]
-p|--preprocessor=gdlpp command to run the gdlpp []
-r|--testengine=regtest command to test result font [GrcRegressionTest]
-v|--verbose Run compiler -q by default, this stops it
--version=num default graphite version to generate [2]
-w|--warning= number Run compiler with -w value (may be repeated)
EOT
}
$opts{compiler} ||= 'grcompiler';
$opts{output} ||= 'regtest.log';
$ENV{'GDLPP'} = $opts{preprocessor} if (defined $opts{preprocessor});
$opt{testengine} ||= 'GrcRegressionTest';
$opt{version} ||= 2;
my ($dir) = $ARGV[0] || '.';
my (@fonts) = sort glob("$dir/*Input.ttf");
my ($outf) = IO::File->new("> $opts{output}") || die "Can't create $opts{output}";
my ($f, $errors);
$opts{icu} ||= `icu-config --version` * 10;
my (@icudirs) = reverse sort map {s/^.*?(\d+)$/$1/o; $_} glob("$dir/icu*");
foreach $f (@fonts)
{
my ($b, $v);
my ($t) = $f;
my ($r) = $f;
my ($n) = $f;
$n =~ s/Input.ttf$//o;
next unless (-f "${n}Main.gdl");
foreach $b ("${n}Benchmark_v2.ttf", "${n}Benchmark_v3.ttf", "${n}Benchmark.ttf")
{
next unless (-f $b);
if ($b =~ m/_v(\d)/o)
{
$v = $1;
$r = "${n}Test_v$v.ttf";
}
else
{
$v = $opt{version};
$r = "${n}Test.ttf";
}
if ($opts{dir})
{ $r =~ s{^.*[\\/](.*?)$}{$opts{dir}/$1}o; }
print "Testing Font: $n at v$v\n";
$t = "${n}Main.gdl";
# $r =~ s{^.*[/\\](.*?)$}{$1}o;
my (@gopts);
push (@gopts, '-q') unless ($opts{verbose});
push (@gopts, map {"-w" => $_}, @{$opts{warning}}) if (defined $opts{warning});
push (@gopts, "-v$v");
print $opts{compiler} . " " . join(" ", @gopts) . "\n" if ($opts{verbose});
system($opts{compiler}, @gopts, $t, $f, $r);
if (-f $r) # assume it passes if it gives a result
{
my ($failed) = 0;
unlink 'grcregtest.log';
foreach $i (@icudirs)
{
next if ($i > $opts{icu});
my ($bench) = $b;
$bench =~ s{/([^/]*)$}{/icu$i/$1}og;
if (-f $bench)
{
$b = $bench;
last;
}
}
my ($res) = system($opts{testengine}, $b, $r);
if ($res == -1)
{
print "Failed to run $opts{testengine} because $!\n";
$errors++;
$failed = 1;
}
my ($logf) = IO::File->new("grcregtest.log");
if ($logf)
{
while (<$logf>)
{ $outf->print($_); }
$logf->close;
}
if ($res > 0)
{
$res >>= 8;
print "job error $res\n";
$errors += $res;
$failed = 1;
}
else
{
print "Comparing $r and $b\n";
$failed = compare($r, $b);
print "comparison error in $f\n" if ($failed);
}
unlink $r unless ($opts{'keep'} || $failed);
}
else
{
my ($logf) = IO::File->new("gdlerr.log");
if ($logf)
{
while (<$logf>)
{ $outf->print($_); }
$logf->close;
}
$errors++;
}
}
}
$outf->close;
print "$errors errors encountered\n" if ($errors);
exit($errors);
|
