Improve spec-runner to fully cover warnings and errors

Author: mgreter

t/99_sass_specs.t

@@ -1,3 +1,4 @@
+#!/usr/bin/perl
 # -*- perl -*-
 
 use strict;
@@ -19,6 +20,7 @@ sub new
 	return bless {
 		root => $root,
 		parent => $parent,
+		wtodo => $opt->{wtodo},
 		todo => $opt->{todo},
 		clean => $opt->{clean},
 		style => $opt->{style},
@@ -47,14 +49,28 @@ package SPEC;
 ################################################################################
 
 use CSS::Sass;
+use Cwd qw(getcwd);
 use Carp qw(croak);
 use File::Spec::Functions;
 
+my $cwd = getcwd;
+my $cwd_win = $cwd;
+my $cwd_nix = $cwd;
+$cwd_win =~ s/[\/\\]/\\/g;
+$cwd_nix =~ s/[\/\\]/\//g;
+
 # everything is normalized
 my $norm_output = sub ($) {
 	$_[0] =~ s/(?:\r?\n)+/\n/g;
 	$_[0] =~ s/;(?:\s*;)+/;/g;
 	$_[0] =~ s/;\s*}/}/g;
+	# normalize debug entries
+	$_[0] =~ s/[^\n]+(\d+) DEBUG: /$1: DEBUG: /g;
+	# normalize directory entries
+	$_[0] =~ s/\/libsass-todo-issues\//\/libsass-issues\//g;
+	$_[0] =~ s/\/libsass-closed-issues\//\/libsass-issues\//g;
+	$_[0] =~ s/\Q$cwd_win\E[\/\\]t[\/\\]sass-spec[\/\\]/\/sass\//g;
+	$_[0] =~ s/\Q$cwd_nix\E[\/\\]t[\/\\]sass-spec[\/\\]/\/sass\//g;
 };
 
 # only flagged stuff is cleaned
@@ -69,27 +85,62 @@ sub new
 	my $pkg = $_[0];
 	my $root = $_[1];
 	my $file = $_[2];
+	my $test = $_[3];
 	return bless {
 		root => $root,
 		file => $file,
+		test => $test,
 	}, $pkg;
 }
 
+sub errors
+{
+	my ($spec) = @_;
+
+	local $/ = undef;
+	return -f catfile($spec->{root}->{root}, "status");
+}
+
 sub stderr
 {
 	my ($spec) = @_;
 
 	local $/ = undef;
-	my $path = catfile($_[0]->{root}->{root}, "error");
-	return undef unless -f $path;
+	my $path = catfile($spec->{root}->{root}, "error");
+	return "" unless -f $path;
 	open my $fh, "<:raw:utf8", $path or
 		croak "Error opening <", $path, ">: $!";
 	binmode $fh; my $stderr = join "\n", <$fh>;
+	# fully remove debug messaged from error
+	$stderr =~ s/[^\n]+(\d+) DEBUG: [^\n]*//g;
 	$norm_output->($stderr);
+	# clean todo warnings (remove all warning blocks)
+	$stderr =~ s/^(?:DEPRECATION )?WARNING(?:[^\n]+\n)*\n*//gm;
 	$stderr =~ s/\n.*\Z//s;
 	return $stderr;
+}
+
+sub stdmsg
+{
+	my ($spec) = @_;
 
+	local $/ = undef;
+	my $path = catfile($spec->{root}->{root}, "error");
+	return '' unless -f $path;
+	open my $fh, "<:raw:utf8", $path or
+		croak "Error opening <", $path, ">: $!";
+	binmode $fh; my $stderr = join "\n", <$fh>;
+	$norm_output->($stderr);
+	if ($spec->{test}->{wtodo}) {
+		# clean todo warnings (remove all warning blocks)
+		$stderr =~ s/^(?:DEPRECATION )?WARNING(?:[^\n]+\n)*\n*//gm;
+	}
+	# clean error messages
+	$stderr =~ s/^Error(?:[^\n]+\n)*\n*//gm;
+	$stderr =~ s/\n.*\Z//s;
+	return $stderr;
 }
