Ticket #1386: exporter.t.patch

t/pmc/exporter.t

@@ -1 @@
-#!perl
-# Copyright (C) 2007, Parrot Foundation.
+#!parrot
+# Copyright (C) 2009, Parrot Foundation.
 # $Id$
 
-use strict;
-use warnings;
-use lib qw( . lib ../lib ../../lib );
-use Test::More;
-use Parrot::Test tests => 12;
-
 =head1 NAME
 
 t/pmc/exporter.t - test the Exporter PMC
@@ -23 +17 @@
 =cut
 
 # L<PDD17/Exporter PMC>
-pir_output_is( <<'CODE', <<'OUT', 'new' );
-.sub 'test' :main
+
+.sub 'main' :main
+    .include 'test_more.pir'
+    plan(28)
+
+#
+# Arguably the rest of this file is moot, since if we can import test_more.pir
+# and use it, exporter.pir has already been tested. However our point is to
+# ensure exhausive testing, and to document any failures in a sensible manner,
+# so we press on...
+#
+
+    test_new_exporter()         # 5 tests
+    test_source()               # 4 tests
+    test_destination()          # 5 tests
+
+    $P0 = get_global ['test_globals'], 'test'
+    $P0()                       # 6 tests
+
+    $P0 = get_global ['test_import_without_args'], 'test'
+    $P0()                       # 1 test
+
+    $P0 = get_global ['test_import_with_s_d_g'], 'test'
+    $P0()                       # 1 test
+
+    $P0 = get_global ['test_import_with_s_gs'], 'test'
+    $P0()                       # 1 test
+
+    $P0 = get_global ['test_import_with_gs'], 'test'
+    $P0()                       # 1 test
+
+    $P0 = get_global ['test_import_with_s_ga'], 'test'
+    $P0()                       # 1 test
+
+    $P0 = get_global ['test_import_with_s_gh'], 'test'
+    $P0()                       # 1 test
+
+    $P0 = get_global ['test_import_and_call'], 'test'
+    $P0()                       # 1 test
+
+    $P0 = get_global ['test_import_and_ind_call'], 'test'
+    $P0()                       # 1 test
+
+
+.end
+
+.sub 'test_new_exporter'
     $P0 = new ['Exporter']
-    say "ok 1 - $P0 = new ['Exporter']"
+    $I0 = isnull $P0
+    is( $I0, 0, 'Constructed "Exporter" object' )
 
     $I0 = isa $P0, 'Exporter'
-    if $I0 goto ok_2
-    print 'not '
-  ok_2:
-    say "ok 2 - isa $P0, 'Exporter'"
+    ok( $I0, '... isa "Exporter"' )
+
+    $I0 = can $P0, 'source'
+    ok( $I0, '... can "source"' )
+
+    $I0 = can $P0, 'destination'
+    ok( $I0, '... can "destination"' )
+
+    $I0 = can $P0, 'import'
+    ok( $I0, '... can "import"' )
 .end
-CODE
-ok 1 - $P0 = new ['Exporter']
-ok 2 - isa $P0, 'Exporter'
-OUT
 
-pir_output_is( <<'CODE', <<'OUT', 'source' );
-.sub 'test' :main
+.sub 'test_source'
     $P0 = new ['Exporter']
     $P1 = $P0.'source'()
-    if null $P1 goto ok_1
-    print 'not '
-  ok_1:
-    say 'ok 1 - source() returns PMCNULL upon Exporter init'
+    $I0 = isnull $P1
+    ok( $I0, 'source() returns PMCNULL upon Exporter init' )
 
     # get a NameSpace PMC for testing
-    # TT #1233 replace with make_namespace, when implemented
-    .local pmc ns
-    ns = get_namespace ['Eponymous']
+    # RT #46859 replace with make_namespace, when implemented
+    $P98 = get_namespace ['Eponymous']
 
-    $P0.'source'(ns)
+    $P0.'source'($P98)
     $P1 = $P0.'source'()
-    if $P1 == 'Eponymous' goto ok_2
-    print 'not '
-  ok_2:
-    say 'ok 2 - source() with args sets source namespace'
+    is( $P1, 'Eponymous', '... with args sets source namespace' )
 
