#!/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 (/<pre/) { $inpre = 1; } elsif (/<\/pre/) { $inpre = 0; } # remove \r to allow mixing linux/windows newlines s/\r//; if ($inpre) { print $outfh $_; } else { # remove leading spaces s/^ *//; # remove trailing spaces s/ *$//; # collapse consecutive spaces s/ */ /; # collapse space before /> 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 (<SPEC>) { $linenum++; if (/^\.$/) { $stage = ($stage + 1) % 3; if ($stage == 1) { $exampleline = $linenum; } if ($stage == 0) { $example++; if (!$PATT || $secheading =~ /$PATT/) { $testresult = &dotest($markdown, $html, "Example $example (line $exampleline)"); if ($testresult == 0) { $passed++; } elsif ($testresult == -1) { $failed++; } else { $errored++; } } else { $skipped++; } $markdown = ""; $html = ""; } } elsif ($stage == 0 && $_ =~ /^<!-- END TESTS -->/) { last; } elsif ($stage == 0 && $_ =~ /^(#+) +(.*)/) { my $seclevel = length($1); $secheading = $2; if ($#secnums == $seclevel - 1) { $secnums[$#secnums]++; } elsif ($#secnums > $seclevel - 1) { @secnums = @secnums[0..($seclevel - 1)]; $secnums[$#secnums]++; } else { while ($#secnums < $seclevel - 1) { push(@secnums, 1); } } if (!$PATT || $secheading =~ /$PATT/) { print ("\n", join(".", @secnums) . " " . $secheading, " "); } } elsif ($stage == 1) { $markdown .= $_; } elsif ($stage == 2) { $html .= $_; } } print "\n"; print STDERR colored("$passed tests passed, $failed failed, $errored errored, $skipped skipped.", "bold"); print STDERR "\n"; exit $failed;