t/pmc/exporter.t

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