Legend:
- Unmodified
- Added
- Removed
-
util/fudge
r19541 r19582 4 4 use warnings; 5 5 6 unless (@ARGV) { 7 die "Usage: $0 implname testfilename"; 6 my $ME = shift; 7 my $IN = shift; 8 my $OUT = shift; 9 10 if (!$OUT) { 11 ($OUT = $IN) =~ s/\.t$/.$ME/ or $OUT .= ".$ME"; 8 12 } 9 my $ME = shift; 13 unless ($ME and $IN and -e $IN and $OUT) { 14 die "Usage: $0 implname testfilename [fudgedtestfilename]"; 15 } 10 16 17 if (-e $OUT) { 18 if (-M $IN > -M $OUT) { 19 print "$OUT\n"; # unchanged, so no need to refudge 20 exit(0); 21 } 22 else { 23 unlink $OUT; # old fudged version, may or may not regenerate... 24 } 25 } 26 27 my $REALLY_FUDGED = 0; 28 my $OUTPUT = ""; 11 29 my $FUDGE = ""; 12 30 our $PENDING = 0; … … 14 32 my $IS = '\\b(?:is|ok|is_deeply|isnt|like|unlike|eval_dies_ok|cmp_ok|isa_ok|use_ok|throws_ok|dies_ok|pass|flunk)(?:\\b|_)'; 15 33 34 @ARGV = ($IN); 16 35 fudgeblock(); 36 37 if ($REALLY_FUDGED) { 38 open OUT, ">", $OUT or die "Can't create $OUT: $!"; 39 print OUT $OUTPUT; 40 print OUT <<'END'; 41 42 say "# FUDGED!"; 43 exit(1); # hopefully reported as "dubious" 44 END 45 close OUT; 46 print "$OUT\n"; # pick the output file to run 47 } 48 else { 49 print "$IN\n"; # pick the input file to run 50 } 17 51 18 52 sub fudgeblock { 19 53 while (<>) { 20 54 if (/^\s*\#\? (\w+) \: \s* (.*)/x and $1 eq $ME) { 55 $REALLY_FUDGED = 1; 21 56 $ARGS = $2; 22 57 if ($ARGS =~ s/^(\d+)\s*//) { … … 39 74 if ($FUDGE eq 'todo') { 40 75 local $PENDING = 999999; # do all in block as one action 41 print$_;76 $OUTPUT .= $_; 42 77 fudgeblock(); 43 78 $_ = ''; … … 99 134 } 100 135 continue { 101 print$_;136 $OUTPUT .= $_; 102 137 return if /^\}/ and $PENDING > 0; 103 138 } -
util/fudgeall
r19528 r19582 18 18 map { 19 19 if ($SPEC or m!\bspec\b!) { 20 my $fud; 21 if (($fud = $_) =~ s/\.t/.fud/) { 22 warn "$dir/util/fudge $platform $_ >$fud\n"; 23 system "$dir/util/fudge $platform $_ >$fud"; 24 $fud; 25 } 26 else { 27 $_; 28 } 20 chomp(my $pick = `$dir/util/fudge $platform $_`); 21 $pick; 29 22 } 30 23 else { -
util/prove6
r15968 r19582 9 9 use Test::Harness; 10 10 use File::Spec; 11 use Cwd; 12 my $top = getcwd; 13 14 while (not -f "$top/util/prove6") { 15 die "Not inside pugs directory\n" unless $top; 16 $top =~ s!(.*)/(.*)!!; 17 } 11 18 12 19 my ($pugs, $pir, $perl5, $help, $inc); … … 98 105 if ($sum > 1) { die "error: you can't specify multiple implementations/backends.\n"; } 99 106 if ($sum == 0) { $pugs = 1 } # default to pugs 107 my $impl = "pugs"; 108 # $impl = "smop" if $smop; 109 # etc. 100 110 101 111 my @tfiles = sort map { -d $_ ? all_in($_) : $_ } map glob, @ARGV; 112 @tfiles = split ' ', `$^X $top/util/fudgeall $impl @tfiles`; 102 113 103 114 $ENV{PERL6LIB} ||= 'blib6/lib'; … … 127 138 warn "$pugs_exec -CParse-YAML ext/Test/lib/Test.pm > blib6/lib/Test.pm.yml\n"; 128 139 system("$pugs_exec -CParse-YAML ext/Test/lib/Test.pm > blib6/lib/Test.pm.yml"); 129 system("$^X util/gen_prelude.pl -v -i src/perl6/Prelude.pm -p pugs " .140 system("$^X $top/util/gen_prelude.pl -v -i src/perl6/Prelude.pm -p pugs " . 130 141 "--output blib6/lib/Prelude.pm.yml"); 131 142 } -
util/yaml_harness.pl
r16888 r19582 10 10 use Test::Harness; 11 11 use Test::TAP::Model; 12 use Cwd; 13 my $top = getcwd; 14 15 while (not -f "$top/util/prove6") { 16 die "Not inside pugs directory\n" unless $top; 17 $top =~ s!(.*)/(.*)!!; 18 } 12 19 13 20 # Package and global declarations … … 83 90 get_config(); 84 91 92 my $impl = "pugs"; 93 85 94 @ARGV = sort map glob, "t/*/*.t", "t/*/*/*.t", "ext/*/t/*.t" unless @ARGV; 95 @ARGV = split ' ', `$^X $top/util/fudgeall $impl @ARGV`; 86 96 87 97 my $s = __PACKAGE__->new;
