The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

GRIAN / Deep-Encode-0.19 / t / Deep-Encode-03.t 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120

              
#
#===============================================================================
#
#         FILE:  Deep-Encode-01.t
#
#  DESCRIPTION:  
#
#        FILES:  ---
#         BUGS:  ---
#        NOTES:  ---
#       AUTHOR:  Grishaev Anatoliy (ga), zua.zuz@toh.ru
#      COMPANY:  Adeptus, Russia
#      VERSION:  1.0
#      CREATED:  09/20/10 13:56:34
#     REVISION:  ---
#===============================================================================
use strict;
use warnings;
use Test::More 'no_plan';                      # last test to print
#use ExtUtils::testlib;
use Deep::Encode qw(deep_utf8_off deep_utf8_upgrade deep_utf8_downgrade deep_utf8_check);
my $s1 = chr(1);
for my $t ( 
        'deep_utf8_off( $_ = chr(1) ) == 0',
        'deep_utf8_off( $_ = chr(256) ) == 1',
        'deep_utf8_off( $_ = [ chr(1), chr(256), chr(257)] ) == 2',
        ){
    local $_;
    ok( scalar eval $t, $t);
}
for my $t ( 
        'deep_utf8_upgrade( $_ = chr(1) ) == 1',
        'deep_utf8_upgrade( $_ = chr(256) ) == 0',
        'deep_utf8_upgrade( $_ = [ chr(1), chr(256), chr(257)] ) == 1',
        'deep_utf8_upgrade( $_ = [ chr(1), chr(2), chr(257)] ) == 2',
        ){
    local $_;
    ok( scalar eval $t, $t);
}
for my $t ( 
        'deep_utf8_downgrade( $_ = chr(1) ) == 0',
        'deep_utf8_downgrade( $_ = chr(128) ) == 0',
        'deep_utf8_downgrade( $_ = mychr(2) ) == 1',
        'deep_utf8_downgrade( $_ = mychr(128) ) == 1',
        'deep_utf8_downgrade( $_ = [ chr(1), chr(2), mychr(1), mychr(2) ]) == 2 ',
        ){
    local $_;
    ok( scalar eval $t, $t);
}
is(scalar eval { deep_utf8_downgrade( chr(256))}, undef, "fail downgrade");
sub mychr{
    my $x = shift;
    $x = chr $x;
    $x.= chr(256);
    chop $x;
    return $x;
}
my $x = chr(256);
my $y = $x;
utf8::encode( $y );
deep_utf8_off( $x );
ok( $y eq $x, "check off flag");
ok( $y ne chr(256), "check on flag" );
{{ # upgrade/downgrade
    my $orig = pack "C*", 0..255;
    my $x = $orig;
    my $y = $x;
    my $z = Encode::decode( 'latin1', $orig );
    utf8::upgrade( $y );
    my $res = deep_utf8_upgrade( $x );
    ok( $x eq $y , "deep_upgrade" );
    ok( $x eq $z , "deep_upgrade(latin1)" );
    is( $res, 1, "upgrade res");
    utf8::downgrade( $y );
    $res = deep_utf8_downgrade( $x );
    $z = Encode::encode( 'latin1', $z );
     
    ok( $x eq $y, "deep_downgrade" );
    ok( $x eq $z, "deep_downgrade latin1" );
    ok( $x eq $orig, "deep_downgrade orig");
    is( $res, 1, "downgrade res");
}};
ok( deep_utf8_check( pack("C*", 0..127)), "deep_utf8_check");
for ( 128 .. 255 ){
    my $x = pack("C*", $_);
    my $true = !deep_utf8_check( $x ) && ! deep_utf8_check(chr(127).$x) && ! deep_utf8_check($x . chr(127));
    ok( $true , "! deep_utf8_check($_)");
}
my $true_ok = 1;
my $message = '';
for (128 .. 0xB7FF){
    my $x = pack "U*", $_;
    utf8::encode( $x );
    chop( my $y = $x);
    my $true  = deep_utf8_check( $x ) && !deep_utf8_check( substr($x, 1)) &&!deep_utf8_check($y);
    $true_ok &&= $true;
    $message = "at $_ " unless $true;
    last unless $true;
};
ok( $true_ok , " deep_utf8_check(128..0xb7FF_) $message");