-    $P1 = clone ns
-
+    $P1 = clone $P98
+    $I0 = 1
     push_eh ok_3
-    $P0.'source'(ns, $P1)
+    $P0.'source'($P98, $P1)
+    $I0 = 0
+  ok_3:
     pop_eh
+    ok( $I0, '... with too many args throws exception' )
 
-    print 'not '
-  ok_3:
-    say 'ok 3 - source() with too many args fails'
-
+    $I0 = 1
     push_eh ok_4
     $P0.'source'('foo')
-    pop_eh
-    print 'not '
+    $I0 = 0
 
   ok_4:
-    say 'ok 4 - source() with non-namespace arg throws exception'
+    pop_eh
+    ok( $I0, '... with non-namespace arg throws exception' )
 .end
 
-
-# TT #1233 replace with make_namespace, when implemented
-.namespace ['Eponymous']
-.sub 'Eponymous' :anon
-.end
-CODE
-ok 1 - source() returns PMCNULL upon Exporter init
-ok 2 - source() with args sets source namespace
-ok 3 - source() with too many args fails
-ok 4 - source() with non-namespace arg throws exception
-OUT
-
-pir_output_is( <<'CODE', <<'OUT', 'destination' );
-.sub 'test' :main
+.sub 'test_destination'
     $P0 = new ['Exporter']
     $P1 = $P0.'destination'()
-    unless null $P1 goto ok_1
-    print 'not '
-  ok_1:
-    say 'ok 1 - destination() with no args returns destination namespace'
+    $I0 = isnull $P1
+    is( $I0, 0, 'destination() with no args returns destination namespace' )
 
     $P99 = get_namespace
-    if $P1 == $P99 goto ok_2
-    print 'not '
-  ok_2:
-    say 'ok 2 - ...which is current namespace at first'
+    is( $P1, $P99, '... which is current namespace at first' )
 
     # get a NameSpace PMC for testing
-    # TT #1233 replace with make_namespace, when implemented
-    .local pmc ns
-    ns = get_namespace ['Eponymous']
+    # RT #46859 replace with make_namespace, when implemented
+    $P98 = get_namespace ['Eponymous']
 
-    $P0.'destination'(ns)
+    $P0.'destination'($P98)
     $P1 = $P0.'destination'()
-    if $P1 == 'Eponymous' goto ok_3
-    print 'not '
-  ok_3:
-    say 'ok 3 - destination() with args sets destination namespace'
+    is( $P1, 'Eponymous', '... with args sets destination namespace' )
 
-    $P1 = clone ns
-
+    $P1 = clone $P98
+    $I0 = 1
     push_eh ok_4
-    $P0.'destination'(ns, $P1)
+    $P0.'destination'($P98, $P1)
+    $I0 = 0
+  ok_4:
     pop_eh
+    ok( $I0, '... with too many args throws exception' )
 
-    print 'not '
-  ok_4:
-    say 'ok 4 - destination() with too many args fails'
-
+    $I0 = 1
     push_eh ok_5
     $P0.'destination'('foo')
+    $I0 = 0
+  ok_5:
     pop_eh
-    print 'not '
+    ok( $I0, '... with non-namespace arg throws exception' )
 
-  ok_5:
-    say 'ok 5 - destination() with non-namespace arg throws exception'
 .end
 
-
-# TT #1233 replace with make_namespace, when implemented
+# RT #46859 replace with make_namespace, when implemented
 .namespace ['Eponymous']
 .sub 'Eponymous' :anon
 .end
-CODE
-ok 1 - destination() with no args returns destination namespace
-ok 2 - ...which is current namespace at first
-ok 3 - destination() with args sets destination namespace
-ok 4 - destination() with too many args fails
-ok 5 - destination() with non-namespace arg throws exception
-OUT
 
-pir_output_is( <<'CODE', <<'OUT', 'globals' );
-.sub 'test' :main
+
+.namespace ['test_globals']
+.sub 'test'
     $P0 = new ['Exporter']
 
     $P1 = $P0.'globals'()
     $I0 = isnull $P1
