[svn:parrot] r40856 - in trunk: . t/pmc
dukeleto at svn.parrot.org
dukeleto at svn.parrot.org
Sun Aug 30 03:55:08 UTC 2009
Author: dukeleto
Date: Sun Aug 30 03:55:07 2009
New Revision: 40856
URL: https://trac.parrot.org/parrot/changeset/40856
Log:
[t] Translate most of t/pmc/integer.t into PIR
Added:
trunk/t/pmc/integer-old.t
Modified:
trunk/MANIFEST
trunk/t/pmc/integer.t
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST Sat Aug 29 18:09:30 2009 (r40855)
+++ trunk/MANIFEST Sun Aug 30 03:55:07 2009 (r40856)
@@ -1870,6 +1870,7 @@
t/pmc/hashiterator.t [test]
t/pmc/hashiteratorkey.t [test]
t/pmc/integer.t [test]
+t/pmc/integer-old.t [test]
t/pmc/io.t [test]
t/pmc/io_iterator.t [test]
t/pmc/io_status.t [test]
Added: trunk/t/pmc/integer-old.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/t/pmc/integer-old.t Sun Aug 30 03:55:07 2009 (r40856)
@@ -0,0 +1,54 @@
+#!perl
+# Copyright (C) 2001-2009, Parrot Foundation.
+# $Id$
+
+use strict;
+use warnings;
+use lib qw( . lib ../lib ../../lib );
+
+use Test::More;
+use Parrot::Test tests => 2;
+
+=head1 NAME
+
+t/pmc/integer-old.t - Perl tests for Integer basic type
+
+=head1 SYNOPSIS
+
+ % prove t/pmc/integer.t
+
+=head1 DESCRIPTION
+
+Perl tests the Integer PMC. These should be translated to PIR when possible.
+
+=cut
+
+
+pir_error_output_like( <<'CODE',qr/get_as_base: base out of bounds/ms, "get_as_base() bounds check" );
+.sub main :main
+ $P0 = new ['Integer']
+ $P0 = 42
+
+ $S0 = $P0.'get_as_base'(1)
+
+ say $S0
+.end
+CODE
+
+pir_error_output_like( <<'CODE', qr/get_as_base: base out of bounds/ms,"get_as_base() bounds check" );
+.sub main :main
+ $P0 = new ['Integer']
+ $P0 = 42
+
+ $S0 = $P0.'get_as_base'(37)
+
+ say $S0
+.end
+CODE
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Modified: trunk/t/pmc/integer.t
==============================================================================
--- trunk/t/pmc/integer.t Sat Aug 29 18:09:30 2009 (r40855)
+++ trunk/t/pmc/integer.t Sun Aug 30 03:55:07 2009 (r40856)
@@ -1,14 +1,7 @@
-#!perl
-# Copyright (C) 2001-2008, Parrot Foundation.
+#!parrot
+# Copyright (C) 2001-2009, Parrot Foundation.
# $Id$
-use strict;
-use warnings;
-use lib qw( . lib ../lib ../../lib );
-
-use Test::More;
-use Parrot::Test tests => 19;
-
=head1 NAME
t/pmc/integer.t - Integer basic type
@@ -23,372 +16,297 @@
=cut
-pir_output_is( << 'CODE', << 'OUTPUT', "basic math" );
+.sub 'test' :main
+ .include 'test_more.pir'
+
+ plan(58)
+ test_basic_math()
+ test_truthiness_and_definedness()
+ test_set_string_native()
+ test_isa()
+ test_interface()
+ test_ne()
+ test_gt()
+ test_ge()
+ test_istrue_isfalse()
+ test_if_unless()
+ test_add()
+ test_arithmetic()
+ test_get_as_base()
+ test_get_as_base10()
+ test_get_as_base_various()
+ test_cmp_subclass()
+ test_cmp_RT59336()
+.end
-.sub _main
+
+.sub test_basic_math
.local pmc int_1
int_1 = new ['Integer']
- print int_1
- print "\n"
+ is(int_1,0)
int_1 = 1
- print int_1
- print "\n"
+ is(int_1,1)
int_1 += 777777
int_1 -= 777776
- print int_1
- print "\n"
+ is(int_1,2)
int_1 *= -333333
int_1 /= -222222
- print int_1
- print "\n"
+ is(int_1,3)
inc int_1
inc int_1
dec int_1
- print int_1
- print "\n"
+ is(int_1,4)
neg int_1
dec int_1
neg int_1
- print int_1
- print "\n"
- end
+ is(int_1,5)
.end
-CODE
-0
-1
-2
-3
-4
-5
-OUTPUT
-pir_output_is( << 'CODE', << 'OUTPUT', "truth and definedness" );
-.sub _main
+.sub test_truthiness_and_definedness
.local pmc int_1
int_1 = new ['Integer']
- print "A newly created Integer is "
- if int_1 goto LABEL_1
- print "not "
-LABEL_1:
- print "true.\n"
+ nok(int_1, "A newly created Integer is not true")
.local int is_defined
is_defined = defined int_1
- print "A newly created Integer is "
- if is_defined goto LABEL_2
- print " not "
-LABEL_2:
- print "defined.\n"
+
+ nok(int_1, "A newly created Integer is not defined")
int_1 = -999999999
- print "The Integer "
- print int_1
- print " is "
- if is_defined goto LABEL_3
- print "not "
-LABEL_3:
- print "true.\n"
+
+ ok(int_1, "-999999999 is true")
is_defined = defined int_1
- print "The Integer "
- print int_1
- print " is "
- if is_defined goto LABEL_4
- print "not "
-LABEL_4:
- print "defined.\n"
- end
+
+ ok(int_1, "-999999999 is defined")
+
.end
-CODE
-A newly created Integer is not true.
-A newly created Integer is defined.
-The Integer -999999999 is true.
-The Integer -999999999 is defined.
-OUTPUT
-pir_output_is( <<'CODE', <<'OUTPUT', "set_string_native" );
-.sub _main
+.sub test_set_string_native
.local pmc pmc1
pmc1 = new ['Integer']
pmc1 = "-123456789"
- print pmc1
- print "\n"
- end
+ is(pmc1, -123456789)
.end
-CODE
--123456789
-OUTPUT
-pir_output_is( <<'CODE', <<'OUTPUT', "isa" );
-.sub _main
+.sub test_isa
.local pmc pmc1
pmc1 = new ['Integer']
.local int pmc1_is_a
pmc1_is_a = isa pmc1, "Integer"
- print "A newly created Integer is "
- if pmc1_is_a goto PMC1_IS_A_INTEGER
- print "not "
-PMC1_IS_A_INTEGER:
- print "an Integer.\n"
-
- end
+ isa_ok(pmc1, "Integer")
.end
-CODE
-A newly created Integer is an Integer.
-OUTPUT
-pir_output_is( << 'CODE', << 'OUTPUT', "check whether interface is done" );
-
-.sub _main
+.sub test_interface
.local pmc pmc1
pmc1 = new ['Integer']
.local int bool1
does bool1, pmc1, "scalar"
- print bool1
- print "\n"
+ is(bool1,1)
does bool1, pmc1, "integer"
- print bool1
- print "\n"
+ is(bool1,1)
does bool1, pmc1, "no_interface"
- print bool1
- print "\n"
- end
+ is(bool1,0)
.end
-CODE
-1
-1
-0
-OUTPUT
-pir_output_is( << 'CODE', << 'OUTPUT', "Comparison ops: ne" );
-
-.sub _main
+.sub test_ne
.local pmc pmc1
pmc1 = new ['Integer']
.local int int1
pmc1 = 10
int1 = 20
ne pmc1, int1, OK1
- print "not "
+ ok(0)
+ goto next_test
OK1:
- print "ok 1\n"
+ ok(1)
+
+next_test:
+
int1 = 10
ne pmc1, int1, BAD2
branch OK2
BAD2:
- print "not "
+ ok(0)
+ goto fin
OK2:
- print "ok 2\n"
- end
+ ok(1)
+fin:
.end
-CODE
-ok 1
-ok 2
-OUTPUT
-pir_output_is( << 'CODE', << 'OUTPUT', "Comparison ops: gt" );
-.sub _main
+.sub test_gt
.local pmc pmc1
pmc1 = new ['Integer']
.local int int1
pmc1 = 10
int1 = 5
gt pmc1, int1, OK1
- print "not "
+ ok(0)
+ goto next_test1
OK1:
- print "ok 1\n"
+ ok(1)
+
+next_test1:
int1 = 10
gt pmc1, int1, BAD2
branch OK2
BAD2:
- print "not "
+ ok(0)
OK2:
- print "ok 2\n"
+ ok(1)
+
+next_test2:
int1 = 20
gt pmc1, int1, BAD3
branch OK3
BAD3:
- print "not "
+ ok(0)
+ goto fin
OK3:
- print "ok 3\n"
- end
+ ok(1)
+fin:
.end
-CODE
-ok 1
-ok 2
-ok 3
-OUTPUT
-pir_output_is( << 'CODE', << 'OUTPUT', "Comparison ops: ge" );
-.sub _main
+.sub test_ge
.local pmc pmc1
pmc1 = new ['Integer']
.local int int1
pmc1 = 10
int1 = 5
ge pmc1, int1, OK1
- print "not "
+ ok(0)
+ goto next_test1
OK1:
- print "ok 1\n"
+ ok(1)
int1 = 10
+
+next_test1:
ge pmc1, int1, OK2
- print "not "
+ ok(0)
+ goto next_test2
OK2:
- print "ok 2\n"
+ ok(1)
int1 = 20
+next_test2:
ge pmc1, int1, BAD3
branch OK3
BAD3:
- print "not "
+ ok(0)
+ goto fin
OK3:
- print "ok 3\n"
- end
+ ok(1)
+fin:
.end
-CODE
-ok 1
-ok 2
-ok 3
-OUTPUT
-pir_output_is( << 'CODE', << 'OUTPUT', "Logical ops: istrue & isfalse" );
-.sub _main
+.sub test_istrue_isfalse
.local pmc pmc1
pmc1 = new ['Integer']
.local int int1
pmc1 = 10
istrue int1, pmc1
- print int1
- print "\n"
+ is(1,int1)
isfalse int1, pmc1
- print int1
- print "\n"
+ is(0,int1)
pmc1 = 0
istrue int1, pmc1
- print int1
- print "\n"
+ is(0,int1)
isfalse int1, pmc1
- print int1
- print "\n"
-
- end
+ is(1,int1)
.end
-CODE
-1
-0
-0
-1
-OUTPUT
-pasm_output_is( <<'CODE', <<'OUTPUT', "if/unless with Integer PMC" );
- new P0, ['Integer']
- set P0, 10
- if P0, OK1
- print "not "
-OK1: print "ok 1\n"
- unless P0, BAD2
+
+.sub test_if_unless
+ new $P0, ['Integer']
+ set $P0, 10
+ if $P0, OK1
+ ok(0)
+ goto test1
+OK1:
+ ok(1)
+test1:
+ unless $P0, BAD2
branch OK2
-BAD2: print "not "
-OK2: print "ok 2\n"
- set P0, 0
- if P0, BAD3
+BAD2:
+ ok(0)
+ goto test2
+OK2:
+ ok(1)
+ set $P0, 0
+test2:
+ if $P0, BAD3
branch OK3
-BAD3: print "not "
-OK3: print "ok 3\n"
- unless P0, OK4
- print "not "
-OK4: print "ok 4\n"
- end
-CODE
-ok 1
-ok 2
-ok 3
-ok 4
-OUTPUT
-
-pasm_output_is( <<'CODE', <<'OUT', "add" );
- new P0, ['Integer']
- set P0, 5
- new P1, ['Integer']
- set P1, 10
- new P2, ['Integer']
- add P2, P0, P1
- set S0, P2
- print S0
- print "\n"
- set P0, "20"
- set P1, "30"
- add P2, P1, P0
- set S0, P2
- print S0
- print "\n"
- end
-CODE
-15
-50
-OUT
+BAD3:
+ ok(0)
+ goto test3
+OK3:
+ ok(1)
+test3:
+ unless $P0, OK4
+ ok(0)
+ goto fin
+OK4:
+ ok(1)
+fin:
+.end
+
+.sub test_add
+ new $P0, ['Integer']
+ set $P0, 5
+ new $P1, ['Integer']
+ set $P1, 10
+ new $P2, ['Integer']
+ add $P2, $P0, $P1
+ set $S0, $P2
+ is($S0,15)
+ set $P0, "20"
+ set $P1, "30"
+ add $P2, $P1, $P0
+ set $S0, $P2
+ is($S0,50)
+.end
-pir_output_is( << 'CODE', << 'OUTPUT', "<oper>" );
-.sub main :main
+.sub test_arithmetic
$P0 = new ['Integer']
$P1 = new ['Integer']
set $P0, 6
set $P1, 2
add $P2, $P0, $P1
- print $P2
- print "\n"
+ is($P2,8)
$P2 = add $P0, $P1
- print $P2
- print "\n"
+ is($P2,8)
sub $P2, $P0, $P1
- print $P2
- print "\n"
+ is($P2,4)
mul $P2, $P0, $P1
- print $P2
- print "\n"
+ is($P2,12)
div $P2, $P0, $P1
- print $P2
- print "\n"
+ is($P2,3)
mod $P2, $P0, $P1
- print $P2
- print "\n"
+ is($P2,0)
pow $P2, $P0, $P1
- print $P2
- print "\n"
+ is($P2,36)
.end
-CODE
-8
-8
-4
-12
-3
-0
-36
-OUTPUT
-pir_output_is( <<'CODE', <<'OUTPUT', "can get_as_base()" );
-.sub main :main
+
+.sub test_get_as_base
$P0 = new ['Integer']
$P0 = 42
$I0 = can $P0, 'get_as_base'
- if $I0, OK
- print "not "
-OK: print "ok\n"
+ ok($I0,'Integers can get_as_base')
.end
-CODE
-ok
-OUTPUT
-pir_error_output_like( <<'CODE', <<'OUTPUT', "get_as_base() bounds check" );
+=pod
+
+pir_error_output_like( <<'CODE',qr/get_as_base: base out of bounds/ms, "get_as_base() bounds check" );
.sub main :main
$P0 = new ['Integer']
$P0 = 42
@@ -418,84 +336,55 @@
.*/
OUTPUT
-pir_output_is( <<'CODE', <<'OUTPUT', "get_as_base(10)" );
-.sub main :main
+=cut
+
+.sub test_get_as_base10
$P0 = new ['Integer']
$P0 = 42
$S0 = $P0.'get_as_base'(10)
-
- print $S0
- print "\n"
+ is($S0,42)
.end
-CODE
-42
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "get_as_base(various)" );
-.sub main :main
- .local pmc jmpstack
- jmpstack = new 'ResizableIntegerArray'
+.sub test_get_as_base_various
$P0 = new ['Integer']
$P0 = 42
$S0 = $P0.'get_as_base'(2)
- local_branch jmpstack, PRINT
+ is($S0,101010)
$S0 = $P0.'get_as_base'(3)
- local_branch jmpstack, PRINT
+ is($S0,1120)
$S0 = $P0.'get_as_base'(5)
- local_branch jmpstack, PRINT
+ is($S0,132)
$S0 = $P0.'get_as_base'(7)
- local_branch jmpstack, PRINT
+ is($S0,60)
$S0 = $P0.'get_as_base'(11)
- local_branch jmpstack, PRINT
+ is($S0,39)
$S0 = $P0.'get_as_base'(13)
- local_branch jmpstack, PRINT
+ is($S0,33)
$S0 = $P0.'get_as_base'(17)
- local_branch jmpstack, PRINT
+ is($S0,28)
$S0 = $P0.'get_as_base'(19)
- local_branch jmpstack, PRINT
+ is($S0,24)
$S0 = $P0.'get_as_base'(23)
- local_branch jmpstack, PRINT
+ is($S0,'1j')
$S0 = $P0.'get_as_base'(29)
- local_branch jmpstack, PRINT
+ is($S0,'1d')
$S0 = $P0.'get_as_base'(31)
- local_branch jmpstack, PRINT
- goto END
-
-PRINT:
- print $S0
- print "\n"
- local_return jmpstack
-END:
+ is($S0,'1b')
.end
-CODE
-101010
-1120
-132
-60
-39
-33
-28
-24
-1j
-1d
-1b
-OUTPUT
-pir_output_is( <<'CODE', <<'OUTPUT', 'cmp functions for subclasses' );
-.sub main :main
+.sub test_cmp_subclass
$P0 = subclass 'Integer', 'Int'
$P1 = new ['Int']
@@ -504,43 +393,32 @@
$P2 = 2
$I0 = cmp $P1, $P2
- say $I0
+ is($I0,-1)
$I0 = cmp $P1, $P1
- say $I0
+ is($I0,0)
$I0 = cmp $P2, $P1
- say $I0
+ is($I0,1)
.end
-CODE
--1
-0
-1
-OUTPUT
-pir_output_is( <<'CODE', <<'OUTPUT', 'cmp for Integers more than 2^31 apart, RT #59336' );
-.sub 'main' :main
+.sub test_cmp_RT59336
$P0 = new ['Integer']
$P0 = 2147483600
- test_10:
- print $P0
- print " is"
- if $P0 > -10 goto skip_10
- print " not"
- skip_10:
- say " greater than -10"
-
- test_1000:
- print $P0
- print " is"
- if $P0 > -1000 goto skip_1000
- print " not"
- skip_1000:
- say " greater than -1000"
+test_10:
+ if $P0 > -10 goto pass
+ ok(0)
+ goto test_1000
+pass:
+ ok(1)
+
+test_1000:
+ if $P0 > -1000 goto pass2
+ ok(0)
+ goto fin
+pass2:
+ ok(1)
+fin:
.end
-CODE
-2147483600 is greater than -10
-2147483600 is greater than -1000
-OUTPUT
# Local Variables:
# mode: cperl
More information about the parrot-commits
mailing list