#!perl
# Copyright (C) 2001-2007, The Perl Foundation.
# $Id: string.t 23182 2007-11-28 15:26:28Z kjs $
use strict;
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
use Parrot::Test tests => 160;
use Parrot::Config;
=head1 NAME
t/op/string.t - Parrot Strings
=head1 SYNOPSIS
% prove t/op/string.t
=head1 DESCRIPTION
Tests Parrot string registers and operations.
=cut
pasm_output_is( <<'CODE', <<'OUTPUT', 'set_s_s|sc' );
set S4, "JAPH\n"
set S5, S4
print S4
print S5
end
CODE
JAPH
JAPH
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'clone' );
set S0, "Foo\n"
clone S1, S0
print S0
print S1
clone S1, "Bar\n"
print S1
chopn S1, 1 # Check that the contents of S1 are no longer constant
print S1
print "\n"
end
CODE
Foo
Foo
Bar
Bar
OUTPUT
pasm_output_is( <<'CODE', '4', 'length_i_s' );
set I4, 0
set S4, "JAPH"
length I4, S4
print I4
end
CODE
pasm_output_is( <<'CODE', '0', '0 length substr' );
set I4, 0
set S4, "JAPH"
substr S3, S4, 1, 0
length I4, S3
print I4
end
CODE
pasm_output_is( <<'CODE', <<'OUTPUT', 'chopn with clone' );
set S4, "JAPHxyzw"
set S5, "japhXYZW"
clone S3, S4
set S1, "\n"
set I1, 4
chopn S4, 3
chopn S4, 1
chopn S5, I1
print S4
print S1
print S5
print S1
print S3
print S1
end
CODE
JAPH
japh
JAPHxyzw
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'chopn with set' );
set S4, "JAPHxyzw"
set S5, "japhXYZW"
set S3, S4
set S1, "\n"
set I1, 4
chopn S4, 3
chopn S4, 1
chopn S5, I1
print S4
print S1
print S5
print S1
print S3
print S1
end
CODE
JAPH
japh
JAPH
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'chopn, OOB values' );
set S1, "A string of length 21"
chopn S1, 0
print S1
print "\n"
chopn S1, 4
print S1
print "\n"
# -length cuts now
chopn S1, -4
print S1
print "\n"
chopn S1, 1000
print S1
print "** nothing **\n"
end
CODE
A string of length 21
A string of lengt
A st
** nothing **
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'Three argument chopn' );
set S1, "Parrot"
chopn S2, S1, 0
print S1
print "\n"
print S2
print "\n"
chopn S2, S1, 1
print S1
print "\n"
print S2
print "\n"
set I0, 2
chopn S2, S1, I0
print S1
print "\n"
print S2
print "\n"
chopn S2, "Parrot", 3
print S2
print "\n"
chopn S1, S1, 5
print S1
print "\n"
set S1, "Parrot"
set S3, S1
chopn S2, S1, 3
print S3
print "\n"
set S3, S1
chopn S1, 3
print S3
print "\n"
end
CODE
Parrot
Parrot
Parrot
Parro
Parrot
Parr
Par
P
Parrot
Par
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'Three argument chopn, OOB values' );
set S1, "Parrot"
chopn S2, S1, 7
print S1
print "\n"
print S2
print "\n"
chopn S2, S1, -1
print S1
print "\n"
print S2
print "\n"
end
CODE
Parrot
Parrot
P
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'substr_s_s|sc_i|ic_i|ic' );
set S4, "12345JAPH01"
set I4, 5
set I5, 4
substr S5, S4, I4, I5
print S5
substr S5, S4, I4, 4
print S5
substr S5, S4, 5, I5
print S5
substr S5, S4, 5, 4
print S5
substr S5, "12345JAPH01", I4, I5
print S5
substr S5, "12345JAPH01", I4, 4
print S5
substr S5, "12345JAPH01", 5, I5
print S5
substr S5, "12345JAPH01", 5, 4
print S5
print "\n"
end
CODE
JAPHJAPHJAPHJAPHJAPHJAPHJAPHJAPH
OUTPUT
# negative offsets
pasm_output_is( <<'CODE', <<'OUTPUT', 'neg substr offset' );
set S0, "A string of length 21"
set I0, -9
set I1, 6
substr S1, S0, I0, I1
print S0
print "\n"
print S1
print "\n"
end
CODE
A string of length 21
length
OUTPUT
# This asks for substring that shouldn't be allowed...
pasm_error_output_like( <<'CODE', <<'OUTPUT', 'substr OOB' );
set S0, "A string of length 21"
set I0, -99
set I1, 6
substr S1, S0, I0, I1
end
CODE
/^Cannot take substr outside string/
OUTPUT
# This asks for substring that shouldn't be allowed...
pasm_error_output_like( <<'CODE', <<'OUTPUT', 'substr OOB' );
set S0, "A string of length 21"
set I0, 99
set I1, 6
substr S1, S0, I0, I1
end
CODE
/^Cannot take substr outside string/
OUTPUT
# This asks for substring much greater than length of original string
pasm_output_is( <<'CODE', <<'OUTPUT', 'len>strlen' );
set S0, "A string of length 21"
set I0, 12
set I1, 1000
substr S1, S0, I0, I1
print S0
print "\n"
print S1
print "\n"
end
CODE
A string of length 21
length 21
OUTPUT
# The same, with a negative offset
pasm_output_is( <<'CODE', <<'OUTPUT', 'len>strlen, -ve os' );
set S0, "A string of length 21"
set I0, -9
set I1, 1000
substr S1, S0, I0, I1
print S0
print "\n"
print S1
print "\n"
end
CODE
A string of length 21
length 21
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', '5 arg substr, replacement = length' );
set S0, "abcdefghijk"
set S1, "xyz"
substr S2, S0, 4, 3, S1
print S0
print "\n"
print S1
print "\n"
print S2
print "\n"
end
CODE
abcdxyzhijk
xyz
efg
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', '5 arg substr, replacement > length' );
set S0, "abcdefghijk"
set S1, "xyz0123"
substr S2, S0, 4, 3, S1
print S0
print "\n"
print S1
print "\n"
print S2
print "\n"
end
CODE
abcdxyz0123hijk
xyz0123
efg
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', '5 arg substr, replacement < length' );
set S0, "abcdefghijk"
set S1, "x"
substr S2, S0, 4, 3, S1
print S0
print "\n"
print S1
print "\n"
print S2
print "\n"
end
CODE
abcdxhijk
x
efg
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', '5 arg substr, offset at end of string' );
set S0, "abcdefghijk"
set S1, "xyz"
substr S2, S0, 11, 3, S1
print S0
print "\n"
print S1
print "\n"
print S2
print "\n"
end
CODE
abcdefghijkxyz
xyz
OUTPUT
pasm_error_output_like( <<'CODE', <<'OUTPUT', '5 arg substr, offset past end of string' );
set S0, "abcdefghijk"
set S1, "xyz"
substr S2, S0, 12, 3, S1
print S0
print "\n"
print S1
print "\n"
print S2
print "\n"
end
CODE
/^Can only replace inside string or index after end of string/
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', '5 arg substr, -ve offset, repl=length' );
set S0, "abcdefghijk"
set S1, "xyz"
substr S2, S0, -3, 3, S1
print S0
print "\n"
print S1
print "\n"
print S2
print "\n"
end
CODE
abcdefghxyz
xyz
ijk
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', '5 arg substr, -ve offset, repl>length' );
set S0, "abcdefghijk"
set S1, "xyz"
substr S2, S0, -6, 2, S1
print S0
print "\n"
print S1
print "\n"
print S2
print "\n"
end
CODE
abcdexyzhijk
xyz
fg
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', '5 arg substr, -ve offset, repl<length' );
set S0, "abcdefghijk"
set S1, "xyz"
substr S2, S0, -6, 4, S1
print S0
print "\n"
print S1
print "\n"
print S2
print "\n"
end
CODE
abcdexyzjk
xyz
fghi
OUTPUT
pasm_error_output_like( <<'CODE', <<'OUTPUT', '5 arg substr, -ve offset out of string' );
set S0, "abcdefghijk"
set S1, "xyz"
substr S2, S0, -12, 4, S1
print S0
print "\n"
print S1
print "\n"
print S2
print "\n"
end
CODE
/^Can only replace inside string or index after end of string/
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', '5 arg substr, length > strlen ' );
set S0, "abcdefghijk"
set S1, "xyz"
substr S2, S0, 3, 11, S1
print S0
print "\n"
print S1
print "\n"
print S2
print "\n"
end
CODE
abcxyz
xyz
defghijk
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', '5 arg substr, length > strlen, -ve offset' );
set S0, "abcdefghijk"
set S1, "xyz"
substr S2, S0, -3, 11, S1
print S0
print "\n"
print S1
print "\n"
print S2
print "\n"
end
CODE
abcdefghxyz
xyz
ijk
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', '4-arg, replacement-only substr' );
set S0, "abcdefghijk"
set S1, "xyz"
substr S0, 3, 3, S1
print S0
print "\n"
print S1
print "\n"
end
CODE
abcxyzghijk
xyz
OUTPUT
pasm_output_is( <<'CODE', 'PH', '3-arg substr' );
set S0, "JAPH"
substr S1, S0, 2
print S1
end
CODE
pasm_error_output_like( <<'CODE', <<'OUTPUT', "substr, +ve offset, zero-length string" );
set S0, ""
substr S1, S0, 10, 3
print S1
end
CODE
/Cannot take substr outside string/
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'substr, offset 0, zero-length string' );
set S0, ""
substr S1, S0, 0, 1
print S1
print "_\n"
end
CODE
_
OUTPUT
pasm_error_output_like( <<'CODE', <<'OUTPUT', "substr, offset -1, zero-length string" );
set S0, ""
substr S1, S0, -1, 1
print S1
end
CODE
/Cannot take substr outside string/
OUTPUT
pasm_error_output_like( <<'CODE', <<'OUTPUT', "substr, -ve offset, zero-length string" );
set S0, ""
substr S1, S0, -10, 5
print S1
end
CODE
/Cannot take substr outside string/
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'zero-length substr, zero-length string' );
set S0, ""
substr S1, S0, 10, 0
print S1
print "_\n"
end
CODE
_
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'zero-length substr, zero-length string' );
set S0, ""
substr S1, S0, -10, 0
print S1
print "_\n"
end
CODE
_
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', '3-arg substr, zero-length string' );
set S0, ""
substr S1, S0, 2
print S1
print "_\n"
end
CODE
_
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', '5 arg substr, zero-length string' );
set S0, ""
set S1, "xyz"
substr S2, S0, 0, 3, S1
print S0
print "\n"
print S1
print "\n"
print S2
print "\n"
set S3, ""
set S4, "abcde"
substr S5, S3, 0, 0, S4
print S3
print "\n"
print S4
print "\n"
print S5
print "\n"
end
CODE
xyz
xyz
abcde
abcde
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', '4 arg substr replace, zero-length string' );
set S0, ""
set S1, "xyz"
substr S0, 0, 3, S1
print S0
print "\n"
print S1
print "\n"
set S2, ""
set S3, "abcde"
substr S2, 0, 0, S3
print S2
print "\n"
print S3
print "\n"
end
CODE
xyz
xyz
abcde
abcde
OUTPUT
pasm_output_is( <<'CODE', '<><', 'concat_s_s|sc, null onto null' );
print "<>"
concat S0, S0
concat S1, ""
print "<"
end
CODE
pasm_output_is( <<'CODE', <<'OUTPUT', 'concat_s_sc, repeated two-arg concats' );
set S12, ""
set I0, 0
WHILE:
concat S12, "hi"
add I0, 1
lt I0, 10, WHILE
print S12
print "\n"
end
CODE
hihihihihihihihihihi
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'concat_s_s|sc, "foo1" onto null' );
concat S0, "foo1"
set S1, "foo2"
concat S2, S1
print S0
print "\n"
print S2
print "\n"
end
CODE
foo1
foo2
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'concat_s_s|sc' );
set S1, "fish"
set S2, "bone"
concat S1, S2
print S1
concat S1, "\n"
print S1
end
CODE
fishbonefishbone
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'concat_s_s|sc_s|sc' );
set S1, "japh"
set S2, "JAPH"
concat S0, "japh", "JAPH"
print S0
print "\n"
concat S0, S1, "JAPH"
print S0
print "\n"
concat S0, "japh", S2
print S0
print "\n"
concat S0, S1, S2
print S0
print "\n"
end
CODE
japhJAPH
japhJAPH
japhJAPH
japhJAPH
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'concat - ensure copy is made' );
set S2, "JAPH"
concat S0, S2, ""
concat S1, "", S2
chopn S0, 1
chopn S1, 1
print S2
print "\n"
end
CODE
JAPH
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'clears' );
@{[ set_str_regs( sub {"BOO $_[0]\\n"} ) ]}
clears
@{[ print_str_regs() ]}
print "done\\n"
end
CODE
done
OUTPUT
my @strings = (
"hello", "hello", "hello", "world", "world", "hello", "hello", "hellooo",
"hellooo", "hello", "hello", "hella", "hella", "hello", "hella", "hellooo",
"hellooo", "hella", "hElLo", "HeLlO", "hElLo", "hElLo"
);
pasm_output_is( <<"CODE", <<'OUTPUT', 'eq_s_s_ic' );
@{[ compare_strings( 0, "eq", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'eq_sc_s_ic' );
@{[ compare_strings( 1, "eq", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'eq_s_sc_ic' );
@{[ compare_strings( 2, "eq", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'eq_sc_sc_ic' );
@{[ compare_strings( 3, "eq", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'ne_s_s_ic' );
@{[ compare_strings( 0, "ne", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'ne_sc_s_ic' );
@{[ compare_strings( 1, "ne", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'ne_s_sc_ic' );
@{[ compare_strings( 2, "ne", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'ne_sc_sc_ic' );
@{[ compare_strings( 3, "ne", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'lt_s_s_ic' );
@{[ compare_strings( 0, "lt", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'lt_sc_s_ic' );
@{[ compare_strings( 1, "lt", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'lt_s_sc_ic' );
@{[ compare_strings( 2, "lt", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'lt_sc_sc_ic' );
@{[ compare_strings( 3, "lt", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'le_s_s_ic' );
@{[ compare_strings( 0, "le", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'le_sc_s_ic' );
@{[ compare_strings( 1, "le", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'le_s_sc_ic' );
@{[ compare_strings( 2, "le", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'le_sc_sc_ic' );
@{[ compare_strings( 3, "le", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'gt_s_s_ic' );
@{[ compare_strings( 0, "gt", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'gt_sc_s_ic' );
@{[ compare_strings( 1, "gt", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'gt_s_sc_ic' );
@{[ compare_strings( 2, "gt", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'gt_sc_sc_ic' );
@{[ compare_strings( 3, "gt", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'ge_s_s_ic' );
@{[ compare_strings( 0, "ge", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'ge_sc_s_ic' );
@{[ compare_strings( 1, "ge", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'ge_s_sc_ic' );
@{[ compare_strings( 2, "ge", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<"CODE", <<'OUTPUT', 'ge_sc_sc_ic' );
@{[ compare_strings( 3, "ge", @strings ) ]}
print "ok\\n"
end
ERROR:
print "bad\\n"
end
CODE
ok
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'same constant twice bug' );
set S0, ""
set S1, ""
set S2, "foo"
concat S1,S1,S2
print S1
print S0
print "\n"
end
CODE
foo
OUTPUT
pasm_error_output_like( <<'CODE', <<'OUTPUT', '2-param ord, empty string' );
ord I0,""
print I0
end
CODE
/^Cannot get character of empty string/
OUTPUT
pasm_error_output_like( <<'CODE', <<'OUTPUT', '2-param ord, empty string register' );
ord I0,S0
print I0
end
CODE
/^Cannot get character of empty string/
OUTPUT
pasm_error_output_like( <<'CODE', <<'OUTPUT', '3-param ord, empty string' );
ord I0,"",0
print I0
end
CODE
/^Cannot get character of empty string/
OUTPUT
pasm_error_output_like( <<'CODE', <<'OUTPUT', '3-param ord, empty string register' );
ord I0,S0,0
print I0
end
CODE
/^Cannot get character of empty string/
OUTPUT
pasm_output_is( <<'CODE', ord('a'), '2-param ord, one-character string' );
ord I0,"a"
print I0
end
CODE
pasm_output_is( <<'CODE', ord('a'), '2-param ord, multi-character string' );
ord I0,"abc"
print I0
end
CODE
pasm_output_is( <<'CODE', ord('a'), '2-param ord, one-character string register' );
set S0,"a"
ord I0,S0
print I0
end
CODE
pasm_output_is( <<'CODE', ord('a'), '3-param ord, one-character string' );
ord I0,"a",0
print I0
end
CODE
pasm_output_is( <<'CODE', ord('a'), '3-param ord, one-character string register' );
set S0,"a"
ord I0,S0,0
print I0
end
CODE
pasm_output_is( <<'CODE', ord('b'), '3-param ord, multi-character string' );
ord I0,"ab",1
print I0
end
CODE
pasm_output_is( <<'CODE', ord('b'), '3-param ord, multi-character string register' );
set S0,"ab"
ord I0,S0,1
print I0
end
CODE
pasm_error_output_like( <<'CODE', <<'OUTPUT', '3-param ord, multi-character string' );
ord I0,"ab",2
print I0
end
CODE
/^Cannot get character past end of string/
OUTPUT
pasm_error_output_like( <<'CODE', <<'OUTPUT', '3-param ord, multi-character string' );
set S0,"ab"
ord I0,S0,2
print I0
end
CODE
/^Cannot get character past end of string/
OUTPUT
pasm_output_is( <<'CODE', ord('a'), '3-param ord, one-character string, from end' );
ord I0,"a",-1
print I0
end
CODE
pasm_output_is( <<'CODE', ord('a'), '3-param ord, one-character string register, from end' );
set S0,"a"
ord I0,S0,-1
print I0
end
CODE
pasm_output_is( <<'CODE', ord('b'), '3-param ord, multi-character string, from end' );
ord I0,"ab",-1
print I0
end
CODE
pasm_output_is( <<'CODE', ord('b'), '3-param ord, multi-character string register, from end' );
set S0,"ab"
ord I0,S0,-1
print I0
end
CODE
pasm_error_output_like(
<<'CODE', <<'OUTPUT', '3-param ord, multi-character string register, from end, OOB' );
set S0,"ab"
ord I0,S0,-3
print I0
end
CODE
/^Cannot get character before beginning of string/
OUTPUT
pasm_output_is( <<'CODE', chr(32), 'chr of 32 is space in ASCII' );
chr S0, 32
print S0
end
CODE
pasm_output_is( <<'CODE', chr(65), 'chr of 65 is A in ASCII' );
chr S0, 65
print S0
end
CODE
pasm_output_is( <<'CODE', chr(122), 'chr of 122 is z in ASCII' );
chr S0, 122
print S0
end
CODE
SKIP: {
skip( "RT#45503: broken test in jit runcore", 1 )
if ( defined $ENV{TEST_PROG_ARGS} )
and ( $ENV{TEST_PROG_ARGS} =~ /-j/ );
pasm_output_is( <<'CODE', <<'OUTPUT', 'if_s_ic' );
set S0, "I've told you once, I've told you twice..."
if S0, OK1
print "not "
OK1: print "ok 1\n"
set S0, "0.0"
if S0, OK2
print "not "
OK2: print "ok 2\n"
set S0, ""
if S0, BAD3
branch OK3
BAD3: print "not "
OK3: print "ok 3\n"
set S0, "0"
if S0, BAD4
branch OK4
BAD4: print "not "
OK4: print "ok 4\n"
set S0, "0e0"
if S0, OK5
print "not "
OK5: print "ok 5\n"
set S0, "x"
if S0, OK6
print "not "
OK6: print "ok 6\n"
set S0, "\\x0"
if S0, OK7
print "not "
OK7: print "ok 7\n"
set S0, "\n"
if S0, OK8
print "not "
OK8: print "ok 8\n"
set S0, " "
if S0, OK9
print "not "
OK9: print "ok 9\n"
# An empty register should be false...
clears
if S1, BAD10
branch OK10
BAD10: 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
}
pasm_output_is( <<'CODE', <<'OUTPUT', 'repeat_s_s|sc_i|ic' );
set S0, "x"
repeat S1, S0, 12
print S0
print "\n"
print S1
print "\n"
set I0, 12
set S2, "X"
repeat S3, S2, I0
print S2
print "\n"
print S3
print "\n"
repeat S4, "~", 12
print S4
print "\n"
repeat S5, "~", I0
print S5
print "\n"
print ">"
repeat S6, "***", 0
print S6
print "< done\n"
end
CODE
x
xxxxxxxxxxxx
X
XXXXXXXXXXXX
~~~~~~~~~~~~
~~~~~~~~~~~~
>< done
OUTPUT
pasm_error_output_like( <<'CODE', qr/Cannot repeat with negative arg\n/, 'repeat OOB' );
repeat S0, "japh", -1
end
CODE
pasm_output_is( <<'CODE', <<'OUTPUT', 'index, 3-arg form' );
set S0, "Parrot"
set S1, "Par"
index I1, S0, S1
print I1
print "\n"
set S1, "rot"
index I1, S0, S1
print I1
print "\n"
set S1, "bar"
index I1, S0, S1
print I1
print "\n"
end
CODE
0
3
-1
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'index, 4-arg form' );
set S0, "Barbarian"
set S1, "ar"
index I1, S0, S1, 0
print I1
print "\n"
index I1, S0, S1, 2
print I1
print "\n"
set S1, "qwx"
index I1, S0, S1, 0
print I1
print "\n"
end
CODE
1
4
-1
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'index, 4-arg form, bug 22718' );
set S1, "This is not quite right"
set S0, " is "
index I0, S1, S0, 0
print I0
set S0, "is"
index I0, S1, S0, 0
print I0
print "\n"
end
CODE
42
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'index, null strings' );
set S0, "Parrot"
set S1, ""
index I1, S0, S1
print I1
print "\n"
index I1, S0, S1, 0
print I1
print "\n"
index I1, S0, S1, 5
print I1
print "\n"
index I1, S0, S1, 6
print I1
print "\n"
set S0, ""
set S1, "a"
index I1, S0, S1
print I1
print "\n"
index I1, S0, S1, 0
print I1
print "\n"
set S0, "Parrot"
null S1
index I1, S0, S1
print I1
print "\n"
null S0
null S1
index I1, S0, S1
print I1
print "\n"
end
CODE
-1
-1
-1
-1
-1
-1
-1
-1
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'index, embedded nulls' );
set S0, "Par\0\0rot"
set S1, "\0"
index I1, S0, S1
print I1
print "\n"
index I1, S0, S1, 4
print I1
print "\n"
end
CODE
3
4
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'index, big strings' );
set S0, "a"
repeat S0, S0, 10000
set S1, "a"
repeat S1, S1, 500
index I1, S0, S1
print I1
print "\n"
index I1, S0, S1, 1234
print I1
print "\n"
index I1, S0, S1, 9501
print I1
print "\n"
end
CODE
0
1234
-1
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'index, big, hard to match strings' );
# Builds a 24th iteration fibonacci string (approx. 100K)
set S1, "a"
set S2, "b"
set I0, 0
LOOP:
set S3, S1
concat S1, S2, S3
set S2, S3
inc I0
lt I0, 24, LOOP
index I1, S1, S2
print I1
print "\n"
index I1, S1, S2, 50000
print I1
print "\n"
end
CODE
46368
-1
OUTPUT
pir_output_is( << 'CODE', << 'OUTPUT', 'index with different charsets' );
.sub test :main
print "default - default:\n"
set S0, "Parrot"
set S1, "rot"
index I1, S0, S1
print I1
print "\n"
print "ascii - ascii:\n"
set S0, ascii:"Parrot"
set S1, ascii:"rot"
index I1, S0, S1
print I1
print "\n"
print "default - ascii:\n"
set S0, "Parrot"
set S1, ascii:"rot"
index I1, S0, S1
print I1
print "\n"
print "ascii - default:\n"
set S0, ascii:"Parrot"
set S1, "rot"
index I1, S0, S1
print I1
print "\n"
print "binary - binary:\n"
set S0, binary:"Parrot"
set S1, binary:"rot"
index I1, S0, S1
print I1
print "\n"
.end
CODE
default - default:
3
ascii - ascii:
3
default - ascii:
3
ascii - default:
3
binary - binary:
-1
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'negative index #35959' );
index I1, "u", "t", -123456
print I1
print "\n"
index I1, "u", "t", -123456789
print I1
print "\n"
end
CODE
-1
-1
OUTPUT
SKIP: {
skip( "Pending rework of creating non-ascii literals", 2 );
pasm_output_is( <<'CODE', <<'OUTPUT', 'index, multibyte matching' );
set S0, "\xAB"
find_chartype I0, "8859-1"
set_chartype S0, I0
find_encoding I0, "singlebyte"
set_encoding S0, I0
find_encoding I0, "utf8"
find_chartype I1, "unicode"
transcode S1, S0, I0, I1
eq S0, S1, equal
print "not "
equal:
print "equal\n"
index I0, S0, S1
print I0
print "\n"
index I0, S1, S0
print I0
print "\n"
end
CODE
equal
0
0
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'index, multibyte matching 2' );
set S0, "\xAB\xBA"
set S1, "foo\xAB\xAB\xBAbar"
find_chartype I0, "8859-1"
set_chartype S0, I0
find_encoding I0, "singlebyte"
set_encoding S0, I0
find_chartype I0, "unicode"
find_encoding I1, "utf8"
transcode S1, S1, I1, I0
index I0, S0, S1
print I0
print "\n"
index I0, S1, S0
print I0
print "\n"
end
CODE
-1
4
OUTPUT
}
pasm_output_is( <<'CODE', <<'OUTPUT', 'num to string' );
set N0, 80.43
set S0, N0
print S0
print "\n"
set N0, -1.111111
set S0, N0
print S0
print "\n"
end
CODE
80.43
-1.11111
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'string to int' );
set S0, "123"
set I0, S0
print I0
print "\n"
set S0, " 1"
set I0, S0
print I0
print "\n"
set S0, "-1"
set I0, S0
print I0
print "\n"
set S0, "Not a number"
set I0, S0
print I0
print "\n"
set S0, ""
set I0, S0
print I0
print "\n"
end
CODE
123
1
-1
0
0
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'concat/substr (COW)' );
set S0, "<JA"
set S1, "PH>"
set S2, ""
concat S2, S2, S0
concat S2, S2, S1
print S2
print "\n"
substr S0, S2, 1, 4
print S0
print "\n"
end
CODE
<JAPH>
JAPH
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'constant to cstring' );
stringinfo I0, "\n", 2
stringinfo I1, "\n", 2
eq I1, I0, ok1
print "N"
ok1:
print "OK"
print "\n"
stringinfo I2, "\n", 2
eq I2, I0, ok2
print "N"
ok2:
print "OK\n"
end
CODE
OK
OK
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'COW with chopn leaving original untouched' );
set S0, "ABCD"
clone S1, S0
chopn S0, 1
print S0
print "\n"
print S1
print "\n"
end
CODE
ABC
ABCD
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'Check that bug #16874 was fixed' );
set S0, "foo "
set S1, "bar "
set S2, "quux "
set S15, ""
concat S15, S0
concat S15, S1
concat S15, S2
print "["
print S15
print "]\n"
end
CODE
[foo bar quux ]
OUTPUT
pasm_output_is( <<'CODE', "all ok\n", 'stress concat' );
set I0, 1000
set S0, "michael"
LOOP:
set S2, I0
concat S1, S0, S2
concat S3, "mic", "hael"
concat S3, S3, S2
eq S1, S3, BOTTOM
print "Failed: "
print S1
print " ne "
print S3
print "\n"
end
BOTTOM:
sub I0, I0, 1
ne I0, 0, LOOP
print "all ok\n"
end
CODE
pasm_output_is( <<'CODE', <<'OUTPUT', 'ord and substring (see #17035)' );
set S0, "abcdef"
substr S1, S0, 2, 3
ord I0, S0, 2
ord I1, S1, 0
ne I0, I1, fail
ord I0, S0, 3
ord I1, S1, 1
ne I0, I1, fail
ord I0, S0, 4
ord I1, S1, 2
ne I0, I1, fail
print "It's all good\n"
end
fail:
print "Not good: original string="
print I0
print ", substring="
print I1
print "\n"
end
CODE
It's all good
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'sprintf' );
branch MAIN
NEWARYP:
new P1, 'ResizablePMCArray'
set P1[0], P0
ret
NEWARYS:
new P1, 'ResizablePMCArray'
set P1[0], S0
ret
NEWARYI:
new P1, 'ResizablePMCArray'
set P1[0], I0
ret
NEWARYN:
new P1, 'ResizablePMCArray'
set P1[0], N0
ret
PRINTF:
sprintf S2, S1, P1
print S2
ret
MAIN:
set S1, "Hello, %s\n"
set S0, "Parrot!"
bsr NEWARYS
bsr PRINTF
set S1, "Hash[0x%x]\n"
set I0, 256
bsr NEWARYI
bsr PRINTF
set S1, "Hash[0x%lx]\n"
set I0, 256
bsr NEWARYI
bsr PRINTF
set S1, "Hello, %.2s!\n"
set S0, "Parrot"
bsr NEWARYS
bsr PRINTF
set S1, "Hello, %Ss"
set S0, S2
bsr NEWARYS
bsr PRINTF
set S1, "1 == %Pd\n"
new P0, 'Integer'
set P0, 1
bsr NEWARYP
bsr PRINTF
set S1, "-255 == %vd\n"
set I0, -255
bsr NEWARYI
bsr PRINTF
set S1, "+123 == %+vd\n"
set I0, 123
bsr NEWARYI
bsr PRINTF
set S1, "256 == %vu\n"
set I0, 256
bsr NEWARYI
bsr PRINTF
set S1, "1 == %+vu\n"
set I0, 1
bsr NEWARYI
bsr PRINTF
set S1, "001 == %0.3u\n"
set I0, 1
bsr NEWARYI
bsr PRINTF
set S1, "001 == %+0.3u\n"
set I0, 1
bsr NEWARYI
bsr PRINTF
set S1, "0.500000 == %f\n"
set N0, 0.5
bsr NEWARYN
bsr PRINTF
set S1, "0.500 == %5.3f\n"
set N0, 0.5
bsr NEWARYN
bsr PRINTF
set S1, "0.001 == %g\n"
set N0, 0.001
bsr NEWARYN
bsr PRINTF
set S1, "1e+06 == %g\n"
set N0, 1.0e6
bsr NEWARYN
bsr PRINTF
set S1, "0.5 == %3.3g\n"
set N0, 0.5
bsr NEWARYN
bsr PRINTF
set S1, "%% == %%\n"
set I0, 0
bsr NEWARYI
bsr PRINTF
set S1, "That's all, %s\n"
set S0, "folks!"
bsr NEWARYS
bsr PRINTF
end
CODE
Hello, Parrot!
Hash[0x100]
Hash[0x100]
Hello, Pa!
Hello, Hello, Pa!
1 == 1
-255 == -255
+123 == +123
256 == 256
1 == 1
001 == 001
001 == 001
0.500000 == 0.500000
0.500 == 0.500
0.001 == 0.001
1e+06 == 1e+06
0.5 == 0.5
% == %
That's all, folks!
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'other form of sprintf op' );
branch MAIN
PRINTF:
sprintf P3, P2, P1
print P3
ret
MAIN:
new P3, 'String'
new P2, 'String'
set P2, "15 is %b\n"
new P1, 'ResizablePMCArray'
set P1[0], 15
bsr PRINTF
new P2, 'String'
set P2, "128 is %o\n"
new P1, 'ResizablePMCArray'
set P1[0], 128
bsr PRINTF
end
CODE
15 is 1111
128 is 200
OUTPUT
pir_output_is( <<'CODE', <<'OUTPUT', 'sprintf - left justify' );
.sub main :main
$P0 = new 'ResizablePMCArray'
$P1 = new 'Integer'
$P1 = 10
$P0[0] = $P1
$P1 = new 'String'
$P1 = "foo"
$P0[1] = $P1
$P1 = new 'String'
$P1 = "bar"
$P0[2] = $P1
$S0 = sprintf "%-*s - %s\n", $P0
print $S0
end
.end
CODE
foo - bar
OUTPUT
{
my $output = substr( ( 'f' x ( $PConfig{intvalsize} * 2 ) ) . ( ' ' x 20 ), 0, 20 );
pir_output_is( <<'CODE', $output, 'Correct precision for %x' ); }
.sub main :main
$P0 = new 'ResizablePMCArray'
$P0[0] = -1
$S0 = sprintf "%-20x", $P0
print $S0
end
.end
CODE
pasm_output_is( <<'CODE', <<'OUTPUT', 'exchange' );
set S0, "String #0\n"
set S1, "String #1\n"
exchange S0, S1
print S0
print S1
set S2, "String #2\n"
exchange S2, S2
print S2
end
CODE
String #1
String #0
String #2
OUTPUT
SKIP: {
skip( "Peding reimplementation of find_encoding", 1 );
pasm_output_is( <<'CODE', <<'OUTPUT', 'find_encoding' );
find_encoding I0, "singlebyte"
print I0
print "\n"
find_encoding I0, "utf8"
print I0
print "\n"
find_encoding I0, "utf16"
print I0
print "\n"
find_encoding I0, "utf32"
print I0
print "\n"
end
CODE
0
1
2
3
OUTPUT
}
SKIP: {
skip( "no more visible encoding", 1 );
pasm_output_is( <<'CODE', <<'OUTPUT', 'string_encoding' );
set I0, 0
new S0, 0, I0
string_encoding I1, S0
eq I0, I1, OK1
print "not "
OK1: print "ok 1\n"
set I0, 1
new S0, 0, I0
string_encoding I1, S0
eq I0, I1, OK2
print "not "
OK2: print "ok 2\n"
set I0, 2
new S0, 0, I0
string_encoding I1, S0
eq I0, I1, OK3
print "not "
OK3: print "ok 3\n"
set I0, 3
new S0, 0, I0
string_encoding I1, S0
eq I0, I1, OK4
print "not "
OK4: print "ok 4\n"
end
CODE
ok 1
ok 2
ok 3
ok 4
OUTPUT
}
pasm_output_is( <<'CODE', <<'OUTPUT', 'experimental opcode substr_r_s_s|sc_i|ic_i|ic' );
set S4, "12345JAPH01"
set I4, 5
set I5, 4
substr_r S5, S4, I4, I5
print S5
substr_r S5, S4, I4, 4
print S5
substr_r S5, S4, 5, I5
print S5
substr_r S5, S4, 5, 4
print S5
substr_r S5, "12345JAPH01", I4, I5
print S5
substr_r S5, "12345JAPH01", I4, 4
print S5
substr_r S5, "12345JAPH01", 5, I5
print S5
substr_r S5, "12345JAPH01", 5, 4
print S5
print "\n"
end
CODE
JAPHJAPHJAPHJAPHJAPHJAPHJAPHJAPH
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'assign' );
set S4, "JAPH\n"
assign S5, S4
print S4
print S5
end
CODE
JAPH
JAPH
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'assign & globber' );
set S4, "JAPH\n"
assign S5, S4
assign S4, "Parrot\n"
print S4
print S5
end
CODE
Parrot
JAPH
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'assign & globber 2' );
set S4, "JAPH\n"
set S5, S4
assign S4, "Parrot\n"
print S4
print S5
end
CODE
Parrot
Parrot
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'bands NULL string' );
null S1
set S2, "abc"
bands S1, S2
null S3
eq S1, S3, ok1
print "not "
ok1: print "ok 1\n"
set S1, ""
bands S1, S2
unless S1, ok2
print "not "
ok2: print "ok 2\n"
null S2
set S1, "abc"
bands S1, S2
null S3
eq S1, S3, ok3
print "not "
ok3: print "ok 3\n"
set S2, ""
bands S1, S2
unless S1, ok4
print "not "
ok4: print "ok 4\n"
end
CODE
ok 1
ok 2
ok 3
ok 4
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'bands 2' );
set S1, "abc"
set S2, "EE"
bands S1, S2
print S1
print "\n"
print S2
print "\n"
end
CODE
A@
EE
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'bands 3' );
set S1, "abc"
set S2, "EE"
bands S0, S1, S2
print S0
print "\n"
print S1
print "\n"
print S2
print "\n"
end
CODE
A@
abc
EE
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'bands COW' );
set S1, "foo"
substr S2, S1, 0, 3
bands S1, "bar"
print S2
print "\n"
end
CODE
foo
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'bors NULL string' );
null S1
null S2
bors S1, S2
null S3
eq S1, S3, OK1
print "not "
OK1: print "ok 1\n"
null S1
set S2, ""
bors S1, S2
null S3
eq S1, S3, OK2
print "not "
OK2: print "ok 2\n"
bors S2, S1
eq S2, S3, OK3
print "not "
OK3: print "ok 3\n"
null S1
set S2, "def"
bors S1, S2
eq S1, "def", OK4
print "not "
OK4: print "ok 4\n"
null S2
bors S1, S2
eq S1, "def", OK5
print "not "
OK5: print "ok 5\n"
null S1
null S2
bors S3, S1, S2
null S4
eq S3, S4, OK6
print "not "
OK6: print "ok 6\n"
set S1, ""
bors S3, S1, S2
eq S3, S4, OK7
print "not "
OK7: print "ok 7\n"
bors S3, S2, S1
eq S3, S4, OK8
print "not "
OK8: print "ok 8\n"
set S1, "def"
bors S3, S1, S2
eq S3, "def", OK9
print "not "
OK9: print "ok 9\n"
bors S3, S2, S1
eq S3, "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
pasm_output_is( <<'CODE', <<'OUTPUT', 'bors 2' );
set S1, "abc"
set S2, "EE"
bors S1, S2
print S1
print "\n"
print S2
print "\n"
end
CODE
egc
EE
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'bors 3' );
set S1, "abc"
set S2, "EE"
bors S0, S1, S2
print S0
print "\n"
print S1
print "\n"
print S2
print "\n"
end
CODE
egc
abc
EE
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'bors COW' );
set S1, "foo"
substr S2, S1, 0, 3
bors S1, "bar"
print S2
print "\n"
end
CODE
foo
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'bxors NULL string' );
null S1
null S2
bxors S1, S2
null S3
eq S1, S3, OK1
print "not "
OK1: print "ok 1\n"
null S1
set S2, ""
bxors S1, S2
null S3
eq S1, S3, OK2
print "not "
OK2: print "ok 2\n"
bxors S2, S1
eq S2, S3, OK3
print "not "
OK3: print "ok 3\n"
null S1
set S2, "abc"
bxors S1, S2
eq S1, "abc", OK4
print "not "
OK4: print "ok 4\n"
null S2
bxors S1, S2
eq S1, "abc", OK5
print "not "
OK5: print "ok 5\n"
null S1
null S2
bxors S3, S1, S2
null S4
eq S3, S4, OK6
print "not "
OK6: print "ok 6\n"
set S1, ""
bxors S3, S1, S2
eq S3, S4, OK7
print "not "
OK7: print "ok 7\n"
bxors S3, S2, S1
eq S3, S4, OK8
print "not "
OK8: print "ok 8\n"
set S1, "abc"
bxors S3, S1, S2
eq S3, "abc", OK9
print "not "
OK9: print "ok 9\n"
bxors S3, S2, S1
eq S3, "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
pasm_output_is( <<'CODE', <<'OUTPUT', 'bxors 2' );
set S1, "a2c"
set S2, "Dw"
bxors S1, S2
print S1
print "\n"
print S2
print "\n"
set S1, "abc"
set S2, " X"
bxors S1, S2
print S1
print "\n"
print S2
print "\n"
end
CODE
%Ec
Dw
ABCX
X
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'bxors 3' );
set S1, "a2c"
set S2, "Dw"
bxors S0, S1, S2
print S0
print "\n"
print S1
print "\n"
print S2
print "\n"
set S1, "abc"
set S2, " Y"
bxors S0, S1, S2
print S0
print "\n"
print S1
print "\n"
print S2
print "\n"
end
CODE
%Ec
a2c
Dw
ABCY
abc
Y
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'bxors COW' );
set S1, "foo"
substr S2, S1, 0, 3
bxors S1, "bar"
print S2
print "\n"
end
CODE
foo
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'bnots NULL string' );
null S1
null S2
bnots S1, S2
null S3
eq S1, S3, OK1
print "not "
OK1: print "ok 1\n"
null S1
set S2, ""
bnots S1, S2
null S3
eq S1, S3, OK2
print "not "
OK2: print "ok 2\n"
bnots S2, S1
eq S2, S3, OK3
print "not "
OK3: print "ok 3\n"
end
CODE
ok 1
ok 2
ok 3
OUTPUT
SKIP: {
skip( "No unicode yet", 1 );
pasm_output_is( <<'CODE', <<'OUTPUT', 'bnots 2' );
getstdout P0
push P0, "utf8"
set S1, "a2c"
bnots S2, S1
print S1
print "\n"
print S2
print "\n"
bnots S1, S1
print S1
print "\n"
bnots S1, S1
print S1
print "\n"
end
CODE
a2c
\xC2\x9E\xC3\x8D\xC2\x9C
\xC2\x9E\xC3\x8D\xC2\x9C
a2c
OUTPUT
}
pasm_output_is( <<'CODE', <<'OUTPUT', 'bnots COW' );
set S1, "foo"
substr S2, S1, 0, 3
bnots S1, S1
print S2
print "\n"
end
CODE
foo
OUTPUT
SKIP: {
skip( "no more transcode", 1 );
pasm_output_is( <<'CODE', <<'OUTPUT', 'transcode to utf8' );
set S1, "ASCII is the same as UTF8\n"
find_encoding I1, "utf8"
transcode S2, S1, I1
print S1
print S2
end
CODE
ASCII is the same as UTF8
ASCII is the same as UTF8
OUTPUT
}
SKIP: {
skip( "no more chartype", 1 );
pasm_output_is( <<'CODE', <<'OUTPUT', 'string_chartype' );
set S0, "Test String"
find_chartype I0, "usascii"
set_chartype S0, I0
string_chartype I1, S0
eq I1, I0, OK
print I0
print "\n"
print I1
print "\n"
print "not "
OK: print "ok\n"
end
CODE
ok
OUTPUT
}
# Set all string registers to values given by &$_[0](reg num)
sub set_str_regs {
my $code = shift;
my $rt;
for ( 0 .. 31 ) {
$rt .= "\tset S$_, \"" . &$code($_) . "\"\n";
}
return $rt;
}
# print string registers, no additional prints
sub print_str_regs {
my $rt;
for ( 0 .. 31 ) {
$rt .= "\tprint S$_\n";
}
return $rt;
}
# Generate code to compare each pair of strings in a list
sub compare_strings {
my $const = shift;
my $op = shift;
my @strings = @_;
my $i = 1;
my $rt;
while (@strings) {
my $s1 = shift @strings;
my $s2 = shift @strings;
my $arg1;
my $arg2;
if ( $const == 3 ) {
$arg1 = "\"$s1\"";
$arg2 = "\"$s2\"";
}
elsif ( $const == 2 ) {
$rt .= " set S0, \"$s1\"\n";
$arg1 = "S0";
$arg2 = "\"$s2\"";
}
elsif ( $const == 1 ) {
$rt .= " set S0, \"$s2\"\n";
$arg1 = "\"$s1\"";
$arg2 = "S0";
}
else {
$rt .= " set S0, \"$s1\"\n";
$rt .= " set S1, \"$s2\"\n";
$arg1 = "S0";
$arg2 = "S1";
}
if ( eval "\"$s1\" $op \"$s2\"" ) {
$rt .= " $op $arg1, $arg2, OK$i\n";
$rt .= " branch ERROR\n";
}
else {
$rt .= " $op $arg1, $arg2, ERROR\n";
}
$rt .= "OK$i:\n";
$i++;
}
return $rt;
}
pasm_output_is( <<'CODE', <<'OUTPUT', 'split on empty string' );
_main:
split P1, "", ""
set I1, P1
print I1
print "\n"
split P0, "", "ab"
set I0, P0
print I0
print "\n"
set S0, P0[0]
print S0
set S0, P0[1]
print S0
print "\n"
end
CODE
0
2
ab
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'split on non-empty string' );
_main:
split P0, "a", "afooabara"
set I0, P0
print I0
print "\n"
set I1, 0
loop:
set S0, P0[I1]
print S0
print "\n"
inc I1
sub I2, I1, I0
if I2, loop
end
CODE
5
foo
b
r
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'join' );
_main:
new P0, 'ResizablePMCArray'
join S0, "--", P0
print S0
print "\n"
push P0, "a"
join S0, "--", P0
print S0
print "\n"
new P0, 'ResizablePMCArray'
push P0, "a"
push P0, "b"
join S0, "--", P0
print S0
print "\n"
end
CODE
a
a--b
OUTPUT
pir_output_is( <<'CODE', <<'OUTPUT', 'join: get_string returns a null string' );
.sub _main
newclass P0, "Foo"
new P0, 'ResizablePMCArray'
P1 = new "Foo"
push P0, P1
print "a"
join S0, "", P0
print "b"
print S0
print "c\n"
end
.end
.namespace ["Foo"]
.sub get_string :vtable :method
.local string ret
null ret
.begin_return
.return ret
.end_return
.end
CODE
abc
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'eq_addr/ne_addr' );
set S0, "Test"
set S1, S0
eq_addr S1, S0, OK1
print "not "
OK1: print "ok 1\n"
set S1, "Test"
eq_addr S1, S0, BAD2
branch OK2
BAD2: print "not "
OK2: print "ok 2\n"
ne_addr S1, S0, OK3
print "not "
OK3: print "ok 3\n"
set S0, S1
ne_addr S1, S0, BAD4
branch OK4
BAD4: print "not "
OK4: print "ok 4\n"
end
CODE
ok 1
ok 2
ok 3
ok 4
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'if_null_s_ic' );
set S0, "foo"
if_null S0, ERROR
print "ok 1\n"
null S0
if_null S0, OK
ERROR: print "error\n"
end
OK: print "ok 2\n"
end
CODE
ok 1
ok 2
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'upcase' );
set S0, "abCD012yz\n"
upcase S1, S0
print S1
upcase S0
print S0
end
CODE
ABCD012YZ
ABCD012YZ
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'downcase' );
set S0, "ABcd012YZ\n"
downcase S1, S0
print S1
downcase S0
print S0
end
CODE
abcd012yz
abcd012yz
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', 'titlecase' );
set S0, "aBcd012YZ\n"
titlecase S1, S0
print S1
titlecase S0
print S0
end
CODE
Abcd012yz
Abcd012yz
OUTPUT
pasm_output_is( <<'CODE', ord('a'), '3-param ord, one-character string register, I' );
set S0,"a"
set I1, 0
ord I0,S0,I1
print I0
end
CODE
pasm_output_is( <<'CODE', ord('b'), '3-param ord, multi-character string, I' );
set I1, 1
ord I0,"ab",I1
print I0
end
CODE
pasm_output_is( <<'CODE', ord('b'), '3-param ord, multi-character string register, I' );
set I1, 1
set S0,"ab"
ord I0,S0,I1
print I0
end
CODE
pasm_error_output_like( <<'CODE', <<'OUTPUT', '3-param ord, multi-character string, I' );
set I1, 2
ord I0,"ab",I1
print I0
end
CODE
/^Cannot get character past end of string/
OUTPUT
pasm_error_output_like( <<'CODE', <<'OUTPUT', '3-param ord, multi-character string, I' );
set I1, 2
set S0,"ab"
ord I0,S0,I1
print I0
end
CODE
/^Cannot get character past end of string/
OUTPUT
pasm_output_is( <<'CODE', ord('a'), '3-param ord, one-character string, from end, I' );
set I1, -1
ord I0,"a",I1
print I0
end
CODE
pasm_output_is( <<'CODE', ord('a'), '3-param ord, one-character string register, from end, I' );
set I1, -1
set S0,"a"
ord I0,S0,I1
print I0
end
CODE
pasm_output_is( <<'CODE', ord('b'), '3-param ord, multi-character string, from end, I' );
set I1, -1
ord I0,"ab",I1
print I0
end
CODE
pasm_output_is( <<'CODE', ord('b'), '3-param ord, multi-character string register, from end, I' );
set I1, -1
set S0,"ab"
ord I0,S0,I1
print I0
end
CODE
pasm_error_output_like(
<<'CODE', <<'OUTPUT', '3-param ord, multi-character string register, from end, OOB, I' );
set I1, -3
set S0,"ab"
ord I0,S0,I1
print I0
end
CODE
/^Cannot get character before beginning of string/
OUTPUT
pir_output_is( <<'CODE', <<'OUT', 'more string_to_int' );
.sub 'main' :main
print_as_integer('-4')
print_as_integer('X-4')
print_as_integer('--4')
print_as_integer('+')
print_as_integer('++')
print_as_integer('+2')
print_as_integer(' +3')
print_as_integer('++4')
print_as_integer('+ 5')
print_as_integer('-')
print_as_integer('--56')
print_as_integer(' -+67')
print_as_integer('+-78')
print_as_integer(' -089xyz')
print_as_integer('- 89')
.end
.sub 'print_as_integer'
.param string s
$I0 = s
print $I0
print "\n"
.end
CODE
-4
0
0
0
0
2
3
0
0
0
0
0
0
-89
0
OUT
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
syntax highlighted by Code2HTML, v. 0.9.1