#!/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 () {
  $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 && $_ =~ /^/) {
      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;