aboutsummaryrefslogtreecommitdiff
path: root/runtests.pl
blob: 2e2b7958a2b67ca6c3772b14e61d3c562dd55f23 (plain)
  1. #!/usr/bin/env perl
  2. use warnings;
  3. use strict;
  4. use Term::ANSIColor;
  5. use IO::Handle;
  6. use IPC::Open2;
  7. 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";
  8. my $SPEC = shift @ARGV;
  9. my @PROG = @ARGV;
  10. my $PATT=$ENV{'PATT'};
  11. if (!(@PROG && defined $SPEC)) {
  12. print STDERR $usage;
  13. exit 1;
  14. }
  15. my $passed = 0;
  16. my $failed = 0;
  17. my $skipped = 0;
  18. # Markdown implementations vary on insignificant whitespace.
  19. # Some leave blanks between block elements, others don't.
  20. # This function tries to normalize the output so it can be
  21. # compared with our test. tidy takes two arguments: the
  22. # string containing the actual output, and a pathname of the
  23. # file to which the tidied output is to be saved.
  24. sub tidy
  25. {
  26. my $inpre = 0;
  27. my $out = "";
  28. my $outfh;
  29. open($outfh, '>', \$out);
  30. for (split /^/, $_[0]) {
  31. if (/<pre/) {
  32. $inpre = 1;
  33. } elsif (/<\/pre/) {
  34. $inpre = 0;
  35. }
  36. if ($inpre) {
  37. print $outfh $_;
  38. } else {
  39. # remove leading spaces
  40. s/^ *//;
  41. # remove trailing spaces
  42. s/ *$//;
  43. # collapse consecutive spaces
  44. s/ */ /;
  45. # collapse space before /> in tag
  46. s/ *\/>/\/>/;
  47. # skip blank line
  48. if (/^$/) {
  49. next;
  50. }
  51. print $outfh $_;
  52. }
  53. }
  54. close $outfh;
  55. return $out;
  56. }
  57. sub dotest
  58. {
  59. my $markdown = $_[0];
  60. my $html = $_[1];
  61. my $testname = $_[2];
  62. my $actual = "";
  63. # We use → to indicate tab and ␣ space in the spec
  64. $markdown =~ s/→/\t/g;s/␣/ /g;
  65. $html =~ s/→/\t/g;s/␣/ /g;
  66. open2(my $out, my $in, @PROG);
  67. print $in $markdown;
  68. close $in;
  69. flush $out;
  70. $actual = do { local $/; <$out>; };
  71. close $out;
  72. $html = &tidy($html);
  73. $actual = &tidy($actual);
  74. $actual =~ s/\&#39;/'/;
  75. if ($actual eq $html) {
  76. print colored("✓", "green");
  77. return 1;
  78. } else {
  79. print colored("\n$testname", "red");
  80. print "\n";
  81. print color "cyan";
  82. print "=== markdown ===============\n";
  83. print $markdown;
  84. print "=== expected ===============\n";
  85. print $html;
  86. print "=== got ====================\n";
  87. print $actual;
  88. print color "black";
  89. return 0;
  90. }
  91. }
  92. my $stage = 0;
  93. my $markdown = "";
  94. my $html = "";
  95. my $example = 0;
  96. my $linenum = 0;
  97. my $exampleline = 0;
  98. my @secnums = ();
  99. my $secheading;
  100. open(SPEC, "< $SPEC");
  101. while (<SPEC>) {
  102. $linenum++;
  103. if (/^\.$/) {
  104. $stage = ($stage + 1) % 3;
  105. if ($stage == 1) {
  106. $exampleline = $linenum;
  107. }
  108. if ($stage == 0) {
  109. $example++;
  110. if (!$PATT || $secheading =~ /$PATT/) {
  111. if (&dotest($markdown, $html,
  112. "Example $example (line $exampleline)")) {
  113. $passed++;
  114. } else {
  115. $failed++;
  116. }
  117. } else {
  118. $skipped++;
  119. }
  120. $markdown = "";
  121. $html = "";
  122. }
  123. } elsif ($stage == 0 && $_ =~ /^<!-- END TESTS -->/) {
  124. last;
  125. } elsif ($stage == 0 && $_ =~ /^(#+) +(.*)/) {
  126. my $seclevel = length($1);
  127. $secheading = $2;
  128. if ($#secnums == $seclevel - 1) {
  129. $secnums[$#secnums]++;
  130. } elsif ($#secnums > $seclevel - 1) {
  131. @secnums = @secnums[0..($seclevel - 1)];
  132. $secnums[$#secnums]++;
  133. } else {
  134. while ($#secnums < $seclevel - 1) {
  135. push(@secnums, 1);
  136. }
  137. }
  138. if (!$PATT || $secheading =~ /$PATT/) {
  139. print ("\n", join(".", @secnums) . " " . $secheading, " ");
  140. }
  141. } elsif ($stage == 1) {
  142. $markdown .= $_;
  143. } elsif ($stage == 2) {
  144. $html .= $_;
  145. }
  146. }
  147. print "\n";
  148. print STDERR colored("$passed tests passed, $failed failed, $skipped skipped.", "bold");
  149. print STDERR "\n";
  150. exit $failed;