+
 sub expected
 {
 	my ($spec) = @_;
@@ -135,12 +186,22 @@ sub err
 {
 	$_[0]->execute;
 	my $err = $_[0]->{err};
-	return $err unless defined $err;
+	return "" unless defined $err;
 	$norm_output->($err);
 	$err =~ s/\n.*\Z//s;
 	return $err;
 }
 
+sub msg
+{
+	$_[0]->execute;
+	my $msg = $_[0]->{msg};
+	return "" unless defined $msg;
+	$norm_output->($msg);
+	$msg =~ s/\n.*\Z//s;
+	return $msg;
+}
+
 sub execute
 {
 
@@ -167,16 +228,18 @@ sub execute
 	open OLDFH, '>&STDERR';
 
 	# redirect stderr to file
-	open(STDERR, "+>", "specs.stderr.log"); select(STDERR); $| = 1;
+	open(STDERR, "+>:raw:utf8", "specs.stderr.log"); select(STDERR); $| = 1;
 	my $css = eval { $comp->compile_file($spec->{file}) }; my $err = $@;
-	print STDERR "\n"; sysseek(STDERR, 0, 0); close(STDERR);
+	sysseek(STDERR, 0, 0); sysread(STDERR, my $msg, 65536); close(STDERR);
 
 	# reset stderr
 	open STDERR, '>&OLDFH';
 
 	# store the results
 	$spec->{css} = $css;
 	$spec->{err} = $err;
+	$spec->{msg} = $msg;
+
 	# return the results
 	return $css, $err;
 
@@ -216,7 +279,8 @@ sub load_tests()
 {
 
 	# result
-	my @specs; my $filter = qr/huge|unicode\/report/;
+	my @specs; my $ignore = qr/huge|unicode\/report/;
+	my $filter = qr/\Q$ARGV[0]\E/ if defined $ARGV[0];
 	# initial spec test directory entry
 	my $root = new DIR;
 	$root->{start} = 0;
@@ -238,9 +302,11 @@ sub load_tests()
 			$test->{start} = $yaml->{':start_version'};
 			$test->{end} = $yaml->{':end_version'};
 			$test->{ignore} = grep /^libsass$/i,
-				@{$yaml->{':ignore_for'} ||  []};
+				@{$yaml->{':ignore_for'} || []};
+			$test->{wtodo} = grep /^libsass$/i,
+				@{$yaml->{':warning_todo'} || []};
 			$test->{todo} = grep /^libsass$/i,
-				@{$yaml->{':todo'} ||  []};
+				@{$yaml->{':todo'} || []};
 		}
 
 		$test->{clean} = $parent->{clean} unless $test->{clean};
@@ -249,19 +315,24 @@ sub load_tests()
 		$test->{start} = $parent->{start} unless $test->{start};
 		$test->{end} = $parent->{end} unless $test->{end};
 		$test->{ignore} = $parent->{ignore} unless $test->{ignore};
+		$test->{wtodo} = $parent->{wtodo} unless $test->{wtodo};
 		$test->{todo} = $parent->{todo} unless $test->{todo};
 
 		my $sass = catfile($dir, "input.sass");
 		my $scss = catfile($dir, "input.scss");
 		# have spec test
 		if (-e $scss) {
-			if (!$filter || !($scss =~ m/$filter/)) {
-				push @specs, new SPEC($test, $scss);
+			if (!$ignore || !($scss =~ m/$ignore/)) {
+				if (!$filter || ($scss =~ m/$filter/)) {
+					push @specs, new SPEC($test, $scss, $test);
+				}
 			}
 		}
 		elsif (-e $sass) {
-			if (!$filter || !($sass =~ m/$filter/)) {
-				push @specs, new SPEC($test, $sass);
+			if (!$ignore || !($sass =~ m/$ignore/)) {
+				if (!$filter || ($sass =~ m/$filter/)) {
+					push @specs, new SPEC($test, $sass, $test);
+				}
 			}
 		}
 
@@ -285,27 +356,35 @@ sub load_tests()
 	return @specs;
 }
 
-use vars qw(@specs);
+use vars qw(@tests @specs);
 # specs must be loaded first
 # before registering tests
-BEGIN { @specs = grep {
-	! $_->query('todo') &&
-	! $_->query('ignore') &&
-	$_->query('start') <= 3.4
-} load_tests }
+BEGIN {
+	@tests = load_tests;
+	@specs = grep {
+		! $_->query('todo') &&
+		! $_->query('ignore') &&
+		$_->query('start') <= 3.4
+	} @tests;
+}
+
+# report todo tests
+# die join("\n", map {
+# 	$_->{root}->{root}
+# } grep {
+# 	$_->query('todo') &&
+# 	! $_->query('ignore') &&
+# 	$_->query('start') <= 3.4
+# } @tests);
 
-use Test::More tests => scalar @specs;
+use Test::More tests => 3 * scalar @specs;
 use Test::Differences;
 
 # run tests after filtering
 foreach my $spec (@specs)
 {
 	# compare the result with expected data
-	if ($spec->err) {
-	  eq_or_diff ($spec->err, $spec->stderr, $spec->file)
-	} elsif ($spec->expect) {
-	  eq_or_diff ($spec->result, $spec->expect, $spec->file)
-	} else {
-	  eq_or_diff ($spec->result, $spec->result, $spec->file)
-	}
+	eq_or_diff ($spec->css, $spec->expect, "CSS: " . $spec->file);
+	eq_or_diff ($spec->err, $spec->stderr, "Errors: " . $spec->file);
+	eq_or_diff ($spec->msg, $spec->stdmsg, "Warnings: " . $spec->file);
 }