Find file
Fetching contributors…
Cannot retrieve contributors at this time
executable file 172 lines (137 sloc) 4.29 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
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.
#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 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'`;
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) = (
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";
-> $full_html
-> $simple_html
-> $snippet_html
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");
# 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 {
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 provided
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";
An error has occurred while processing this file:
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;