-    if $I0 goto ok_1
-    print 'not '
-  ok_1:
-    say 'ok 1 - globals() returns PMCNULL upon Exporter init'
+    ok( $I0, 'globals() returns PMCNULL upon Exporter init' )
 
     # create an array to store globals in
     $P99 = new ['ResizableStringArray']
@@ -167 +170 @@
     $P0.'globals'($P99)
     $P1 = $P0.'globals'()
     $I0 = isnull $P1
-    if $I0 goto ok_2
-    print 'not '
-  ok_2:
-    say 'ok 2 - globals() with empty array arg sets PMCNULL'
+    ok( $I0, '... with empty array arg sets PMCNULL' )
 
     $P99 = push 'Alex'
     $P99 = push 'Prince'
 
+    $I9 = 1
     $P0.'globals'($P99)
     $P1 = $P0.'globals'()
     $I0 = does $P1, 'hash'
+    eq $I0, 0, nok_3
     $I99 = $P99
     $I1 = $P1
-    unless $I0 == 1 goto nok_3
-    unless $I1 == $I99 goto nok_3
-    unless $I1 == 2 goto ok_3
+    ne $I1, $I99, nok_3
+    ne $I1, 2, ok_3     # <<< should this be nok_3 instead?!?
     $I0 = exists $P1['Prince']
-    unless $I0 goto nok_3
+    eq $I0, 0, nok_3
     $I0 = exists $P1['Alex']
+    eq $I0, 0, nok_3
     goto ok_3
   nok_3:
-    print 'not '
+    $I9 = 0
   ok_3:
-    say 'ok 3 - globals() with array arg sets globals hash (hash with two keys)'
+    ok( $I9, '... with array arg sets globals hash (hash with two keys)' )
 
     # create a hash to store globals in
     $P99 = new ['Hash']
@@ -198 +200 @@
     $P0.'globals'($P99)
     $P1 = $P0.'globals'()
     $I0 = isnull $P1
-    if $I0 goto ok_4
-    print 'not '
-  ok_4:
-    say 'ok 4 - globals() with empty hash arg sets PMCNULL'
+    ok( $I0, '... with empty hash arg sets PMCNULL' )
 
     $P99['Prince'] = ''
     $P99['Alex'] = ''
 
+    $I9 = 1
     $P0.'globals'($P99)
     $P1 = $P0.'globals'()
     $I99 = $P99
     $I1 = $P1
-    unless $I1 == $I99 goto nok_5
-    unless $I1 == 2 goto nok_5
+    ne $I1, $I99, nok_5
+    ne $I1, 2, nok_5
     $I0 = exists $P1['Prince']
-    unless $I0 goto nok_5
+    eq $I0, 0, nok_5
     $I0 = exists $P1['Alex']
-    unless $I0 goto nok_5
+    eq $I0, 0, nok_5
     goto ok_5
   nok_5:
-    print 'not '
+    $I9 = 0
   ok_5:
-    say 'ok 5 - globals() with hash arg sets globals hash (hash with two keys)'
+    ok( $I9, '... with hash arg sets globals hash (hash with two keys)' )
 
-
     $P98 = clone $P99
 
+    $I9 = 1
     push_eh ok_6
     $P0.'globals'($P99, $P98)
+    $I9 = 0
+  ok_6:
     pop_eh
+    ok( $I9, '... with too many args throws exception' )
 
-    print 'not '
-  ok_6:
-    say 'ok 6 - globals() with too many args fails'
-
 .end
-CODE
-ok 1 - globals() returns PMCNULL upon Exporter init
-ok 2 - globals() with empty array arg sets PMCNULL
-ok 3 - globals() with array arg sets globals hash (hash with two keys)
-ok 4 - globals() with empty hash arg sets PMCNULL
-ok 5 - globals() with hash arg sets globals hash (hash with two keys)
-ok 6 - globals() with too many args fails
-OUT
 
-pir_error_output_like( <<'CODE', <<'OUT', 'import - no args' );
-.sub 'test' :main
+.namespace ['test_import_without_args']
+.sub 'test'
     $P0 = new ['Exporter']
 
+    $I0 = 1
+    push_eh e1
     $P0.'import'()
-    say 'ok 1 - import() with no args throws an exception'
-
+    $I0 = 0
+e1:
+    pop_eh
+# /^source namespace not set\n/
+    ok( $I0, 'import() with no args throws exception' )
 .end
