t/pmc/exporter.t

   1 #!perl
   2 # Copyright (C) 2007-2010, Parrot Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8 use Test::More;
   9 use Parrot::Test tests => 12;
  10
  11 =head1 NAME
  12
  13 t/pmc/exporter.t - test the Exporter PMC
  14
  15 =head1 SYNOPSIS
  16
  17     % prove t/pmc/exporter.t
  18
  19 =head1 DESCRIPTION
  20
  21 Tests the Exporter PMC.
  22
  23 =cut
  24
  25 # L<PDD17/Exporter PMC>
  26 pir_output_is( <<'CODE', <<'OUT', 'new' );
  27 .sub 'test' :main
  28     $P0 = new ['Exporter']
  29     say "ok 1 - $P0 = new ['Exporter']"
  30
  31     # Most uses of export are short-lived, so use a explicit sweep
  32     # here to ensure coverage of the mark vtable.
  33     sweep 1
  34
  35     $I0 = isa $P0, 'Exporter'
  36     if $I0 goto ok_2
  37     print 'not '
  38   ok_2:
  39     say "ok 2 - isa $P0, 'Exporter'"
  40 .end
  41 CODE
  42 ok 1 - $P0 = new ['Exporter']
  43 ok 2 - isa $P0, 'Exporter'
  44 OUT
  45
  46 pir_output_is( <<'CODE', <<'OUT', 'source' );
  47 .sub 'test' :main
  48     $P0 = new ['Exporter']
  49     $P1 = $P0.'source'()
  50     if null $P1 goto ok_1
  51     print 'not '
  52   ok_1:
  53     say 'ok 1 - source() returns PMCNULL upon Exporter init'
  54
  55     # get a NameSpace PMC for testing
  56     # TT #1233 replace with make_namespace, when implemented
  57     .local pmc ns
  58     ns = get_namespace ['Eponymous']
  59
  60     $P0.'source'(ns)
  61     $P1 = $P0.'source'()
  62     if $P1 == 'Eponymous' goto ok_2
  63     print 'not '
  64   ok_2:
  65     say 'ok 2 - source() with args sets source namespace'
  66
  67     $P1 = clone ns
  68
  69     push_eh ok_3
  70     $P0.'source'(ns, $P1)
  71     pop_eh
  72
  73     print 'not '
  74   ok_3:
  75     say 'ok 3 - source() with too many args fails'
  76
  77     push_eh ok_4
  78     $P0.'source'('foo')
  79     pop_eh
  80     print 'not '
  81
  82   ok_4:
  83     say 'ok 4 - source() with non-namespace arg throws exception'
  84 .end
  85
  86
  87 # TT #1233 replace with make_namespace, when implemented
  88 .namespace ['Eponymous']
  89 .sub 'Eponymous' :anon
  90 .end
  91 CODE
  92 ok 1 - source() returns PMCNULL upon Exporter init
  93 ok 2 - source() with args sets source namespace
  94 ok 3 - source() with too many args fails
  95 ok 4 - source() with non-namespace arg throws exception
  96 OUT
  97
  98 pir_output_is( <<'CODE', <<'OUT', 'destination' );
  99 .sub 'test' :main
 100     $P0 = new ['Exporter']
 101     $P1 = $P0.'destination'()
 102     unless null $P1 goto ok_1
 103     print 'not '
 104   ok_1:
 105     say 'ok 1 - destination() with no args returns destination namespace'
 106
 107     $P99 = get_namespace
 108     if $P1 == $P99 goto ok_2
 109     print 'not '
 110   ok_2:
 111     say 'ok 2 - ...which is current namespace at first'
 112
 113     # get a NameSpace PMC for testing
 114     # TT #1233 replace with make_namespace, when implemented
 115     .local pmc ns
 116     ns = get_namespace ['Eponymous']
 117
 118     $P0.'destination'(ns)
 119     $P1 = $P0.'destination'()
 120     if $P1 == 'Eponymous' goto ok_3
 121     print 'not '
 122   ok_3:
 123     say 'ok 3 - destination() with args sets destination namespace'
 124
 125     $P1 = clone ns
 126
 127     push_eh ok_4
 128     $P0.'destination'(ns, $P1)
 129     pop_eh
 130
 131     print 'not '
 132   ok_4:
 133     say 'ok 4 - destination() with too many args fails'
 134
 135     push_eh ok_5
 136     $P0.'destination'('foo')
 137     pop_eh
 138     print 'not '
 139
 140   ok_5:
 141     say 'ok 5 - destination() with non-namespace arg throws exception'
 142 .end
 143
 144
 145 # TT #1233 replace with make_namespace, when implemented
 146 .namespace ['Eponymous']
 147 .sub 'Eponymous' :anon
 148 .end
 149 CODE
 150 ok 1 - destination() with no args returns destination namespace
 151 ok 2 - ...which is current namespace at first
 152 ok 3 - destination() with args sets destination namespace
 153 ok 4 - destination() with too many args fails
 154 ok 5 - destination() with non-namespace arg throws exception
 155 OUT
 156
 157 pir_output_is( <<'CODE', <<'OUT', 'globals' );
 158 .sub 'test' :main
 159     $P0 = new ['Exporter']
 160
 161     $P1 = $P0.'globals'()
 162     $I0 = isnull $P1
 163     if $I0 goto ok_1
 164     print 'not '
 165   ok_1:
 166     say 'ok 1 - globals() returns PMCNULL upon Exporter init'
 167
 168     # create an array to store globals in
 169     $P99 = new ['ResizableStringArray']
 170
 171     $P0.'globals'($P99)
 172     $P1 = $P0.'globals'()
 173     $I0 = isnull $P1
 174     if $I0 goto ok_2
 175     print 'not '
 176   ok_2:
 177     say 'ok 2 - globals() with empty array arg sets PMCNULL'
 178
 179     push $P99, 'Alex'
 180     push $P99, 'Prince'
 181
 182     $P0.'globals'($P99)
 183     $P1 = $P0.'globals'()
 184     $I0 = does $P1, 'hash'
 185     $I99 = $P99
 186     $I1 = $P1
 187     unless $I0 == 1 goto nok_3
 188     unless $I1 == $I99 goto nok_3
 189     unless $I1 == 2 goto ok_3
 190     $I0 = exists $P1['Prince']
 191     unless $I0 goto nok_3
 192     $I0 = exists $P1['Alex']
 193     goto ok_3
 194   nok_3:
 195     print 'not '
 196   ok_3:
 197     say 'ok 3 - globals() with array arg sets globals hash (hash with two keys)'
 198
 199     # create a hash to store globals in
 200     $P99 = new ['Hash']
 201
 202     $P0.'globals'($P99)
 203     $P1 = $P0.'globals'()
 204     $I0 = isnull $P1
 205     if $I0 goto ok_4
 206     print 'not '
 207   ok_4:
 208     say 'ok 4 - globals() with empty hash arg sets PMCNULL'
 209
 210     $P99['Prince'] = ''
 211     $P99['Alex'] = ''
 212
 213     $P0.'globals'($P99)
 214     $P1 = $P0.'globals'()
 215     $I99 = $P99
 216     $I1 = $P1
 217     unless $I1 == $I99 goto nok_5
 218     unless $I1 == 2 goto nok_5
 219     $I0 = exists $P1['Prince']
 220     unless $I0 goto nok_5
 221     $I0 = exists $P1['Alex']
 222     unless $I0 goto nok_5
 223     goto ok_5
 224   nok_5:
 225     print 'not '
 226   ok_5:
 227     say 'ok 5 - globals() with hash arg sets globals hash (hash with two keys)'
 228
 229
 230     $P98 = clone $P99
 231
 232     push_eh ok_6
 233     $P0.'globals'($P99, $P98)
 234     pop_eh
 235
 236     print 'not '
 237   ok_6:
 238     say 'ok 6 - globals() with too many args fails'
 239
 240 .end
 241 CODE
 242 ok 1 - globals() returns PMCNULL upon Exporter init
 243 ok 2 - globals() with empty array arg sets PMCNULL
 244 ok 3 - globals() with array arg sets globals hash (hash with two keys)
 245 ok 4 - globals() with empty hash arg sets PMCNULL
 246 ok 5 - globals() with hash arg sets globals hash (hash with two keys)
 247 ok 6 - globals() with too many args fails
 248 OUT
 249
 250 pir_error_output_like( <<'CODE', <<'OUT', 'import - no args' );
 251 .sub 'test' :main
 252     $P0 = new ['Exporter']
 253
 254     $P0.'import'()
 255     say 'ok 1 - import() with no args throws an exception'
 256
 257 .end
 258 CODE
 259 /^source namespace not set\n/
 260 OUT
 261
 262 pir_output_is( <<'CODE', <<'OUT', 'import - same source and destination namespaces' );
 263 .sub 'test' :main
 264     .local pmc exporter, src
 265
 266     src      = get_namespace
 267
 268     exporter = new ['Exporter']
 269     exporter.'import'( src :named('source'), src :named('destination'), 'plan ok' :named('globals') )
 270     plan(1)
 271     ok(1)
 272 .end
 273
 274 .sub 'plan'
 275     .param int one
 276     say '1..1'
 277 .end
 278
 279 .sub 'ok'
 280     .param int one
 281     say 'ok 1'
 282 .end
 283 CODE
 284 1..1
 285 ok 1
 286 OUT
 287
 288 pir_output_is( <<'CODE', <<'OUT', 'import - globals as string' );
 289 .sub 'test' :main
 290     load_bytecode 'Test/More.pbc'
 291     .local pmc exporter, src
 292
 293     src      = get_namespace [ 'Test'; 'More' ]
 294
 295     exporter = new ['Exporter']
 296     exporter.'import'( src :named('source'), 'plan ok' :named('globals') )
 297     plan(1)
 298     ok(1)
 299 .end
 300 CODE
 301 1..1
 302 ok 1
 303 OUT
 304
 305 pir_output_is( <<'CODE', <<'OUT', 'import - globals with source passed separately' );
 306 .sub 'test' :main
 307     load_bytecode 'Test/More.pbc'
 308     .local pmc exporter, src
 309
 310     src      = get_namespace [ 'Test'; 'More' ]
 311
 312     exporter = new ['Exporter']
 313     exporter.'source'( src )
 314     exporter.'import'( 'plan ok' :named('globals') )
 315     plan(1)
 316     ok(1)
 317 .end
 318 CODE
 319 1..1
 320 ok 1
 321 OUT
 322
 323 pir_output_is( <<'CODE', <<'OUT', 'import - globals as array' );
 324 .sub 'test' :main
 325     load_bytecode 'Test/More.pbc'
 326     .local pmc exporter, src, globals
 327
 328     src     = get_namespace [ 'Test'; 'More' ]
 329     globals = new ['ResizableStringArray']
 330     push globals, 'ok'
 331     push globals, 'plan'
 332
 333     exporter = new ['Exporter']
 334     exporter.'import'( src :named('source'), globals :named('globals') )
 335     plan(1)
 336     ok(1)
 337 .end
 338 CODE
 339 1..1
 340 ok 1
 341 OUT
 342
 343 pir_output_is( <<'CODE', <<'OUT', 'import - globals as hash - null + empty string' );
 344 .sub 'test' :main
 345     load_bytecode 'Test/More.pbc'
 346     .local pmc exporter, src, globals, nul
 347
 348     nul     = new ['Null']
 349     src     = get_namespace [ 'Test'; 'More' ]
 350     globals = new ['Hash']
 351     globals['ok'] = nul
 352     globals['plan'] = ''
 353
 354     exporter = new ['Exporter']
 355     exporter.'import'( src :named('source'), globals :named('globals') )
 356     plan(1)
 357     ok(1)
 358 .end
 359 CODE
 360 1..1
 361 ok 1
 362 OUT
 363
 364 pir_output_is( <<'CODE', <<'OUT', 'import - globals as hash - with dest names (latin)' );
 365 .sub 'test' :main
 366     load_bytecode 'Test/More.pbc'
 367     .local pmc exporter, src, globals
 368
 369     src     = get_namespace [ 'Test'; 'More' ]
 370     globals = new ['Hash']
 371     globals['plan'] = 'consilium'
 372     globals['ok'] = 'rectus'
 373
 374     exporter = new ['Exporter']
 375     exporter.'import'( src :named('source'), globals :named('globals') )
 376     consilium(1)
 377     rectus(1)
 378 .end
 379 CODE
 380 1..1
 381 ok 1
 382 OUT
 383
 384 pir_output_is( <<'CODE', <<'OUT', 'import - globals with destination' );
 385 .sub 'test' :main
 386     load_bytecode 'Test/More.pbc'
 387     .local pmc exporter, src, dest, globals
 388
 389     src     = get_namespace [ 'Test'; 'More' ]
 390     dest    = get_namespace ['foo']
 391     globals = new ['ResizableStringArray']
 392     push globals, 'ok'
 393     push globals, 'plan'
 394
 395     exporter = new ['Exporter']
 396     exporter.'import'( src :named('source'), dest :named('destination'), globals :named('globals') )
 397
 398     $P0 = get_global ['foo'], 'bar'
 399     $P0()
 400 .end
 401
 402 .namespace ['foo']
 403 .sub 'bar'
 404     plan(1)
 405     ok(1)
 406 .end
 407 CODE
 408 1..1
 409 ok 1
 410 OUT
 411
 412 # Test exporting mmd subs: TT #1205
 413 # https://trac.parrot.org/parrot/ticket/1205
 414
 415 # Local Variables:
 416 #   mode: cperl
 417 #   cperl-indent-level: 4
 418 #   fill-column: 100
 419 # End:
 420 # vim: expandtab shiftwidth=4: