cvsuser 05/03/23 07:57:04
Modified: . MANIFEST
t/pmc integer.t perlint.t perlnum.t perlstring.t pmc.t
Added: t/pmc perlundef.t
Log:
applied #34539 - #34545
* more perl tests moved from pmc.t to perl*.t
Courtesy of Steven Schubiger <[EMAIL PROTECTED]>
Revision Changes Path
1.854 +1 -0 parrot/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /cvs/public/parrot/MANIFEST,v
retrieving revision 1.853
retrieving revision 1.854
diff -u -r1.853 -r1.854
--- MANIFEST 22 Mar 2005 10:15:34 -0000 1.853
+++ MANIFEST 23 Mar 2005 15:57:03 -0000 1.854
@@ -2922,6 +2922,7 @@
t/pmc/perlint.t []
t/pmc/perlnum.t []
t/pmc/perlstring.t []
+t/pmc/perlundef.t []
t/pmc/pmc.t []
t/pmc/prop.t []
t/pmc/ref.t []
1.5 +30 -2 parrot/t/pmc/integer.t
Index: integer.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/integer.t,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- integer.t 4 Mar 2005 17:49:11 -0000 1.4
+++ integer.t 23 Mar 2005 15:57:04 -0000 1.5
@@ -1,6 +1,7 @@
#! perl -w
+
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: integer.t,v 1.4 2005/03/04 17:49:11 bernhard Exp $
+# $Id: integer.t,v 1.5 2005/03/23 15:57:04 leo Exp $
=head1 NAME
@@ -16,7 +17,7 @@
=cut
-use Parrot::Test tests => 9;
+use Parrot::Test tests => 10;
pir_output_is(<< 'CODE', << 'OUTPUT', "basic math");
@@ -278,3 +279,30 @@
0
1
OUTPUT
+
+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
+ branch OK2
+BAD2: print "not "
+OK2: print "ok 2\n"
+ set P0, 0
+ 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
+
1.24 +183 -2 parrot/t/pmc/perlint.t
Index: perlint.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/perlint.t,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- perlint.t 22 Mar 2005 13:02:11 -0000 1.23
+++ perlint.t 23 Mar 2005 15:57:04 -0000 1.24
@@ -1,6 +1,7 @@
#! perl -w
+
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: perlint.t,v 1.23 2005/03/22 13:02:11 leo Exp $
+# $Id: perlint.t,v 1.24 2005/03/23 15:57:04 leo Exp $
=head1 NAME
@@ -16,7 +17,7 @@
=cut
-use Parrot::Test tests => 60;
+use Parrot::Test tests => 70;
use Parrot::PMC '%pmc_types';
my $perlint = $pmc_types{'PerlInt'};
my $ok = '"ok 1\n"';
@@ -155,6 +156,166 @@
123
OUTPUT
+output_is(<<CODE, <<OUTPUT, "if (P) - Int");
+ new P0, .PerlInt
+
+ set P0, 1
+ if P0, OK1
+ print "not "
+OK1: print "ok 1\\n"
+
+ set P0, 0
+ if P0, BAD2
+ branch OK2
+BAD2: print "not "
+OK2: print "ok 2\\n"
+
+ end
+CODE
+ok 1
+ok 2
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "unless (P) - Int");
+ new P0, .PerlInt
+
+ set P0, 0
+ unless P0, OK1
+ print "not "
+OK1: print "ok 1\\n"
+
+ set P0, 1
+ unless P0, BAD2
+ branch OK2
+BAD2: print "not "
+OK2: print "ok 2\\n"
+
+ end
+CODE
+ok 1
+ok 2
+OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "inc, PerlInt");
+ new P3, .PerlInt
+ set P3, 0
+ inc P3
+ print P3
+ print "\n"
+
+LP: inc P3
+ set I3, P3
+ lt I3, 1000, LP
+ print P3
+ print "\n"
+
+ end
+CODE
+1
+1000
+OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "dec, PerlInt");
+ new P3, .PerlInt
+ set P3, 0
+ dec P3
+ print P3
+ print "\n"
+
+LP: dec P3
+ set I3, P3
+ gt I3, -2000, LP
+ print P3
+ print "\n"
+
+ end
+CODE
+-1
+-2000
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "mul_p_p, PerlInt");
[EMAIL PROTECTED] $fp_equality_macro ]}
+ new P0,.PerlInt
+ new P1,.PerlInt
+ set P0,8
+ set P1,2
+ mul P0,P1
+ .fp_eq(P0,16,EQ1)
+ print "not "
+EQ1: print "ok 1"
+ print "\\n"
+
+ new P2, .PerlNum
+ set P2, 0.0625
+ mul P0, P2
+ .fp_eq(P0,1,EQ2)
+ print "not "
+EQ2: print "ok 2"
+ print "\\n"
+ end
+CODE
+ok 1
+ok 2
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "mul_p_i, PerlInt");
[EMAIL PROTECTED] $fp_equality_macro ]}
+ new P0,.PerlInt
+ set P0,8
+ mul P0,2
+ .fp_eq(P0,16,EQ1)
+ print "not "
+EQ1: print "ok 1"
+ print "\\n"
+ end
+CODE
+ok 1
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "div_p_i, PerlInt");
[EMAIL PROTECTED] $fp_equality_macro ]}
+ new P0,.PerlInt
+ set P0,8
+ div P0,2
+ .fp_eq(P0,4,EQ1)
+ print "not "
+EQ1: print "ok 1"
+ print "\\n"
+ end
+CODE
+ok 1
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "mod_p_i, PerlInt");
[EMAIL PROTECTED] $fp_equality_macro ]}
+ new P0,.PerlInt
+ set P0,3
+ mod P0,6
+ .fp_eq(P0,3,EQ1)
+ print "not "
+EQ1: print "ok 1"
+ print "\\n"
+ end
+CODE
+ok 1
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "mod_p_p_i, PerlInt");
[EMAIL PROTECTED] $fp_equality_macro ]}
+ new P0,.PerlInt
+ set P0,7
+ new P1,.PerlInt
+ mod P1, P0, 6
+ .fp_eq(P1,1,EQ1)
+ print "not "
+EQ1: print "ok 1"
+ print "\\n"
+ end
+CODE
+ok 1
+OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "bor");
new P0, .PerlInt
set P0, 0b11110000
@@ -287,8 +448,28 @@
100
OUTPUT
+output_is(<<'CODE', <<'OUTPUT', "bnot");
+ new P0, .PerlUndef
+# We use band in these tests to null out the high bits, and make the
+# tests independent of the size of our INTVALs
+ bnot P0, P0
+ band P0, 0b01010101
+ print P0
+ print "\n"
+ new P0, .PerlUndef
+ new P1, .PerlInt
+ set P1, 0b01100110
+ bnot P0, P1
+ band P0, 0b10011001
+ print P0
+ print "\n"
+ end
+CODE
+85
+153
+OUTPUT
output_is(<<'CODE', <<'OUTPUT', "bnot");
new P0, .PerlInt
1.14 +111 -2 parrot/t/pmc/perlnum.t
Index: perlnum.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/perlnum.t,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- perlnum.t 22 Mar 2005 13:02:11 -0000 1.13
+++ perlnum.t 23 Mar 2005 15:57:04 -0000 1.14
@@ -1,6 +1,7 @@
#! perl -w
+
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: perlnum.t,v 1.13 2005/03/22 13:02:11 leo Exp $
+# $Id: perlnum.t,v 1.14 2005/03/23 15:57:04 leo Exp $
=head1 NAME
@@ -16,7 +17,7 @@
=cut
-use Parrot::Test tests => 49;
+use Parrot::Test tests => 54;
my $fp_equality_macro = <<'ENDOFMACRO';
.macro fp_eq ( J, K, L )
@@ -147,6 +148,114 @@
ok 4
OUTPUT
+output_is(<<CODE, <<OUTPUT, "if (P) - Num");
+ new P0, .PerlNum
+
+ set P0, 1.1
+ if P0, OK1
+ print "not "
+OK1: print "ok 1\\n"
+
+ set P0, 0.0
+ if P0, BAD2
+ branch OK2
+BAD2: print "not "
+OK2: print "ok 2\\n"
+
+ end
+CODE
+ok 1
+ok 2
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "unless (P) - Num");
+ new P0, .PerlNum
+
+ set P0, 0.0
+ unless P0, OK1
+ print "not "
+OK1: print "ok 1\\n"
+
+ set P0, 1.1
+ unless P0, BAD2
+ branch OK2
+BAD2: print "not "
+OK2: print "ok 2\\n"
+
+ end
+CODE
+ok 1
+ok 2
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "inc, PerlNum");
[EMAIL PROTECTED] $fp_equality_macro ]}
+ new P3, .PerlNum
+
+ set P3, -0.999
+ inc P3
+ .fp_eq(P3, 0.001, OK1)
+ print "not "
+OK1: print "ok 1\\n"
+
+ inc P3
+ .fp_eq(P3, 1.001, OK2)
+ print "not "
+OK2: print "ok 2\\n"
+
+ end
+CODE
+ok 1
+ok 2
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "dec, PerlNum");
[EMAIL PROTECTED] $fp_equality_macro ]}
+ new P3, .PerlNum
+
+ set P3, 1.001
+ dec P3
+ .fp_eq(P3, 0.001, OK1)
+ print "not "
+OK1: print "ok 1\\n"
+
+ dec P3
+ .fp_eq(P3, -0.999, OK2)
+ print "not "
+OK2: print "ok 2\\n"
+
+ end
+CODE
+ok 1
+ok 2
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "mul_p_p, PerlNum");
[EMAIL PROTECTED] $fp_equality_macro ]}
+ new P0,.PerlNum
+ new P1,.PerlNum
+ set P0,-2.5
+ set P1,2.5
+ mul P0,P1
+ .fp_eq(P0,-6.25,EQ1)
+ print "not "
+EQ1: print "ok 1"
+ print "\\n"
+
+ new P2, .PerlInt
+ set P2, 2
+ mul P0, P2
+ .fp_eq(P0,-12.5,EQ2)
+ print "not "
+EQ2: print "ok 2"
+ print "\\n"
+
+ end
+CODE
+ok 1
+ok 2
+OUTPUT
+
output_is(<<"CODE", <<OUTPUT, "add number to string integer");
@{[ $fp_equality_macro ]}
new P0, .PerlNum
1.37 +112 -3 parrot/t/pmc/perlstring.t
Index: perlstring.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/perlstring.t,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -r1.36 -r1.37
--- perlstring.t 22 Mar 2005 13:02:11 -0000 1.36
+++ perlstring.t 23 Mar 2005 15:57:04 -0000 1.37
@@ -1,6 +1,7 @@
#! perl -w
-# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: perlstring.t,v 1.36 2005/03/22 13:02:11 leo Exp $
+
+# Copyright: 2001-2005 The Perl Foundation. All Rights Reserved.
+# $Id: perlstring.t,v 1.37 2005/03/23 15:57:04 leo Exp $
=head1 NAME
@@ -16,7 +17,7 @@
=cut
-use Parrot::Test tests => 65;
+use Parrot::Test tests => 68;
use Test::More; # Included for skip().
my $fp_equality_macro = <<'ENDOFMACRO';
@@ -367,6 +368,89 @@
C2H5OH + 10H20
OUTPUT
+output_is(<<CODE, <<OUTPUT, "if (P) - String");
+ new P0, .PerlString
+
+ set P0, "I've told you once, I've told you twice..."
+ if P0, OK1
+ print "not "
+OK1: print "ok 1\\n"
+
+ set P0, "0.0"
+ if P0, OK2
+ print "not "
+OK2: print "ok 2\\n"
+
+ set P0, ""
+ if P0, BAD3
+ branch OK3
+BAD3: print "not "
+OK3: print "ok 3\\n"
+
+ set P0, "0"
+ if P0, BAD4
+ branch OK4
+BAD4: print "not "
+OK4: print "ok 4\\n"
+
+ set P0, "0e0"
+ if P0, OK5
+ print "not "
+OK5: print "ok 5\\n"
+
+ set P0, "x"
+ if P0, OK6
+ print "not "
+OK6: print "ok 6\\n"
+
+ set P0, "\\x0"
+ if P0, OK7
+ print "not "
+OK7: print "ok 7\\n"
+
+ set P0, "\\n"
+ if P0, OK8
+ print "not "
+OK8: print "ok 8\\n"
+
+ set P0, " "
+ if P0, OK9
+ print "not "
+OK9: print "ok 9\\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+ok 5
+ok 6
+ok 7
+ok 8
+ok 9
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "unless (P) - String");
+ new P0, .PerlString
+
+ set P0, "0"
+ unless P0, OK1
+ print "not"
+OK1: print "ok 1\\n"
+
+ set P0, "1"
+ unless P0, BAD2
+ branch OK2
+BAD2: print "not "
+OK2: print "ok 2\\n"
+
+ end
+CODE
+ok 1
+ok 2
+OUTPUT
+
#
# Basic string number conversion
#
@@ -1205,6 +1289,31 @@
0
OUTPUT
+output_is(<<'CODE', <<OUTPUT, "repeat");
+ new P0, .PerlUndef
+ new P1, .PerlString
+ new P2, .PerlInt
+
+ set P2, 1024
+ repeat P1, P0, P2
+ set S1, P1
+ eq S1, "", OK1
+ print "not "
+OK1: print "ok 1\n"
+
+ new P0, .PerlUndef
+ new P1, .PerlString
+ repeat P1, P0, 1024
+ set S1, P1
+ eq S1, "", OK2
+ print "not "
+OK2: print "ok 2\n"
+ end
+CODE
+ok 1
+ok 2
+OUTPUT
+
output_is(<<'CODE', <<OUTPUT, "substr");
new P0, .PerlString
set P0, "This is a test\n"
1.103 +3 -769 parrot/t/pmc/pmc.t
Index: pmc.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/pmc.t,v
retrieving revision 1.102
retrieving revision 1.103
diff -u -r1.102 -r1.103
--- pmc.t 22 Mar 2005 13:02:11 -0000 1.102
+++ pmc.t 23 Mar 2005 15:57:04 -0000 1.103
@@ -1,7 +1,7 @@
#! perl -w
-# Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
-# $Id: pmc.t,v 1.102 2005/03/22 13:02:11 leo Exp $
+# Copyright: 2001-2005 The Perl Foundation. All Rights Reserved.
+# $Id: pmc.t,v 1.103 2005/03/23 15:57:04 leo Exp $
=head1 NAME
@@ -17,7 +17,7 @@
=cut
-use Parrot::Test tests => 51;
+use Parrot::Test tests => 20;
use Test::More;
use Parrot::PMC qw(%pmc_types);
my $max_pmc = scalar(keys(%pmc_types)) + 1;
@@ -89,357 +89,6 @@
Illegal PMC enum ($max_pmc) in new
OUTPUT
-output_is(<<CODE, <<OUTPUT, "if (P) - Int");
- new P0, .PerlInt
-
- set P0, 1
- if P0, OK1
- print "not "
-OK1: print "ok 1\\n"
-
- set P0, 0
- if P0, BAD2
- branch OK2
-BAD2: print "not "
-OK2: print "ok 2\\n"
-
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-output_is(<<CODE, <<OUTPUT, "unless (P) - Int");
- new P0, .PerlInt
-
- set P0, 0
- unless P0, OK1
- print "not "
-OK1: print "ok 1\\n"
-
- set P0, 1
- unless P0, BAD2
- branch OK2
-BAD2: print "not "
-OK2: print "ok 2\\n"
-
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-output_is(<<CODE, <<OUTPUT, "if (P) - Num");
- new P0, .PerlNum
-
- set P0, 1.1
- if P0, OK1
- print "not "
-OK1: print "ok 1\\n"
-
- set P0, 0.0
- if P0, BAD2
- branch OK2
-BAD2: print "not "
-OK2: print "ok 2\\n"
-
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-output_is(<<CODE, <<OUTPUT, "unless (P) - Num");
- new P0, .PerlNum
-
- set P0, 0.0
- unless P0, OK1
- print "not "
-OK1: print "ok 1\\n"
-
- set P0, 1.1
- unless P0, BAD2
- branch OK2
-BAD2: print "not "
-OK2: print "ok 2\\n"
-
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-output_is(<<CODE, <<OUTPUT, "if (P) - String");
- new P0, .PerlString
-
- set P0, "I've told you once, I've told you twice..."
- if P0, OK1
- print "not "
-OK1: print "ok 1\\n"
-
- set P0, "0.0"
- if P0, OK2
- print "not "
-OK2: print "ok 2\\n"
-
- set P0, ""
- if P0, BAD3
- branch OK3
-BAD3: print "not "
-OK3: print "ok 3\\n"
-
- set P0, "0"
- if P0, BAD4
- branch OK4
-BAD4: print "not "
-OK4: print "ok 4\\n"
-
- set P0, "0e0"
- if P0, OK5
- print "not "
-OK5: print "ok 5\\n"
-
- set P0, "x"
- if P0, OK6
- print "not "
-OK6: print "ok 6\\n"
-
- set P0, "\\x0"
- if P0, OK7
- print "not "
-OK7: print "ok 7\\n"
-
- set P0, "\\n"
- if P0, OK8
- print "not "
-OK8: print "ok 8\\n"
-
- set P0, " "
- if P0, OK9
- print "not "
-OK9: print "ok 9\\n"
-
- end
-CODE
-ok 1
-ok 2
-ok 3
-ok 4
-ok 5
-ok 6
-ok 7
-ok 8
-ok 9
-OUTPUT
-
-output_is(<<CODE, <<OUTPUT, "unless (P) - String");
- new P0, .PerlString
-
- set P0, "0"
- unless P0, OK1
- print "not"
-OK1: print "ok 1\\n"
-
- set P0, "1"
- unless P0, BAD2
- branch OK2
-BAD2: print "not "
-OK2: print "ok 2\\n"
-
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-output_is(<<"CODE", <<'OUTPUT', "undef-logical");
- new P0, .PerlInt
- new P1, .PerlUndef
- new P2, .PerlInt
-
-# undef or undef = 0
- or P0, P1, P1
- print P0
- print "a"
-
-# undef and undef = 0
- and P0, P1, P1
- print P0
- print "b"
-
-#undef xor undef = "0"
- xor P0, P1, P1
- print P0
- print "c"
-
-# undef or foo = foo
- set P2, 349
- or P0, P1, P2
- print P0
-
-# undef and foo = undef
- and P0, P1, P2
- print P0
- print "c"
-
-#undef xor foo = foo
- set P2, 910
- xor P0, P1, P2
- print P0
-
-# not undef = 1
- not P0, P1
- print "x"
- print P1
- print "y"
- print P0
- print "z"
- print "\\n"
- end
-CODE
-ab0c349c910xy1z
-OUTPUT
-
-output_is(<<"CODE", <<'OUTPUT', "undef-add");
[EMAIL PROTECTED] $fp_equality_macro ]}
- new P1, .PerlUndef
-
-# undef + perlundef
- new P0, .PerlUndef
- add P0, P1, P1
- print P0
- print "\\n"
-
-# undef + perlint
-
- new P0, .PerlUndef
- new P2, .PerlInt
- set P2, 947
- add P0, P1, P2
- print P0
- print "\\n"
-
-# undef + perlnum
-
- new P0, .PerlUndef
- new P2, .PerlNum
- set P2, 385.623
- add P0, P1, P2
- .fp_eq( P0, 385.623, OK)
-
- print "not"
-OK: print "ok"
- print "\\n"
-
- end
-CODE
-0
-947
-ok
-OUTPUT
-
-output_is(<<"CODE", <<'OUTPUT', "undef-subtract");
[EMAIL PROTECTED] $fp_equality_macro ]}
- new P0, .PerlInt
- new P1, .PerlUndef
-
-# undef - undef
- sub P0, P1, P1
- print P0
- print "\\n"
-
-# undef - perlint
- new P2, .PerlInt
- set P2, 947
- sub P0, P1, P2
- print P0
- print "\\n"
-
-# undef - perlnum
-
- new P2, .PerlNum
- set P2, 385.623
- sub P0, P1, P2
- .fp_eq( P0, -385.623, OK2)
-
- print "not"
-OK2: print "ok"
- print "\\n"
-
- end
-CODE
-0
--947
-ok
-OUTPUT
-
-output_is(<<"CODE", <<'OUTPUT', "undef-multiply");
[EMAIL PROTECTED] $fp_equality_macro ]}
-
- new P0, .PerlInt
- new P1, .PerlUndef
- new P2, .PerlInt
-
-# Undef * Undef
- mul P0, P1, P1
- print P0
- print "\\n"
-
-# Undef * PerlInt
- set P2, 983
- mul P0, P1, P2
- print P0
- print "\\n"
-
-# Undef * PerlNum
- new P2, .PerlNum
- set P2, 983.3
- mul P0, P1, P2
- print P0
- print "\\n"
-
- end
-CODE
-0
-0
-0
-OUTPUT
-
-output_is(<<"CODE", <<'OUTPUT', "undef-divide");
- new P0, .PerlInt
- new P1, .PerlUndef
- new P2, .PerlInt
-
-# Undef / PerlInt
- set P2, 19
- div P0, P1, P2
- print P0
- print "\\n"
-
-# Undef / PerlNum
- new P2, .PerlNum
- set P2, 343.8
- div P0, P1, P2
- print P0
- print "\\n"
-
- end
-CODE
-0
-0
-OUTPUT
-
-output_is(<<"CODE", <<'OUTPUT', "undef-string");
- new P0, .PerlUndef
- set S0, P0
- eq S0, "", OK
- print "not "
-OK: print "ok\\n"
- end
-CODE
-ok
-OUTPUT
-
output_is(<<CODE, <<OUTPUT, "typeof");
new P0,.PerlInt
typeof S0,P0
@@ -458,194 +107,6 @@
ok 2
OUTPUT
-output_is(<<'CODE', <<OUTPUT, "inc, PerlInt");
- new P3, .PerlInt
- set P3, 0
- inc P3
- print P3
- print "\n"
-
-LP: inc P3
- set I3, P3
- lt I3, 1000, LP
- print P3
- print "\n"
-
- end
-CODE
-1
-1000
-OUTPUT
-
-output_is(<<"CODE", <<OUTPUT, "inc, PerlNum");
[EMAIL PROTECTED] $fp_equality_macro ]}
- new P3, .PerlNum
-
- set P3, -0.999
- inc P3
- .fp_eq(P3, 0.001, OK1)
- print "not "
-OK1: print "ok 1\\n"
-
- inc P3
- .fp_eq(P3, 1.001, OK2)
- print "not "
-OK2: print "ok 2\\n"
-
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-output_is(<<'CODE', <<OUTPUT, "dec, PerlInt");
- new P3, .PerlInt
- set P3, 0
- dec P3
- print P3
- print "\n"
-
-LP: dec P3
- set I3, P3
- gt I3, -2000, LP
- print P3
- print "\n"
-
- end
-CODE
--1
--2000
-OUTPUT
-
-output_is(<<"CODE", <<OUTPUT, "dec, PerlNum");
[EMAIL PROTECTED] $fp_equality_macro ]}
- new P3, .PerlNum
-
- set P3, 1.001
- dec P3
- .fp_eq(P3, 0.001, OK1)
- print "not "
-OK1: print "ok 1\\n"
-
- dec P3
- .fp_eq(P3, -0.999, OK2)
- print "not "
-OK2: print "ok 2\\n"
-
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-output_is(<<CODE, <<OUTPUT, "mul_p_p, PerlInt");
[EMAIL PROTECTED] $fp_equality_macro ]}
- new P0,.PerlInt
- new P1,.PerlInt
- set P0,8
- set P1,2
- mul P0,P1
- .fp_eq(P0,16,EQ1)
- print "not "
-EQ1: print "ok 1"
- print "\\n"
-
- new P2, .PerlNum
- set P2, 0.0625
- mul P0, P2
- .fp_eq(P0,1,EQ2)
- print "not "
-EQ2: print "ok 2"
- print "\\n"
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-output_is(<<CODE, <<OUTPUT, "mul_p_p, PerlNum");
[EMAIL PROTECTED] $fp_equality_macro ]}
- new P0,.PerlNum
- new P1,.PerlNum
- set P0,-2.5
- set P1,2.5
- mul P0,P1
- .fp_eq(P0,-6.25,EQ1)
- print "not "
-EQ1: print "ok 1"
- print "\\n"
-
- new P2, .PerlInt
- set P2, 2
- mul P0, P2
- .fp_eq(P0,-12.5,EQ2)
- print "not "
-EQ2: print "ok 2"
- print "\\n"
-
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-output_is(<<CODE, <<OUTPUT, "mul_p_i, PerlInt");
[EMAIL PROTECTED] $fp_equality_macro ]}
- new P0,.PerlInt
- set P0,8
- mul P0,2
- .fp_eq(P0,16,EQ1)
- print "not "
-EQ1: print "ok 1"
- print "\\n"
- end
-CODE
-ok 1
-OUTPUT
-
-output_is(<<CODE, <<OUTPUT, "div_p_i, PerlInt");
[EMAIL PROTECTED] $fp_equality_macro ]}
- new P0,.PerlInt
- set P0,8
- div P0,2
- .fp_eq(P0,4,EQ1)
- print "not "
-EQ1: print "ok 1"
- print "\\n"
- end
-CODE
-ok 1
-OUTPUT
-
-output_is(<<CODE, <<OUTPUT, "mod_p_i, PerlInt");
[EMAIL PROTECTED] $fp_equality_macro ]}
- new P0,.PerlInt
- set P0,3
- mod P0,6
- .fp_eq(P0,3,EQ1)
- print "not "
-EQ1: print "ok 1"
- print "\\n"
- end
-CODE
-ok 1
-OUTPUT
-
-output_is(<<CODE, <<OUTPUT, "mod_p_p_i, PerlInt");
[EMAIL PROTECTED] $fp_equality_macro ]}
- new P0,.PerlInt
- set P0,7
- new P1,.PerlInt
- mod P1, P0, 6
- .fp_eq(P1,1,EQ1)
- print "not "
-EQ1: print "ok 1"
- print "\\n"
- end
-CODE
-ok 1
-OUTPUT
-
my $checkTypes;
while (my ($type, $id) = each %pmc_types) {
next if $type eq "Null";
@@ -839,86 +300,6 @@
ok 6
OUTPUT
-output_is(<<'CODE', <<OUTPUT, "arithmetic with PerlUndef and native ints");
- new P0, .PerlUndef
- add P0, 10
- set I1, P0
- print I1
- print "\n"
-
- new P0, .PerlUndef
- sub P0, 20
- set I1, P0
- print I1
- print "\n"
-
- new P0, .PerlUndef
- mul P0, 30
- set I1, P0
- print I1
- print "\n"
-
- new P0, .PerlUndef
- div P0, 40
- set I1, P0
- print I1
- print "\n"
- end
-CODE
-10
--20
-0
-0
-OUTPUT
-
-output_is(<<"CODE", <<OUTPUT, "arithmetic with PerlUndef and native floats");
[EMAIL PROTECTED] $fp_equality_macro ]}
- new P0, .PerlUndef
- add P0, 10.0
- set N1, P0
- .fp_ne(N1, 10.0, ERROR)
- print "ok 1\\n"
-
- new P0, .PerlUndef
- sub P0, 2.345
- set N1, P0
- .fp_ne(N1, -2.345, ERROR)
- print "ok 2\\n"
-
- new P0, .PerlUndef
- mul P0, 32.5
- set N1, P0
- .fp_ne(N1, 0.000, ERROR)
- print "ok 3\\n"
-
- new P0, .PerlUndef
- div P0, 0.5
- set N1, P0
- .fp_ne(N1, 0.000, ERROR)
- print "ok 4\\n"
- branch DONE
-ERROR: print "not ok\\n"
- print N1
-DONE:
- end
-CODE
-ok 1
-ok 2
-ok 3
-ok 4
-OUTPUT
-
-output_like(<<"CODE", <<'OUTPUT', "undef warning");
- .include "warnings.pasm"
- warningson .PARROT_WARNINGS_UNDEF_FLAG
- new P0, .PerlUndef
- print P0
- end
-CODE
-/Use of uninitialized.*
-\s+in file .*pasm/i
-OUTPUT
-
output_like(<<"CODE", <<'OUTPUT', "find_method");
new P1, .PerlInt
find_method P0, P1, "no_such_meth"
@@ -935,49 +316,6 @@
/(unknown macro|unexpected DOT)/
OUTPUT
-output_is(<<'CODE', <<OUTPUT, "repeat");
- new P0, .PerlUndef
- new P1, .PerlString
- new P2, .PerlInt
-
- set P2, 1024
- repeat P1, P0, P2
- set S1, P1
- eq S1, "", OK1
- print "not "
-OK1: print "ok 1\n"
-
- new P0, .PerlUndef
- new P1, .PerlString
- repeat P1, P0, 1024
- set S1, P1
- eq S1, "", OK2
- print "not "
-OK2: print "ok 2\n"
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-output_is(<<'CODE', <<'OUTPUT', "bor undef");
- new P0, .PerlUndef
- bor P0, 0b00001111
- print P0
- print "\n"
-
- new P0, .PerlUndef
- new P1, .PerlInt
- set P1, 0b11110000
- bor P0, P1
- print P0
- print "\n"
- end
-CODE
-15
-240
-OUTPUT
-
output_is(<<'CODE', <<'OUTPUT', "bxor undef");
new P0, .PerlUndef
bxor P0, 0b00001111
@@ -1014,55 +352,6 @@
0
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "bnot");
- new P0, .PerlUndef
-
-# We use band in these tests to null out the high bits, and make the
-# tests independent of the size of our INTVALs
- bnot P0, P0
- band P0, 0b01010101
- print P0
- print "\n"
-
- new P0, .PerlUndef
- new P1, .PerlInt
- set P1, 0b01100110
- bnot P0, P1
- band P0, 0b10011001
- print P0
- print "\n"
- end
-CODE
-85
-153
-OUTPUT
-
-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
- branch OK2
-BAD2: print "not "
-OK2: print "ok 2\n"
- set P0, 0
- 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
-
output_is(<<'CODE', <<'OUTPUT', "eq_addr same");
new P0, .Integer
set P1, P0
@@ -1122,61 +411,6 @@
ok
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "rand int");
- new P0, .Random
- time I1
- set P0, I1 # seed
- set I0, P0
- set I1, P0
- ne I0, I1, ok1
- print "not "
-ok1:print "ok 1\n"
- set I2, P0[100]
- ne I0, I2, ok2
- print "not "
-ok2:print "ok 2\n"
- ge I2, 0, ok3
- print "not "
-ok3:print "ok 3\n"
- lt I2, 100, ok4
- print "not "
-ok4:print "ok 4\n"
- end
-CODE
-ok 1
-ok 2
-ok 3
-ok 4
-OUTPUT
-
-output_is(<<'CODE', <<'OUTPUT', "rand float");
- new P0, .Random
- set N0, P0
- set N1, P0
- ne N0, N1, ok1
- print "not "
-ok1:print "ok 1\n"
- ge N0, 0, ok2
- print "not "
-ok2:print "ok 2\n"
- lt N0, 1.0, ok3
- print "not "
-ok3:print "ok 3\n"
- ge N1, 0, ok4
- print "not "
-ok4:print "ok 4\n"
- lt N1, 1.0, ok5
- print "not "
-ok5:print "ok 5\n"
- end
-CODE
-ok 1
-ok 2
-ok 3
-ok 4
-ok 5
-OUTPUT
-
output_is(<<'CODE', <<'OUTPUT', "issame");
new P0, .Undef
new P1, .Undef
1.1 parrot/t/pmc/perlundef.t
Index: perlundef.t
===================================================================
#! perl -w
# Copyright: 2001-2005 The Perl Foundation. All Rights Reserved.
# $Id: perlundef.t,v 1.1 2005/03/23 15:57:04 leo Exp $
=head1 NAME
t/pmc/perlundef.t - Perl Undefs
=head1 SYNOPSIS
% perl -Ilib t/pmc/perlundef.t
=head1 DESCRIPTION
Tests the C<PerlUndef> PMC. Checks Perl-specific undef behaviour.
=cut
use Parrot::Test tests => 10;
my $fp_equality_macro = <<'ENDOFMACRO';
.macro fp_eq ( J, K, L )
save N0
save N1
save N2
set N0, .J
set N1, .K
sub N2, N1,N0
abs N2, N2
gt N2, 0.000001, .$FPEQNOK
restore N2
restore N1
restore N0
branch .L
.local $FPEQNOK:
restore N2
restore N1
restore N0
.endm
.macro fp_ne( J,K,L)
save N0
save N1
save N2
set N0, .J
set N1, .K
sub N2, N1,N0
abs N2, N2
lt N2, 0.000001, .$FPNENOK
restore N2
restore N1
restore N0
branch .L
.local $FPNENOK:
restore N2
restore N1
restore N0
.endm
ENDOFMACRO
output_is(<<"CODE", <<'OUTPUT', "undef-logical");
new P0, .PerlInt
new P1, .PerlUndef
new P2, .PerlInt
# undef or undef = 0
or P0, P1, P1
print P0
print "a"
# undef and undef = 0
and P0, P1, P1
print P0
print "b"
#undef xor undef = "0"
xor P0, P1, P1
print P0
print "c"
# undef or foo = foo
set P2, 349
or P0, P1, P2
print P0
# undef and foo = undef
and P0, P1, P2
print P0
print "c"
#undef xor foo = foo
set P2, 910
xor P0, P1, P2
print P0
# not undef = 1
not P0, P1
print "x"
print P1
print "y"
print P0
print "z"
print "\\n"
end
CODE
ab0c349c910xy1z
OUTPUT
output_is(<<"CODE", <<'OUTPUT', "undef-add");
@{[ $fp_equality_macro ]}
new P1, .PerlUndef
# undef + perlundef
new P0, .PerlUndef
add P0, P1, P1
print P0
print "\\n"
# undef + perlint
new P0, .PerlUndef
new P2, .PerlInt
set P2, 947
add P0, P1, P2
print P0
print "\\n"
# undef + perlnum
new P0, .PerlUndef
new P2, .PerlNum
set P2, 385.623
add P0, P1, P2
.fp_eq( P0, 385.623, OK)
print "not"
OK: print "ok"
print "\\n"
end
CODE
0
947
ok
OUTPUT
output_is(<<"CODE", <<'OUTPUT', "undef-subtract");
@{[ $fp_equality_macro ]}
new P0, .PerlInt
new P1, .PerlUndef
# undef - undef
sub P0, P1, P1
print P0
print "\\n"
# undef - perlint
new P2, .PerlInt
set P2, 947
sub P0, P1, P2
print P0
print "\\n"
# undef - perlnum
new P2, .PerlNum
set P2, 385.623
sub P0, P1, P2
.fp_eq( P0, -385.623, OK2)
print "not"
OK2: print "ok"
print "\\n"
end
CODE
0
-947
ok
OUTPUT
output_is(<<"CODE", <<'OUTPUT', "undef-multiply");
@{[ $fp_equality_macro ]}
new P0, .PerlInt
new P1, .PerlUndef
new P2, .PerlInt
# Undef * Undef
mul P0, P1, P1
print P0
print "\\n"
# Undef * PerlInt
set P2, 983
mul P0, P1, P2
print P0
print "\\n"
# Undef * PerlNum
new P2, .PerlNum
set P2, 983.3
mul P0, P1, P2
print P0
print "\\n"
end
CODE
0
0
0
OUTPUT
output_is(<<"CODE", <<'OUTPUT', "undef-divide");
new P0, .PerlInt
new P1, .PerlUndef
new P2, .PerlInt
# Undef / PerlInt
set P2, 19
div P0, P1, P2
print P0
print "\\n"
# Undef / PerlNum
new P2, .PerlNum
set P2, 343.8
div P0, P1, P2
print P0
print "\\n"
end
CODE
0
0
OUTPUT
output_is(<<"CODE", <<'OUTPUT', "undef-string");
new P0, .PerlUndef
set S0, P0
eq S0, "", OK
print "not "
OK: print "ok\\n"
end
CODE
ok
OUTPUT
output_is(<<'CODE', <<OUTPUT, "arithmetic with PerlUndef and native ints");
new P0, .PerlUndef
add P0, 10
set I1, P0
print I1
print "\n"
new P0, .PerlUndef
sub P0, 20
set I1, P0
print I1
print "\n"
new P0, .PerlUndef
mul P0, 30
set I1, P0
print I1
print "\n"
new P0, .PerlUndef
div P0, 40
set I1, P0
print I1
print "\n"
end
CODE
10
-20
0
0
OUTPUT
output_is(<<"CODE", <<OUTPUT, "arithmetic with PerlUndef and native floats");
@{[ $fp_equality_macro ]}
new P0, .PerlUndef
add P0, 10.0
set N1, P0
.fp_ne(N1, 10.0, ERROR)
print "ok 1\\n"
new P0, .PerlUndef
sub P0, 2.345
set N1, P0
.fp_ne(N1, -2.345, ERROR)
print "ok 2\\n"
new P0, .PerlUndef
mul P0, 32.5
set N1, P0
.fp_ne(N1, 0.000, ERROR)
print "ok 3\\n"
new P0, .PerlUndef
div P0, 0.5
set N1, P0
.fp_ne(N1, 0.000, ERROR)
print "ok 4\\n"
branch DONE
ERROR: print "not ok\\n"
print N1
DONE:
end
CODE
ok 1
ok 2
ok 3
ok 4
OUTPUT
output_like(<<"CODE", <<'OUTPUT', "undef warning");
.include "warnings.pasm"
warningson .PARROT_WARNINGS_UNDEF_FLAG
new P0, .PerlUndef
print P0
end
CODE
/Use of uninitialized.*
\s+in file .*pasm/i
OUTPUT
output_is(<<'CODE', <<'OUTPUT', "bor undef");
new P0, .PerlUndef
bor P0, 0b00001111
print P0
print "\n"
new P0, .PerlUndef
new P1, .PerlInt
set P1, 0b11110000
bor P0, P1
print P0
print "\n"
end
CODE
15
240
OUTPUT
