cvsuser 04/02/25 11:45:09
Modified: t/pmc objects.t
Log:
Convert object tests to use new API
Revision Changes Path
1.18 +136 -476 parrot/t/pmc/objects.t
Index: objects.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/objects.t,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -w -r1.17 -r1.18
--- objects.t 25 Feb 2004 00:28:58 -0000 1.17
+++ objects.t 25 Feb 2004 19:45:09 -0000 1.18
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: objects.t,v 1.17 2004/02/25 00:28:58 dan Exp $
+# $Id: objects.t,v 1.18 2004/02/25 19:45:09 scog Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 24;
+use Parrot::Test tests => 21;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "findclass (base class)");
@@ -296,557 +296,217 @@
ok 5
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "addattrib");
+output_is(<<'CODE', <<'OUTPUT', "addattribute");
newclass P1, "Foo"
- addattribute I1, P1, "foo_i"
+# Check that addattribute doesn't blow up
+ addattribute P1, "foo_i"
print "ok 1\n"
- print I1
- print "\n"
- addattribute I1, P1, "foo_j"
- print I1
- print "\n"
+# Check that P1 is still the same ParrotClass PMC
+ classname S0, P1
+ eq S0, "Foo", ok2
+ print "not "
+ok2:
+ print "ok 2\n"
+# Check that we can add multiple attributes
+ set I0, 0
+l1:
+ set S0, I0
+ addattribute P1, S0
+ inc I0
+ lt I0, 1000, l1
+ print "ok 3\n"
end
CODE
ok 1
-0
-1
+ok 2
+ok 3
OUTPUT
output_is(<<'CODE', <<'OUTPUT', "addattribute subclass");
newclass P1, "Foo"
- addattribute I1, P1, "foo_i"
+ addattribute P1, "foo_i"
print "ok 1\n"
- print I1
- print "\n"
- addattribute I1, P1, "foo_j"
- print I1
- print "\n"
-
subclass P2, P1, "Bar"
- addattribute I1, P2, "bar_i"
+ addattribute P2, "bar_i"
print "ok 2\n"
- print I1
- print "\n"
- addattribute I1, P2, "bar_j"
- print I1
- print "\n"
- # attr count
- set I0, P2
- print I0
- print "\n"
end
CODE
ok 1
-0
-1
ok 2
-2
-3
-4
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "addattribute subclass - get idx");
+# This needs a better test...
+output_is(<<'CODE', <<'OUTPUT', "addattribute subclass - same name");
newclass P1, "Foo"
- addattribute I1, P1, "foo_i"
- set I2, P1["Foo\x00foo_i"]
- eq I1, I2, ok1
- print "not "
-ok1:
- print "ok 1\n"
- addattribute I1, P1, "foo_j"
- set I2, P1["Foo\x00foo_j"]
- eq I1, I2, ok2
- print "not "
-ok2:
- print "ok 2\n"
-
+ addattribute P1, "i"
+ addattribute P1, "j"
subclass P2, P1, "Bar"
- addattribute I1, P2, "bar_i"
- set I2, P2["Bar\x00bar_i"]
- eq I1, I2, ok3
- print "not "
-ok3:
- print "ok 3\n"
- addattribute I1, P2, "bar_j"
- set I2, P2["Bar\x00bar_j"]
- eq I1, I2, ok4
- print "not "
-ok4:
- print "ok 4\n"
+ addattribute P2, "i"
+ addattribute P2, "j"
+ print "ok 1\n"
end
CODE
ok 1
-ok 2
-ok 3
-ok 4
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "object attr count");
+output_is(<<'CODE', <<'OUTPUT', "set/get object attribs");
newclass P1, "Foo"
- addattribute I1, P1, "foo_i"
- addattribute I1, P1, "foo_j"
- set I1, P1
- print I1
- print "\n"
-
+ addattribute P1, "i"
find_type I0, "Foo"
new P2, I0
- set I1, P2
- print I1
+
+ new P3, .PerlInt
+ set P3, 1024
+ setattribute P2, 0, P3
+
+ new P4, .PerlInt
+ getattribute P4, P2, 0
+ print P4
print "\n"
end
CODE
-2
-2
+1024
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "object attribs 1");
+output_is(<<'CODE', <<'OUTPUT', "set/get multiple object attribs");
newclass P1, "Foo"
- addattribute I1, P1, "i"
- addattribute I1, P1, "j"
-
+ addattribute P1, "i"
+ addattribute P1, "j"
find_type I0, "Foo"
new P2, I0
- new P3, I0
- set P2["Foo\x00i"], 10
- set P3["Foo\x00i"], 20
- set I2, P2["Foo\x00i"]
- set I3, P3["Foo\x00i"]
- print I2
+ new P3, .PerlInt
+ set P3, 4201
+ new P4, .PerlHash
+ set P4["Key"], "Value"
+
+ setattribute P2, 0, P3
+ setattribute P2, 1, P4
+
+ getattribute P5, P2, 0
+ print P5
print "\n"
- print I3
+ getattribute P6, P2, 1
+ set S0, P6["Key"]
+ print S0
print "\n"
end
CODE
-10
-20
+4201
+Value
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "object attribs 2");
+output_like(<<'CODE', <<'OUTPUT', "setting non-existant attribute");
newclass P1, "Foo"
- addattribute I1, P1, "i"
- addattribute I1, P1, "j"
-
find_type I0, "Foo"
new P2, I0
- new P3, I0
-
- set P2["Foo\x00i"], 10
- set P3["Foo\x00i"], 20
- set P2["Foo\x00j"], 30
- set P3["Foo\x00j"], 40
- set I4, P2["Foo\x00j"]
- set I5, P3["Foo\x00j"]
- set I2, P2["Foo\x00i"]
- set I3, P3["Foo\x00i"]
- print I2
- print "\n"
- print I3
- print "\n"
- print I4
- print "\n"
- print I5
- print "\n"
- end
+ new P3, .PerlInt
+ setattribute P2, 0, P3
end
CODE
-10
-20
-30
-40
+/No such attribute/
OUTPUT
-output_like(<<'CODE', <<'OUTPUT', "object attribs 3");
+output_like(<<'CODE', <<'OUTPUT', "getting non-existant attribute");
newclass P1, "Foo"
- addattribute I1, P1, "i"
-
find_type I0, "Foo"
new P2, I0
-
- set P2["Foo\x00no_such"], 10
- print "never\n"
+ getattribute P3, P2, 0
end
CODE
/No such attribute/
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "object attribs 4");
- newclass P1, "Foo"
- addattribute I1, P1, "i"
- addattribute I1, P1, "j"
+output_is(<<'CODE', <<'OUTPUT', "attribute values are specific to objects");
+ newclass P1, "Foo"
+ addattribute P1, "i"
find_type I0, "Foo"
new P2, I0
new P3, I0
- # the preferred method of accessing attribs is by index
- set P2[0], 10
- set P3[0], 20
- set P2[1], 30
- set P3[1], 40
- set I4, P2[1]
- set I5, P3[1]
- set I2, P2[0]
- set I3, P3[0]
- print I2
- print "\n"
- print I3
- print "\n"
- print I4
- print "\n"
- print I5
- print "\n"
- set I6, P3["Foo\x00j"]
- eq I5, I6, ok
- print "not "
-ok: print "ok\n"
- end
-CODE
-10
-20
-30
-40
-ok
-OUTPUT
+ new P4, .PerlInt
+ set P4, 100
+ setattribute P2, 0, P4
+ new P5, .PerlString
+ set P5, "One hundred"
+ setattribute P3, 0, P5
-output_is(<<'CODE', <<'OUTPUT', "class attribs - same name");
- newclass P1, "Foo"
- addattribute I1, P1, "i"
- addattribute I1, P1, "j"
- subclass P2, P1, "Bar"
- addattribute I1, P2, "i"
- addattribute I1, P2, "j"
- set I0, P2
- print I0
+ getattribute P6, P2, 0
+ print P6
print "\n"
- set I0, P2["Foo\x0i"]
- print I0
- print "\n"
- set I0, P2["Bar\x0i"]
- print I0
+ getattribute P6, P3, 0
+ print P6
print "\n"
end
CODE
-4
-0
-2
+100
+One hundred
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "object attribs 5");
+output_is(<<'CODE', <<'OUTPUT', "attribute values and subclassing");
newclass P1, "Foo"
- addattribute I1, P1, "i"
- addattribute I1, P1, "j"
+ addattribute P1, "i"
+ addattribute P1, "j"
subclass P2, P1, "Bar"
- addattribute I1, P2, "k"
- addattribute I1, P2, "l"
+ addattribute P2, "k"
+ addattribute P2, "l"
find_type I0, "Bar"
new P2, I0
new P3, I0
- set P2[0], 10
- set P2[1], 20
- set P2[2], 30
- set P2[3], 40
- set P3[0], 110
- set P3[1], 120
- set P3[2], 130
- set P3[3], 140
-
- set I0, 0
-lp1:
- set I4, P2[I0]
- print I4
+ new P4, .PerlInt
+ set P4, 10
+ setattribute P2, 0, P4
+ inc P4
+ setattribute P2, 1, P4
+ inc P4
+ setattribute P2, 2, P4
+ inc P4
+ setattribute P2, 3, P4
+
+ set P4, 100
+ setattribute P3, 0, P4
+ inc P4
+ setattribute P3, 1, P4
+ inc P4
+ setattribute P3, 2, P4
+ inc P4
+ setattribute P3, 3, P4
+
+
+ getattribute P5, P2, 0
+ bsr l1
+ getattribute P5, P2, 1
+ bsr l1
+ getattribute P5, P2, 2
+ bsr l1
+ getattribute P5, P2, 3
+ bsr l1
+
+ getattribute P5, P3, 0
+ bsr l1
+ getattribute P5, P3, 1
+ bsr l1
+ getattribute P5, P3, 2
+ bsr l1
+ getattribute P5, P3, 3
+ bsr l1
+ branch end
+l1:
+ print P5
print "\n"
- inc I0
- lt I0, 4, lp1
-
- set I0, 0
-lp2:
- set I4, P3[I0]
- print I4
- print "\n"
- inc I0
- lt I0, 4, lp2
-
+ ret
+end:
end
CODE
10
-20
-30
-40
-110
-120
-130
-140
+11
+12
+13
+100
+101
+102
+103
OUTPUT
-
-
-output_is(<<'CODE', (join '', map { "$_\n" }42..65), "attributes");
- newclass P0, "Foo"
- find_type I1, "Foo"
- addattribute I0, P0, "b"
- addattribute I0, P0, "l"
- addattribute I0, P0, "a"
- new P1, I1
-
- set P1["Foo\x00a"], 42
- set I2, P1["Foo\x00a"]
- print I2
- print "\n"
-
- set S0, "Foo\x00a"
- set P1[S0], 43
- set I2, P1[S0]
- print I2
- print "\n"
-
- set P1[2], 44
- set I2, P1[2]
- print I2
- print "\n"
-
- set I3, 2
- set P1[I3], 45
- set I2, P1[I3]
- print I2
- print "\n"
-
-
-
- new P2, .Key
- set P2, "Foo\x00a"
-
- set P1[P2], 46
- set I2, P1[P2]
- print I2
- print "\n"
-
- new P2, .Key
- set P2, 0
-
- set P1[P2], 47
- set I2, P1[P2]
- print I2
- print "\n"
-
-
-
-# strings
-
- set P1["Foo\x00a"], "48"
- set S2, P1["Foo\x00a"]
- print S2
- print "\n"
-
- set S0, "Foo\x00a"
- set P1[S0], "49"
- set S2, P1[S0]
- print S2
- print "\n"
-
- set P1[2], "50"
- set S2, P1[2]
- print S2
- print "\n"
-
- set I3, 2
- set P1[I3], "51"
- set S2, P1[I3]
- print S2
- print "\n"
-
-
-
- new P2, .Key
- set P2, "Foo\x00a"
-
- set P1[P2], "52"
- set S2, P1[P2]
- print S2
- print "\n"
-
- new P2, .Key
- set P2, 0
-
- set P1[P2], "53"
- set S2, P1[P2]
- print S2
- print "\n"
-
-# pmc
-
-
- set P1["Foo\x00a"], 54
- set P4, P1["Foo\x00a"]
- print P4
- print "\n"
-
- set S0, "Foo\x00a"
- set P1[S0], 55
- set P4, P1[S0]
- print P4
- print "\n"
-
- set P1[2], 56
- set P4, P1[2]
- print P4
- print "\n"
-
- set I3, 2
- set P1[I3], 57
- set P4, P1[I3]
- print P4
- print "\n"
-
-
-
- new P2, .Key
- set P2, "Foo\x00a"
-
- set P1[P2], 58
- set P4, P1[P2]
- print P4
- print "\n"
-
- new P2, .Key
- set P2, 0
-
- set P1[P2], 59
- set P4, P1[P2]
- print P4
- print "\n"
-
-
- set P1["Foo\x00a"], "60"
- set P4, P1["Foo\x00a"]
- print P4
- print "\n"
-
- set S0, "Foo\x00a"
- set P1[S0], "61"
- set P4, P1[S0]
- print P4
- print "\n"
-
- set P1[2], "62"
- set P4, P1[2]
- print P4
- print "\n"
-
- set I3, 2
- set P1[I3], "63"
- set P4, P1[I3]
- print P4
- print "\n"
-
-
-
- new P2, .Key
- set P2, "Foo\x00a"
-
- set P1[P2], "64"
- set P4, P1[P2]
- print P4
- print "\n"
-
- new P2, .Key
- set P2, 0
-
- set P1[P2], "65"
- set P4, P1[P2]
- print P4
- print "\n"
- end
-CODE
-
-my $output_re = join '', map { "$_.00.*[\\n\\r]+" } 4..15;
-$output_re = qr/^$output_re$/;
-output_like(<<'CODE', $output_re , "float attributes");
- newclass P0, "Foo"
- find_type I1, "Foo"
- addattribute P0, "b"
- addattribute P0, "l"
- addattribute P0, "a"
- new P1, I1
-
-
- set P1["Foo\x00a"], 4.00001
- set N2, P1["Foo\x00a"]
- print N2
- print "\n"
-
-
- set S0, "Foo\x00a"
- set P1[S0], 5.00001
- set N2, P1[S0]
- print N2
- print "\n"
-
-
- set P1[2], 6.00001
- set N2, P1[2]
- print N2
- print "\n"
-
- set I3, 2
- set P1[I3], 7.00001
- set N2, P1[I3]
- print N2
- print "\n"
-
- new P2, .Key
- set P2, "Foo\x00a"
- set P1[P2], 8.00001
- set N2, P1[P2]
- print N2
- print "\n"
-
- new P2, .Key
- set P2, 0
- set P1[P2], 9.00001
- set N2, P1[P2]
- print N2
- print "\n"
-
- set P1["Foo\x00a"], 10.00001
- set P4, P1["Foo\x00a"]
- print P4
- print "\n"
-
- set S0, "Foo\x00a"
- set P1[S0], 11.00001
- set P4, P1[S0]
- print P4
- print "\n"
-
- set P1[2], 12.00001
- set P4, P1[2]
- print P4
- print "\n"
-
- set I3, 2
- set P1[I3], 13.00001
- set P4, P1[I3]
- print P4
- print "\n"
-
-
- new P2, .Key
- set P2, "Foo\x00a"
- set P1[P2], 14.00001
- set P4, P1[P2]
- print P4
- print "\n"
-
- new P2, .Key
- set P2, 0
- set P1[P2], 15.00001
- set P4, P1[P2]
- print P4
- print "\n"
- end
-
-
-CODE
