#!/usr/bin/env perl use warnings; use strict; use Term::ANSIColor; use IO::Handle; use IPC::Open2; my $usage="runtests.pl SPEC PROGRAM\nSet ANSI_COLORS_DISABLED=1 if you redirect to a file.\nSet PATT='...' to restrict tests to sections matching a regex.\n"; my $SPEC = shift @ARGV; my @PROG = @ARGV; my $PATT=$ENV{'PATT'}; if (!(@PROG && defined $SPEC)) { print STDERR $usage; exit 1; } my $passed = 0; my $failed = 0; my $skipped = 0; my $errored = 0; # Markdown implementations vary on insignificant whitespace. # Some leave blanks between block elements, others don't. # This function tries to normalize the output so it can be # compared with our test. tidy takes two arguments: the # string containing the actual output, and a pathname of the # file to which the tidied output is to be saved. sub tidy { my $inpre = 0; my $out = ""; my $outfh; open($outfh, '>', \$out); for (split /^/, $_[0]) { if (/
in tag s/ *\/>/\/>/; s/>\n$/>/; # skip blank line if (/^$/) { next; } print $outfh $_; } } close $outfh; return $out; } # return 0 for passing test, -1 for failing, positive for error sub dotest { my $markdown = $_[0]; my $html = $_[1]; my $testname = $_[2]; my $actual = ""; # We use → to indicate tab and ␣ space in the spec $markdown =~ s/→/\t/g;s/␣/ /g; $html =~ s/→/\t/g;s/␣/ /g; my $pid = open2(my $out, my $in, @PROG); print $in $markdown; close $in; flush $out; $actual = do { local $/; <$out>; }; close $out; waitpid($pid, 0); my $exit_status = $?; $html = &tidy($html); $actual = &tidy($actual); $actual =~ s/\'/'/g; if ($actual eq $html) { print colored("✓", "green"); return 0; } else { print colored("\n✘ $testname", "red"); print "\n"; print color "cyan"; print "=== markdown ===============\n"; print $markdown; print "=== expected ===============\n"; print $html; print "\n"; print "=== got ====================\n"; print $actual; print "\n"; print color "black"; if ($exit_status == 0) { return -1; } else { return $exit_status; } } } my $stage = 0; my $markdown = ""; my $html = ""; my $example = 0; my $linenum = 0; my $exampleline = 0; my @secnums = (); my $secheading; my $testresult; open(SPEC, "< $SPEC"); while (