lib/Test/Harness/t/point-parse.t

   1 #!/usr/bin/perl -w
   2
   3 BEGIN {
   4     if ( $ENV{PERL_CORE} ) {
   5         chdir 't';
   6         @INC = ('../lib', 'lib');
   7     }
   8     else {
   9         unshift @INC, 't/lib';
  10     }
  11 }
  12
  13 use strict;
  14
  15 use Test::More tests => 52;
  16
  17 BEGIN {
  18     use_ok( 'Test::Harness::Point' );
  19     use_ok( 'Test::Harness::Straps' );
  20 }
  21
  22 my $strap = Test::Harness::Straps->new;
  23 isa_ok( $strap, 'Test::Harness::Straps', 'new()' );
  24
  25
  26 my $testlines = {
  27     'not ok' => {
  28         ok => 0
  29     },
  30     'not ok # TODO' => {
  31         ok => 0,
  32         reason => '',
  33         type => 'todo'
  34     },
  35     'not ok 1' => {
  36         number => 1,
  37         ok => 0
  38     },
  39     'not ok 11 - this is \\# all the name # skip this is not' => {
  40         description => 'this is \\# all the name',
  41         number => 11,
  42         ok => 0,
  43         reason => 'this is not',
  44         type => 'skip'
  45     },
  46     'not ok 23 # TODO world peace' => {
  47         number => 23,
  48         ok => 0,
  49         reason => 'world peace',
  50         type => 'todo'
  51     },
  52     'not ok 42 - universal constant' => {
  53         description => 'universal constant',
  54         number => 42,
  55         ok => 0
  56     },
  57     ok => {
  58         ok => 1
  59     },
  60     'ok # skip' => {
  61         ok => 1,
  62         type => 'skip'
  63     },
  64     'ok 1' => {
  65         number => 1,
  66         ok => 1
  67     },
  68     'ok 1066 - and all that' => {
  69         description => 'and all that',
  70         number => 1066,
  71         ok => 1
  72     },
  73     'ok 11 - have life # TODO get a life' => {
  74         description => 'have life',
  75         number => 11,
  76         ok => 1,
  77         reason => 'get a life',
  78         type => 'todo'
  79     },
  80     'ok 2938' => {
  81         number => 2938,
  82         ok => 1
  83     },
  84     'ok 42 - _is_header() is a header \'1..192 todo 4 2 13 192 \\# Skip skip skip because' => {
  85         description => '_is_header() is a header \'1..192 todo 4 2 13 192 \\# Skip skip skip because',
  86         number => 42,
  87         ok => 1
  88     }
  89 };
  90 my @untests = (
  91                ' ok',
  92                'not',
  93                'okay 23',
  94               );
  95
  96 for my $line ( sort keys %$testlines ) {
  97     my $point = Test::Harness::Point->from_test_line( $line );
  98     isa_ok( $point, 'Test::Harness::Point' );
  99
 100     my $fields = $testlines->{$line};
 101     for my $property ( sort keys %$fields ) {
 102         my $value = $fields->{$property};
 103         is( eval "\$point->$property", $value, "$property on $line" );
 104         # Perls pre-5.6 can't handle $point->$property, and must be eval()d
 105     }
 106 }