Lines Matching refs:pack
51 my $foo = pack($format,@ary);
95 is( ($x = unpack("I",pack("I", 0xFFFFFFFF))), 0xFFFFFFFF );
102 my $x = pack('w*', @x);
103 my $y = pack 'H*', '0581028200843081fa0081bd8440ffffff7f8480808014A0808'.
119 $x = pack('w*', 5000000000); $y = '';
122 $y = pack('w*', Math::BigInt::->new(5000000000));
126 $x = pack 'w', ~0;
127 $y = pack 'w', (~0).'';
132 $x = pack 'w', ~0 - 1;
133 $y = pack 'w', (~0) - 2;
143 # These should spot that pack 'w' is using NV, not double, on platforms
149 $x = pack 'w', $x0;
150 $y = pack 'w', $y0;
165 eval { $x = unpack 'w', pack 'C*', 0xff, 0xff};
168 eval { $x = unpack 'w', pack 'C*', 0xff, 0xff, 0xff, 0xff};
171 eval { $x = unpack 'w', pack 'C*', 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff};
174 eval { $x = pack 'w', -1 };
177 eval { $x = pack 'w', '1'x(1 + length ~0) . 'e0' };
204 eval { $x = pack 'w', $inf };
222 eval { $x = pack 'w', $big };
223 is ($@, '', "Should be able to pack 'w', $big # 2**1023");
227 "Should be able to unpack 'w' the result of pack 'w', $big # 2**1023");
232 "Round trip pack, unpack 'w' of $big is withing 1% ($quotient%)");
240 is(unpack("p",pack("p","foo")), "foo");
243 is(unpack("p",pack("p",239)), 239);
253 my $junk = pack("p", &foo);
259 like(pack("p", undef), qr/^\0+/);
264 is((unpack("i",pack("i",-1))), -1);
266 print "# test the pack lengths of s S i I l L n N v V\n";
270 my $len = length(pack($format, 0));
281 print "# test unpack-pack lengths\n";
287 my @t = eval { unpack("$t*", pack("$t*", 12, 34)) };
312 my $in = pack 'C*', 0 .. 255;
327 is(pack('u', $in), $_);
371 my $got = $what eq 'u' ? (unpack $template, $in) : (pack $template, $in);
374 print "# ${un}pack ('$template', "._qq($in).') gave '._qq($out).
381 is(length(pack("s!", 0)), $Config{shortsize});
382 is(length(pack("i!", 0)), $Config{intsize});
383 is(length(pack("l!", 0)), $Config{longsize});
384 ok(length(pack("s!", 0)) <= length(pack("i!", 0)));
385 ok(length(pack("i!", 0)) <= length(pack("l!", 0)));
386 is(length(pack("i!", 0)), length(pack("i", 0)));
404 my $out = eval {unpack($format, pack($format, $_))};
405 skip "cannot pack '$format' on this perl", 2 if
424 my $sum = eval {unpack "%$_$format*", pack "$format*", @_};
425 skip "cannot pack '$format' on this perl", 3
535 print "# pack nvNV byteorders\n";
537 is(pack("n", 0xdead), "\xde\xad");
538 is(pack("v", 0xdead), "\xad\xde");
539 is(pack("N", 0xdeadbeef), "\xde\xad\xbe\xef");
540 is(pack("V", 0xdeadbeef), "\xef\xbe\xad\xde");
565 eval { ($x) = pack '/a*','hello' };
568 eval { $x = pack '/a*','hello' };
571 $z = pack 'n/a* N/Z* w/A*','string','hi there ','etc';
633 $z = pack $pattern,'string','etc';
641 is("1.20.300.4000", sprintf "%vd", pack("U*",1,20,300,4000));
642 is("1.20.300.4000", sprintf "%vd", pack(" U*",1,20,300,4000));
644 isnt(v1.20.300.4000, sprintf "%vd", pack("C0U*",1,20,300,4000));
649 # does pack U create Unicode?
650 is(ord(pack('U', 300)), 300);
655 # is unpack U the reverse of pack U for Unicode string?
656 is("@{[unpack('U*', pack('U*', 100, 200, 300))]}", "100 200 300");
658 # is unpack U the reverse of pack U for byte string?
659 is("@{[unpack('U*', pack('U*', 100, 200))]}", "100 200");
665 # does unpack C unravel pack U?
666 is("@{[unpack('C*', pack('U*', 100, 200))]}", "100 195 136");
668 # does pack U0C create Unicode?
669 is("@{[pack('U0C*', 100, 195, 136)]}", v100.v200);
671 # does pack C0U create characters?
672 is("@{[pack('C0U*', 100, 200)]}", pack("C*", 100, 195, 136));
683 my $p = pack 'i*', -2147483648, ~0, 0, 1, 2147483647;
696 $p = pack 'I*', 42, 12;
722 # pack x X @
736 my $got = eval {pack $template, @in};
739 printf "# pack ('$template', %s) gave %s expected %s\n",
772 my $p = pack($t, $u, $v);
793 my $buf = pack( 'Z*/A* C', $s, $x );
814 @a = unpack '(SL)', pack 'SLSLSL', 67..90;
816 @a = unpack '(SL)3', pack 'SLSLSL', 67..90;
819 @a = unpack '(SL)3', pack 'SLSLSLSL', 67..90;
821 @a = unpack '(SL)[3]', pack 'SLSLSLSL', 67..90;
823 @a = unpack '(SL)[2] SL', pack 'SLSLSLSL', 67..90;
825 @a = unpack 'A/(SL)', pack 'ASLSLSLSL', 3, 67..90;
827 @a = unpack 'A/(SL)SL', pack 'ASLSLSLSL', 2, 67..90;
829 @a = unpack '(SL)*', pack 'SLSLSLSL', 67..90;
832 @a = unpack '(SL)*SL', pack 'SLSLSLSL', 67..90;
840 eval { @a = pack '(*SL)' };
842 @a = unpack '(SL)3 SL', pack '(SL)4', 67..74;
844 @a = unpack '(SL)3 SL', pack '(SL)[4]', 67..74;
846 @a = unpack '(SL)3 SL', pack '(SL)*', 67..74;
857 my $badc = pack( '(a)*', unpack( '(@1a @0a @2)*', 'abcd' ) );
860 my $buf = pack( '(@1c)((@2C)@3c)', @b );
867 my $env = pack( 'S(S/A*S/A*)*', @Env/2, @Env );
880 $env = pack( '(S/A* S/A*)' . @Env/2, @Env );
889 eval { $_ = pack( ('(' x 105) . 'A' . (')' x 105) ); };
899 eval { my $s = pack( 'Ax![4c]A', 1..5 ); };
902 eval { my $buf = pack( '(c/*a*)', 'AAA', 'BB' ); };
913 my $env = pack( ' S ( S / A* S / A* )* ', @Env/2, @Env );
919 eval { my $s = pack( $temp, 'B' ); };
925 my $x = pack( 'I,A', 4, 'X' );
930 $x = pack( 'C(C,C)C,C', 65..71 );
934 eval { my $x = pack( 'A[@4]', 'XXXX' ); };
938 my $s = pack( 'AA@A', 'A', 'B', 'C' );
953 if (eval { pack 'q', 1 } ) {
958 if (eval { pack 'D', 1 } ) {
994 my $p = pack $junk1, @list2;
999 $p = pack "$junk $end", @list2, @end;
1010 # XXXX no spaces are allowed in pack... In pack only before the slash...
1011 is(scalar unpack('A /A Z20', pack 'A/A* Z20', 'bcde', 'xxxxx'), 'bcde');
1017 my $p = pack($t, @a);
1024 $p = pack($t, @a);
1035 my $p = pack $t, @a;
1056 is(length(pack("j", 0)), $Config{ivsize});
1057 is(length(pack("J", 0)), $Config{uvsize});
1058 is(length(pack("F", 0)), $Config{nvsize});
1064 my $t = eval { unpack("D*", pack("D", 12.34)) };
1068 is(length(pack("D", 0)), $Config{longdblsize});
1072 # Maybe this knowledge needs to be "global" for all of pack.t
1078 my $packed = eval {pack "${template}4", 1, 4, 9, 16};
1120 ok(pack('u2', 'AA'), "[perl #8026]"); # used to hang and eat RAM in perl 5.7.2