[spec tests] allow fudge and fudgeall to process arguments

~ add --keep-exit-code to fudge, to allow implementations to report passing fudged test files as successful ~ regenerate fudged files if fudge has changed since last they were generated ~ default $keyword to and empty string to avoid a warning git-svn-id: http://svn.pugscode.org/pugs@20306 c213334d-75ef-0310-aa23-eaa082d1ae64
Raku · Apr 25, 2008 · 1a3b0cc · 1a3b0cc
1 parent d198f6b
commit 1a3b0cc
Show file tree

Hide file tree

Showing 2 changed files with 27 additions and 6 deletions.
diff --git a/fudge b/fudge
@@ -3,6 +3,13 @@
 use strict;
 use warnings;
 
+my %OPTS;
+while( $_ = $ARGV[0], /^-/ ) {
+    shift;
+    last if /^--$/;
+    $OPTS{$_} = $_;
+}
+
 my $ME = shift;
 my $IN = shift;
 my $OUT = shift;
@@ -13,7 +20,12 @@ if (!$OUT and $IN) {
 unless ($ME and $IN and -e $IN and $OUT) {
 
     die <<"USAGE";
-Usage: $0 implname testfilename [fudgedtestfilename]
+Usage: $0 [options] implname testfilename [fudgedtestfilename]
+
+    Options:
+    --keep-exit-code
+        by default, fudge modifies the exit code for fudged test files to 1.
+        supplying this option will suppress that behavior.
 
     Verbs:
     #?implname [num] skip 'reason'
@@ -47,7 +59,7 @@ USAGE
 }
 
 if (-e $OUT) {
-    if (-M $IN >= -M $OUT) {
+    if (-M $IN >= -M $OUT and -M $0 >= -M $OUT) {
         print "$OUT\n";     # unchanged, so no need to refudge
         exit(0);
     }
@@ -64,17 +76,18 @@ my $ARGS = '';
 my $IS = '\\b(?:is|ok|is_deeply|is_approx|isnt|like|unlike|eval_dies_ok|cmp_ok|isa_ok|use_ok|throws_ok|dies_ok|pass|flunk)(?:\\b|_)';
 my %DOES;
 my $DOES = 0;
+my $EXIT = $OPTS{'--keep-exit-code'} ? '' : 'exit(1);';
 
 @ARGV = ($IN);
 fudgeblock();
 
 if ($REALLY_FUDGED) {
     open OUT, ">", $OUT or die "Can't create $OUT: $!";
     print OUT $OUTPUT;
-    print OUT <<'END';
+    print OUT <<"END";
 
 say "# FUDGED!";
-exit(1);    # hopefully reported as "dubious"
+$EXIT
 END
     close OUT;
     print "$OUT\n"; # pick the output file to run
@@ -179,7 +192,7 @@ sub fudgeblock {
                     last unless $more;
                     $_ .= $more;
                 }
-                my ($keyword) = /^\s*(\w+)/;
+                my ($keyword) = /^\s*(\w+)/ || '';
                 my $numtests;
                 if ($DOES{$keyword}) {
                     $numtests = $DOES{$keyword};

diff --git a/fudgeall b/fudgeall
@@ -3,6 +3,13 @@
 use strict;
 use warnings;
 
+my @opts;
+while( $_ = $ARGV[0], /^-/ ) {
+    shift;
+    last if /^--$/;
+    push @opts, $_;
+}
+
 my $platform = shift;
 
 use Cwd;
@@ -37,7 +44,8 @@ print join(' ',
     map {
         my $pick;
         if ( $_ !~ m/\.$platform$/ ) {
-            chomp( $pick = `$^X $fudge $platform $_` );
+            my $cmd = "$^X $fudge @opts $platform $_";
+            chomp( $pick = `$cmd` );
         }
         defined $pick ? $pick : ();
     } @ARGV