xref: /openbsd/gnu/usr.bin/perl/t/op/vec.t (revision 5af055cd) 
1#!./perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    @INC = qw(. ../lib);
6}
7
8require "test.pl";
9plan( tests => 35 );
10
11my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
12
13is(vec($foo,0,1), 0);
14is(length($foo), undef);
15vec($foo,0,1) = 1;
16is(length($foo), 1);
17is(unpack('C',$foo), 1);
18is(vec($foo,0,1), 1);
19
20is(vec($foo,20,1), 0);
21vec($foo,20,1) = 1;
22is(vec($foo,20,1), 1);
23is(length($foo), 3);
24is(vec($foo,1,8), 0);
25vec($foo,1,8) = 0xf1;
26is(vec($foo,1,8), 0xf1);
27is((unpack('C',substr($foo,1,1)) & 255), 0xf1);
28is(vec($foo,2,4), 1);;
29is(vec($foo,3,4), 15);
30vec($Vec, 0, 32) = 0xbaddacab;
31is($Vec, "\xba\xdd\xac\xab");
32is(vec($Vec, 0, 32), 3135089835);
33
34# ensure vec() handles numericalness correctly
35$foo = $bar = $baz = 0;
36vec($foo = 0,0,1) = 1;
37vec($bar = 0,1,1) = 1;
38$baz = $foo | $bar;
39ok($foo eq "1" && $foo == 1);
40ok($bar eq "2" && $bar == 2);
41ok("$foo $bar $baz" eq "1 2 3");
42
43# error cases
44
45$x = eval { vec $foo, 0, 3 };
46like($@, qr/^Illegal number of bits in vec/);
47$@ = undef;
48$x = eval { vec $foo, 0, 0 };
49like($@, qr/^Illegal number of bits in vec/);
50$@ = undef;
51$x = eval { vec $foo, 0, -13 };
52like($@, qr/^Illegal number of bits in vec/);
53$@ = undef;
54$x = eval { vec($foo, -1, 4) = 2 };
55like($@, qr/^Negative offset to vec in lvalue context/);
56$@ = undef;
57ok(! vec('abcd', 7, 8));
58
59# UTF8
60# N.B. currently curiously coded to circumvent bugs elswhere in UTF8 handling
61
62$foo = "\x{100}" . "\xff\xfe";
63$x = substr $foo, 1;
64is(vec($x, 0, 8), 255);
65$@ = undef;
66eval { vec($foo, 1, 8) };
67ok(! $@);
68$@ = undef;
69eval { vec($foo, 1, 8) = 13 };
70ok(! $@);
71if ($Is_EBCDIC) {
72    is($foo, "\x8c\x0d\xff\x8a\x69");
73}
74else {
75    is($foo, "\xc4\x0d\xc3\xbf\xc3\xbe");
76}
77$foo = "\x{100}" . "\xff\xfe";
78$x = substr $foo, 1;
79vec($x, 2, 4) = 7;
80is($x, "\xff\xf7");
81
82# mixed magic
83
84$foo = "\x61\x62\x63\x64\x65\x66";
85is(vec(substr($foo, 2, 2), 0, 16), 25444);
86vec(substr($foo, 1,3), 5, 4) = 3;
87is($foo, "\x61\x62\x63\x34\x65\x66");
88
89# A variation of [perl #20933]
90{
91    my $s = "";
92    vec($s, 0, 1) = 0;
93    vec($s, 1, 1) = 1;
94    my @r;
95    $r[$_] = \ vec $s, $_, 1 for (0, 1);
96    ok(!(${ $r[0] } != 0 || ${ $r[1] } != 1));
97}
98
99
100my $destroyed;
101{ package Class; DESTROY { ++$destroyed; } }
102
103$destroyed = 0;
104{
105    my $x = '';
106    vec($x,0,1) = 0;
107    $x = bless({}, 'Class');
108}
109is($destroyed, 1, 'Timely scalar destruction with lvalue vec');
110
111use constant roref => \1;
112eval { for (roref) { vec($_,0,1) = 1 } };
113like($@, qr/^Modification of a read-only value attempted at /,
114        'err msg when modifying read-only refs');
115
116
117{
118    # downgradeable utf8 strings should be downgraded before accessing
119    # the byte string.
120    # See the p5p thread with Message-ID:
121    # <CAMx+QJ6SAv05nmpnc7bmp0Wo+sjcx=ssxCcE-P_PZ8HDuCQd9A@mail.gmail.com>
122
123
124    my $x = substr "\x{100}\xff\xfe", 1; # a utf8 string with all ords < 256
125    my $v;
126    $v = vec($x, 0, 8);
127    is($v, 255, "downgraded utf8 try 1");
128    $v = vec($x, 0, 8);
129    is($v, 255, "downgraded utf8 try 2");
130}
131