1#!/usr/bin/perl -w
2
3BEGIN {
4    unshift @INC, 't/lib';
5}
6
7use strict;
8
9# use lib 't/lib';
10
11use Test::More;
12use File::Spec;
13use Test::Harness qw(execute_tests);
14
15# unset this global when self-testing ('testcover' and etc issue)
16local $ENV{HARNESS_PERL_SWITCHES};
17
18my $TEST_DIR = 't/sample-tests';
19
20{
21
22    # if the harness wants to save the resulting TAP we shouldn't
23    # do it for our internal calls
24    local $ENV{PERL_TEST_HARNESS_DUMP_TAP} = 0;
25
26    my $PER_LOOP = 4;
27
28    my $results = {
29        'descriptive' => {
30            'failed' => {},
31            'todo'   => {},
32            'totals' => {
33                'bad'         => 0,
34                'bonus'       => 0,
35                'files'       => 1,
36                'good'        => 1,
37                'max'         => 5,
38                'ok'          => 5,
39                'skipped'     => 0,
40                'sub_skipped' => 0,
41                'tests'       => 1,
42                'todo'        => 0
43            }
44        },
45        join(
46            ',', qw(
47              descriptive die die_head_end die_last_minute duplicates
48              head_end head_fail inc_taint junk_before_plan lone_not_bug
49              no_nums no_output schwern sequence_misparse shbang_misparse
50              simple simple_fail skip skip_nomsg skipall skipall_nomsg
51              stdout_stderr taint todo_inline
52              todo_misparse too_many vms_nit
53              )
54          ) => {
55            'failed' => {
56                "$TEST_DIR/die" => {
57                    'canon'  => '??',
58                    'estat'  => 1,
59                    'failed' => '??',
60                    'max'    => '??',
61                    'name'   => "$TEST_DIR/die",
62                    'wstat'  => '256'
63                },
64                "$TEST_DIR/die_head_end" => {
65                    'canon'  => '??',
66                    'estat'  => 1,
67                    'failed' => '??',
68                    'max'    => '??',
69                    'name'   => "$TEST_DIR/die_head_end",
70                    'wstat'  => '256'
71                },
72                "$TEST_DIR/die_last_minute" => {
73                    'canon'  => '??',
74                    'estat'  => 1,
75                    'failed' => 0,
76                    'max'    => 4,
77                    'name'   => "$TEST_DIR/die_last_minute",
78                    'wstat'  => '256'
79                },
80                "$TEST_DIR/duplicates" => {
81                    'canon'  => '??',
82                    'estat'  => '',
83                    'failed' => '??',
84                    'max'    => 10,
85                    'name'   => "$TEST_DIR/duplicates",
86                    'wstat'  => ''
87                },
88                "$TEST_DIR/head_fail" => {
89                    'canon'  => 2,
90                    'estat'  => '',
91                    'failed' => 1,
92                    'max'    => 4,
93                    'name'   => "$TEST_DIR/head_fail",
94                    'wstat'  => ''
95                },
96                "$TEST_DIR/inc_taint" => {
97                    'canon'  => 1,
98                    'estat'  => 1,
99                    'failed' => 1,
100                    'max'    => 1,
101                    'name'   => "$TEST_DIR/inc_taint",
102                    'wstat'  => '256'
103                },
104                "$TEST_DIR/no_nums" => {
105                    'canon'  => 3,
106                    'estat'  => '',
107                    'failed' => 1,
108                    'max'    => 5,
109                    'name'   => "$TEST_DIR/no_nums",
110                    'wstat'  => ''
111                },
112                "$TEST_DIR/no_output" => {
113                    'canon'  => '??',
114                    'estat'  => '',
115                    'failed' => '??',
116                    'max'    => '??',
117                    'name'   => "$TEST_DIR/no_output",
118                    'wstat'  => ''
119                },
120                "$TEST_DIR/simple_fail" => {
121                    'canon'  => '2 5',
122                    'estat'  => '',
123                    'failed' => 2,
124                    'max'    => 5,
125                    'name'   => "$TEST_DIR/simple_fail",
126                    'wstat'  => ''
127                },
128                "$TEST_DIR/todo_misparse" => {
129                    'canon'  => 1,
130                    'estat'  => '',
131                    'failed' => 1,
132                    'max'    => 1,
133                    'name'   => "$TEST_DIR/todo_misparse",
134                    'wstat'  => ''
135                },
136                "$TEST_DIR/too_many" => {
137                    'canon'  => '4-7',
138                    'estat'  => 4,
139                    'failed' => 4,
140                    'max'    => 3,
141                    'name'   => "$TEST_DIR/too_many",
142                    'wstat'  => '1024'
143                },
144                "$TEST_DIR/vms_nit" => {
145                    'canon'  => 1,
146                    'estat'  => '',
147                    'failed' => 1,
148                    'max'    => 2,
149                    'name'   => "$TEST_DIR/vms_nit",
150                    'wstat'  => ''
151                }
152            },
153            'todo' => {
154                "$TEST_DIR/todo_inline" => {
155                    'canon'  => 2,
156                    'estat'  => '',
157                    'failed' => 1,
158                    'max'    => 2,
159                    'name'   => "$TEST_DIR/todo_inline",
160                    'wstat'  => ''
161                }
162            },
163            'totals' => {
164                'bad'         => 12,
165                'bonus'       => 1,
166                'files'       => 27,
167                'good'        => 15,
168                'max'         => 76,
169                'ok'          => 78,
170                'skipped'     => 2,
171                'sub_skipped' => 2,
172                'tests'       => 27,
173                'todo'        => 2
174            }
175          },
176        'die' => {
177            'failed' => {
178                "$TEST_DIR/die" => {
179                    'canon'  => '??',
180                    'estat'  => 1,
181                    'failed' => '??',
182                    'max'    => '??',
183                    'name'   => "$TEST_DIR/die",
184                    'wstat'  => '256'
185                }
186            },
187            'todo'   => {},
188            'totals' => {
189                'bad'         => 1,
190                'bonus'       => 0,
191                'files'       => 1,
192                'good'        => 0,
193                'max'         => 0,
194                'ok'          => 0,
195                'skipped'     => 0,
196                'sub_skipped' => 0,
197                'tests'       => 1,
198                'todo'        => 0
199            }
200        },
201        'die_head_end' => {
202            'failed' => {
203                "$TEST_DIR/die_head_end" => {
204                    'canon'  => '??',
205                    'estat'  => 1,
206                    'failed' => '??',
207                    'max'    => '??',
208                    'name'   => "$TEST_DIR/die_head_end",
209                    'wstat'  => '256'
210                }
211            },
212            'todo'   => {},
213            'totals' => {
214                'bad'         => 1,
215                'bonus'       => 0,
216                'files'       => 1,
217                'good'        => 0,
218                'max'         => 0,
219                'ok'          => 4,
220                'skipped'     => 0,
221                'sub_skipped' => 0,
222                'tests'       => 1,
223                'todo'        => 0
224            }
225        },
226        'die_last_minute' => {
227            'failed' => {
228                "$TEST_DIR/die_last_minute" => {
229                    'canon'  => '??',
230                    'estat'  => 1,
231                    'failed' => 0,
232                    'max'    => 4,
233                    'name'   => "$TEST_DIR/die_last_minute",
234                    'wstat'  => '256'
235                }
236            },
237            'todo'   => {},
238            'totals' => {
239                'bad'         => 1,
240                'bonus'       => 0,
241                'files'       => 1,
242                'good'        => 0,
243                'max'         => 4,
244                'ok'          => 4,
245                'skipped'     => 0,
246                'sub_skipped' => 0,
247                'tests'       => 1,
248                'todo'        => 0
249            }
250        },
251        'duplicates' => {
252            'failed' => {
253                "$TEST_DIR/duplicates" => {
254                    'canon'  => '??',
255                    'estat'  => '',
256                    'failed' => '??',
257                    'max'    => 10,
258                    'name'   => "$TEST_DIR/duplicates",
259                    'wstat'  => ''
260                }
261            },
262            'todo'   => {},
263            'totals' => {
264                'bad'         => 1,
265                'bonus'       => 0,
266                'files'       => 1,
267                'good'        => 0,
268                'max'         => 10,
269                'ok'          => 11,
270                'skipped'     => 0,
271                'sub_skipped' => 0,
272                'tests'       => 1,
273                'todo'        => 0
274            }
275        },
276        'head_end' => {
277            'failed' => {},
278            'todo'   => {},
279            'totals' => {
280                'bad'         => 0,
281                'bonus'       => 0,
282                'files'       => 1,
283                'good'        => 1,
284                'max'         => 4,
285                'ok'          => 4,
286                'skipped'     => 0,
287                'sub_skipped' => 0,
288                'tests'       => 1,
289                'todo'        => 0
290            }
291        },
292        'head_fail' => {
293            'failed' => {
294                "$TEST_DIR/head_fail" => {
295                    'canon'  => 2,
296                    'estat'  => '',
297                    'failed' => 1,
298                    'max'    => 4,
299                    'name'   => "$TEST_DIR/head_fail",
300                    'wstat'  => ''
301                }
302            },
303            'todo'   => {},
304            'totals' => {
305                'bad'         => 1,
306                'bonus'       => 0,
307                'files'       => 1,
308                'good'        => 0,
309                'max'         => 4,
310                'ok'          => 3,
311                'skipped'     => 0,
312                'sub_skipped' => 0,
313                'tests'       => 1,
314                'todo'        => 0
315            }
316        },
317        'inc_taint' => {
318            'failed' => {
319                "$TEST_DIR/inc_taint" => {
320                    'canon'  => 1,
321                    'estat'  => 1,
322                    'failed' => 1,
323                    'max'    => 1,
324                    'name'   => "$TEST_DIR/inc_taint",
325                    'wstat'  => '256'
326                }
327            },
328            'todo'   => {},
329            'totals' => {
330                'bad'         => 1,
331                'bonus'       => 0,
332                'files'       => 1,
333                'good'        => 0,
334                'max'         => 1,
335                'ok'          => 0,
336                'skipped'     => 0,
337                'sub_skipped' => 0,
338                'tests'       => 1,
339                'todo'        => 0
340            }
341        },
342        'junk_before_plan' => {
343            'failed' => {},
344            'todo'   => {},
345            'totals' => {
346                'bad'         => 0,
347                'bonus'       => 0,
348                'files'       => 1,
349                'good'        => 1,
350                'max'         => 1,
351                'ok'          => 1,
352                'skipped'     => 0,
353                'sub_skipped' => 0,
354                'tests'       => 1,
355                'todo'        => 0
356            }
357        },
358        'lone_not_bug' => {
359            'failed' => {},
360            'todo'   => {},
361            'totals' => {
362                'bad'         => 0,
363                'bonus'       => 0,
364                'files'       => 1,
365                'good'        => 1,
366                'max'         => 4,
367                'ok'          => 4,
368                'skipped'     => 0,
369                'sub_skipped' => 0,
370                'tests'       => 1,
371                'todo'        => 0
372            }
373        },
374        'no_nums' => {
375            'failed' => {
376                "$TEST_DIR/no_nums" => {
377                    'canon'  => 3,
378                    'estat'  => '',
379                    'failed' => 1,
380                    'max'    => 5,
381                    'name'   => "$TEST_DIR/no_nums",
382                    'wstat'  => ''
383                }
384            },
385            'todo'   => {},
386            'totals' => {
387                'bad'         => 1,
388                'bonus'       => 0,
389                'files'       => 1,
390                'good'        => 0,
391                'max'         => 5,
392                'ok'          => 4,
393                'skipped'     => 0,
394                'sub_skipped' => 0,
395                'tests'       => 1,
396                'todo'        => 0
397            }
398        },
399        'no_output' => {
400            'failed' => {
401                "$TEST_DIR/no_output" => {
402                    'canon'  => '??',
403                    'estat'  => '',
404                    'failed' => '??',
405                    'max'    => '??',
406                    'name'   => "$TEST_DIR/no_output",
407                    'wstat'  => ''
408                }
409            },
410            'todo'   => {},
411            'totals' => {
412                'bad'         => 1,
413                'bonus'       => 0,
414                'files'       => 1,
415                'good'        => 0,
416                'max'         => 0,
417                'ok'          => 0,
418                'skipped'     => 0,
419                'sub_skipped' => 0,
420                'tests'       => 1,
421                'todo'        => 0
422            }
423        },
424        'schwern' => {
425            'failed' => {},
426            'todo'   => {},
427            'totals' => {
428                'bad'         => 0,
429                'bonus'       => 0,
430                'files'       => 1,
431                'good'        => 1,
432                'max'         => 1,
433                'ok'          => 1,
434                'skipped'     => 0,
435                'sub_skipped' => 0,
436                'tests'       => 1,
437                'todo'        => 0
438            }
439        },
440        'sequence_misparse' => {
441            'failed' => {},
442            'todo'   => {},
443            'totals' => {
444                'bad'         => 0,
445                'bonus'       => 0,
446                'files'       => 1,
447                'good'        => 1,
448                'max'         => 5,
449                'ok'          => 5,
450                'skipped'     => 0,
451                'sub_skipped' => 0,
452                'tests'       => 1,
453                'todo'        => 0
454            }
455        },
456        'shbang_misparse' => {
457            'failed' => {},
458            'todo'   => {},
459            'totals' => {
460                'bad'         => 0,
461                'bonus'       => 0,
462                'files'       => 1,
463                'good'        => 1,
464                'max'         => 2,
465                'ok'          => 2,
466                'skipped'     => 0,
467                'sub_skipped' => 0,
468                'tests'       => 1,
469                'todo'        => 0
470            }
471        },
472        'simple' => {
473            'failed' => {},
474            'todo'   => {},
475            'totals' => {
476                'bad'         => 0,
477                'bonus'       => 0,
478                'files'       => 1,
479                'good'        => 1,
480                'max'         => 5,
481                'ok'          => 5,
482                'skipped'     => 0,
483                'sub_skipped' => 0,
484                'tests'       => 1,
485                'todo'        => 0
486            }
487        },
488        'simple_fail' => {
489            'failed' => {
490                "$TEST_DIR/simple_fail" => {
491                    'canon'  => '2 5',
492                    'estat'  => '',
493                    'failed' => 2,
494                    'max'    => 5,
495                    'name'   => "$TEST_DIR/simple_fail",
496                    'wstat'  => ''
497                }
498            },
499            'todo'   => {},
500            'totals' => {
501                'bad'         => 1,
502                'bonus'       => 0,
503                'files'       => 1,
504                'good'        => 0,
505                'max'         => 5,
506                'ok'          => 3,
507                'skipped'     => 0,
508                'sub_skipped' => 0,
509                'tests'       => 1,
510                'todo'        => 0
511            }
512        },
513        'skip' => {
514            'failed' => {},
515            'todo'   => {},
516            'totals' => {
517                'bad'         => 0,
518                'bonus'       => 0,
519                'files'       => 1,
520                'good'        => 1,
521                'max'         => 5,
522                'ok'          => 5,
523                'skipped'     => 0,
524                'sub_skipped' => 1,
525                'tests'       => 1,
526                'todo'        => 0
527            }
528        },
529        'skip_nomsg' => {
530            'failed' => {},
531            'todo'   => {},
532            'totals' => {
533                'bad'         => 0,
534                'bonus'       => 0,
535                'files'       => 1,
536                'good'        => 1,
537                'max'         => 1,
538                'ok'          => 1,
539                'skipped'     => 0,
540                'sub_skipped' => 1,
541                'tests'       => 1,
542                'todo'        => 0
543            }
544        },
545        'skipall' => {
546            'failed' => {},
547            'todo'   => {},
548            'totals' => {
549                'bad'         => 0,
550                'bonus'       => 0,
551                'files'       => 1,
552                'good'        => 1,
553                'max'         => 0,
554                'ok'          => 0,
555                'skipped'     => 1,
556                'sub_skipped' => 0,
557                'tests'       => 1,
558                'todo'        => 0
559            }
560        },
561        'skipall_nomsg' => {
562            'failed' => {},
563            'todo'   => {},
564            'totals' => {
565                'bad'         => 0,
566                'bonus'       => 0,
567                'files'       => 1,
568                'good'        => 1,
569                'max'         => 0,
570                'ok'          => 0,
571                'skipped'     => 1,
572                'sub_skipped' => 0,
573                'tests'       => 1,
574                'todo'        => 0
575            }
576        },
577        'stdout_stderr' => {
578            'failed' => {},
579            'todo'   => {},
580            'totals' => {
581                'bad'         => 0,
582                'bonus'       => 0,
583                'files'       => 1,
584                'good'        => 1,
585                'max'         => 4,
586                'ok'          => 4,
587                'skipped'     => 0,
588                'sub_skipped' => 0,
589                'tests'       => 1,
590                'todo'        => 0
591            }
592        },
593        'switches' => {
594            'skip_if' => sub {
595                ( $ENV{PERL5OPT} || '' ) =~ m{(?:^|\s)-[dM]};
596            },
597            'failed' => {
598                "$TEST_DIR/switches" => {
599                    'canon'  => 1,
600                    'estat'  => '',
601                    'failed' => 1,
602                    'max'    => 1,
603                    'name'   => "$TEST_DIR/switches",
604                    'wstat'  => ''
605                }
606            },
607            'todo'   => {},
608            'totals' => {
609                'bad'         => 1,
610                'bonus'       => 0,
611                'files'       => 1,
612                'good'        => 0,
613                'max'         => 1,
614                'ok'          => 0,
615                'skipped'     => 0,
616                'sub_skipped' => 0,
617                'tests'       => 1,
618                'todo'        => 0
619            }
620        },
621        'taint' => {
622            'failed' => {},
623            'todo'   => {},
624            'totals' => {
625                'bad'         => 0,
626                'bonus'       => 0,
627                'files'       => 1,
628                'good'        => 1,
629                'max'         => 1,
630                'ok'          => 1,
631                'skipped'     => 0,
632                'sub_skipped' => 0,
633                'tests'       => 1,
634                'todo'        => 0
635            }
636        },
637        'taint_warn' => {
638            'failed' => {},
639            'todo'   => {},
640            'totals' => {
641                'bad'         => 0,
642                'bonus'       => 0,
643                'files'       => 1,
644                'good'        => 1,
645                'max'         => 1,
646                'ok'          => 1,
647                'skipped'     => 0,
648                'sub_skipped' => 0,
649                'tests'       => 1,
650                'todo'        => 0
651            },
652            'require' => 5.008001,
653        },
654        'todo_inline' => {
655            'failed' => {},
656            'todo'   => {
657                "$TEST_DIR/todo_inline" => {
658                    'canon'  => 2,
659                    'estat'  => '',
660                    'failed' => 1,
661                    'max'    => 2,
662                    'name'   => "$TEST_DIR/todo_inline",
663                    'wstat'  => ''
664                }
665            },
666            'totals' => {
667                'bad'         => 0,
668                'bonus'       => 1,
669                'files'       => 1,
670                'good'        => 1,
671                'max'         => 3,
672                'ok'          => 3,
673                'skipped'     => 0,
674                'sub_skipped' => 0,
675                'tests'       => 1,
676                'todo'        => 2
677            }
678        },
679        'todo_misparse' => {
680            'failed' => {
681                "$TEST_DIR/todo_misparse" => {
682                    'canon'  => 1,
683                    'estat'  => '',
684                    'failed' => 1,
685                    'max'    => 1,
686                    'name'   => "$TEST_DIR/todo_misparse",
687                    'wstat'  => ''
688                }
689            },
690            'todo'   => {},
691            'totals' => {
692                'bad'         => 1,
693                'bonus'       => 0,
694                'files'       => 1,
695                'good'        => 0,
696                'max'         => 1,
697                'ok'          => 0,
698                'skipped'     => 0,
699                'sub_skipped' => 0,
700                'tests'       => 1,
701                'todo'        => 0
702            }
703        },
704        'too_many' => {
705            'failed' => {
706                "$TEST_DIR/too_many" => {
707                    'canon'  => '4-7',
708                    'estat'  => 4,
709                    'failed' => 4,
710                    'max'    => 3,
711                    'name'   => "$TEST_DIR/too_many",
712                    'wstat'  => '1024'
713                }
714            },
715            'todo'   => {},
716            'totals' => {
717                'bad'         => 1,
718                'bonus'       => 0,
719                'files'       => 1,
720                'good'        => 0,
721                'max'         => 3,
722                'ok'          => 7,
723                'skipped'     => 0,
724                'sub_skipped' => 0,
725                'tests'       => 1,
726                'todo'        => 0
727            }
728        },
729        'vms_nit' => {
730            'failed' => {
731                "$TEST_DIR/vms_nit" => {
732                    'canon'  => 1,
733                    'estat'  => '',
734                    'failed' => 1,
735                    'max'    => 2,
736                    'name'   => "$TEST_DIR/vms_nit",
737                    'wstat'  => ''
738                }
739            },
740            'todo'   => {},
741            'totals' => {
742                'bad'         => 1,
743                'bonus'       => 0,
744                'files'       => 1,
745                'good'        => 0,
746                'max'         => 2,
747                'ok'          => 1,
748                'skipped'     => 0,
749                'sub_skipped' => 0,
750                'tests'       => 1,
751                'todo'        => 0
752            }
753        }
754    };
755
756    my $num_tests = ( keys %$results ) * $PER_LOOP;
757
758    plan tests => $num_tests;
759
760    sub local_name {
761        my $name = shift;
762        return File::Spec->catfile( split /\//, $name );
763    }
764
765    sub local_result {
766        my $hash = shift;
767        my $new  = {};
768
769        while ( my ( $file, $want ) = each %$hash ) {
770            if ( exists $want->{name} ) {
771                $want->{name} = local_name( $want->{name} );
772            }
773            $new->{ local_name($file) } = $want;
774        }
775        return $new;
776    }
777
778    sub vague_status {
779        my $hash = shift;
780        return $hash unless $^O eq 'VMS';
781
782        while ( my ( $file, $want ) = each %$hash ) {
783            for (qw( estat wstat )) {
784                if ( exists $want->{$_} ) {
785                    $want->{$_} = $want->{$_} ? 1 : 0;
786                }
787            }
788        }
789        return $hash;
790    }
791
792    {
793        local $^W = 0;
794
795        # Silence harness output
796        *TAP::Formatter::Console::_output = sub {
797
798            # do nothing
799        };
800    }
801
802    for my $test_key ( sort keys %$results ) {
803        my $result = $results->{$test_key};
804        SKIP: {
805            if ( $result->{require} && $] < $result->{require} ) {
806                skip "Test requires Perl $result->{require}, we have $]", 4;
807            }
808
809            if ( my $skip_if = $result->{skip_if} ) {
810                skip
811                  "Test '$test_key' can't run properly in this environment", 4
812                  if $skip_if->();
813            }
814
815            my @test_names = split( /,/, $test_key );
816            my @test_files
817              = map { File::Spec->catfile( $TEST_DIR, $_ ) } @test_names;
818
819            # For now we supress STDERR because it crufts up /our/ test
820            # results. Should probably capture and analyse it.
821            local ( *OLDERR, *OLDOUT );
822            open OLDERR, '>&STDERR' or die $!;
823            open OLDOUT, '>&STDOUT' or die $!;
824            my $devnull = File::Spec->devnull;
825            open STDERR, ">$devnull" or die $!;
826            open STDOUT, ">$devnull" or die $!;
827
828            my ( $tot, $fail, $todo, $harness, $aggregate )
829              = execute_tests( tests => \@test_files );
830
831            open STDERR, '>&OLDERR' or die $!;
832            open STDOUT, '>&OLDOUT' or die $!;
833
834            my $bench = delete $tot->{bench};
835            isa_ok $bench, 'Benchmark';
836
837            # Localise filenames in failed, todo
838            my $lfailed = vague_status( local_result( $result->{failed} ) );
839            my $ltodo   = vague_status( local_result( $result->{todo} ) );
840
841            # use Data::Dumper;
842            # diag Dumper( [ $lfailed, $ltodo ] );
843
844            is_deeply $tot, $result->{totals}, "totals match for $test_key";
845            is_deeply vague_status($fail), $lfailed,
846              "failure summary matches for $test_key";
847            is_deeply vague_status($todo), $ltodo,
848              "todo summary matches for $test_key";
849        }
850    }
851}
852