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