On Sun, 20 Jun 2004, Ion Alexandru Morega wrote:
Dan Sugalski wrote:
I checked in more of PDD 17, detailing parrot's base types. Some of those types definitely don't exist (like, say, the string and bignum type...) and could definitely use implementing. Should be fairly straightforward, and would be a good way to get up to speed on writing PMC classes.
Hello, i'm new to this list and to parrot programming, so i decided to start with something simple. I implemented a String PMC that is pretty much complete, it compiles, but i haven't tested it yet. It would be great if someone had a look at it, and later when i write some tests i'll check in a patch. The .pmc is attached.
Sorry this one sat so long. (Piers reminded me with the summary) I checked in the PMC. Tests would be cool, to be sure. :)
Thanks much.
Actually Leo answered pretty quickly, and then you did too... but why split hairs? :)
In the mean time i fixed some things that were wrong, added a few functions and the tests. I found some weird things while doing this, probably bugs. So here's the patch i promised.
The function string_make() in src/string.c reads in the documentation: "the the string reperesentation will default to enum_stringrep_unknown". This doesn't happen. I changed a line in classes/undef.pmc which used this.
As i understand, the default implementation for the function is_equal_str() in a PMC is to fall back to is_equal(). This works OK. But when i actually tried to implement is_equal_str(), it turns out the return condition is used backwards (true means false :). BTW i didn't find any documentation for is_equal_str(), it was generated by genclass.pl. I commented out my implementation of is_equal_str() and the tests pass now... it's still there if anyone wants to play with it.
Now back to the String class. I should say that much of the code was inspired by PerlString, and the tests, well, i just took them from perlstring.t. There's still some original code there tough :)
Leo suggested to subclass PerlString from String, but it's already subclassed from PerlScalar, do PMC's have multiple inheritance?
And a noob question: what does the $Id: line at the top of each file do? Is it generated or do I have to uptade it myself?
alexm
diff -ruN parrot/MANIFEST my_parrot/MANIFEST
--- parrot/MANIFEST 2004-06-23 18:00:09.000000000 +0300
+++ my_parrot/MANIFEST 2004-06-23 21:35:26.000000000 +0300
@@ -94,6 +94,7 @@
classes/scratchpad.pmc []
classes/sharedref.pmc []
classes/slice.pmc []
+classes/string.pmc []
classes/stringarray.pmc []
classes/sub.pmc []
classes/timer.pmc []
@@ -2749,6 +2750,7 @@
t/pmc/sarray.t []
t/pmc/scratchpad.t []
t/pmc/signal.t []
+t/pmc/string.t []
t/pmc/sub.t []
t/pmc/sys.t []
t/pmc/threads.t []
diff -ruN parrot/classes/string.pmc my_parrot/classes/string.pmc
--- parrot/classes/string.pmc 1970-01-01 02:00:00.000000000 +0200
+++ my_parrot/classes/string.pmc 2004-06-23 21:31:07.000000000 +0300
@@ -0,0 +1,668 @@
+/*
+Copyright: 2003 The Perl Foundation. All Rights Reserved.
+$Id: string.pmc,v 1.0 2004/06/21 20:31:57 alexm Exp $
+
+=head1 NAME
+
+classes/string.pmc - String PMC Class
+
+=head1 DESCRIPTION
+
+C<String> extends C<mmd_default> to provide a string for languages
+that want a C<string> type without going to an S register. Acts as a
+wrapper for the functions in /src/string.c
+
+=head2 Methods
+
+=over 4
+
+=cut
+
+*/
+
+#include "parrot/parrot.h"
+
+pmclass String {
+
+/*
+
+=item C<void init()>
+
+Initializes the string.
+
+=cut
+
+*/
+
+ void init () {
+ PMC_str_val(SELF) =
+ string_make_empty(INTERP, enum_stringrep_one, 0);
+ PObj_custom_mark_SET(SELF);
+ }
+
+/*
+
+=item C<void mark()>
+
+Marks the string as live.
+
+=cut
+
+*/
+
+ void mark () {
+ if(PMC_str_val(SELF))
+ pobject_lives(INTERP, (PObj *)PMC_str_val(SELF));
+ }
+
+/*
+
+=item C<PMC* clone()>
+
+Creates a copy of the string.
+
+=cut
+
+*/
+
+ PMC* clone () {
+ PMC* dest = pmc_new_noinit(INTERP, SELF->vtable->base_type);
+ PObj_custom_mark_SET(dest);
+ PMC_str_val(dest) = string_copy(INTERP,PMC_str_val(SELF));
+ return dest;
+ }
+
+/*
+
+=item C<INTVAL get_integer()>
+
+Returns the integer representation of the string.
+
+=cut
+
+*/
+
+ INTVAL get_integer () {
+ STRING *s = (STRING*) PMC_str_val(SELF);
+ return string_to_int(INTERP, s);
+ }
+
+/*
+
+=item C<FLOATVAL get_number()>
+
+Returns the floating-point representation of the string.
+
+=cut
+
+*/
+
+ FLOATVAL get_number () {
+ STRING *s = (STRING*) PMC_str_val(SELF);
+ return string_to_num(INTERP, s);
+ }
+
+/*
+
+=item C<BIGNUM* get_bignum()>
+
+Returns the big numbers representation of the string.
+(unimplemented, returns NULL)
+
+=cut
+
+*/
+
+ BIGNUM* get_bignum () {
+ /* XXX */
+ return (BIGNUM*)0;
+ }
+
+/*
+
+=item C<STRING* get_string()>
+
+Returns the string itself.
+
+=cut
+
+*/
+ /* XXX useless? */
+ STRING* get_string () {
+ return (STRING*) PMC_str_val(SELF);
+ }
+
+/*
+
+=item C<INTVAL get_bool()>
+
+Returns the boolean value of the string.
+
+=cut
+
+*/
+
+ INTVAL get_bool () {
+ STRING *s = (STRING*) PMC_str_val(SELF);
+ return string_bool(INTERP, s);
+ }
+
+/*
+
+=item C<VOID set_integer_native(INTVAL value)>
+
+Sets the value of the string to the integer C<value>.
+
+=cut
+
+*/
+
+ void set_integer_native (INTVAL value) {
+ PMC_str_val(SELF) = string_from_int(INTERP, value);
+ }
+
+/*
+
+=item C<VOID set_number_native(FLOATVAL value)>
+
+Sets the value of the string to the floating-point C<value>.
+
+=cut
+
+*/
+
+ void set_number_native (FLOATVAL value) {
+ PMC_str_val(SELF) = string_from_num(INTERP, value);
+ }
+
+/*
+
+=item C<VOID set_bignum_native(BIGNUM* value)>
+
+Sets the value of the string to the big number C<value>.
+(unimplemented, no-op)
+
+=cut
+
+*/
+
+ void set_bignum_native (BIGNUM* value) {
+ /* XXX */
+ }
+
+/*
+
+=item C<VOID set_string_native(STRING* value)>
+
+Sets the value of the string to that of the specified C<string>.
+
+=cut
+
+*/
+
+ void set_string_native (STRING* value) {
+ PMC_str_val(SELF) = value;
+ }
+
+/*
+
+=item C<VOID assign_string_native(STRING* value)>
+
+Sets the value of the string to a copy of the specified C<string>.
+
+=cut
+
+*/
+
+ void assign_string_native (STRING* value) {
+ PMC_str_val(SELF) =
+ string_set(INTERP, PMC_str_val(SELF), value);
+ }
+
+/*
+
+=item C<VOID set_string_same(PMC* value)>
+
+Sets the value of the string to the value of
+the specified C<String> PMC.
+
+=cut
+
+*/
+
+ void set_string_same (PMC* value) {
+ PMC_str_val(SELF) =
+ string_set(INTERP, PMC_str_val(SELF), PMC_str_val(value));
+ }
+
+/*
+
+=item C<VOID set_pmc(PMC* value)>
+
+Sets the value of the string to the string value of
+the specified C<PMC>.
+
+=cut
+
+*/
+ void set_pmc (PMC* value) {
+ PMC_str_val(SELF) = VTABLE_get_string(INTERP, value);
+ }
+
+/*
+
+=item C<VOID assign_pmc(PMC* value)>
+
+Sets the value of the string to the string value of
+the specified C<PMC>.
+
+=cut
+
+*/
+ void assign_pmc (PMC* value) {
+ STRING *s = VTABLE_get_string(INTERP, value);
+ PMC_str_val(SELF) = string_set(INTERP, PMC_str_val(SELF), s);
+ }
+
+/*
+
+=item C<VOID bitwise_or(PMC* value, PMC* dest)>
+=cut
+=item C<VOID bitwise_and(PMC* value, PMC* dest)>
+=cut
+=item C<VOID bitwise_xor(PMC* value, PMC* dest)>
+=cut
+=item C<VOID bitwise_ors(PMC* value, PMC* dest)>
+=cut
+=item C<VOID bitwise_ors_str(PMC* value, PMC* dest)>
+=cut
+=item C<VOID bitwise_ands(PMC* value, PMC* dest)>
+=cut
+=item C<VOID bitwise_ands_str(PMC* value, PMC* dest)>
+=cut
+=item C<VOID bitwise_xors(PMC* value, PMC* dest)>
+=cut
+=item C<VOID bitwise_xors_str(PMC* value, PMC* dest)>
+=cut
+=item C<VOID bitwise_nots(PMC* value)>
+
+These functions perform bitwise operations on entire
+strings, and place the result in C<dest>.
+
+=cut
+
+*/
+ void bitwise_or (PMC* value, PMC* dest) {
+ STRING *s = PMC_str_val(SELF);
+ STRING *v = VTABLE_get_string(INTERP, value);
+ VTABLE_set_string_native(
+ INTERP, dest, string_bitwise_or(INTERP, s, v, NULL));
+ }
+
+ void bitwise_and (PMC* value, PMC* dest) {
+ STRING *s = PMC_str_val(SELF);
+ STRING *v = VTABLE_get_string(INTERP, value);
+ VTABLE_set_string_native(
+ INTERP, dest, string_bitwise_and(INTERP, s, v, NULL));
+ }
+
+ void bitwise_xor (PMC* value, PMC* dest) {
+ STRING *s = PMC_str_val(SELF);
+ STRING *v = VTABLE_get_string(INTERP, value);
+ VTABLE_set_string_native(
+ INTERP, dest, string_bitwise_xor(INTERP, s, v, NULL));
+ }
+
+ void bitwise_ors (PMC* value, PMC* dest) {
+ STRING *s = PMC_str_val(SELF);
+ STRING *v = VTABLE_get_string(INTERP, value);
+ VTABLE_set_string_native(
+ INTERP, dest, string_bitwise_or(INTERP, s, v, NULL));
+ }
+
+ void bitwise_ors_str (STRING* value, PMC* dest) {
+ STRING *s = PMC_str_val(SELF);
+ VTABLE_set_string_native(
+ INTERP, dest, string_bitwise_or(INTERP, s, value, NULL));
+ }
+
+ void bitwise_ands (PMC* value, PMC* dest) {
+ STRING *s = PMC_str_val(SELF);
+ STRING *v = VTABLE_get_string(INTERP, value);
+ VTABLE_set_string_native(
+ INTERP, dest, string_bitwise_and(INTERP, s, v, NULL));
+ }
+
+ void bitwise_ands_str (STRING* value, PMC* dest) {
+ STRING *s = PMC_str_val(SELF);
+ VTABLE_set_string_native(
+ INTERP, dest, string_bitwise_and(INTERP, s, value, NULL));
+ }
+
+ void bitwise_xors (PMC* value, PMC* dest) {
+ STRING *s = PMC_str_val(SELF);
+ STRING *v = VTABLE_get_string(INTERP, value);
+ VTABLE_set_string_native(
+ INTERP, dest, string_bitwise_xor(INTERP, s, v, NULL));
+ }
+
+ void bitwise_xors_str (STRING* value, PMC* dest) {
+ STRING *s = PMC_str_val(SELF);
+ VTABLE_set_string_native(
+ INTERP, dest, string_bitwise_xor(INTERP, s, value, NULL));
+ }
+
+ void bitwise_nots (PMC* dest) {
+ STRING *s = PMC_str_val(SELF);
+ VTABLE_set_string_native(
+ INTERP, dest, string_bitwise_not(INTERP, s, NULL));
+ }
+
+/*
+
+=item C<VOID concatenate(PMC* value, PMC* dest)>
+
+Concatenates the string with C<value> and places the result in C<dest>.
+
+=cut
+
+*/
+ void concatenate (PMC* value, PMC* dest) {
+ STRING *s = PMC_str_val(SELF);
+ STRING *v = VTABLE_get_string(INTERP, value);
+ STRING *o = string_concat(INTERP, s, v, 0);
+ VTABLE_set_string_native(
+ INTERP, dest, o);
+ }
+
+/*
+
+=item C<VOID concatenate_str(STRING* value, PMC* dest)>
+
+Concatenates the string with C<value> and places the result in C<dest>.
+
+=cut
+
+*/
+ void concatenate_str (STRING* value, PMC* dest) {
+ STRING *s = PMC_str_val(SELF);
+ STRING *o = string_concat(INTERP, s, value, 0);
+ VTABLE_set_string_native(INTERP, dest, o);
+ }
+
+/*
+
+=item C<INTVAL is_equal(PMC* value)>
+
+Compares the string with C<value>; returns true if
+they match.
+
+=cut
+
+*/
+ INTVAL is_equal (PMC* value) {
+ STRING *s = PMC_str_val(SELF);
+ STRING *v = VTABLE_get_string(INTERP, value);
+ return (INTVAL)(0 == string_equal(INTERP, s, v));
+ }
+
+/*
+
+=item C<INTVAL is_equal_num(PMC* value)>
+
+Compares the numerical value of the string with that of
+C<value>; returns true if they match.
+
+=cut
+
+*/
+ INTVAL is_equal_num (PMC* value) {
+ FLOATVAL sf = string_to_num(INTERP, PMC_str_val(SELF));
+ FLOATVAL vf = VTABLE_get_number(INTERP, value);
+ return (INTVAL)(sf == vf);
+ }
+
+/*
+
+=item C<INTVAL is_equal_str(PMC* value)>
+
+Compares the string with C<value>; returns true if
+they match.
+
+=cut
+
+*/
+/* INTVAL is_equal_str (PMC* value) {
+ STRING *s = PMC_str_val(SELF);
+ STRING *v = VTABLE_get_string(INTERP, value);
+ return (INTVAL)(0 == string_equal(INTERP, s, v));
+ }
+*/
+/*
+
+=item C<INTVAL is_same(PMC* value)>
+
+Compares the string in this PMC with the one in the C<value> PMC.
+Returns true if this PMC and the one in C<value> are of the same PMC
+class and their strings are aliases of the same internal string.
+
+(this can only happen if you use the set_string_native method)
+
+=cut
+
+*/
+ INTVAL is_same (PMC* value) {
+ STRING *s = PMC_str_val(SELF);
+ STRING *v = PMC_str_val(value);
+ return (INTVAL)(
+ value->vtable == SELF->vtable &&
+ s == v
+ );
+ }
+
+/*
+
+=item C<INTVAL cmp(PMC* value)>
+
+Compares the string with C<value>; returns -1 if the
+string is smaller, 0 if they are equal, and 1 if C<value>
+is smaller.
+
+=cut
+
+*/
+ INTVAL cmp (PMC* value) {
+ STRING *s = PMC_str_val(SELF);
+ STRING *v = VTABLE_get_string(INTERP, value);
+ return string_compare(INTERP, s, v);
+ }
+
+/*
+
+=item C<INTVAL cmp_num(PMC* value)>
+
+Compares the numerical value of the string with that of
+C<value>; returns -1 if the string is smaller, 0 if they
+are equal, and 1 if C<value> is smaller.
+
+=cut
+
+*/
+ INTVAL cmp_num (PMC* value) {
+ FLOATVAL sf = string_to_num(INTERP, PMC_str_val(SELF));
+ FLOATVAL vf = VTABLE_get_number(INTERP, value);
+ if(sf < vf)
+ return (INTVAL)(-1);
+ if(sf > vf)
+ return (INTVAL)(1);
+ return (INTVAL)(0);
+ }
+
+/*
+
+=item C<INTVAL cmp_string(PMC* value)>
+
+Compares the string with C<value>; returns -1 if the
+string is smaller, 0 if they are equal, and 1 if C<value>
+is smaller.
+
+=cut
+
+*/
+ INTVAL cmp_string (PMC* value) {
+ STRING *s = PMC_str_val(SELF);
+ STRING *v = VTABLE_get_string(INTERP, value);
+ return string_compare(INTERP, s, v);
+ }
+
+/*
+
+=item C<void repeat(PMC* value, PMC* dest)>
+
+Repeats the string C<value> times and places the result in C<dest>.
+
+=cut
+
+*/
+ void repeat (PMC* value, PMC* dest) {
+ INTVAL n = VTABLE_get_integer(INTERP, value);
+ STRING *s = PMC_str_val(SELF);
+ STRING *s2 = string_repeat(INTERP, s, n, NULL);
+ VTABLE_set_string_native(INTERP, dest, s2);
+ }
+
+/*
+
+=item C<void repeat_int(INTVAL value, PMC* dest)>
+
+Repeats the string C<value> times and places the result in C<dest>.
+
+=cut
+
+*/
+ void repeat_int (INTVAL value, PMC* dest) {
+ STRING *s = PMC_str_val(SELF);
+ STRING *s2 = string_repeat(INTERP, s, value, NULL);
+ VTABLE_set_string_native(INTERP, dest, s2);
+ }
+
+/*
+
+=item C<void substr(INTVAL offset, INTVAL length, PMC* dest)>
+
+Extracts the substring starting at C<offset>, with size
+C<length>, and places it in C<dest>.
+
+=cut
+
+*/
+ void substr (INTVAL offset, INTVAL length, PMC* dest) {
+ STRING *s = PMC_str_val(SELF);
+ STRING *s2 = string_substr(INTERP, s, offset, length, NULL, 0);
+ VTABLE_set_string_native(INTERP, dest, s2);
+ }
+
+/*
+
+=item C<void substr(INTVAL offset, INTVAL length)>
+
+Extracts the substring starting at C<offset>, with size
+C<length>, and returns it.
+
+=cut
+
+*/
+ STRING* substr_str (INTVAL offset, INTVAL length) {
+ STRING *s = PMC_str_val(SELF);
+ return string_substr(INTERP, s, offset, length, NULL, 0);
+ }
+
+/*
+
+=item C<INTVAL exists_keyed(PMC *key)>
+
+Returns true if the C<key>'th character in the string exists. Negative
+numbers count from the end.
+
+=cut
+
+*/
+
+ INTVAL exists_keyed(PMC* key) {
+ INTVAL n = string_length(INTERP, PMC_str_val(SELF));
+ INTVAL k = VTABLE_get_integer(INTERP, key);
+ return (INTVAL)( (k>=0 && k<=n) || (k<0 && -k<=n) );
+ }
+
+/*
+
+=item C<STRING *get_string_keyed(PMC *key)>
+
+Returns the C<key>'th character in the string. Negative numbers count
+from the end.
+
+=cut
+
+*/
+
+ STRING* get_string_keyed(PMC* key) {
+ STRING *s = PMC_str_val(SELF);
+ INTVAL k = VTABLE_get_integer(INTERP, key);
+ return string_substr(INTERP, s, k, 1, NULL, 0);
+ }
+
+/*
+
+=item C<void freeze(visit_info *info)>
+
+Used to archive the string.
+
+=cut
+
+*/
+ void freeze(visit_info *info) {
+ IMAGE_IO *io = info->image_io;
+ SUPER(info);
+ io->vtable->push_string(INTERP, io, PMC_str_val(SELF));
+ }
+
+/*
+
+=item C<void thaw(visit_info *info)>
+
+Used to unarchive the string.
+
+=cut
+
+*/
+ void thaw(visit_info *info) {
+ IMAGE_IO *io = info->image_io;
+ SUPER(info);
+ if (info->extra_flags == EXTRA_IS_NULL)
+ PMC_str_val(SELF) = io->vtable->shift_string(INTERP, io);
+ }
+}
+
+/*
+
+=back
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+*/
+
+
+
+
+
+
diff -ruN parrot/classes/undef.pmc my_parrot/classes/undef.pmc
--- parrot/classes/undef.pmc 2004-06-23 21:12:34.000000000 +0300
+++ my_parrot/classes/undef.pmc 2004-06-23 21:34:12.000000000 +0300
@@ -23,7 +23,7 @@
*/
#include "parrot/parrot.h"
-#define UNDEF_STRING_CLASS enum_class_PerlString
+#define UNDEF_STRING_CLASS enum_class_String
pmclass Undef extends default {
@@ -50,7 +50,7 @@
}
STRING* get_string() {
- return string_make(INTERP, NULL, 0, NULL, 0);
+ return string_make_empty(INTERP,enum_stringrep_one,0);
}
void set_string_native(STRING *value) {
diff -ruN parrot/t/pmc/string.t my_parrot/t/pmc/string.t
--- parrot/t/pmc/string.t 1970-01-01 02:00:00.000000000 +0200
+++ my_parrot/t/pmc/string.t 2004-06-23 21:31:30.000000000 +0300
@@ -0,0 +1,1120 @@
+#! perl -w
+# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
+# $Id: string.t,v 1.23 2004/06/21 13:47:00 alexm Exp $
+
+=head1 NAME
+
+t/pmc/string.t - Strings
+
+=head1 SYNOPSIS
+
+ % perl t/pmc/string.t
+
+=head1 DESCRIPTION
+
+Tests the C<String> PMC.
+
+=cut
+
+use Parrot::Test tests => 30;
+use Test::More; # Included for skip().
+
+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, "Set/get strings");
+ new P0, .String
+ set P0, "foo"
+ set S0, P0
+ eq S0, "foo", OK1
+ print "not "
+OK1: print "ok 1\\n"
+
+ set P0, "\0"
+ set S0, P0
+ eq S0, "\0", OK2
+ print "not "
+OK2: print "ok 2\\n"
+
+ set P0, ""
+ set S0, P0
+ eq S0, "", OK3
+ print "not "
+OK3: print "ok 3\\n"
+
+ set P0, 123
+ set S0, P0
+ eq S0, "123", OK4
+ print "not "
+OK4: print "ok 4\\n"
+
+# XXX: can't handle double yet - string_from_num() in src/string.c
+# set P0, 1.23456789
+# print P0
+# set S0, P0
+# print S0
+# eq S0, "1.23456789", OK5
+# print "not "
+OK5: print "ok 5\\n"
+
+ set P0, "0xFFFFFF"
+ set S0, P0
+ eq S0, "0xFFFFFF", OK6
+ print "not "
+OK6: print "ok 6\\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+ok 5
+ok 6
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "Setting integers");
+ new P0, .String
+ set P0, "1"
+ set I0, P0
+ print I0
+ print "\\n"
+
+ new P0, .String
+ set P0, "2.0"
+ set I0, P0
+ print I0
+ print "\\n"
+
+ new P0, .String
+ set P0, ""
+ set I0, P0
+ print I0
+ print "\\n"
+
+ new P0, .String
+ set P0, "\0"
+ set I0, P0
+ print I0
+ print "\\n"
+
+ new P0, .String
+ set P0, "foo"
+ set I0, P0
+ print I0
+ print "\\n"
+
+ end
+CODE
+1
+2
+0
+0
+0
+OUTPUT
+
+output_is(<<"CODE", <<OUTPUT, "Setting numbers");
[EMAIL PROTECTED] $fp_equality_macro ]}
+ new P0, .String
+ set P0, "1"
+ set N0, P0
+ .fp_eq(N0, 1.0, OK1)
+ print "not "
+OK1: print "ok 1\\n"
+
+ new P0, .String
+ set P0, "2.0"
+ set N0, P0
+ .fp_eq(N0, 2.0, OK2)
+ print "not "
+OK2: print "ok 2\\n"
+
+ new P0, .String
+ set P0, ""
+ set N0, P0
+ .fp_eq(N0, 0.0, OK3)
+ print "not "
+OK3: print "ok 3\\n"
+
+ new P0, .String
+ set P0, "\0"
+ set N0, P0
+ .fp_eq(N0, 0.0, OK4)
+ print "not "
+OK4: print "ok 4\\n"
+
+ new P0, .String
+ set P0, "foo"
+ set N0, P0
+ .fp_eq(N0, 0.0, OK5)
+ print "not "
+OK5: print "ok 5\\n"
+
+ new P0, .String
+ set P0, "1.3e5"
+ set N0, P0
+ .fp_eq(N0, 130000.0, OK6)
+ print "not "
+OK6: print "ok 6\\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+ok 5
+ok 6
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "ensure that concat ppp copies strings");
+ new P0, .String
+ new P1, .String
+ new P2, .String
+ set P0, "foo"
+ concat P1, P0, P0
+
+ print P0
+ print "\\n"
+
+ print P1
+ print "\\n"
+
+ set P1, "You can't teach an old dog new..."
+ set P2, "clear physics"
+ concat P0, P1, P2
+
+ print P1
+ print "\\n"
+ print P2
+ print "\\n"
+ print P0
+ print "\\n"
+ end
+CODE
+foo
+foofoo
+You can't teach an old dog new...
+clear physics
+You can't teach an old dog new...clear physics
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "ensure that concat pps copies strings");
+ new P0, .String
+ new P1, .String
+
+ set S0, "Grunties"
+ set P1, "fnargh"
+ concat P0, P1, S0
+
+ print S0
+ print "\\n"
+ print P1
+ print "\\n"
+ print P0
+ print "\\n"
+
+ end
+CODE
+Grunties
+fnargh
+fnarghGrunties
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "Setting string references");
+ new P0, .String
+ set S0, "C2H5OH + 10H20"
+ set P0, S0
+ chopn S0, 8
+
+ print S0
+ print "\\n"
+ print P0
+ print "\\n"
+ end
+CODE
+C2H5OH
+C2H5OH
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "Assigning string copies");
+ new P0, .String
+ set S0, "C2H5OH + 10H20"
+ assign P0, S0
+ chopn S0, 8
+
+ print S0
+ print "\\n"
+ print P0
+ print "\\n"
+ end
+CODE
+C2H5OH
+C2H5OH + 10H20
+OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "repeat");
+ new P0, .String
+ set P0, "x"
+ new P1, .Integer
+ set P1, 12
+ new P2, .String
+ repeat P2, P0, P1
+ print P2
+ print "\n"
+
+ set P0, "y"
+ new P1, .Float
+ set P1, 6.5
+ repeat P2, P0, P1
+ print P2
+ print "\n"
+
+ set P0, "z"
+ new P1, .String
+ set P1, "3"
+ repeat P2, P0, P1
+ print P2
+ print "\n"
+
+ set P0, "a"
+ new P1, .Undef
+ repeat P2, P0, P1
+ print P2
+ print "\n"
+
+ end
+CODE
+xxxxxxxxxxxx
+yyyyyy
+zzz
+
+OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "repeat_int");
+ new P0, .String
+ set P0, "x"
+ set I1, 12
+ new P2, .String
+ repeat P2, P0, I1
+ print P2
+ print "\n"
+
+ set P0, "za"
+ set I1, 3
+ repeat P2, P0, I1
+ print P2
+ print "\n"
+ end
+CODE
+xxxxxxxxxxxx
+zazaza
+OUTPUT
+
+
+output_is(<<CODE, <<OUTPUT, "if(String)");
+ new P0, .String
+ set S0, "True"
+ set P0, S0
+ if P0, TRUE
+ print "false"
+ branch NEXT
+TRUE: print "true"
+NEXT: print "\\n"
+
+ new P1, .String
+ set S1, ""
+ set P1, S1
+ if P1, TRUE2
+ print "false"
+ branch NEXT2
+TRUE2: print "true"
+NEXT2: print "\\n"
+
+ new P2, .String
+ set S2, "0"
+ set P2, S2
+ if P2, TRUE3
+ print "false"
+ branch NEXT3
+TRUE3: print "true"
+NEXT3: print "\\n"
+
+ new P3, .String
+ set S3, "0123"
+ set P3, S3
+ if P3, TRUE4
+ print "false"
+ branch NEXT4
+TRUE4: print "true"
+NEXT4: print "\\n"
+
+ new P4, .String
+ if P4, TRUE5
+ print "false"
+ branch NEXT5
+TRUE5: print "true"
+NEXT5: print "\\n"
+ end
+CODE
+true
+false
+false
+true
+false
+OUTPUT
+
+# XXX unimplemented ops... should remove tests
+
+## XXX these tests better should get generated
+## with all combinations of params and ops
+#output_is(<<'CODE', <<OUTPUT, "add str_int, str_int");
+# new P0, .String
+# set P0, "23"
+# new P1, .String
+# set P1, "2"
+# new P2, .Undef
+# add P2, P0, P1
+# print P2
+# print "\n"
+# end
+#CODE
+#25
+#OUTPUT
+
+#output_is(<<"CODE", <<OUTPUT, "add str_int, str_num");
[EMAIL PROTECTED] $fp_equality_macro ]}
+# new P0, .String
+# set P0, "23"
+# new P1, .String
+# set P1, "2.5"
+# new P2, .Undef
+# add P2, P0, P1
+# .fp_eq(P2, 25.5, EQ1)
+# print "not "
+# EQ1: print "ok 1\\n"
+# end
+# CODE
+# ok 1
+# OUTPUT
+
+# output_is(<<'CODE', <<OUTPUT, "add str_int, int");
+# new P0, .String
+# set P0, "23"
+# new P1, .Integer
+# set P1, 2
+# new P2, .Undef
+# add P2, P0, P1
+# print P2
+# print "\n"
+# end
+# CODE
+# 25
+# OUTPUT
+
+# output_is(<<"CODE", <<OUTPUT, "add str_int, num");
+# @{[ $fp_equality_macro ]}
+# new P0, .String
+# set P0, "23"
+# new P1, .Float
+# set P1, 2.5
+# new P2, .Undef
+# add P2, P0, P1
+# .fp_eq(P2, 25.5, EQ1)
+# print "not "
+# EQ1: print "ok 1\\n"
+# end
+# CODE
+# ok 1
+# OUTPUT
+
+# output_is(<<"CODE", <<OUTPUT, "add str_num, int");
+# @{[ $fp_equality_macro ]}
+# new P0, .String
+# set P0, "23.5"
+# new P1, .Integer
+# set P1, 2
+# new P2, .Undef
+# add P2, P0, P1
+# .fp_eq(P2, 25.5, EQ1)
+# print "not "
+# EQ1: print "ok 1\\n"
+# end
+# CODE
+# ok 1
+#OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "concat");
+ new P0, .String
+ new P1, .Undef
+ set P0, "foo"
+ concat P1, P0, P0
+
+ print P0
+ print "\n"
+ print P1
+ print "\n"
+
+ new P0, .String
+ new P1, .Undef
+ set P0, "bar"
+ concat P0, P0, P1
+
+ print P0
+ print "\n"
+ print P1
+ print "\n"
+
+ new P0, .String
+ new P1, .Undef
+ set P1, "str"
+ concat P1, P0, P1
+
+ print P0
+ print "\n"
+ print P1
+ print "\n"
+ end
+CODE
+foo
+foofoo
+bar
+
+
+str
+OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "cmp");
+ new P1, .String
+ new P2, .String
+
+ set P1, "abc"
+ set P2, "abc"
+ cmp I0, P1, P2
+ print I0
+ print "\n"
+
+ set P1, "abcde"
+ set P2, "abc"
+ cmp I0, P1, P2
+ print I0
+ print "\n"
+
+ set P1, "abc"
+ set P2, "abcde"
+ cmp I0, P1, P2
+ print I0
+ print "\n"
+
+ end
+CODE
+0
+1
+-1
+OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "cmp with Integer");
+ new P1, .Integer
+ new P2, .String
+ set P2, "10"
+
+# Int. vs Str.
+ set P1, 10
+ cmp I0, P1, P2
+ print I0
+ print "\n"
+
+ set P1, 20
+ cmp I0, P1, P2
+ print I0
+ print "\n"
+
+ set P1, 0
+ cmp I0, P1, P2
+ print I0
+ print "\n"
+
+# Str. vs Int.
+ set P1, 0
+ cmp I0, P2, P1
+ print I0
+ print "\n"
+
+ set P1, 20
+ cmp I0, P2, P1
+ print I0
+ print "\n"
+
+ set P1, 10
+ cmp I0, P2, P1
+ print I0
+ print "\n"
+
+ end
+CODE
+0
+1
+-1
+1
+-1
+0
+OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "substr");
+ new P0, .String
+ set P0, "This is a test\n"
+ substr S0, P0, 0, 5
+ substr S1, P0, 10, 4
+ substr S2, P0, -11, 3
+ substr S3, P0, 7, 1000 # Valid offset, but length > string length
+ print S0
+ print S1
+ print S2
+ print S3
+ print P0 # Check that the original is unmodified
+ end
+CODE
+This test is a test
+This is a test
+OUTPUT
+
+output_like(<<'CODE', <<'OUTPUT', "Out-of-bounds substr, +ve offset");
+ new P0, .String
+ set P0, "Woburn"
+ substr S0, P0, 123, 22
+ end
+CODE
+/^Cannot take substr outside string$/
+OUTPUT
+
+output_like(<<'CODE', <<'OUTPUT', "Out-of-bounds substr, -ve offset");
+ new P0, .String
+ set P0, "Woburn"
+ substr S0, P0, -123, 22
+ end
+CODE
+/^Cannot take substr outside string$/
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "bands NULL string");
+ new P1, .String
+ new P2, .String
+ new P3, .String
+ null S1
+ set S2, "abc"
+ set P1, S1
+ set P2, S2
+ bands P1, P2
+ null S3
+ set P3, S3
+ eq P1, P3, ok1
+ print "not "
+ok1: print "ok 1\n"
+ set P1, ""
+ bands P1, P2
+ unless P1, ok2
+ print "not "
+ok2: print "ok 2\n"
+
+ null S2
+ set P2, S2
+ set P1, "abc"
+ bands P1, P2
+ null S3
+ set P3, S3
+ eq P1, P3, ok3
+ print "not "
+ok3: print "ok 3\n"
+ set P2, ""
+ bands P1, P2
+ unless P1, ok4
+ print "not "
+ok4: print "ok 4\n"
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "bands 2");
+ new P1, .String
+ new P2, .String
+ set P1, "abc"
+ set P2, "EE"
+ bands P1, P2
+ print P1
+ print "\n"
+ print P2
+ print "\n"
+ end
+CODE
+A@
+EE
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "bands 3");
+ new P1, .String
+ new P2, .String
+ new P0, .String
+ set P1, "abc"
+ set P2, "EE"
+ bands P0, P1, P2
+ print P0
+ print "\n"
+ print P1
+ print "\n"
+ print P2
+ print "\n"
+ end
+CODE
+A@
+abc
+EE
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "bors NULL string");
+ new P1, .String
+ new P2, .String
+ new P3, .String
+ null S1
+ null S2
+ set P1, S1
+ set P2, S2
+ bors P1, P2
+ null S3
+ set P3, S3
+ eq P1, P3, OK1
+ print "not "
+OK1: print "ok 1\n"
+
+ null S1
+ set P1, S1
+ set P2, ""
+ bors P1, P2
+ null S3
+ set P3, S3
+ eq P1, P3, OK2
+ print "not "
+OK2: print "ok 2\n"
+ bors P2, P1
+ eq P2, P3, OK3
+ print "not "
+OK3: print "ok 3\n"
+
+ null S1
+ set P1, S1
+ set P2, "def"
+ bors P1, P2
+ eq P1, "def", OK4
+ print "not "
+OK4: print "ok 4\n"
+ null S2
+ set P2, S2
+ bors P1, P2
+ eq P1, "def", OK5
+ print "not "
+OK5: print "ok 5\n"
+
+ null S1
+ null S2
+ set P1, S1
+ set P2, S2
+ bors P3, P1, P2
+ null S4
+ eq P3, S4, OK6
+ print "not "
+OK6: print "ok 6\n"
+
+ set P1, ""
+ bors P3, P1, P2
+ eq P3, S4, OK7
+ print "not "
+OK7: print "ok 7\n"
+ bors P3, P2, P1
+ eq P3, S4, OK8
+ print "not "
+OK8: print "ok 8\n"
+
+ set P1, "def"
+ bors P3, P1, P2
+ eq P3, "def", OK9
+ print "not "
+OK9: print "ok 9\n"
+ bors P3, P2, P1
+ eq P3, "def", OK10
+ print "not "
+OK10: print "ok 10\n"
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+ok 5
+ok 6
+ok 7
+ok 8
+ok 9
+ok 10
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "bors 2");
+ new P1, .String
+ new P2, .String
+ set P1, "abc"
+ set P2, "EE"
+ bors P1, P2
+ print P1
+ print "\n"
+ print P2
+ print "\n"
+ end
+CODE
+egc
+EE
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "bors 3");
+ new P1, .String
+ new P2, .String
+ new P0, .String
+ set P1, "abc"
+ set P2, "EE"
+ bors P0, P1, P2
+ print P0
+ print "\n"
+ print P1
+ print "\n"
+ print P2
+ print "\n"
+ end
+CODE
+egc
+abc
+EE
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "bxors NULL string");
+ new P1, .String
+ new P2, .String
+ new P3, .String
+ null S1
+ null S2
+ set P1, S1
+ set P2, S2
+ bxors P1, P2
+ null S3
+ eq P1, S3, OK1
+ print "not "
+OK1: print "ok 1\n"
+
+ null S1
+ set P1, S1
+ set P2, ""
+ bxors P1, P2
+ null S3
+ eq P1, S3, OK2
+ print "not "
+OK2: print "ok 2\n"
+ bxors P2, P1
+ eq S2, S3, OK3
+ print "not "
+OK3: print "ok 3\n"
+
+ null S1
+ set P1, S1
+ set P2, "abc"
+ bxors P1, P2
+ eq P1, "abc", OK4
+ print "not "
+OK4: print "ok 4\n"
+ null S2
+ set P2, S2
+ bxors P1, P2
+ eq P1, "abc", OK5
+ print "not "
+OK5: print "ok 5\n"
+
+ null S1
+ null S2
+ set P1, S1
+ set P2, S2
+ bxors P3, P1, P2
+ null S4
+ eq P3, S4, OK6
+ print "not "
+OK6: print "ok 6\n"
+
+ set P1, ""
+ bxors P3, P1, P2
+ eq P3, S4, OK7
+ print "not "
+OK7: print "ok 7\n"
+ bxors P3, P2, P1
+ eq P3, S4, OK8
+ print "not "
+OK8: print "ok 8\n"
+
+ set P1, "abc"
+ bxors P3, P1, P2
+ eq P3, "abc", OK9
+ print "not "
+OK9: print "ok 9\n"
+ bxors P3, P2, P1
+ eq P3, "abc", OK10
+ print "not "
+OK10: print "ok 10\n"
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+ok 5
+ok 6
+ok 7
+ok 8
+ok 9
+ok 10
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "bxors 2");
+ new P1, .String
+ new P2, .String
+ new P3, .String
+ set P1, "a2c"
+ set P2, "Dw"
+ bxors P1, P2
+ print P1
+ print "\n"
+ print P2
+ print "\n"
+ set P1, "abc"
+ set P2, " X"
+ bxors P1, P2
+ print P1
+ print "\n"
+ print P2
+ print "\n"
+ end
+CODE
+%Ec
+Dw
+ABCX
+ X
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "bxors 3");
+ new P1, .String
+ new P2, .String
+ new P0, .String
+ set P1, "a2c"
+ set P2, "Dw"
+ bxors P0, P1, P2
+ print P0
+ print "\n"
+ print P1
+ print "\n"
+ print P2
+ print "\n"
+ set P1, "abc"
+ set P2, " Y"
+ bxors P0, P1, P2
+ print P0
+ print "\n"
+ print P1
+ print "\n"
+ print P2
+ print "\n"
+ end
+CODE
+%Ec
+a2c
+Dw
+ABCY
+abc
+ Y
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "bnots NULL string");
+ new P1, .String
+ new P2, .String
+ new P3, .String
+ null S1
+ null S2
+ set P1, S1
+ set P2, S2
+ bnots P1, P2
+ null S3
+ eq P1, S3, OK1
+ print "not "
+OK1: print "ok 1\n"
+
+ null S1
+ set P1, S1
+ set P2, ""
+ bnots P1, P2
+ null S3
+ eq P1, S3, OK2
+ print "not "
+OK2: print "ok 2\n"
+ bnots P2, P1
+ eq S2, S3, OK3
+ print "not "
+OK3: print "ok 3\n"
+ end
+CODE
+ok 1
+ok 2
+ok 3
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "bnots 2");
+ getstdout P0
+ push P0, "utf8"
+ new P1, .String
+ new P2, .String
+ set P1, "a2c"
+ bnots P2, P1
+ print P1
+ print "\n"
+ print P2
+ print "\n"
+ bnots P1, P1
+ print P1
+ print "\n"
+ bnots P1, P1
+ print P1
+ print "\n"
+ end
+CODE
+a2c
+\xC2\x9E\xC3\x8D\xC2\x9C
+\xC2\x9E\xC3\x8D\xC2\x9C
+a2c
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "eq_str");
+ new P1, .String
+ new P2, .String
+ set P1, "ABC"
+ set P2, "ABC"
+ eq_str P2, P1, OK1
+ print "not "
+OK1: print "ok 1\n"
+
+ set P2, "abc"
+ eq_str P2, P1, BAD2
+ branch OK2
+BAD2: print "not "
+OK2: print "ok 2\n"
+
+ new P3, .Integer
+ set P3, 0
+ eq_str P2, P3, BAD3
+ branch OK3
+BAD3: print "not "
+OK3: print "ok 3\n"
+
+ eq_str P3, P2, BAD4
+ branch OK4
+BAD4: print "not "
+OK4: print "ok 4\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "ne_str");
+ new P1, .String
+ new P2, .String
+ set P1, "ABC"
+ set P2, "abc"
+ ne_str P2, P1, OK1
+ print "not "
+OK1: print "ok 1\n"
+
+ set P2, "ABC"
+ ne_str P2, P1, BAD2
+ branch OK2
+BAD2: print "not "
+OK2: print "ok 2\n"
+
+ new P3, .Integer
+ set P3, 0
+ ne_str P2, P3, OK3
+ print "not "
+OK3: print "ok 3\n"
+
+ ne_str P3, P2, OK4
+ print "not "
+OK4: print "ok 4\n"
+
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "set const and chop");
+ new P0, .String
+ set P0, "str"
+ set S0, P0
+ chopn S0, 2
+ print "str"
+ print "\n"
+ end
+CODE
+str
+OUTPUT
+
+1;
+