-CODE
-/^source namespace not set\n/
-OUT
 
-pir_output_is( <<'CODE', <<'OUT', 'import - same source and destination namespaces' );
-.sub 'test' :main
-    .local pmc exporter, src
+.namespace ['test_import_with_s_d_g']
+.sub 'test'
+    $P99 = get_namespace
 
-    src      = get_namespace
-
-    exporter = new ['Exporter']
-    exporter.'import'( src :named('source'), src :named('destination'), 'plan ok' :named('globals') )
-    plan(1)
-    ok(1)
+    $P97 = new ['Exporter']
+    $I0 = 0
+    push_eh e1
+    $P97.'import'( $P99 :named('source'), $P99 :named('destination'), 'plan ok' :named('globals') )
+    $I0 = 1
+e1:
+    pop_eh
+    ok( $I0, '... idempotently does nothing (and succeeds)' )
 .end
 
 .sub 'plan'
-    .param int one
-    say '1..1'
+    die 'Extra planning was not expected'
 .end
 
 .sub 'ok'
-    .param int one
-    say 'ok 1'
+    .param pmc args :slurpy
+    $P0 = get_root_global [ 'parrot'; 'Test'; 'More' ], 'ok'
+    $P0( args :flat )
 .end
-CODE
-1..1
-ok 1
-OUT
 
-pir_output_is( <<'CODE', <<'OUT', 'import - globals as string' );
-.sub 'test' :main
-    load_bytecode 'Test/More.pbc'
-    .local pmc exporter, src
-
-    src      = get_namespace [ 'Test'; 'More' ]
-
-    exporter = new ['Exporter']
-    exporter.'import'( src :named('source'), 'plan ok' :named('globals') )
-    plan(1)
-    ok(1)
+.namespace ['test_import_with_s_gs']
+.sub 'test'
+    $P99 = get_root_namespace [ 'parrot'; 'Test'; 'More' ]
+    $P97 = new ['Exporter']
+    $P97.'import'( $P99 :named('source'), 'plan ok' :named('globals') )
+    ok( 1, '... with globals-as-string succeeds' )
 .end
-CODE
-1..1
-ok 1
-OUT
 
-pir_output_is( <<'CODE', <<'OUT', 'import - globals with source passed separately' );
-.sub 'test' :main
-    load_bytecode 'Test/More.pbc'
-    .local pmc exporter, src
+.namespace ['test_import_with_gs']
+.sub 'test'
+    $P99 = get_root_namespace [ 'parrot'; 'Test'; 'More' ]
 
-    src      = get_namespace [ 'Test'; 'More' ]
-
-    exporter = new ['Exporter']
-    exporter.'source'( src )
-    exporter.'import'( 'plan ok' :named('globals') )
-    plan(1)
-    ok(1)
+    $P97 = new ['Exporter']
+    $P97.'source'( $P99 )
+    $P97.'import'( 'plan ok' :named('globals') )
+    ok( 1, '... having called "source" separately succeeds' )
 .end
-CODE
-1..1
-ok 1
-OUT
 
-pir_output_is( <<'CODE', <<'OUT', 'import - globals as array' );
-.sub 'test' :main
-    load_bytecode 'Test/More.pbc'
-    .local pmc exporter, src, globals
+.namespace ['test_import_with_s_ga']
+.sub 'test'
+    $P99 = get_root_namespace [ 'parrot'; 'Test'; 'More' ]
+    $P96 = new ['ResizableStringArray']
+    $P96 = push 'ok'
+    $P96 = push 'plan'
 
-    src     = get_namespace [ 'Test'; 'More' ]
-    globals = new ['ResizableStringArray']
-    globals = push 'ok'
-    globals = push 'plan'
-
-    exporter = new ['Exporter']
-    exporter.'import'( src :named('source'), globals :named('globals') )
-    plan(1)
-    ok(1)
+    $P97 = new ['Exporter']
+    $P97.'import'( $P99 :named('source'), $P96 :named('globals') )
+    ok( 1, '... with globals-as-array succeeds' )
 .end
-CODE
-1..1
-ok 1
-OUT
 
