t/perl/Parrot_Test.t

   1 #! perl
   2 # Copyright (C) 2001-2007, The Perl Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/perl/Parrot_Test.t - Parrot::Test unit tests
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/perl/Parrot_Test.t
  12
  13 =head1 DESCRIPTION
  14
  15 These tests cover the basic functionality of C<Parrot::Test>.
  16
  17 =cut
  18
  19 use strict;
  20 use warnings;
  21 use Test::More;
  22
  23 BEGIN {
  24     eval "use Test::Builder::Tester;";
  25     if ($@) {
  26         plan( skip_all => "Test::Builder::Tester not installed\n" );
  27         exit 0;
  28     }
  29     plan( tests => 66 );
  30 }
  31
  32 use lib qw( . lib ../lib ../../lib );
  33
  34 BEGIN {
  35     my $pre_env = exists $ENV{PARROT_TEST} ? $ENV{PARROT_TEST} : undef;
  36     use_ok('Parrot::Test') or die;
  37
  38     my $post_env = exists $ENV{PARROT_TEST} ? $ENV{PARROT_TEST} : undef;
  39     if ( defined $pre_env ) {
  40         is( $post_env, $pre_env, 'PARROT_TEST env unchanged' );
  41     }
  42     else {
  43         is( $post_env, 1, 'PARROT_TEST env set' );
  44     }
  45 }
  46
  47 can_ok( 'Parrot::Test', $_ ) for qw/
  48     c_output_is                     c_output_isnt
  49     c_output_like
  50     example_output_is               example_output_isnt
  51     example_output_like
  52     language_error_output_is        language_error_output_isnt
  53     language_error_output_like
  54     language_output_is              language_output_isnt
  55     language_output_like
  56     pasm_error_output_is            pasm_error_output_isnt
  57     pasm_error_output_like          pasm_error_output_unlike
  58     pasm_output_is                  pasm_output_isnt
  59     pasm_output_like                pasm_output_unlike
  60     pbc_error_output_is             pbc_error_output_isnt
  61     pbc_error_output_like           pbc_error_output_unlike
  62     pbc_output_is                   pbc_output_isnt
  63     pbc_output_like                 pbc_output_unlike
  64     pir_error_output_is             pir_error_output_isnt
  65     pir_error_output_like           pir_error_output_unlike
  66     pir_output_is                   pir_output_isnt
  67     pir_output_like                 pir_output_unlike
  68     pir_2_pasm_is                   pir_2_pasm_isnt
  69     pir_2_pasm_like                 pir_2_pasm_unlike
  70     generate_languages_functions
  71     per_test
  72     plan
  73     skip
  74     slurp_file
  75     run_command
  76     write_code_to_file
  77     /;
  78
  79 # RT#46891 test run_command()
  80
  81 # per_test
  82 is( Parrot::Test::per_test(), undef, 'per_test() no args' );
  83 is( Parrot::Test::per_test( undef, 0 ),     undef, 'per_test() invalid first arg' );
  84 is( Parrot::Test::per_test( 0,     undef ), undef, 'per_test() invalid second arg' );
  85 is( Parrot::Test::per_test( undef, undef ), undef, 'per_test() two invalid args' );
  86
  87 # RT#46893 test write_code_to_file(), plan(), skip(), slurp_file()
  88
  89 # test the test functions from Parrot::Test
  90 # RT#46893: test the untested test functions
  91 my ( $desc, $err, $line );
  92
  93 # PASM
  94 $desc = 'pasm_output_is: success';
  95 test_out("ok 1 - $desc");
  96 pasm_output_is( <<'CODE', <<'OUTPUT', $desc );
  97     print "ok\n"
  98     end
  99 CODE
 100 ok
 101 OUTPUT
 102 test_test($desc);
 103
 104 $desc = 'pasm_output_is: failure';
 105 test_out("not ok 1 - $desc");
 106 test_fail(+9);
 107 $err = <<"ERR";
 108 #          got: 'ok
 109 # '
 110 #     expected: 'not ok
 111 # '
 112 ERR
 113 chomp $err;
 114 test_err($err);
 115 pasm_output_is( <<'CODE', <<"OUTPUT", $desc );
 116     print "ok\n"
 117     end
 118 CODE
 119 not ok
 120 OUTPUT
 121 test_test($desc);
 122
 123 $desc = 'pasm_output_isnt: success';
 124 test_out("ok 1 - $desc");
 125 pasm_output_isnt( <<'CODE', <<"OUTPUT", $desc );
 126     print "ok\n"
 127     end
 128 CODE
 129 not ok
 130 OUTPUT
 131 test_test($desc);
 132
 133 $desc = 'pasm_output_isnt: failure';
 134 test_out("not ok 1 - $desc");
 135 test_fail(+10);
 136 $err = <<"ERR";
 137 #     'ok
 138 # '
 139 #         ne
 140 #     'ok
 141 # '
 142 ERR
 143 chomp $err;
 144 test_err $err;
 145 pasm_output_isnt( <<'CODE', <<'OUTPUT', $desc );
 146     print "ok\n"
 147     end
 148 CODE
 149 ok
 150 OUTPUT
 151 test_test($desc);
 152
 153 $desc = 'pasm_output_like: success';
 154 test_out("ok 1 - $desc");
 155 pasm_output_like( <<'CODE', <<'OUTPUT', $desc );
 156     print "ok\n"
 157     end
 158 CODE
 159 /ok/
 160 OUTPUT
 161 test_test($desc);
 162
 163 $desc = 'pasm_output_like: failure';
 164 test_out("not ok 1 - $desc");
 165 test_fail(+9);
 166 $err = <<"ERR";
 167 #                   'ok
 168 # '
 169 #     doesn't match '/not ok/
 170 # '
 171 ERR
 172 chomp $err;
 173 test_err($err);
 174 pasm_output_like( <<'CODE', <<"OUTPUT", $desc );
 175     print "ok\n"
 176     end
 177 CODE
 178 /not ok/
 179 OUTPUT
 180 test_test($desc);
 181
 182 # PIR
 183 $desc = 'pir_output_is: success';
 184 test_out("ok 1 - $desc");
 185 pir_output_is( <<'CODE', <<'OUTPUT', $desc );
 186 .sub 'test' :main
 187     print "ok\n"
 188 .end
 189 CODE
 190 ok
 191 OUTPUT
 192 test_test($desc);
 193
 194 $desc = 'pir_output_is: failure';
 195 test_out("not ok 1 - $desc");
 196 test_fail(+9);
 197 $err = <<"ERR";
 198 #          got: 'ok
 199 # '
 200 #     expected: 'not ok
 201 # '
 202 ERR
 203 chomp $err;
 204 test_err($err);
 205 pir_output_is( <<'CODE', <<"OUTPUT", $desc );
 206 .sub 'test' :main
 207     print "ok\n"
 208 .end
 209 CODE
 210 not ok
 211 OUTPUT
 212 test_test($desc);
 213
 214 $desc = 'pir_output_isnt: success';
 215 test_out("ok 1 - $desc");
 216 pir_output_isnt( <<'CODE', <<"OUTPUT", $desc );
 217 .sub 'test' :main
 218     print "ok\n"
 219 .end
 220 CODE
 221 not ok
 222 OUTPUT
 223 test_test($desc);
 224
 225 $desc = 'pir_output_isnt: failure';
 226 test_out("not ok 1 - $desc");
 227 test_fail(+10);
 228 $err = <<"ERR";
 229 #     'ok
 230 # '
 231 #         ne
 232 #     'ok
 233 # '
 234 ERR
 235 chomp $err;
 236 test_err($err);
 237 pir_output_isnt( <<'CODE', <<'OUTPUT', $desc );
 238 .sub 'test' :main
 239     print "ok\n"
 240 .end
 241 CODE
 242 ok
 243 OUTPUT
 244 test_test($desc);
 245
 246 $desc = 'pir_output_like: success';
 247 test_out("ok 1 - $desc");
 248 pir_output_like( <<'CODE', <<'OUTPUT', $desc );
 249 .sub 'test' :main
 250     print "ok\n"
 251 .end
 252 CODE
 253 /ok/
 254 OUTPUT
 255 test_test($desc);
 256
 257 $desc = 'pir_output_like: failure';
 258 test_out("not ok 1 - $desc");
 259 test_fail(+9);
 260 $err = <<"ERR";
 261 #                   'ok
 262 # '
 263 #     doesn't match '/not ok/
 264 # '
 265 ERR
 266 chomp $err;
 267 test_err($err);
 268 pir_output_like( <<'CODE', <<"OUTPUT", $desc );
 269 .sub 'test' :main
 270     print "ok\n"
 271 .end
 272 CODE
 273 /not ok/
 274 OUTPUT
 275 test_test($desc);
 276
 277 $desc = 'pir_error_output_like: todo';
 278 $line = line_num(+21);
 279 my $location;
 280 if ($Test::Builder::VERSION <= eval '0.33') {
 281     $location = "in $0 at line $line";
 282 } else {
 283     $location = "at $0 line $line";
 284 }
 285 test_out("not ok 1 - $desc # TODO foo");
 286 $err = <<"ERR";
 287 #   Failed (TODO) test '$desc'
 288 #   $location.
 289 # Expected error but exited cleanly
 290 # Received:
 291 # ok
 292 #
 293 # Expected:
 294 # /not ok/
 295 #
 296 ERR
 297 chomp $err;
 298 test_err($err);
 299 pir_error_output_like( <<'CODE', <<"OUTPUT", $desc, todo => 'foo' );
 300 .sub 'test' :main
 301     print "ok\n"
 302 .end
 303 CODE
 304 /not ok/
 305 OUTPUT
 306 test_test($desc);
 307
 308 # Local Variables:
 309 #   mode: cperl
 310 #   cperl-indent-level: 4
 311 #   fill-column: 100
 312 # End:
 313 # vim: expandtab shiftwidth=4: