package TestCase::Lib::SPVM::StringUtil {
use SPVM::Unicode (uchar);
use TestCase::Minimal;
use TestCase::Minimal;
use SPVM::EqualityChecker;
use SPVM::EqualityChecker::SameObject;
use SPVM::ArrayUtil(equals_array_byte, equals_array_short, equals_array_int, equals_array_long, equals_array_float, equals_array_double, equals_array_string);
use SPVM::StringUtil (
chompr,
copy_string,
is_perl_space,
is_perl_word,
is_alnum,
is_alpha,
is_blank,
is_cntrl,
is_digit,
is_graph,
is_lower,
is_print,
is_punct,
is_space,
is_upper,
is_xdigit,
join,
lc,
lcfirst,
uc,
ucfirst,
rindex,
to_double,
to_float,
to_int,
to_int_with_base,
to_long,
to_long_with_base,
index,
split,
sprintf,
to_lower,
to_upper,
);
sub test_hex : int () {
# 0
{
my $hex_string = (string)"0";
my $hex_num = SPVM::StringUtil->hex($hex_string);
unless ($hex_num isa int) {
return 0;
}
unless ($hex_num == 0) {
return 0;
}
}
# 1-9
{
unless (SPVM::StringUtil->hex("1") == 1) { return 0; }
unless (SPVM::StringUtil->hex("2") == 2) { return 0; }
unless (SPVM::StringUtil->hex("3") == 3) { return 0; }
unless (SPVM::StringUtil->hex("4") == 4) { return 0; }
unless (SPVM::StringUtil->hex("5") == 5) { return 0; }
unless (SPVM::StringUtil->hex("6") == 6) { return 0; }
unless (SPVM::StringUtil->hex("7") == 7) { return 0; }
unless (SPVM::StringUtil->hex("8") == 8) { return 0; }
unless (SPVM::StringUtil->hex("9") == 9) { return 0; }
}
# a-z
{
unless (SPVM::StringUtil->hex("a") == 10) { return 0; }
unless (SPVM::StringUtil->hex("b") == 11) { return 0; }
unless (SPVM::StringUtil->hex("c") == 12) { return 0; }
unless (SPVM::StringUtil->hex("d") == 13) { return 0; }
unless (SPVM::StringUtil->hex("e") == 14) { return 0; }
unless (SPVM::StringUtil->hex("f") == 15) { return 0; }
}
# A-Z
{
unless (SPVM::StringUtil->hex("A") == 10) { return 0; }
unless (SPVM::StringUtil->hex("B") == 11) { return 0; }
unless (SPVM::StringUtil->hex("C") == 12) { return 0; }
unless (SPVM::StringUtil->hex("D") == 13) { return 0; }
unless (SPVM::StringUtil->hex("E") == 14) { return 0; }
unless (SPVM::StringUtil->hex("F") == 15) { return 0; }
}
# 19afAF25
{
unless (SPVM::StringUtil->hex("19afAF25") == 430944037) { return 0; }
unless (SPVM::StringUtil->hex("19afAF25") == 430944037) { return 0; }
}
# FFFFFFFF
{
unless (SPVM::StringUtil->hex("FFFFFFFF") == 0xFFFFFFFF) { return 0; }
}
# Exception - undef
{
eval { SPVM::StringUtil->hex(undef); };
unless ($@) {
return 0;
}
}
# Exception - Empty String
{
eval { SPVM::StringUtil->hex(""); };
unless ($@) {
return 0;
}
}
# Exception - Invalid hex string
{
eval { SPVM::StringUtil->hex("g"); };
unless ($@) {
return 0;
}
}
# Exception - Too long
{
eval { SPVM::StringUtil->hex("111111111"); };
unless ($@) {
return 0;
}
}
$@ = undef;
return 1;
}
sub test_trim_ascii_space : int () {
# undef
{
my $string = (string)undef;
my $trimed_string = SPVM::StringUtil->trim_ascii_space($string);
unless ($trimed_string == undef) {
return 0;
}
}
# no left and right spaces
{
my $string = (string)"ab c";
my $trimed_string = SPVM::StringUtil->trim_ascii_space($string);
unless ($trimed_string eq "ab c") {
return 0;
}
}
# left spaces
{
my $string = (string)" \t \nab c";
my $trimed_string = SPVM::StringUtil->trim_ascii_space($string);
unless ($trimed_string eq "ab c") {
return 0;
}
}
# right spaces
{
my $string = (string)"ab c \t \n";
my $trimed_string = SPVM::StringUtil->trim_ascii_space($string);
unless ($trimed_string eq "ab c") {
return 0;
}
}
# left and right spaces
{
my $string = (string)" \t \nab c \t \n";
my $trimed_string = SPVM::StringUtil->trim_ascii_space($string);
unless ($trimed_string eq "ab c") {
return 0;
}
}
return 1;
}
sub test_split : int () {
{
my $string = "foo,bar,baz";
my $split_strs = split(",", $string);
unless (equals_array_string($split_strs, ["foo", "bar", "baz"])) {
return 0;
}
}
{
my $string = "foo,bar,";
my $split_strs = split(",", $string);
unless (equals_array_string($split_strs, ["foo", "bar", ""])) {
return 0;
}
}
{
my $string = ",foo,,bar,,";
my $split_strs = split(",", $string);
unless (equals_array_string($split_strs, ["", "foo", "", "bar", "", ""])) {
return 0;
}
}
{
my $string = "foo : bar : baz";
my $split_strs = split(" : ", $string);
unless (equals_array_string($split_strs, ["foo", "bar", "baz"])) {
return 0;
}
}
{
my $string = "foo : bar : ";
my $split_strs = split(" : ", $string);
unless (equals_array_string($split_strs, ["foo", "bar", ""])) {
return 0;
}
}
{
my $string = " : foo : : bar : : ";
my $split_strs = split(" : ", $string);
unless (equals_array_string($split_strs, ["", "foo", "", "bar", "", ""])) {
return 0;
}
}
{
my $string = "foo---bar---baz";
my $split_strs = split("---", $string);
unless (equals_array_string($split_strs, ["foo", "bar", "baz"])) {
return 0;
}
}
{
my $string = "foo---bar---";
my $split_strs = split("---", $string);
unless (equals_array_string($split_strs, ["foo", "bar", ""])) {
return 0;
}
}
{
my $string = "---foo------bar------";
my $split_strs = split("---", $string);
unless (equals_array_string($split_strs, ["", "foo", "", "bar", "", ""])) {
return 0;
}
}
{
my $string = "foo--!bar---baz";
my $split_strs = split("---", $string);
unless (equals_array_string($split_strs, ["foo--!bar", "baz"])) {
return 0;
}
}
return 1;
}
sub test_sprintf_d : int () {
my $tests = [
[ sprintf("abc%d", 123), "abc123" ],
[ sprintf("%dabc", 123), "123abc" ],
[ sprintf("%dabc%d", 1, 10), "1abc10" ],
[ sprintf("%d%d%d", 1, 10, 100), "110100" ],
[ sprintf("%d%d%d", 1, 10, 100), "110100" ],
[ sprintf("%05d", 123), "00123" ],
[ sprintf("%+5d", 123), " +123" ],
[ sprintf("%-5d", 123), "123 " ],
];
for (my $i = 0; $i < @$tests; ++$i) {
unless ($tests->[$i][0] eq $tests->[$i][1]) {
warn("got: '" . $tests->[$i][0] . "', expected: '" . $tests->[$i][1] . "'");
return 0;
}
}
{
eval {
sprintf("%d", "str");
};
unless ($@ && index($@, "Can't cast", 0) > -1) {
warn("got error: $@");
return 0;
}
$@ = undef;
}
return 1;
}
sub test_sprintf_u : int () {
my $tests = [
[ sprintf("abc%u", 123), "abc123" ],
[ sprintf("%uabc", 123), "123abc" ],
[ sprintf("%uabc%u", 1, 10), "1abc10" ],
[ sprintf("%u%u%u", 1, 10, 100), "110100" ],
[ sprintf("%05u", 123), "00123" ],
[ sprintf("%+5u", 123), " +123" ],
[ sprintf("%-5u", 123), "123 " ],
[ sprintf("%-5u", 123), "123 " ],
[ sprintf("%u", -1), "4294967295" ],
];
for (my $i = 0; $i < @$tests; ++$i) {
unless ($tests->[$i][0] eq $tests->[$i][1]) {
warn("got: '" . $tests->[$i][0] . "', expected: '" . $tests->[$i][1] . "'");
return 0;
}
}
{
eval {
sprintf("%d", "str");
};
unless ($@ && index($@, "Can't cast", 0) > -1) {
warn("got error: $@");
return 0;
}
$@ = undef;
}
return 1;
}
sub test_sprintf_ld : int () {
my $tests = [
[ sprintf("abc%ld", 10000000000L), "abc10000000000" ],
[ sprintf("%ldabc", 10000000000L), "10000000000abc" ],
[ sprintf("%ldabc%ld", 10000000000L, 20000000000L), "10000000000abc20000000000" ],
[ sprintf("%ld%ld%ld", 10000000000L, 20000000000L, 30000000000L), "100000000002000000000030000000000" ],
[ sprintf("%013ld", 12345678901L), "0012345678901" ],
[ sprintf("%+13ld", 12345678901L), " +12345678901" ],
[ sprintf("%-13ld", 12345678901L), "12345678901 " ],
];
for (my $i = 0; $i < @$tests; ++$i) {
unless ($tests->[$i][0] eq $tests->[$i][1]) {
warn("got: '" . $tests->[$i][0] . "', expected: '" . $tests->[$i][1] . "'");
return 0;
}
}
{
eval {
sprintf("%ld", "str");
};
unless ($@ && index($@, "Can't cast", 0) > -1) {
warn("got error: $@");
return 0;
}
$@ = undef;
}
{
eval {
sprintf("%l", 1L);
};
unless ($@ && index($@, "Invalid conversion in sprintf: \"%l\"", 0) > -1) {
warn("got error: $@");
return 0;
}
$@ = undef;
}
return 1;
}
sub test_sprintf_lu : int () {
my $tests = [
[ sprintf("abc%lu", 10000000000L), "abc10000000000" ],
[ sprintf("%luabc", 10000000000L), "10000000000abc" ],
[ sprintf("%luabc%lu", 10000000000L, 20000000000L), "10000000000abc20000000000" ],
[ sprintf("%lu%ld%lu", 10000000000L, 20000000000L, 30000000000L), "100000000002000000000030000000000" ],
[ sprintf("%013lu", 12345678901L), "0012345678901" ],
[ sprintf("%+13lu", 12345678901L), " +12345678901" ],
[ sprintf("%-13lu", 12345678901L), "12345678901 " ],
[ sprintf("%lu", -1L), "18446744073709551615" ],
];
for (my $i = 0; $i < @$tests; ++$i) {
unless ($tests->[$i][0] eq $tests->[$i][1]) {
warn("got: '" . $tests->[$i][0] . "', expected: '" . $tests->[$i][1] . "'");
return 0;
}
}
{
eval {
sprintf("%ld", "str");
};
unless ($@ && index($@, "Can't cast", 0) > -1) {
warn("got error: $@");
return 0;
}
$@ = undef;
}
{
eval {
sprintf("%l", 1L);
};
unless ($@ && index($@, "Invalid conversion in sprintf: \"%l\"", 0) > -1) {
warn("got error: $@");
return 0;
}
$@ = undef;
}
return 1;
}
sub test_sprintf_f : int () {
my $tests = [
[ sprintf("abc%.2f", 3.14), "abc3.14" ],
[ sprintf("%.2fabc", 3.14), "3.14abc" ],
[ sprintf("%.2fabc%.2f", 3.14, 2.71), "3.14abc2.71" ],
[ sprintf("%.2f%.2f%.2f", 3.14, 2.71, 2.67), "3.142.712.67" ],
[ sprintf("%.10f", 3.14), "3.1400000000" ],
[ sprintf("%012.6f", 3.14), "00003.140000" ],
[ sprintf("%+12.6f", 3.14), " +3.140000" ],
[ sprintf("%-12.6f", 3.14), "3.140000 " ],
[ sprintf("%+-12.6f", 3.14), "+3.140000 " ],
[ sprintf("%g", 3.14), "3.14" ],
];
for (my $i = 0; $i < @$tests; ++$i) {
unless ($tests->[$i][0] eq $tests->[$i][1]) {
warn("got: '" . $tests->[$i][0] . "', expected: '" . $tests->[$i][1] . "'");
return 0;
}
}
{
eval {
sprintf("%f", "str");
};
unless ($@ && index($@, "Can't cast", 0) > -1) {
warn("got error: $@");
return 0;
}
$@ = undef;
}
return 1;
}
sub test_sprintf_c : int () {
my $tests = [
[ sprintf("abc%c", 'x'), "abcx" ],
[ sprintf("%cabc", 'x'), "xabc" ],
[ sprintf("%cabc%c", 'x', 'y'), "xabcy" ],
[ sprintf("%c%c%c", 'x', 'y', 'z'), "xyz" ],
[ sprintf("%05c", 'x'), "0000x" ],
[ sprintf("%-5c", 'x'), "x " ],
];
for (my $i = 0; $i < @$tests; ++$i) {
unless ($tests->[$i][0] eq $tests->[$i][1]) {
warn("got: '" . $tests->[$i][0] . "', expected: '" . $tests->[$i][1] . "'");
return 0;
}
}
{
eval {
sprintf("%c", "str");
};
unless ($@ && index($@, "Can't cast", 0) > -1) {
warn("got error: $@");
return 0;
}
$@ = undef;
}
return 1;
}
sub test_sprintf_s : int () {
my $tests = [
[ sprintf("abc%s", "ABC"), "abcABC" ],
[ sprintf("%sabc", "ABC"), "ABCabc" ],
[ sprintf("%sabc%s", "ABC", "XYZ"), "ABCabcXYZ" ],
[ sprintf("%s%s%s", "ABC", "XYZ", "123"), "ABCXYZ123" ],
[ sprintf("%05s", "str"), "00str" ],
[ sprintf("%-5s", "str"), "str " ],
];
for (my $i = 0; $i < @$tests; ++$i) {
unless ($tests->[$i][0] eq $tests->[$i][1]) {
warn("got: '" . $tests->[$i][0] . "', expected: '" . $tests->[$i][1] . "'");
return 0;
}
}
{
eval {
sprintf("%s", 1);
};
unless ($@ && index($@, "Can't cast", 0) > -1) {
warn("got error: $@");
return 0;
}
$@ = undef;
}
return 1;
}
private sub _first_uchar : int ($string : string) {
my $uchar_pos = 0;
return uchar($string, \$uchar_pos);
}
sub test_sprintf_U : int () {
my $tests = [
[ sprintf("abc%U", _first_uchar("あ")), "abcあ" ],
[ sprintf("%Uabc", _first_uchar("あ")), "あabc" ],
[ sprintf("%Uabc%U", _first_uchar("あ"), _first_uchar("い")), "あabcい" ],
[ sprintf("%U%U%U", _first_uchar("あ"), _first_uchar("い"), _first_uchar("う")), "あいう" ],
];
for (my $i = 0; $i < @$tests; ++$i) {
unless ($tests->[$i][0] eq $tests->[$i][1]) {
warn("got: '" . $tests->[$i][0] . "', expected: '" . $tests->[$i][1] . "'");
return 0;
}
}
{
eval {
sprintf("%U", "str");
};
unless ($@ && index($@, "Can't cast", 0) > -1) {
warn("got error: $@");
return 0;
}
$@ = undef;
}
return 1;
}
sub test_sprintf_percent : int () {
my $tests = [
[ sprintf("%d%%", 1), "1%" ],
[ sprintf("%%%d", 1), "%1" ],
[ sprintf("%d%%str", 1), "1%str" ],
];
for (my $i = 0; $i < @$tests; ++$i) {
unless ($tests->[$i][0] eq $tests->[$i][1]) {
warn("got: '" . $tests->[$i][0] . "', expected: '" . $tests->[$i][1] . "'");
return 0;
}
}
return 1;
}
sub test_sprintf_all : int () {
{
# Invalid conversion (end of string)
eval {
sprintf("%d%", 1);
};
unless ($@ && index($@, "Invalid conversion in sprintf: end of string", 0) > -1) {
warn("got error: $@");
return 0;
}
$@ = undef;
}
{
# Invalid conversion (unknown specifier)
eval {
sprintf("%d%k", 1, 2);
};
unless ($@ && index($@, "Invalid conversion in sprintf: \"%k\"", 0) > -1) {
warn("got error: $@");
return 0;
}
$@ = undef;
}
{
# Invalid conversion (no type)
eval {
sprintf("%012.3", 3.14);
};
unless ($@ && index($@, "Invalid conversion in sprintf: \"%012.3\"", 0) > -1) {
warn("got error: $@");
return 0;
}
$@ = undef;
}
{
# Missing argument
eval {
sprintf("%d%d", 1);
};
unless ($@ && index($@, "Missing argument in sprintf", 0) > -1) {
warn("got error: $@");
return 0;
}
$@ = undef;
}
{
my $string = "abc\n";
my $ret = chompr($string);
unless ($ret eq "abc") {
return 0;
}
}
{
my $string = "abc";
my $ret = chompr($string);
unless ($ret eq "abc") {
return 0;
}
}
{
my $string = "";
my $ret = chompr($string);
unless ($ret eq "") {
return 0;
}
}
return 1;
}
sub test_chompr : int () {
{
my $string = "abc\n";
my $ret = chompr($string);
unless ($ret eq "abc") {
return 0;
}
}
{
my $string = "abc";
my $ret = chompr($string);
unless ($ret eq "abc") {
return 0;
}
}
{
my $string = "";
my $ret = chompr($string);
unless ($ret eq "") {
return 0;
}
}
return 1;
}
sub test_is_alnum : int () {
my $ok = 1;
for (my $i = 0; $i < 128; $i++) {
my $char = $i;
if (($char >= 'A' && $char <= 'Z') || ($char >= 'a' && $char <= 'z') || ($char >= '0' && $char <= '9')) {
my $ret = is_alnum($char);
unless ($ret == 1) {
$ok = 0;
}
}
else {
my $ret = is_alnum($char);
unless ($ret == 0) {
$ok = 0;
}
}
}
unless ($ok) {
return 0;
}
return 1;
}
sub test_is_alpha : int () {
my $ok = 1;
for (my $i = 0; $i < 128; $i++) {
my $char = $i;
if (($char >= 'A' && $char <= 'Z') || ($char >= 'a' && $char <= 'z')) {
my $ret = is_alpha($char);
unless ($ret == 1) {
$ok = 0;
}
}
else {
my $ret = is_alpha($char);
unless ($ret == 0) {
$ok = 0;
}
}
}
unless ($ok) {
return 0;
}
return 1;
}
sub test_is_blank : int () {
my $ok = 1;
for (my $i = 0; $i < 128; $i++) {
my $char = $i;
if ($char >= ' ' || $char <= '\t') {
my $ret = is_blank($char);
unless ($ret == 1) {
$ok = 0;
}
}
else {
my $ret = is_blank($char);
unless ($ret == 0) {
$ok = 0;
}
}
}
unless ($ok) {
return 0;
}
return 1;
}
sub test_is_cntrl : int () {
my $ok = 1;
for (my $i = 0; $i < 128; $i++) {
my $char = $i;
if (($char >= 0x00 && $char <= 0x1f) || $char == 0x7f) {
my $ret = is_cntrl($char);
unless ($ret == 1) {
$ok = 0;
}
}
else {
my $ret = is_cntrl($char);
unless ($ret == 0) {
$ok = 0;
}
}
}
unless ($ok) {
return 0;
}
return 1;
}
sub test_is_digit : int () {
my $ok = 1;
for (my $i = 0; $i < 128; $i++) {
my $char = $i;
if ($char >= '0' && $char <= '9') {
my $ret = is_digit($char);
unless ($ret == 1) {
$ok = 0;
}
}
else {
my $ret = is_digit($char);
unless ($ret == 0) {
$ok = 0;
}
}
}
unless ($ok) {
return 0;
}
return 1;
}
sub test_is_graph : int () {
my $ok = 1;
for (my $i = 0; $i < 128; $i++) {
my $char = $i;
if ($char >= 0x21 && $char <= 0x7e) {
my $ret = is_graph($char);
unless ($ret == 1) {
$ok = 0;
}
}
else {
my $ret = is_graph($char);
unless ($ret == 0) {
$ok = 0;
}
}
}
unless ($ok) {
return 0;
}
return 1;
}
sub test_is_lower : int () {
my $ok = 1;
for (my $i = 0; $i < 128; $i++) {
my $char = $i;
if ($char >= 'a' && $char <= 'z') {
my $ret = is_lower($char);
unless ($ret == 1) {
$ok = 0;
}
}
else {
my $ret = is_lower($char);
unless ($ret == 0) {
$ok = 0;
}
}
}
unless ($ok) {
return 0;
}
return 1;
}
sub test_is_print : int () {
my $ok = 1;
for (my $i = 0; $i < 128; $i++) {
my $char = $i;
if ($char >= 0x20 && $char <= 0x7e) {
my $ret = is_print($char);
unless ($ret == 1) {
$ok = 0;
}
}
else {
my $ret = is_print($char);
unless ($ret == 0) {
$ok = 0;
}
}
}
unless ($ok) {
return 0;
}
return 1;
}
sub test_is_punct : int () {
my $ok = 1;
for (my $i = 0; $i < 128; $i++) {
my $char = $i;
if (($char >= 0x21 && $char <= 0x2f) || ($char >= 0x3a && $char <= 0x40) || ($char >= 0x5b && $char <= 0x60) || ($char >= 0x7b && $char <= 0x7e)) {
my $ret = is_punct($char);
unless ($ret == 1) {
$ok = 0;
}
}
else {
my $ret = is_punct($char);
unless ($ret == 0) {
$ok = 0;
}
}
}
unless ($ok) {
return 0;
}
return 1;
}
sub test_is_space : int () {
my $ok = 1;
for (my $i = 0; $i < 128; $i++) {
my $char = $i;
if (($char >= 0x09 && $char <= 0x0d) || $char == 0x20) {
my $ret = is_space($char);
unless ($ret == 1) {
$ok = 0;
}
}
else {
my $ret = is_space($char);
unless ($ret == 0) {
$ok = 0;
}
}
}
unless ($ok) {
return 0;
}
return 1;
}
sub test_is_upper : int () {
my $ok = 1;
for (my $i = 0; $i < 128; $i++) {
my $char = $i;
if ($char >= 'A' && $char <= 'Z') {
my $ret = is_upper($char);
unless ($ret == 1) {
$ok = 0;
}
}
else {
my $ret = is_upper($char);
unless ($ret == 0) {
$ok = 0;
}
}
}
unless ($ok) {
return 0;
}
return 1;
}
sub test_is_xdigit : int () {
my $ok = 1;
for (my $i = 0; $i < 128; $i++) {
my $char = $i;
if (($char >= 'A' && $char <= 'F') || ($char >= 'a' && $char <= 'f') || ($char >= '0' && $char <= '9')) {
my $ret = is_xdigit($char);
unless ($ret == 1) {
$ok = 0;
}
}
else {
my $ret = is_xdigit($char);
unless ($ret == 0) {
$ok = 0;
}
}
}
unless ($ok) {
return 0;
}
return 1;
}
sub test_to_lower : int () {
my $ok = 1;
for (my $i = 0; $i < 128; $i++) {
my $char = $i;
if ($char >= 'A' && $char <= 'Z') {
my $ret = to_lower($char);
unless ($ret == $char + 0x20) {
$ok = 0;
}
}
else {
my $ret = to_lower($char);
unless ($ret == $char) {
$ok = 0;
}
}
}
unless ($ok) {
return 0;
}
return 1;
}
sub test_to_upper : int () {
my $ok = 1;
for (my $i = 0; $i < 128; $i++) {
my $char = $i;
if ($char >= 'a' && $char <= 'z') {
my $ret = to_upper($char);
unless ($ret == $char - 0x20) {
$ok = 0;
}
}
else {
my $ret = to_upper($char);
unless ($ret == $char) {
$ok = 0;
}
}
}
unless ($ok) {
return 0;
}
return 1;
}
sub test_is_perl_space : int () {
my $ok = 1;
for (my $i = 0; $i < 128; $i++) {
my $char = $i;
if ($char == ' ' || $char == '\r' || $char == '\n' || $char == '\t' || $char == '\f') {
my $ret = is_perl_space($char);
unless ($ret == 1) {
$ok = 0;
}
}
else {
my $ret = is_perl_space($char);
unless ($ret == 0) {
$ok = 0;
}
}
}
unless ($ok) {
return 0;
}
return 1;
}
sub test_is_perl_word : int () {
my $ok = 1;
for (my $i = 0; $i < 128; $i++) {
my $char = $i;
if ($char >= 'a' && $char <= 'z' || $char >= 'A' && $char <= 'Z' || $char == '_' || $char >= '0' && $char <= '9') {
my $ret = is_perl_word($char);
unless ($ret == 1) {
$ok = 0;
}
}
else {
my $ret = is_perl_word($char);
unless ($ret == 0) {
$ok = 0;
}
}
}
unless ($ok) {
return 0;
}
return 1;
}
sub test_to_int : int () {
# 10 digit minimal and return type is int
{
my $string = "-2147483648";
my $num = to_int($string);
unless ($num isa int) {
return 0;
}
unless ($num == -2147483648) {
return 0;
}
}
return 1;
}
sub test_to_int_with_base : int () {
# 10 digit minimal and return type is int
{
my $string = "-2147483648";
my $num = to_int_with_base($string, 10);
unless ($num isa int) {
return 0;
}
unless ($num == -2147483648) {
return 0;
}
}
# 10 digit max
{
my $string = "2147483647";
my $num = to_int_with_base($string, 10);
unless ($num isa int) {
return 0;
}
unless ($num == 2147483647) {
return 0;
}
}
# 2 digit
{
my $string = "11";
my $num = to_int_with_base($string, 2);
unless ($num == 3) {
return 0;
}
}
# 8 digit
{
my $string = "11";
my $num = to_int_with_base($string, 8);
unless ($num == 9) {
return 0;
}
}
# 16 digit
{
my $string = "FF";
my $num = to_int_with_base($string, 16);
unless ($num == 255) {
return 0;
}
}
# Invalid string format
{
my $string = "10oppp";
eval {
to_int_with_base($string, 10);
};
unless ($@) {
return 0;
}
$@ = undef;
}
# Invalid digit
{
my $string = "10";
eval {
to_int_with_base($string, 100);
};
unless ($@) {
return 0;
}
$@ = undef;
}
# Out of range max + 1
{
my $string = "2147483648";
eval {
to_int_with_base($string, 10);
};
unless ($@) {
return 0;
}
$@ = undef;
}
# Out of range min - 1
{
my $string = "-2147483649";
eval {
to_int_with_base($string, 10);
};
unless ($@) {
return 0;
}
$@ = undef;
}
return 1;
}
sub test_to_long : int () {
# 10 digit minimal and return type is int
{
my $string = "-9223372036854775808";
my $num = to_long($string);
unless ($num isa long) {
return 0;
}
unless ($num == -9223372036854775808L) {
return 0;
}
}
return 1;
}
sub test_to_long_with_base : int () {
# 10 digit minimal and return type is int
{
my $string = "-9223372036854775808";
my $num = to_long_with_base($string, 10);
unless ($num isa long) {
return 0;
}
unless ($num == -9223372036854775808L) {
return 0;
}
}
# 10 digit max
{
my $string = "9223372036854775807";
my $num = to_long_with_base($string, 10);
unless ($num == 9223372036854775807L) {
return 0;
}
}
# 2 digit
{
my $string = "11";
my $num = to_long_with_base($string, 2);
unless ($num == 3) {
return 0;
}
}
# 8 digit
{
my $string = "11";
my $num = to_long_with_base($string, 8);
unless ($num == 9) {
return 0;
}
}
# 16 digit
{
my $string = "FF";
my $num = to_long_with_base($string, 16);
unless ($num == 255) {
return 0;
}
}
# Invalid string format
{
my $string = "10oppp";
eval {
to_long_with_base($string, 10);
};
unless ($@) {
return 0;
}
$@ = undef;
}
# Invalid digit
{
my $string = "10";
eval {
to_long_with_base($string, 100);
};
unless ($@) {
return 0;
}
$@ = undef;
}
# Out of range max + 1
{
my $string = "9223372036854775808";
eval {
to_long_with_base($string, 10);
};
unless ($@) {
return 0;
}
$@ = undef;
}
# Out of range min - 1
{
my $string = "-9223372036854775809";
eval {
to_long_with_base($string, 10);
};
unless ($@) {
return 0;
}
$@ = undef;
}
return 1;
}
sub test_to_float : int () {
# 10 digit minimal and return type is int
{
my $string = "1.25";
my $num = to_float($string);
unless ($num isa float) {
return 0;
}
unless ($num == 1.25) {
return 0;
}
}
# Invalid string format
{
my $string = "10.5oppp";
eval {
to_float($string);
};
unless ($@) {
return 0;
}
$@ = undef;
}
return 1;
}
sub test_to_double : int () {
# 10 digit minimal and return type is int
{
my $string = "1.25";
my $num = to_double($string);
unless ($num isa double) {
return 0;
}
unless ($num == 1.25) {
return 0;
}
}
# Invalid string format
{
my $string = "10.5oppp";
eval {
to_double($string);
};
unless ($@) {
return 0;
}
$@ = undef;
}
return 1;
}
sub test_ucfirst : int () {
{
my $string = "@abc";
my $result_str = ucfirst($string);
unless ($result_str eq "@abc") {
return 0;
}
}
{
my $string = "[abc";
my $result_str = ucfirst($string);
unless ($result_str eq "[abc") {
return 0;
}
}
{
my $string = "aabc";
my $result_str = ucfirst($string);
unless ($result_str eq "Aabc") {
return 0;
}
}
{
my $string = "pabc";
my $result_str = ucfirst($string);
unless ($result_str eq "Pabc") {
return 0;
}
}
{
my $string = "zabc";
my $result_str = ucfirst($string);
unless ($result_str eq "Zabc") {
return 0;
}
}
return 1;
}
sub test_uc : int () {
{
my $string = "@[apz[";
my $result_str = uc($string);
unless ($result_str eq "@[APZ[") {
return 0;
}
}
return 1;
}
sub test_lc : int () {
{
my $string = "@[APZ[";
my $result_str = lc($string);
unless ($result_str eq "@[apz[") {
return 0;
}
}
return 1;
}
sub test_lcfirst : int () {
{
my $string = "@ABC";
my $result_str = lcfirst($string);
unless ($result_str eq "@ABC") {
return 0;
}
}
{
my $string = "[ABC";
my $result_str = lcfirst($string);
unless ($result_str eq "[ABC") {
return 0;
}
}
{
my $string = "AABC";
my $result_str = lcfirst($string);
unless ($result_str eq "aABC") {
return 0;
}
}
{
my $string = "PABC";
my $result_str = lcfirst($string);
unless ($result_str eq "pABC") {
return 0;
}
}
{
my $string = "ZABC";
my $result_str = lcfirst($string);
unless ($result_str eq "zABC") {
return 0;
}
}
return 1;
}
sub test_index : int () {
{
my $target = "abcde";
my $search = "bcd";
my $pos = index($target, $search, 0);
unless ($pos == 1) {
return 0;
}
}
{
my $target = "abcde";
my $search = "bcd";
my $pos = index($target, $search, 1);
unless ($pos == 1) {
return 0;
}
}
{
my $target = "abcde";
my $search = "bcd";
my $pos = index($target, $search, 2);
unless ($pos == -1) {
return 0;
}
}
{
my $target = "abcde";
my $search = "pq";
my $pos = index($target, $search, 2);
unless ($pos == -1) {
return 0;
}
}
return 1;
}
sub test_rindex : int () {
{
my $target = "abab";
my $search = "ab";
my $pos = rindex($target, $search, 3);
unless ($pos == 2) {
return 0;
}
}
{
my $target = "abab";
my $search = "ab";
my $pos = rindex($target, $search, 2);
unless ($pos == 2) {
return 0;
}
}
{
my $target = "abab";
my $search = "ab";
my $pos = rindex($target, $search, 1);
unless ($pos == 0) {
return 0;
}
}
{
my $target = "abab";
my $search = "ab";
my $pos = rindex($target, $search, 0);
unless ($pos == 0) {
return 0;
}
}
{
my $target = "abab";
my $search = "pq";
my $pos = rindex($target, $search, 2);
unless ($pos == -1) {
return 0;
}
}
return 1;
}
sub test_join : int () {
my $strings = ["abc", "def", "hij"];
my $dump = join(",", $strings);
if ($dump eq "abc,def,hij") {
return 1;
}
return 0;
}
sub test_copy_string : int () {
# copy string
{
my $string = "abc";
my $string_out = copy_string($string);
# Equals the value
unless ($string_out eq "abc") {
return 0;
}
# Not equals address
if ($string == $string_out) {
return 0;
}
}
# undef
{
my $string_out = copy_string(undef);
# Equals the value
unless ($string_out == undef) {
return 0;
}
}
return 1;
}
}