Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Tree: 6ca59e035f
Fetching contributors…

Cannot retrieve contributors at this time

executable file 172 lines (137 sloc) 4.391 kB
#!/usr/bin/env perl
use strict;
use warnings;
use English;
use feature qw(say);
use Benchmark;
use File::Path;
use File::Basename;
use File::Copy;
use Cwd;
use POSIX qw(nice);
sub MAIN {
#let us play nice with others
nice(19);
print <<"WARNING";
My job is to run STD_syntax_highlight over all the tests in t/.
You can press CTRL-C when you feel bored.
WARNING
#sanity check: working directory should end with src/perl6
my $cwd = getcwd();
unless($cwd =~ m{src/perl6$}) {
die "Please run $PROGRAM_NAME in src/perl6\n";
}
#sanity check: make sure STD.pm is correctly built
unless(-r 'STD.pmc') {
die "Could not find 'STD.pmc'. Maybe your forgot to 'make'\n";
}
#sanity check: make sure unicode will work with your locale
unless($ENV{LANG} =~ /\.UTF-8$/) {
die "Unicode will not work. Please set your LANG environment variable.\n" .
"(e.g. 'export LANG=en_US.UTF-8' in your ~/.bashrc)";
}
#make sure that the output html directory is there
unless(-d 'html') {
print "Creating html directory...\n";
mkdir 'html' or die "Could not create html directory\n";
}
my $dir_to_test = '../../t/';
my $fail = 0;
my $success = 0;
say "Finding *.t in $dir_to_test... Please wait";
my @files = sort `find $dir_to_test -name '*.t'`;
chomp(@files);
$OUTPUT_AUTOFLUSH = 1;
my $total = 0+@files;
say "Going to run $total tests... Maybe watch a movie meanwhile?";
my $HILITE = "std_hilite/STD_syntax_highlight";
my $JQUERY_JS = "jquery-1.4.2.min.js";
my $start_time = new Benchmark;
my @failed;
for my $file (@files) {
my $myfile = $file;
$myfile =~ s/^\.\.\/\.\.\/t/html/;
my ($simple_html,$snippet_html, $full_html) = (
"$myfile.simple.html",
"$myfile.snippet.html",
"$myfile.html");
my ($html_filename,$html_path,$html_suffix) = fileparse($full_html);
mkpath $html_path;
my $dir = dirname(dirname($myfile));
copy_resource("std_hilite/$JQUERY_JS", $dir);
copy_resource("std_hilite/$HILITE.js", $dir);
copy_resource("std_hilite/$HILITE.css", $dir);
#run the process and time it
print <<"OUT";
$file
-> $full_html
-> $simple_html
-> $snippet_html
OUT
my $t0 = new Benchmark;
my $cmd = "./$HILITE --clean-html " .
"--simple-html=$simple_html " .
"--snippet-html=$snippet_html " .
"--full-html=$full_html $file";
my $log = `$cmd 2>&1`;
say "It took " .
timestr(timediff(new Benchmark,$t0),"nop");
if ($CHILD_ERROR) {
push(@failed,$file);
$fail++;
# let us write something useful into those htmls
# when an error occurs
write_error_html($simple_html, $file, $log, 1);
write_error_html($snippet_html, $file, $log, 0);
write_error_html($full_html, $file, $log, 1);
say "error";
} else {
$success++;
say "ok";
}
}
printf "\nPassed $success/$total, %6.2f%%\n", $success/$total * 100;
say "It took " .
timestr(timediff(new Benchmark,$start_time),"noc");
if (@failed) {
say "Failed tests:";
for my $file (@failed) {
say $file;
}
}
say "\nThe output is now in the html directory. Thanks for your time ;-)";
}
# copy resource
sub copy_resource {
my ($src,$dir) = @_;
my $dst = File::Spec->catfile( $dir, basename($src));
if(not -e $dst) {
print "Copying $dst\n";
copy($src, $dst) or warn "WARN: Could not copy: $OS_ERROR\n";
}
}
# write the error log in the html file provied
sub write_error_html {
my ($html_file, $file, $log, $is_full) = @ARG;
my $error_html = "";
if($is_full) {
$error_html = "<html><title>Error</title><body>";
}
$error_html .= <<"ERROR";
<pre>
An error has occurred while processing this file:
filename:
$file
Reason:
$log
</pre>
ERROR
if($is_full) {
$error_html .= "<body></html>";
}
open FILE, ">$html_file"
or die "Could not open $html_file for writing: $OS_ERROR\n";
print FILE $error_html;
close FILE;
}
MAIN(@ARGV);
Jump to Line
Something went wrong with that request. Please try again.