1use Test2::V0; 2 3use Config qw/%Config/; 4use File::Temp qw/tempfile/; 5use File::Spec; 6 7use App::Yath::Tester qw/yath/; 8use Test2::Harness::Util::File::JSONL; 9 10use Test2::Harness::Util qw/clean_path/; 11use Test2::Harness::Util::JSON qw/decode_json/; 12 13my $dir = __FILE__; 14$dir =~ s{\.t$}{}g; 15$dir =~ s{^\./}{}; 16 17yath( 18 command => 'test', 19 args => [$dir, '--ext=tx', '--ext=txx'], 20 exit => T(), 21 test => sub { 22 my $out = shift; 23 24 like($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was seen as a failure when reading the output"); 25 like($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the output"); 26 }, 27); 28 29yath( 30 command => 'test', 31 args => [$dir, '--ext=tx'], 32 exit => 0, 33 test => sub { 34 my $out = shift; 35 unlike($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was seen as a failure when reading the output"); 36 like($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the output"); 37 }, 38); 39 40yath( 41 command => 'test', 42 args => [$dir, '--ext=txx'], 43 exit => T(), 44 test => sub { 45 my $out = shift; 46 47 like($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was seen as a failure when reading the output"); 48 unlike($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the output"); 49 }, 50); 51 52yath( 53 command => 'test', 54 args => [$dir, '-vvv'], 55 exit => T(), 56 test => sub { 57 my $out = shift; 58 59 like($out->{output}, qr/No tests were seen!/, "Got error message"); 60 }, 61); 62 63 64note q[Checking --exclude-file option when a file is provided on the command line]; 65 66yath( 67 command => 'test', 68 args => [ "--exclude-file=$dir/fail.txx", "$dir/pass.tx", "$dir/fail.txx" ], 69 exit => 0, 70 test => sub { 71 my $out = shift; 72 73 unlike($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was excluded using '--exclude-file' option"); 74 like($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the output"); 75 }, 76); 77 78note q[Checking --exclude-list option when a file is provided on the command line]; 79 80my ($fh, $list_name) = tempfile(UNLINK => 1); 81print $fh "# GENERATED YATH TEST EXCLUSION LIST\n#$dir/pass.tx\n$dir/fail.txx"; 82close($fh); 83 84yath( 85 command => 'test', 86 args => ["--exclude-list=$list_name", "$dir/pass.tx", "$dir/fail.txx"], 87 exit => 0, 88 test => sub { 89 my $out = shift; 90 91 unlike($out->{output}, qr{FAILED.*fail\.tx}, "'fail.tx' was excluded using '--exclude-list' option with a file"); 92 like($out->{output}, qr{PASSED.*pass\.tx}, "'pass.tx' was not seen as a failure when reading the output"); 93 }, 94); 95 96{ 97 note q[Testsuite using symlinks: check that $0 is preserved]; 98 99 my $sdir = $dir . '-symlinks'; 100 my $base = "$sdir/_base.xt"; 101 my $symlink = "$sdir/symlink_to_base.xt"; 102 103 unlink $symlink if -e $symlink; 104 if ( eval{ symlink('_base.xt', $symlink) } ) { 105 106 yath( 107 command => 'test', 108 args => [$sdir, '--ext=xt' ], 109 exit => 0, 110 test => sub { 111 my $out = shift; 112 113 like($out->{output}, qr{SKIPPED.*\Q$base\E}, "'_base.xt' was skipped"); 114 like($out->{output}, qr{PASSED.*\Q$symlink\E}, "'symlink_to_base.xt' passed [and is not skipped]"); 115 }, 116 ); 117 118 yath( 119 command => 'test', 120 args => [ $base, $symlink ], 121 exit => 0, 122 test => sub { 123 my $out = shift; 124 125 like($out->{output}, qr{SKIPPED.*\Q$base\E}, "'_base.xt' was skipped"); 126 like($out->{output}, qr{PASSED.*\Q$symlink\E}, "'symlink_to_base.xt' passed [and is not skipped]"); 127 }, 128 ); 129 130 131 } 132 133} 134 135{ 136 note q[Testsuite checking broken symlinks #103]; 137 138 my $sdir = $dir . '-broken-symlinks'; 139 my $symlink = "$sdir/broken-symlink.tx"; 140 141 unlink $symlink if -e $symlink; 142 if ( eval{ symlink('nothing-there', $symlink) } ) { 143 144 yath( 145 command => 'test', 146 args => [$sdir, '--ext=tx' ], 147 exit => 0, 148 test => sub { 149 my $out = shift; 150 151 unlike($out->{output}, qr{FAILED}, q[no failures]); 152 unlike($out->{output}, qr{\Qbroken-symlink.tx\E}, q[no mention of broken-symlink.tx] ); 153 like($out->{output}, qr{PASSED.*\Qt/integration/test-broken-symlinks/pass.tx\E}, q[t/integration/test-broken-symlinks/pass.tx PASSED]); 154 }, 155 ); 156 } 157} 158 159{ 160 note "Testing durations when provided using a json file"; 161 162 my $sdir = $dir . '-durations'; 163 164 # using a directory 165 yath( 166 command => 'test', 167 args => [ '-v', '-j1', '--durations', "$sdir/../test-durations.json", '--ext=tx', $sdir, ], 168 exit => 0, 169 test => sub { 170 my $out = shift; 171 172 my @lines = sort { 173 my ($aj) = ($a =~ m/job\s+(\d+)/) or return 0; 174 my ($bj) = ($b =~ m/job\s+(\d+)/) or return 0; 175 return $aj <=> $bj; 176 } grep { m/\Q( PASSED )\E/ } split /\n/, $out->{output}; 177 178 is \@lines, array { 179 180 item match qr{\Qslow-01.tx\E}; 181 item match qr{\Qslow-02.tx\E}; 182 item match qr{\Qfast-01.tx\E}; 183 item match qr{\Qfast-02.tx\E}; 184 item match qr{\Qfast-03.tx\E}; 185 item match qr{\Qfast-04.tx\E}; 186 187 end; 188 }, "tests are run in order from slow to fast - using a directory"; 189 }, 190 ); 191 192 # using a list of files 193 my @files = ( 194 "$sdir/fast-01.tx", "$sdir/fast-02.tx", "$sdir/fast-03.tx", "$sdir/fast-04.tx", 195 "$sdir/slow-01.tx", "$sdir/slow-02.tx" 196 ); 197 my %hfiles = map { $_ => 1 } @files; 198 yath( 199 command => 'test', 200 args => [ '-v', '-j1', '--durations', "$sdir/../test-durations.json", '--ext=tx', 201 keys %hfiles, # random order 202 ], 203 exit => 0, 204 test => sub { 205 my $out = shift; 206 207 my @lines = sort { 208 my ($aj) = ($a =~ m/job\s+(\d+)/) or return 0; 209 my ($bj) = ($b =~ m/job\s+(\d+)/) or return 0; 210 return $aj <=> $bj; 211 } grep { m/\Q( PASSED )\E/ } split /\n/, $out->{output}; 212 213 is \@lines, array { 214 215 item match qr{\Qslow-01.tx\E}; 216 item match qr{\Qslow-02.tx\E}; 217 item match qr{\Qfast-01.tx\E}; 218 item match qr{\Qfast-02.tx\E}; 219 item match qr{\Qfast-03.tx\E}; 220 item match qr{\Qfast-04.tx\E}; 221 222 end; 223 }, "tests are run in order from slow to fast - using a list of files"; 224 }, 225 ); 226} 227 228if ("$]" >= 5.026) { 229 note q[Checking %INC and @INC setup]; 230 231 local @INC = map { clean_path( $_ ) } grep { $_ ne '.' } @INC; 232 local $ENV{PERL5LIB} = join $Config{path_sep}, map { clean_path( $_ ) } grep { $_ ne '.' } split( $Config{path_sep}, $ENV{PERL5LIB} ); 233 local $ENV{PERL_USE_UNSAFE_INC}; 234 delete $ENV{PERL_USE_UNSAFE_INC}; 235 236 my $sdir = $dir . '-inc'; 237 238 yath( 239 command => 'test', 240 args => ['--ext=tx', '--no-unsafe-inc', $sdir], 241 exit => 0, 242 test => sub { 243 my $out = shift; 244 245 unlike($out->{output}, qr{FAILED}, q[no failures]); 246 }, 247 ); 248} 249 250yath( 251 command => 'test', 252 args => [$dir, '--ext=txxx', '::', 'foobar', 'baz' ], 253 exit => 0, 254 test => sub { 255 my $out = shift; 256 like($out->{output}, qr{PASSED}, 'Args after arisdottle are added to @ARGV'); 257 }, 258); 259 260done_testing; 261