view release on metacpan or  search on metacpan

t/01-util.t  view on Meta::CPAN

{
    my $result = MHFS::Util::surrogatepairtochar("\x{D83C}", "\x{DF84}");
    is(ord($result), 0x1F384, "Converting surrogate pair for $result (U+1F384)");
}
{
    my $result = MHFS::Util::surrogatepairtochar("\x{D800}", "\x{DC00}");
    is(ord($result), 0x10000, 'First possible surrogate pair combination');
}
{
    my $result = MHFS::Util::surrogatepairtochar("\x{DBFF}", "\x{DFFF}");
    is(ord($result), 0x10FFFF, 'Last possible surrogate pair combination');
}

{
    my $result = MHFS::Util::surrogatecodepointpairtochar(0xD83C, 0xDF84);
    is(ord($result), 0x1F384, "Converting surrogate pair for $result (U+1F384)");
}
{
    my $result = MHFS::Util::surrogatecodepointpairtochar(0xD800, 0xDC00);
    is(ord($result), 0x10000, 'First possible surrogate pair combination');
}
{
    my $result = MHFS::Util::surrogatecodepointpairtochar(0xDBFF, 0xDFFF);
    is(ord($result), 0x10FFFF, 'Last possible surrogate pair combination');
}

{
    my $result = get_printable_utf8('A'.chr(0xFF).'B');
    is($result, 'A'.chr(0xFFFD).'B', 'Valid invalid valid');
}
{
    my $result = get_printable_utf8("A\xED\xA0\xBC\xED\xBE\x84B");
    is($result, 'A'.chr(0x1F384).'B', 'Valid low surrogate high surrogate valid');
}
{
    # verify truncated sequences are replaced as expected
    my @tests = (
        ["\xC2", chr(0xFFFD)],
        ["\xC2A", chr(0xFFFD).'A'],
        ["\xE0\xA0", chr(0xFFFD)],
        ["\xE0\xA0A", chr(0xFFFD).'A'],
        ["\xF0\x90\x80", chr(0xFFFD)],
        ["\xF0\x90\x80A", chr(0xFFFD).'A'],
    );
    foreach my $test (@tests) {
        my $display = uc(unpack("H*", $test->[0]));
        is(get_printable_utf8($test->[0]), $test->[1], "get_printable_utf8 truncated sequences decode as expected");
    }
}

{
    my $fname = 'test_read_text_file.txt';
    if(open(my $fh, '>:raw', $fname)) {
        print $fh 'A'.chr(0xFF).'B';
        close($fh);
        my $text = do {
            local $SIG{__WARN__} = sub {};
            read_text_file_lossy($fname)
        };
        is($text,  'A'.chr(0xFFFD).'B', 'read_text_file_lossy Valid invalid valid');
        my $message = 'read_text_file throws on invalid file';
        try {
            read_text_file($fname);
            fail($message);
        } catch ($e) {
            pass($message);
        }
        unlink($fname);
    }
}

{
    my $fname = 'test_write_text_file.txt';
    my $message = 'write_text_file throws on invalid text';
    my $input = "A\x{D800}B";
    try {
        {
            local $SIG{__WARN__} = sub {};
            write_text_file($fname, $input);
        }
        fail($message);
    } catch ($e) {
        pass($message);
    }
    unlink($fname);
    try {
        {
            local $SIG{__WARN__} = sub {};
            write_text_file_lossy($fname, $input);
        }
        my $text = read_text_file($fname);
        is($text,  'A'.chr(0xFFFD).'B', 'write_text_file_lossy Valid invalid valid');
    } catch ($e) {
        fail("write_text_file_lossy does not crash");
    }
    unlink($fname);
}

{
    my $str = 'A'.chr(0xFF).'B';
    my $bytes = encode('UTF-8', $str, Encode::FB_CROAK | Encode::LEAVE_SRC);
    try {
        my $bcopy = $bytes;
        is(decode_utf_8($bytes), $str, 'string decodes to original string');
        is($bytes, $bcopy, "decode_utf_8 doesn't modify original string");
    } catch ($e) {
        fail('decode_utf_8 decodes valid string without crashing')
    }
}
{
    my $str = "A\x{D800}B";
    my $bytes = encode('utf8', $str, Encode::FB_CROAK | Encode::LEAVE_SRC);
    my $bcopy = $bytes;
    my $message = 'decode_utf_8 throws on invalid string';
    try {
        decode_utf_8($bytes);
        fail($message);
    } catch ($e) {
        pass($message);
        is($bytes, $bcopy, "decode_utf_8 doesn't modify original string");
    }
}

{
    my $scalar = chr(0xFF);
    my $filename = 'test_write_file.txt';
    my $message = 'Write 0xFF works';
    try {
        write_file($filename, $scalar);
        my $readback = read_file($filename);
        is($readback, $scalar, $message);
    } catch ($e) {
        fail($message);
    }
    unlink($filename);
    $message = 'Write (UTF8) 0xFF works';
    utf8::upgrade($scalar);
    try {
        no warnings 'MHFS::Util';
        write_file($filename , $scalar);
        my $readback = read_file($filename);
        is($readback, "\xC3\xBF", $message);
    } catch ($e) {
        fail($message);
    }
    unlink($filename);
}

{
    is(fold_case('HARAMBE'), 'harambe', 'fold_case works');
}