-pir_output_is( <<'CODE', <<'OUT', 'import - globals as hash - null + empty string' );
-.sub 'test' :main
-    load_bytecode 'Test/More.pbc'
-    .local pmc exporter, src, globals, nul
+.namespace ['test_import_with_s_gh']
+.sub 'test'
+    $P95 = new ['Null']
+    $P99 = get_root_namespace [ 'parrot'; 'Test'; 'More' ]
+    $P96 = new ['Hash']
+    $P96['ok'] = $P95
+    $P96['plan'] = ''
 
-    nul     = new ['Null']
-    src     = get_namespace [ 'Test'; 'More' ]
-    globals = new ['Hash']
-    globals['ok'] = nul
-    globals['plan'] = ''
-
-    exporter = new ['Exporter']
-    exporter.'import'( src :named('source'), globals :named('globals') )
-    plan(1)
-    ok(1)
+    $P97 = new ['Exporter']
+    $P97.'import'( $P99 :named('source'), $P96 :named('globals') )
+    ok( 1, '... with globals-as-hash succeeds' )
 .end
-CODE
-1..1
-ok 1
-OUT
 
-pir_output_is( <<'CODE', <<'OUT', 'import - globals as hash - with dest names (latin)' );
-.sub 'test' :main
-    load_bytecode 'Test/More.pbc'
-    .local pmc exporter, src, globals
+.namespace ['test_import_and_call']
+.sub 'test'
+    $P99 = get_root_namespace [ 'parrot'; 'Test'; 'More' ]
+    $P96 = new ['Hash']
+    $P96['plan'] = 'consilium'
+    $P96['ok'] = 'rectus'
 
-    src     = get_namespace [ 'Test'; 'More' ]
-    globals = new ['Hash']
-    globals['plan'] = 'consilium'
-    globals['ok'] = 'rectus'
-
-    exporter = new ['Exporter']
-    exporter.'import'( src :named('source'), globals :named('globals') )
-    consilium(1)
-    rectus(1)
+    $P97 = new ['Exporter']
+    $P97.'import'( $P99 :named('source'), $P96 :named('globals') )
+    #consilium(1)
+    rectus( 1, '... into current namespace with another (global) name succeeds' )
 .end
-CODE
-1..1
-ok 1
-OUT
 
-pir_output_is( <<'CODE', <<'OUT', 'import - globals with destination' );
-.sub 'test' :main
-    load_bytecode 'Test/More.pbc'
-    .local pmc exporter, src, dest, globals
+.namespace ['test_import_and_ind_call']
+.sub 'test'
+    $P99 = get_root_namespace [ 'parrot'; 'Test'; 'More' ]
+    $P98 = get_root_namespace [ 'parrot'; 'foo' ]
+    $P96 = new ['ResizableStringArray']
+    $P96 = push 'ok'
+    $P96 = push 'plan'
 
-    src     = get_namespace [ 'Test'; 'More' ]
-    dest    = get_namespace ['foo']
-    globals = new ['ResizableStringArray']
-    globals = push 'ok'
-    globals = push 'plan'
+    $P97 = new ['Exporter']
+    $P97.'import'( $P99 :named('source'), $P98 :named('destination'), $P96 :named('globals') )
 
-    exporter = new ['Exporter']
-    exporter.'import'( src :named('source'), dest :named('destination'), globals :named('globals') )
-
-    $P0 = get_global ['foo'], 'bar'
+    $P0 = get_root_global [ 'parrot'; 'foo' ], 'bar'
     $P0()
 .end
 
 .namespace ['foo']
 .sub 'bar'
-    plan(1)
-    ok(1)
+    ok( 1, '... into another namespace succeeds' )
 .end
-CODE
-1..1
-ok 1
-OUT
 
-# TODO: Test exporting mmd subs: TT #1205
-# https://trac.parrot.org/parrot/ticket/1205
+# RT #46861 test exporting mmd subs
 
 # Local Variables:
-#   mode: cperl
+#   mode: pir
 #   cperl-indent-level: 4
 #   fill-column: 100
 # End:
-# vim: expandtab shiftwidth=4:
+# vim: expandtab shiftwidth=4 ft=pir: