# New Ticket Created by Sam Vilain
# Please include the string: [perl #41807]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=41807 >
This transaction appears to have no content
[lib] Test::More - add isa_ok()
---
runtime/parrot/library/Test/More.pir | 85 +++++++++++++++++++++++++++++++++-
t/library/test_more.t | 38 +++++++++++++++-
2 files changed, 121 insertions(+), 2 deletions(-)
diff --git a/runtime/parrot/library/Test/More.pir b/runtime/parrot/library/Test/More.pir
index 48c9d22..5f44471 100644
--- a/runtime/parrot/library/Test/More.pir
+++ b/runtime/parrot/library/Test/More.pir
@@ -4,6 +4,9 @@ Test::More - Parrot extension for testing modules
=head1 SYNOPSIS
+ .include "hllmacros.pir"
+
+ .sub main :main
# load this library
load_bytecode 'library/Test/More.pir'
@@ -14,7 +17,7 @@ Test::More - Parrot extension for testing modules
.local pmc is
.local pmc isnt
.local pmc is_deeply
- .local pmc like
+ .local pmc isa_ok
plan = find_global 'Test::More', 'plan'
diag = find_global 'Test::More', 'diag'
@@ -23,6 +26,7 @@ Test::More - Parrot extension for testing modules
isnt = find_global 'Test::More', 'isnt'
is_deeply = find_global 'Test::More', 'is_deeply'
like = find_global 'Test::More', 'like'
+ isa_ok = find_global 'Test::More', 'isa_ok'
# set a test plan
plan( 13 )
@@ -50,6 +54,11 @@ Test::More - Parrot extension for testing modules
like( 'foo', 'f o**{2}', 'passing regex compare with diagnostic' )
+ $P0 = getclass "Moose"
+ $P0.new()
+
+ isa_ok($P0, "Moose", "new Moose")
+
=head1 DESCRIPTION
C<Test::More> is a pure-Parrot library for testing modules. It provides
@@ -946,6 +955,80 @@ actually skipped. Arguments are optional.
test.'skip'()
.end
+=item C<isa_ok( pmc, class, name )>
+
+Pass if the pmc passed "isa" class. The "name" passed in is a
+description of what it is you've passed in, not a comment. It is
+presented as "name isa class" in the description.
+
+Good input: "C<new MyObject>", "C<return from bar()>"
+
+Bad input: "C<test that the return from Foo is correct type>"
+
+=cut
+
+.sub isa_ok :multi(pmc, string)
+ .param pmc thingy
+ .param string class_name
+ .param string name :optional
+ .param int got_name :opt_flag
+
+ .local pmc test
+ find_global test, 'Test::More', '_test'
+
+ .local string _name
+ _name = name
+ if got_name goto great
+ _name = "object"
+great:
+ $S0 = _name . " isa "
+ $S0 = $S0 . class_name
+
+ $I0 = isa thingy, class_name
+ test.'ok'($I0, $S0)
+ if $I0 goto out
+ _isa_ok_diag(test, class_name, _name, thingy)
+out:
+.end
+
+.sub isa_ok :multi(pmc, pmc)
+ .param pmc thingy
+ .param pmc class
+ .param string name :optional
+ .param int got_name :opt_flag
+
+ .local pmc test
+ find_global test, 'Test::More', '_test'
+
+ .local string _name, class_name
+ _name = name
+ if got_name goto great
+ _name = "object"
+great:
+ $S0 = _name . " isa "
+ class_name = classname class
+ $S0 = $S0 . class_name
+
+ $I0 = isa thingy, class
+ test.'ok'($I0, $S0)
+ if $I0 goto out
+ _isa_ok_diag(test, class_name, _name, thingy)
+out:
+.end
+
+.sub _isa_ok_diag
+ .param pmc test
+ .param string class_name
+ .param string name
+ .param pmc thingy
+ $S0 = name . " isn't a "
+ $S0 = $S0 . class_name
+ $S0 = $S0 . " it's a "
+ $S1 = typeof thingy
+ $S0 = $S0 . $S1
+ test.'diag'($S0)
+.end
+
.sub _make_diagnostic
.param string received
.param string expected
diff --git a/t/library/test_more.t b/t/library/test_more.t
index b7aa317..17b0671 100644
--- a/t/library/test_more.t
+++ b/t/library/test_more.t
@@ -26,6 +26,7 @@
.IMPORT( 'Test::More', 'like' )
.IMPORT( 'Test::More', 'skip' )
.IMPORT( 'Test::More', 'is_deeply' )
+ .IMPORT( 'Test::More', 'isa_ok' )
.IMPORT( 'Test::Builder::Tester', 'plan' )
.IMPORT( 'Test::Builder::Tester', 'test_out' )
.IMPORT( 'Test::Builder::Tester', 'test_diag' )
@@ -33,7 +34,7 @@
.IMPORT( 'Test::Builder::Tester', 'test_pass' )
.IMPORT( 'Test::Builder::Tester', 'test_test' )
- plan( 55 )
+ plan( 60 )
test_skip()
test_ok()
test_is()
@@ -41,6 +42,7 @@
test_is_deeply()
test_diagnostics()
test_isnt()
+ test_isa_ok()
test.'finish'()
.end
@@ -411,3 +413,37 @@
.end
+
+.sub test_isa_ok
+ .local pmc dog, terrier, daschund, Spot, Sossy
+
+ dog = newclass "dog"
+ terrier = subclass dog, "terrier"
+ daschund = subclass dog, "daschund"
+
+ Spot = new "terrier"
+ Sossy = new "daschund"
+
+ test_pass( 'Spot isa terrier' )
+ isa_ok(Spot, "terrier", "Spot")
+ test_test( 'passing isa_ok for PMC/string (class =)' )
+
+ test_pass( 'Spot isa dog' )
+ isa_ok(Spot, "dog", "Spot")
+ test_test( 'passing isa_ok for PMC/string (super)')
+
+ test_pass( 'Sossy isa daschund' )
+ isa_ok(Sossy, "daschund", "Sossy")
+ test_test( 'passing isa_ok for PMC/PMC (class =)' )
+
+ test_pass( 'Sossy isa dog' )
+ isa_ok(Sossy, "dog", "Sossy")
+ test_test( 'passing isa_ok for PMC/PMC (super)')
+
+ test_fail( 'Spot isa daschund' )
+ test_diag( "Spot isn't a daschund it's a terrier" )
+ isa_ok(Spot, 'daschund', "Spot")
+ test_test( 'failing test isnt() for PMC/string')
+
+.end
+
--
1.5.0.2.21.gdcde2
