2 # Copyright (C) 2001-2007, The Perl Foundation.
7 use lib qw( . lib ../lib ../../lib );
10 use Parrot::Test tests => 160;
15 t/op/string.t - Parrot Strings
23 Tests Parrot string registers and operations.
27 pasm_output_is( <<'CODE', <<'OUTPUT', 'set_s_s|sc' );
38 pasm_output_is( <<'CODE', <<'OUTPUT', 'clone' );
46 chopn S1, 1 # Check that the contents of S1 are no longer constant
58 pasm_output_is( <<'CODE', '4', 'length_i_s' );
66 pasm_output_is( <<'CODE', '0', '0 length substr' );
75 pasm_output_is( <<'CODE', <<'OUTPUT', 'chopn with clone' );
97 pasm_output_is( <<'CODE', <<'OUTPUT', 'chopn with set' );
119 pasm_output_is( <<'CODE', <<'OUTPUT', 'chopn, OOB values' );
120 set S1, "A string of length 21"
133 print "** nothing **\n"
136 A string of length 21
142 pasm_output_is( <<'CODE', <<'OUTPUT', 'Three argument chopn' );
164 chopn S2, "Parrot", 3
197 pasm_output_is( <<'CODE', <<'OUTPUT', 'Three argument chopn, OOB values' );
220 pasm_output_is( <<'CODE', <<'OUTPUT', 'substr_s_s|sc_i|ic_i|ic' );
221 set S4, "12345JAPH01"
224 substr S5, S4, I4, I5
232 substr S5, "12345JAPH01", I4, I5
234 substr S5, "12345JAPH01", I4, 4
236 substr S5, "12345JAPH01", 5, I5
238 substr S5, "12345JAPH01", 5, 4
243 JAPHJAPHJAPHJAPHJAPHJAPHJAPHJAPH
247 pasm_output_is( <<'CODE', <<'OUTPUT', 'neg substr offset' );
248 set S0, "A string of length 21"
251 substr S1, S0, I0, I1
258 A string of length 21
262 # This asks for substring that shouldn't be allowed...
263 pasm_error_output_like( <<'CODE', <<'OUTPUT', 'substr OOB' );
264 set S0, "A string of length 21"
267 substr S1, S0, I0, I1
270 /^Cannot take substr outside string/
273 # This asks for substring that shouldn't be allowed...
274 pasm_error_output_like( <<'CODE', <<'OUTPUT', 'substr OOB' );
275 set S0, "A string of length 21"
278 substr S1, S0, I0, I1
281 /^Cannot take substr outside string/
284 # This asks for substring much greater than length of original string
285 pasm_output_is( <<'CODE', <<'OUTPUT', 'len>strlen' );
286 set S0, "A string of length 21"
289 substr S1, S0, I0, I1
296 A string of length 21
300 # The same, with a negative offset
301 pasm_output_is( <<'CODE', <<'OUTPUT', 'len>strlen, -ve os' );
302 set S0, "A string of length 21"
305 substr S1, S0, I0, I1
312 A string of length 21
316 pasm_output_is( <<'CODE', <<'OUTPUT', '5 arg substr, replacement = length' );
317 set S0, "abcdefghijk"
319 substr S2, S0, 4, 3, S1
333 pasm_output_is( <<'CODE', <<'OUTPUT', '5 arg substr, replacement > length' );
334 set S0, "abcdefghijk"
336 substr S2, S0, 4, 3, S1
350 pasm_output_is( <<'CODE', <<'OUTPUT', '5 arg substr, replacement < length' );
351 set S0, "abcdefghijk"
353 substr S2, S0, 4, 3, S1
367 pasm_output_is( <<'CODE', <<'OUTPUT', '5 arg substr, offset at end of string' );
368 set S0, "abcdefghijk"
370 substr S2, S0, 11, 3, S1
384 pasm_error_output_like( <<'CODE', <<'OUTPUT', '5 arg substr, offset past end of string' );
385 set S0, "abcdefghijk"
387 substr S2, S0, 12, 3, S1
396 /^Can only replace inside string or index after end of string/
399 pasm_output_is( <<'CODE', <<'OUTPUT', '5 arg substr, -ve offset, repl=length' );
400 set S0, "abcdefghijk"
402 substr S2, S0, -3, 3, S1
416 pasm_output_is( <<'CODE', <<'OUTPUT', '5 arg substr, -ve offset, repl>length' );
417 set S0, "abcdefghijk"
419 substr S2, S0, -6, 2, S1
433 pasm_output_is( <<'CODE', <<'OUTPUT', '5 arg substr, -ve offset, repl<length' );
434 set S0, "abcdefghijk"
436 substr S2, S0, -6, 4, S1
450 pasm_error_output_like( <<'CODE', <<'OUTPUT', '5 arg substr, -ve offset out of string' );
451 set S0, "abcdefghijk"
453 substr S2, S0, -12, 4, S1
462 /^Can only replace inside string or index after end of string/
465 pasm_output_is( <<'CODE', <<'OUTPUT', '5 arg substr, length > strlen ' );
466 set S0, "abcdefghijk"
468 substr S2, S0, 3, 11, S1
482 pasm_output_is( <<'CODE', <<'OUTPUT', '5 arg substr, length > strlen, -ve offset' );
483 set S0, "abcdefghijk"
485 substr S2, S0, -3, 11, S1
499 pasm_output_is( <<'CODE', <<'OUTPUT', '4-arg, replacement-only substr' );
500 set S0, "abcdefghijk"
513 pasm_output_is( <<'CODE', 'PH', '3-arg substr' );
520 pasm_error_output_like( <<'CODE', <<'OUTPUT', "substr, +ve offset, zero-length string" );
526 /Cannot take substr outside string/
529 pasm_output_is( <<'CODE', <<'OUTPUT', 'substr, offset 0, zero-length string' );
539 pasm_error_output_like( <<'CODE', <<'OUTPUT', "substr, offset -1, zero-length string" );
545 /Cannot take substr outside string/
548 pasm_error_output_like( <<'CODE', <<'OUTPUT', "substr, -ve offset, zero-length string" );
550 substr S1, S0, -10, 5
554 /Cannot take substr outside string/
557 pasm_output_is( <<'CODE', <<'OUTPUT', 'zero-length substr, zero-length string' );
567 pasm_output_is( <<'CODE', <<'OUTPUT', 'zero-length substr, zero-length string' );
569 substr S1, S0, -10, 0
577 pasm_output_is( <<'CODE', <<'OUTPUT', '3-arg substr, zero-length string' );
587 pasm_output_is( <<'CODE', <<'OUTPUT', '5 arg substr, zero-length string' );
590 substr S2, S0, 0, 3, S1
600 substr S5, S3, 0, 0, S4
617 pasm_output_is( <<'CODE', <<'OUTPUT', '4 arg substr replace, zero-length string' );
641 pasm_output_is( <<'CODE', '<><', 'concat_s_s|sc, null onto null' );
649 pasm_output_is( <<'CODE', <<'OUTPUT', 'concat_s_sc, repeated two-arg concats' );
663 pasm_output_is( <<'CODE', <<'OUTPUT', 'concat_s_s|sc, "foo1" onto null' );
677 pasm_output_is( <<'CODE', <<'OUTPUT', 'concat_s_s|sc' );
689 pasm_output_is( <<'CODE', <<'OUTPUT', 'concat_s_s|sc_s|sc' );
692 concat S0, "japh", "JAPH"
695 concat S0, S1, "JAPH"
698 concat S0, "japh", S2
712 pasm_output_is( <<'CODE', <<'OUTPUT', 'concat - ensure copy is made' );
725 pasm_output_is( <<"CODE", <<'OUTPUT', 'clears' );
726 @{[ set_str_regs( sub {"BOO $_[0]\\n"} ) ]}
728 @{[ print_str_regs() ]}
736 "hello", "hello", "hello", "world", "world", "hello", "hello", "hellooo",
737 "hellooo", "hello", "hello", "hella", "hella", "hello", "hella", "hellooo",
738 "hellooo", "hella", "hElLo", "HeLlO", "hElLo", "hElLo"
741 pasm_output_is( <<"CODE", <<'OUTPUT', 'eq_s_s_ic' );
742 @{[ compare_strings( 0, "eq", @strings ) ]}
752 pasm_output_is( <<"CODE", <<'OUTPUT', 'eq_sc_s_ic' );
753 @{[ compare_strings( 1, "eq", @strings ) ]}
763 pasm_output_is( <<"CODE", <<'OUTPUT', 'eq_s_sc_ic' );
764 @{[ compare_strings( 2, "eq", @strings ) ]}
774 pasm_output_is( <<"CODE", <<'OUTPUT', 'eq_sc_sc_ic' );
775 @{[ compare_strings( 3, "eq", @strings ) ]}
785 pasm_output_is( <<"CODE", <<'OUTPUT', 'ne_s_s_ic' );
786 @{[ compare_strings( 0, "ne", @strings ) ]}
796 pasm_output_is( <<"CODE", <<'OUTPUT', 'ne_sc_s_ic' );
797 @{[ compare_strings( 1, "ne", @strings ) ]}
807 pasm_output_is( <<"CODE", <<'OUTPUT', 'ne_s_sc_ic' );
808 @{[ compare_strings( 2, "ne", @strings ) ]}
818 pasm_output_is( <<"CODE", <<'OUTPUT', 'ne_sc_sc_ic' );
819 @{[ compare_strings( 3, "ne", @strings ) ]}
829 pasm_output_is( <<"CODE", <<'OUTPUT', 'lt_s_s_ic' );
830 @{[ compare_strings( 0, "lt", @strings ) ]}
840 pasm_output_is( <<"CODE", <<'OUTPUT', 'lt_sc_s_ic' );
841 @{[ compare_strings( 1, "lt", @strings ) ]}
851 pasm_output_is( <<"CODE", <<'OUTPUT', 'lt_s_sc_ic' );
852 @{[ compare_strings( 2, "lt", @strings ) ]}
862 pasm_output_is( <<"CODE", <<'OUTPUT', 'lt_sc_sc_ic' );
863 @{[ compare_strings( 3, "lt", @strings ) ]}
873 pasm_output_is( <<"CODE", <<'OUTPUT', 'le_s_s_ic' );
874 @{[ compare_strings( 0, "le", @strings ) ]}
884 pasm_output_is( <<"CODE", <<'OUTPUT', 'le_sc_s_ic' );
885 @{[ compare_strings( 1, "le", @strings ) ]}
895 pasm_output_is( <<"CODE", <<'OUTPUT', 'le_s_sc_ic' );
896 @{[ compare_strings( 2, "le", @strings ) ]}
906 pasm_output_is( <<"CODE", <<'OUTPUT', 'le_sc_sc_ic' );
907 @{[ compare_strings( 3, "le", @strings ) ]}
917 pasm_output_is( <<"CODE", <<'OUTPUT', 'gt_s_s_ic' );
918 @{[ compare_strings( 0, "gt", @strings ) ]}
928 pasm_output_is( <<"CODE", <<'OUTPUT', 'gt_sc_s_ic' );
929 @{[ compare_strings( 1, "gt", @strings ) ]}
939 pasm_output_is( <<"CODE", <<'OUTPUT', 'gt_s_sc_ic' );
940 @{[ compare_strings( 2, "gt", @strings ) ]}
950 pasm_output_is( <<"CODE", <<'OUTPUT', 'gt_sc_sc_ic' );
951 @{[ compare_strings( 3, "gt", @strings ) ]}
961 pasm_output_is( <<"CODE", <<'OUTPUT', 'ge_s_s_ic' );
962 @{[ compare_strings( 0, "ge", @strings ) ]}
972 pasm_output_is( <<"CODE", <<'OUTPUT', 'ge_sc_s_ic' );
973 @{[ compare_strings( 1, "ge", @strings ) ]}
983 pasm_output_is( <<"CODE", <<'OUTPUT', 'ge_s_sc_ic' );
984 @{[ compare_strings( 2, "ge", @strings ) ]}
994 pasm_output_is( <<"CODE", <<'OUTPUT', 'ge_sc_sc_ic' );
995 @{[ compare_strings( 3, "ge", @strings ) ]}
1005 pasm_output_is( <<'CODE', <<'OUTPUT', 'same constant twice bug' );
1018 pasm_error_output_like( <<'CODE', <<'OUTPUT', '2-param ord, empty string' );
1023 /^Cannot get character of empty string/
1026 pasm_error_output_like( <<'CODE', <<'OUTPUT', '2-param ord, empty string register' );
1031 /^Cannot get character of empty string/
1034 pasm_error_output_like( <<'CODE', <<'OUTPUT', '3-param ord, empty string' );
1039 /^Cannot get character of empty string/
1042 pasm_error_output_like( <<'CODE', <<'OUTPUT', '3-param ord, empty string register' );
1047 /^Cannot get character of empty string/
1050 pasm_output_is( <<'CODE', ord('a'), '2-param ord, one-character string' );
1056 pasm_output_is( <<'CODE', ord('a'), '2-param ord, multi-character string' );
1062 pasm_output_is( <<'CODE', ord('a'), '2-param ord, one-character string register' );
1069 pasm_output_is( <<'CODE', ord('a'), '3-param ord, one-character string' );
1075 pasm_output_is( <<'CODE', ord('a'), '3-param ord, one-character string register' );
1082 pasm_output_is( <<'CODE', ord('b'), '3-param ord, multi-character string' );
1088 pasm_output_is( <<'CODE', ord('b'), '3-param ord, multi-character string register' );
1095 pasm_error_output_like( <<'CODE', <<'OUTPUT', '3-param ord, multi-character string' );
1100 /^Cannot get character past end of string/
1103 pasm_error_output_like( <<'CODE', <<'OUTPUT', '3-param ord, multi-character string' );
1109 /^Cannot get character past end of string/
1112 pasm_output_is( <<'CODE', ord('a'), '3-param ord, one-character string, from end' );
1118 pasm_output_is( <<'CODE', ord('a'), '3-param ord, one-character string register, from end' );
1125 pasm_output_is( <<'CODE', ord('b'), '3-param ord, multi-character string, from end' );
1131 pasm_output_is( <<'CODE', ord('b'), '3-param ord, multi-character string register, from end' );
1138 pasm_error_output_like(
1139 <<'CODE', <<'OUTPUT', '3-param ord, multi-character string register, from end, OOB' );
1145 /^Cannot get character before beginning of string/
1148 pasm_output_is( <<'CODE', chr(32), 'chr of 32 is space in ASCII' );
1154 pasm_output_is( <<'CODE', chr(65), 'chr of 65 is A in ASCII' );
1160 pasm_output_is( <<'CODE', chr(122), 'chr of 122 is z in ASCII' );
1166 pasm_output_is( <<'CODE', <<'OUTPUT', 'if_s_ic' );
1167 set S0, "I've told you once, I've told you twice..."
1214 # An empty register should be false...
1219 OK10: print "ok 10\n"
1235 pasm_output_is( <<'CODE', <<'OUTPUT', 'repeat_s_s|sc_i|ic' );
1277 pasm_error_output_like( <<'CODE', qr/Cannot repeat with negative arg\n/, 'repeat OOB' );
1278 repeat S0, "japh", -1
1282 pasm_output_is( <<'CODE', <<'OUTPUT', 'index, 3-arg form' );
1306 pasm_output_is( <<'CODE', <<'OUTPUT', 'index, 4-arg form' );
1329 pasm_output_is( <<'CODE', <<'OUTPUT', 'index, 4-arg form, bug 22718' );
1330 set S1, "This is not quite right"
1343 pasm_output_is( <<'CODE', <<'OUTPUT', 'index, null strings' );
1395 pasm_output_is( <<'CODE', <<'OUTPUT', 'index, embedded nulls' );
1396 set S0, "Par\0\0rot"
1412 pasm_output_is( <<'CODE', <<'OUTPUT', 'index, big strings' );
1414 repeat S0, S0, 10000
1421 index I1, S0, S1, 1234
1425 index I1, S0, S1, 9501
1436 pasm_output_is( <<'CODE', <<'OUTPUT', 'index, big, hard to match strings' );
1437 # Builds a 24th iteration fibonacci string (approx. 100K)
1452 index I1, S1, S2, 50000
1461 pir_output_is( << 'CODE', << 'OUTPUT', 'index with different charsets' );
1465 print "default - default:\n"
1472 print "ascii - ascii:\n"
1473 set S0, ascii:"Parrot"
1479 print "default - ascii:\n"
1486 print "ascii - default:\n"
1487 set S0, ascii:"Parrot"
1493 print "binary - binary:\n"
1494 set S0, binary:"Parrot"
1495 set S1, binary:"rot"
1514 pasm_output_is( <<'CODE', <<'OUTPUT', 'negative index #35959' );
1515 index I1, "u", "t", -123456
1518 index I1, "u", "t", -123456789
1528 skip( "Pending rework of creating non-ascii literals", 2 );
1529 pasm_output_is( <<'CODE', <<'OUTPUT', 'index, multibyte matching' );
1531 find_chartype I0, "8859-1"
1533 find_encoding I0, "singlebyte"
1536 find_encoding I0, "utf8"
1537 find_chartype I1, "unicode"
1538 transcode S1, S0, I0, I1
1558 pasm_output_is( <<'CODE', <<'OUTPUT', 'index, multibyte matching 2' );
1560 set S1, "foo\xAB\xAB\xBAbar"
1561 find_chartype I0, "8859-1"
1563 find_encoding I0, "singlebyte"
1566 find_chartype I0, "unicode"
1567 find_encoding I1, "utf8"
1568 transcode S1, S1, I1, I0
1583 pasm_output_is( <<'CODE', <<'OUTPUT', 'num to string' );
1599 pasm_output_is( <<'CODE', <<'OUTPUT', 'string to int' );
1615 set S0, "Not a number"
1634 pasm_output_is( <<'CODE', <<'OUTPUT', 'concat/substr (COW)' );
1651 pasm_output_is( <<'CODE', <<'OUTPUT', 'constant to cstring' );
1652 stringinfo I0, "\n", 2
1653 stringinfo I1, "\n", 2
1659 stringinfo I2, "\n", 2
1670 pasm_output_is( <<'CODE', <<'OUTPUT', 'COW with chopn leaving original untouched' );
1684 pasm_output_is( <<'CODE', <<'OUTPUT', 'Check that bug #16874 was fixed' );
1700 pasm_output_is( <<'CODE', "all ok\n", 'stress concat' );
1706 concat S3, "mic", "hael"
1722 pasm_output_is( <<'CODE', <<'OUTPUT', 'ord and substring (see #17035)' );
1734 print "It's all good\n"
1737 print "Not good: original string="
1739 print ", substring="
1747 pasm_output_is( <<'CODE', <<'OUTPUT', 'sprintf' );
1751 new P1, 'ResizablePMCArray'
1755 new P1, 'ResizablePMCArray'
1759 new P1, 'ResizablePMCArray'
1763 new P1, 'ResizablePMCArray'
1772 set S1, "Hello, %s\n"
1777 set S1, "Hash[0x%x]\n"
1782 set S1, "Hash[0x%lx]\n"
1787 set S1, "Hello, %.2s!\n"
1792 set S1, "Hello, %Ss"
1797 set S1, "1 == %Pd\n"
1803 set S1, "-255 == %vd\n"
1808 set S1, "+123 == %+vd\n"
1813 set S1, "256 == %vu\n"
1818 set S1, "1 == %+vu\n"
1823 set S1, "001 == %0.3u\n"
1828 set S1, "001 == %+0.3u\n"
1833 set S1, "0.500000 == %f\n"
1838 set S1, "0.500 == %5.3f\n"
1843 set S1, "0.001 == %g\n"
1848 set S1, "1e+06 == %g\n"
1853 set S1, "0.5 == %3.3g\n"
1858 set S1, "%% == %%\n"
1863 set S1, "That's all, %s\n"
1882 0.500000 == 0.500000
1891 pasm_output_is( <<'CODE', <<'OUTPUT', 'other form of sprintf op' );
1903 set P2, "15 is %b\n"
1904 new P1, 'ResizablePMCArray'
1909 set P2, "128 is %o\n"
1910 new P1, 'ResizablePMCArray'
1920 pir_output_is( <<'CODE', <<'OUTPUT', 'sprintf - left justify' );
1922 $P0 = new 'ResizablePMCArray'
1932 $S0 = sprintf "%-*s - %s\n", $P0
1941 my $output = substr( ( 'f' x ( $PConfig{intvalsize} * 2 ) ) . ( ' ' x 20 ), 0, 20 );
1942 pir_output_is( <<'CODE', $output, 'Correct precision for %x' ); }
1944 $P0 = new 'ResizablePMCArray'
1946 $S0 = sprintf "%-20x", $P0
1952 pasm_output_is( <<'CODE', <<'OUTPUT', 'exchange' );
1953 set S0, "String #0\n"
1954 set S1, "String #1\n"
1959 set S2, "String #2\n"
1971 skip( "Peding reimplementation of find_encoding", 1 );
1972 pasm_output_is( <<'CODE', <<'OUTPUT', 'find_encoding' );
1973 find_encoding I0, "singlebyte"
1976 find_encoding I0, "utf8"
1979 find_encoding I0, "utf16"
1982 find_encoding I0, "utf32"
1995 skip( "no more visible encoding", 1 );
1996 pasm_output_is( <<'CODE', <<'OUTPUT', 'string_encoding' );
1999 string_encoding I1, S0
2006 string_encoding I1, S0
2013 string_encoding I1, S0
2020 string_encoding I1, S0
2034 pasm_output_is( <<'CODE', <<'OUTPUT', 'experimental opcode substr_r_s_s|sc_i|ic_i|ic' );
2035 set S4, "12345JAPH01"
2038 substr_r S5, S4, I4, I5
2040 substr_r S5, S4, I4, 4
2042 substr_r S5, S4, 5, I5
2044 substr_r S5, S4, 5, 4
2046 substr_r S5, "12345JAPH01", I4, I5
2048 substr_r S5, "12345JAPH01", I4, 4
2050 substr_r S5, "12345JAPH01", 5, I5
2052 substr_r S5, "12345JAPH01", 5, 4
2057 JAPHJAPHJAPHJAPHJAPHJAPHJAPHJAPH
2060 pasm_output_is( <<'CODE', <<'OUTPUT', 'assign' );
2071 pasm_output_is( <<'CODE', <<'OUTPUT', 'assign & globber' );
2074 assign S4, "Parrot\n"
2083 pasm_output_is( <<'CODE', <<'OUTPUT', 'assign & globber 2' );
2086 assign S4, "Parrot\n"
2095 pasm_output_is( <<'CODE', <<'OUTPUT', 'bands NULL string' );
2129 pasm_output_is( <<'CODE', <<'OUTPUT', 'bands 2' );
2143 pasm_output_is( <<'CODE', <<'OUTPUT', 'bands 3' );
2160 pasm_output_is( <<'CODE', <<'OUTPUT', 'bands COW' );
2171 pasm_output_is( <<'CODE', <<'OUTPUT', 'bors NULL string' );
2230 OK10: print "ok 10\n"
2245 pasm_output_is( <<'CODE', <<'OUTPUT', 'bors 2' );
2259 pasm_output_is( <<'CODE', <<'OUTPUT', 'bors 3' );
2276 pasm_output_is( <<'CODE', <<'OUTPUT', 'bors COW' );
2287 pasm_output_is( <<'CODE', <<'OUTPUT', 'bxors NULL string' );
2346 OK10: print "ok 10\n"
2361 pasm_output_is( <<'CODE', <<'OUTPUT', 'bxors 2' );
2384 pasm_output_is( <<'CODE', <<'OUTPUT', 'bxors 3' );
2413 pasm_output_is( <<'CODE', <<'OUTPUT', 'bxors COW' );
2424 pasm_output_is( <<'CODE', <<'OUTPUT', 'bnots NULL string' );
2452 skip( "No unicode yet", 1 );
2453 pasm_output_is( <<'CODE', <<'OUTPUT', 'bnots 2' );
2471 \xC2\x9E\xC3\x8D\xC2\x9C
2472 \xC2\x9E\xC3\x8D\xC2\x9C
2477 pasm_output_is( <<'CODE', <<'OUTPUT', 'bnots COW' );
2489 skip( "no more transcode", 1 );
2490 pasm_output_is( <<'CODE', <<'OUTPUT', 'transcode to utf8' );
2491 set S1, "ASCII is the same as UTF8\n"
2492 find_encoding I1, "utf8"
2493 transcode S2, S1, I1
2498 ASCII is the same as UTF8
2499 ASCII is the same as UTF8
2504 skip( "no more chartype", 1 );
2505 pasm_output_is( <<'CODE', <<'OUTPUT', 'string_chartype' );
2506 set S0, "Test String"
2507 find_chartype I0, "usascii"
2509 string_chartype I1, S0
2523 # Set all string registers to values given by &$_[0](reg num)
2528 $rt .= "\tset S$_, \"" . &$code($_) . "\"\n";
2533 # print string registers, no additional prints
2534 sub print_str_regs {
2537 $rt .= "\tprint S$_\n";
2542 # Generate code to compare each pair of strings in a list
2543 sub compare_strings {
2550 my $s1 = shift @strings;
2551 my $s2 = shift @strings;
2554 if ( $const == 3 ) {
2558 elsif ( $const == 2 ) {
2559 $rt .= " set S0, \"$s1\"\n";
2563 elsif ( $const == 1 ) {
2564 $rt .= " set S0, \"$s2\"\n";
2569 $rt .= " set S0, \"$s1\"\n";
2570 $rt .= " set S1, \"$s2\"\n";
2574 if ( eval "\"$s1\" $op \"$s2\"" ) {
2575 $rt .= " $op $arg1, $arg2, OK$i\n";
2576 $rt .= " branch ERROR\n";
2579 $rt .= " $op $arg1, $arg2, ERROR\n";
2587 pasm_output_is( <<'CODE', <<'OUTPUT', 'split on empty string' );
2609 pasm_output_is( <<'CODE', <<'OUTPUT', 'split on non-empty string' );
2611 split P0, "a", "afooabara"
2633 pasm_output_is( <<'CODE', <<'OUTPUT', 'join' );
2635 new P0, 'ResizablePMCArray'
2643 new P0, 'ResizablePMCArray'
2656 pir_output_is( <<'CODE', <<'OUTPUT', 'join: get_string returns a null string' );
2661 new P0, 'ResizablePMCArray'
2677 .sub get_string :vtable :method
2689 pasm_output_is( <<'CODE', <<'OUTPUT', 'eq_addr/ne_addr' );
2696 eq_addr S1, S0, BAD2
2705 ne_addr S1, S0, BAD4
2717 pasm_output_is( <<'CODE', <<'OUTPUT', 'if_null_s_ic' );
2723 ERROR: print "error\n"
2732 pasm_output_is( <<'CODE', <<'OUTPUT', 'upcase' );
2733 set S0, "abCD012yz\n"
2744 pasm_output_is( <<'CODE', <<'OUTPUT', 'downcase' );
2745 set S0, "ABcd012YZ\n"
2756 pasm_output_is( <<'CODE', <<'OUTPUT', 'titlecase' );
2757 set S0, "aBcd012YZ\n"
2768 pasm_output_is( <<'CODE', ord('a'), '3-param ord, one-character string register, I' );
2776 pasm_output_is( <<'CODE', ord('b'), '3-param ord, multi-character string, I' );
2783 pasm_output_is( <<'CODE', ord('b'), '3-param ord, multi-character string register, I' );
2791 pasm_error_output_like( <<'CODE', <<'OUTPUT', '3-param ord, multi-character string, I' );
2797 /^Cannot get character past end of string/
2800 pasm_error_output_like( <<'CODE', <<'OUTPUT', '3-param ord, multi-character string, I' );
2807 /^Cannot get character past end of string/
2810 pasm_output_is( <<'CODE', ord('a'), '3-param ord, one-character string, from end, I' );
2817 pasm_output_is( <<'CODE', ord('a'), '3-param ord, one-character string register, from end, I' );
2825 pasm_output_is( <<'CODE', ord('b'), '3-param ord, multi-character string, from end, I' );
2832 pasm_output_is( <<'CODE', ord('b'), '3-param ord, multi-character string register, from end, I' );
2840 pasm_error_output_like(
2841 <<'CODE', <<'OUTPUT', '3-param ord, multi-character string register, from end, OOB, I' );
2848 /^Cannot get character before beginning of string/
2851 pir_output_is( <<'CODE', <<'OUT', 'more string_to_int' );
2853 print_as_integer('-4')
2854 print_as_integer('X-4')
2855 print_as_integer('--4')
2856 print_as_integer('+')
2857 print_as_integer('++')
2858 print_as_integer('+2')
2859 print_as_integer(' +3')
2860 print_as_integer('++4')
2861 print_as_integer('+ 5')
2862 print_as_integer('-')
2863 print_as_integer('--56')
2864 print_as_integer(' -+67')
2865 print_as_integer('+-78')
2866 print_as_integer(' -089xyz')
2867 print_as_integer('- 89')
2870 .sub 'print_as_integer'
2896 # cperl-indent-level: 4
2899 # vim: expandtab shiftwidth=4: