Ticket #1386: exporter.t.patch

File exporter.t.patch, 15.9 KB (added by kurahaupo, 5 years ago)

Convert t/pmc/exporter.t to PIR

  • t/pmc/exporter.t

     
    1 #!perl 
    2 # Copyright (C) 2007, Parrot Foundation. 
     1#!parrot 
     2# Copyright (C) 2009, Parrot Foundation. 
    33# $Id$ 
    44 
    5 use strict; 
    6 use warnings; 
    7 use lib qw( . lib ../lib ../../lib ); 
    8 use Test::More; 
    9 use Parrot::Test tests => 12; 
    10  
    115=head1 NAME 
    126 
    137t/pmc/exporter.t - test the Exporter PMC 
     
    2317=cut 
    2418 
    2519# L<PDD17/Exporter PMC> 
    26 pir_output_is( <<'CODE', <<'OUT', 'new' ); 
    27 .sub 'test' :main 
     20 
     21.sub 'main' :main 
     22    .include 'test_more.pir' 
     23    plan(28) 
     24 
     25# 
     26# Arguably the rest of this file is moot, since if we can import test_more.pir 
     27# and use it, exporter.pir has already been tested. However our point is to 
     28# ensure exhausive testing, and to document any failures in a sensible manner, 
     29# so we press on... 
     30# 
     31 
     32    test_new_exporter()         # 5 tests 
     33    test_source()               # 4 tests 
     34    test_destination()          # 5 tests 
     35 
     36    $P0 = get_global ['test_globals'], 'test' 
     37    $P0()                       # 6 tests 
     38 
     39    $P0 = get_global ['test_import_without_args'], 'test' 
     40    $P0()                       # 1 test 
     41 
     42    $P0 = get_global ['test_import_with_s_d_g'], 'test' 
     43    $P0()                       # 1 test 
     44 
     45    $P0 = get_global ['test_import_with_s_gs'], 'test' 
     46    $P0()                       # 1 test 
     47 
     48    $P0 = get_global ['test_import_with_gs'], 'test' 
     49    $P0()                       # 1 test 
     50 
     51    $P0 = get_global ['test_import_with_s_ga'], 'test' 
     52    $P0()                       # 1 test 
     53 
     54    $P0 = get_global ['test_import_with_s_gh'], 'test' 
     55    $P0()                       # 1 test 
     56 
     57    $P0 = get_global ['test_import_and_call'], 'test' 
     58    $P0()                       # 1 test 
     59 
     60    $P0 = get_global ['test_import_and_ind_call'], 'test' 
     61    $P0()                       # 1 test 
     62 
     63 
     64.end 
     65 
     66.sub 'test_new_exporter' 
    2867    $P0 = new ['Exporter'] 
    29     say "ok 1 - $P0 = new ['Exporter']" 
     68    $I0 = isnull $P0 
     69    is( $I0, 0, 'Constructed "Exporter" object' ) 
    3070 
    3171    $I0 = isa $P0, 'Exporter' 
    32     if $I0 goto ok_2 
    33     print 'not ' 
    34   ok_2: 
    35     say "ok 2 - isa $P0, 'Exporter'" 
     72    ok( $I0, '... isa "Exporter"' ) 
     73 
     74    $I0 = can $P0, 'source' 
     75    ok( $I0, '... can "source"' ) 
     76 
     77    $I0 = can $P0, 'destination' 
     78    ok( $I0, '... can "destination"' ) 
     79 
     80    $I0 = can $P0, 'import' 
     81    ok( $I0, '... can "import"' ) 
    3682.end 
    37 CODE 
    38 ok 1 - $P0 = new ['Exporter'] 
    39 ok 2 - isa $P0, 'Exporter' 
    40 OUT 
    4183 
    42 pir_output_is( <<'CODE', <<'OUT', 'source' ); 
    43 .sub 'test' :main 
     84.sub 'test_source' 
    4485    $P0 = new ['Exporter'] 
    4586    $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' 
     87    $I0 = isnull $P1 
     88    ok( $I0, 'source() returns PMCNULL upon Exporter init' ) 
    5089 
    5190    # get a NameSpace PMC for testing 
    52     # TT #1233 replace with make_namespace, when implemented 
    53     .local pmc ns 
    54     ns = get_namespace ['Eponymous'] 
     91    # RT #46859 replace with make_namespace, when implemented 
     92    $P98 = get_namespace ['Eponymous'] 
    5593 
    56     $P0.'source'(ns) 
     94    $P0.'source'($P98) 
    5795    $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' 
     96    is( $P1, 'Eponymous', '... with args sets source namespace' ) 
    6297 
    63     $P1 = clone ns 
    64  
     98    $P1 = clone $P98 
     99    $I0 = 1 
    65100    push_eh ok_3 
    66     $P0.'source'(ns, $P1) 
     101    $P0.'source'($P98, $P1) 
     102    $I0 = 0 
     103  ok_3: 
    67104    pop_eh 
     105    ok( $I0, '... with too many args throws exception' ) 
    68106 
    69     print 'not ' 
    70   ok_3: 
    71     say 'ok 3 - source() with too many args fails' 
    72  
     107    $I0 = 1 
    73108    push_eh ok_4 
    74109    $P0.'source'('foo') 
    75     pop_eh 
    76     print 'not ' 
     110    $I0 = 0 
    77111 
    78112  ok_4: 
    79     say 'ok 4 - source() with non-namespace arg throws exception' 
     113    pop_eh 
     114    ok( $I0, '... with non-namespace arg throws exception' ) 
    80115.end 
    81116 
    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 
     117.sub 'test_destination' 
    96118    $P0 = new ['Exporter'] 
    97119    $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' 
     120    $I0 = isnull $P1 
     121    is( $I0, 0, 'destination() with no args returns destination namespace' ) 
    102122 
    103123    $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' 
     124    is( $P1, $P99, '... which is current namespace at first' ) 
    108125 
    109126    # get a NameSpace PMC for testing 
    110     # TT #1233 replace with make_namespace, when implemented 
    111     .local pmc ns 
    112     ns = get_namespace ['Eponymous'] 
     127    # RT #46859 replace with make_namespace, when implemented 
     128    $P98 = get_namespace ['Eponymous'] 
    113129 
    114     $P0.'destination'(ns) 
     130    $P0.'destination'($P98) 
    115131    $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' 
     132    is( $P1, 'Eponymous', '... with args sets destination namespace' ) 
    120133 
    121     $P1 = clone ns 
    122  
     134    $P1 = clone $P98 
     135    $I0 = 1 
    123136    push_eh ok_4 
    124     $P0.'destination'(ns, $P1) 
     137    $P0.'destination'($P98, $P1) 
     138    $I0 = 0 
     139  ok_4: 
    125140    pop_eh 
     141    ok( $I0, '... with too many args throws exception' ) 
    126142 
    127     print 'not ' 
    128   ok_4: 
    129     say 'ok 4 - destination() with too many args fails' 
    130  
     143    $I0 = 1 
    131144    push_eh ok_5 
    132145    $P0.'destination'('foo') 
     146    $I0 = 0 
     147  ok_5: 
    133148    pop_eh 
    134     print 'not ' 
     149    ok( $I0, '... with non-namespace arg throws exception' ) 
    135150 
    136   ok_5: 
    137     say 'ok 5 - destination() with non-namespace arg throws exception' 
    138151.end 
    139152 
    140  
    141 # TT #1233 replace with make_namespace, when implemented 
     153# RT #46859 replace with make_namespace, when implemented 
    142154.namespace ['Eponymous'] 
    143155.sub 'Eponymous' :anon 
    144156.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 
    152157 
    153 pir_output_is( <<'CODE', <<'OUT', 'globals' ); 
    154 .sub 'test' :main 
     158 
     159.namespace ['test_globals'] 
     160.sub 'test' 
    155161    $P0 = new ['Exporter'] 
    156162 
    157163    $P1 = $P0.'globals'() 
    158164    $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' 
     165    ok( $I0, 'globals() returns PMCNULL upon Exporter init' ) 
    163166 
    164167    # create an array to store globals in 
    165168    $P99 = new ['ResizableStringArray'] 
     
    167170    $P0.'globals'($P99) 
    168171    $P1 = $P0.'globals'() 
    169172    $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' 
     173    ok( $I0, '... with empty array arg sets PMCNULL' ) 
    174174 
    175175    $P99 = push 'Alex' 
    176176    $P99 = push 'Prince' 
    177177 
     178    $I9 = 1 
    178179    $P0.'globals'($P99) 
    179180    $P1 = $P0.'globals'() 
    180181    $I0 = does $P1, 'hash' 
     182    eq $I0, 0, nok_3 
    181183    $I99 = $P99 
    182184    $I1 = $P1 
    183     unless $I0 == 1 goto nok_3 
    184     unless $I1 == $I99 goto nok_3 
    185     unless $I1 == 2 goto ok_3 
     185    ne $I1, $I99, nok_3 
     186    ne $I1, 2, ok_3     # <<< should this be nok_3 instead?!? 
    186187    $I0 = exists $P1['Prince'] 
    187     unless $I0 goto nok_3 
     188    eq $I0, 0, nok_3 
    188189    $I0 = exists $P1['Alex'] 
     190    eq $I0, 0, nok_3 
    189191    goto ok_3 
    190192  nok_3: 
    191     print 'not ' 
     193    $I9 = 0 
    192194  ok_3: 
    193     say 'ok 3 - globals() with array arg sets globals hash (hash with two keys)' 
     195    ok( $I9, '... with array arg sets globals hash (hash with two keys)' ) 
    194196 
    195197    # create a hash to store globals in 
    196198    $P99 = new ['Hash'] 
     
    198200    $P0.'globals'($P99) 
    199201    $P1 = $P0.'globals'() 
    200202    $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' 
     203    ok( $I0, '... with empty hash arg sets PMCNULL' ) 
    205204 
    206205    $P99['Prince'] = '' 
    207206    $P99['Alex'] = '' 
    208207 
     208    $I9 = 1 
    209209    $P0.'globals'($P99) 
    210210    $P1 = $P0.'globals'() 
    211211    $I99 = $P99 
    212212    $I1 = $P1 
    213     unless $I1 == $I99 goto nok_5 
    214     unless $I1 == 2 goto nok_5 
     213    ne $I1, $I99, nok_5 
     214    ne $I1, 2, nok_5 
    215215    $I0 = exists $P1['Prince'] 
    216     unless $I0 goto nok_5 
     216    eq $I0, 0, nok_5 
    217217    $I0 = exists $P1['Alex'] 
    218     unless $I0 goto nok_5 
     218    eq $I0, 0, nok_5 
    219219    goto ok_5 
    220220  nok_5: 
    221     print 'not ' 
     221    $I9 = 0 
    222222  ok_5: 
    223     say 'ok 5 - globals() with hash arg sets globals hash (hash with two keys)' 
     223    ok( $I9, '... with hash arg sets globals hash (hash with two keys)' ) 
    224224 
    225  
    226225    $P98 = clone $P99 
    227226 
     227    $I9 = 1 
    228228    push_eh ok_6 
    229229    $P0.'globals'($P99, $P98) 
     230    $I9 = 0 
     231  ok_6: 
    230232    pop_eh 
     233    ok( $I9, '... with too many args throws exception' ) 
    231234 
    232     print 'not ' 
    233   ok_6: 
    234     say 'ok 6 - globals() with too many args fails' 
    235  
    236235.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 
    245236 
    246 pir_error_output_like( <<'CODE', <<'OUT', 'import - no args' ); 
    247 .sub 'test' :main 
     237.namespace ['test_import_without_args'] 
     238.sub 'test' 
    248239    $P0 = new ['Exporter'] 
    249240 
     241    $I0 = 1 
     242    push_eh e1 
    250243    $P0.'import'() 
    251     say 'ok 1 - import() with no args throws an exception' 
    252  
     244    $I0 = 0 
     245e1: 
     246    pop_eh 
     247# /^source namespace not set\n/ 
     248    ok( $I0, 'import() with no args throws exception' ) 
    253249.end 
    254 CODE 
    255 /^source namespace not set\n/ 
    256 OUT 
    257250 
    258 pir_output_is( <<'CODE', <<'OUT', 'import - same source and destination namespaces' ); 
    259 .sub 'test' :main 
    260     .local pmc exporter, src 
     251.namespace ['test_import_with_s_d_g'] 
     252.sub 'test' 
     253    $P99 = get_namespace 
    261254 
    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) 
     255    $P97 = new ['Exporter'] 
     256    $I0 = 0 
     257    push_eh e1 
     258    $P97.'import'( $P99 :named('source'), $P99 :named('destination'), 'plan ok' :named('globals') ) 
     259    $I0 = 1 
     260e1: 
     261    pop_eh 
     262    ok( $I0, '... idempotently does nothing (and succeeds)' ) 
    268263.end 
    269264 
    270265.sub 'plan' 
    271     .param int one 
    272     say '1..1' 
     266    die 'Extra planning was not expected' 
    273267.end 
    274268 
    275269.sub 'ok' 
    276     .param int one 
    277     say 'ok 1' 
     270    .param pmc args :slurpy 
     271    $P0 = get_root_global [ 'parrot'; 'Test'; 'More' ], 'ok' 
     272    $P0( args :flat ) 
    278273.end 
    279 CODE 
    280 1..1 
    281 ok 1 
    282 OUT 
    283274 
    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) 
     275.namespace ['test_import_with_s_gs'] 
     276.sub 'test' 
     277    $P99 = get_root_namespace [ 'parrot'; 'Test'; 'More' ] 
     278    $P97 = new ['Exporter'] 
     279    $P97.'import'( $P99 :named('source'), 'plan ok' :named('globals') ) 
     280    ok( 1, '... with globals-as-string succeeds' ) 
    295281.end 
    296 CODE 
    297 1..1 
    298 ok 1 
    299 OUT 
    300282 
    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 
     283.namespace ['test_import_with_gs'] 
     284.sub 'test' 
     285    $P99 = get_root_namespace [ 'parrot'; 'Test'; 'More' ] 
    305286 
    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) 
     287    $P97 = new ['Exporter'] 
     288    $P97.'source'( $P99 ) 
     289    $P97.'import'( 'plan ok' :named('globals') ) 
     290    ok( 1, '... having called "source" separately succeeds' ) 
    313291.end 
    314 CODE 
    315 1..1 
    316 ok 1 
    317 OUT 
    318292 
    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 
     293.namespace ['test_import_with_s_ga'] 
     294.sub 'test' 
     295    $P99 = get_root_namespace [ 'parrot'; 'Test'; 'More' ] 
     296    $P96 = new ['ResizableStringArray'] 
     297    $P96 = push 'ok' 
     298    $P96 = push 'plan' 
    323299 
    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) 
     300    $P97 = new ['Exporter'] 
     301    $P97.'import'( $P99 :named('source'), $P96 :named('globals') ) 
     302    ok( 1, '... with globals-as-array succeeds' ) 
    333303.end 
    334 CODE 
    335 1..1 
    336 ok 1 
    337 OUT 
    338304 
    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 
     305.namespace ['test_import_with_s_gh'] 
     306.sub 'test' 
     307    $P95 = new ['Null'] 
     308    $P99 = get_root_namespace [ 'parrot'; 'Test'; 'More' ] 
     309    $P96 = new ['Hash'] 
     310    $P96['ok'] = $P95 
     311    $P96['plan'] = '' 
    343312 
    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) 
     313    $P97 = new ['Exporter'] 
     314    $P97.'import'( $P99 :named('source'), $P96 :named('globals') ) 
     315    ok( 1, '... with globals-as-hash succeeds' ) 
    354316.end 
    355 CODE 
    356 1..1 
    357 ok 1 
    358 OUT 
    359317 
    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 
     318.namespace ['test_import_and_call'] 
     319.sub 'test' 
     320    $P99 = get_root_namespace [ 'parrot'; 'Test'; 'More' ] 
     321    $P96 = new ['Hash'] 
     322    $P96['plan'] = 'consilium' 
     323    $P96['ok'] = 'rectus' 
    364324 
    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) 
     325    $P97 = new ['Exporter'] 
     326    $P97.'import'( $P99 :named('source'), $P96 :named('globals') ) 
     327    #consilium(1) 
     328    rectus( 1, '... into current namespace with another (global) name succeeds' ) 
    374329.end 
    375 CODE 
    376 1..1 
    377 ok 1 
    378 OUT 
    379330 
    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 
     331.namespace ['test_import_and_ind_call'] 
     332.sub 'test' 
     333    $P99 = get_root_namespace [ 'parrot'; 'Test'; 'More' ] 
     334    $P98 = get_root_namespace [ 'parrot'; 'foo' ] 
     335    $P96 = new ['ResizableStringArray'] 
     336    $P96 = push 'ok' 
     337    $P96 = push 'plan' 
    384338 
    385     src     = get_namespace [ 'Test'; 'More' ] 
    386     dest    = get_namespace ['foo'] 
    387     globals = new ['ResizableStringArray'] 
    388     globals = push 'ok' 
    389     globals = push 'plan' 
     339    $P97 = new ['Exporter'] 
     340    $P97.'import'( $P99 :named('source'), $P98 :named('destination'), $P96 :named('globals') ) 
    390341 
    391     exporter = new ['Exporter'] 
    392     exporter.'import'( src :named('source'), dest :named('destination'), globals :named('globals') ) 
    393  
    394     $P0 = get_global ['foo'], 'bar' 
     342    $P0 = get_root_global [ 'parrot'; 'foo' ], 'bar' 
    395343    $P0() 
    396344.end 
    397345 
    398346.namespace ['foo'] 
    399347.sub 'bar' 
    400     plan(1) 
    401     ok(1) 
     348    ok( 1, '... into another namespace succeeds' ) 
    402349.end 
    403 CODE 
    404 1..1 
    405 ok 1 
    406 OUT 
    407350 
    408 # TODO: Test exporting mmd subs: TT #1205 
    409 # https://trac.parrot.org/parrot/ticket/1205 
     351# RT #46861 test exporting mmd subs 
    410352 
    411353# Local Variables: 
    412 #   mode: cperl 
     354#   mode: pir 
    413355#   cperl-indent-level: 4 
    414356#   fill-column: 100 
    415357# End: 
    416 # vim: expandtab shiftwidth=4: 
     358# vim: expandtab shiftwidth=4 ft=pir: