Commit | Line | Data |
6be43b56 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More; |
5 | use Test::Exception; |
6 | |
7 | use Devel::PeekPoke qw/peek poke peek_address poke_address/; |
8 | use Devel::PeekPoke::Constants qw/PTR_SIZE PTR_PACK_TYPE/; |
9 | |
10 | my $str = 'for mutilation and mayhem'; |
11 | my $len = length($str); |
12 | my $str_pv_addr = unpack(PTR_PACK_TYPE, pack('p', $str) ); |
13 | |
14 | is( peek($str_pv_addr, $len + 1), $str . "\0", 'peek as expected (with NUL termination)' ); |
15 | |
16 | is( poke($str_pv_addr+5, 'itig'), 4, 'poke success and correct RV' ); |
17 | is( $str, 'for mitigation and mayhem', 'original changed' ); |
18 | |
28dc7271 |
19 | is( poke($str_pv_addr+1, 'u'), 1, 'second poke success and correct RV' ); |
20 | is( $str, 'fur mitigation and mayhem', 'original changed again' ); |
21 | |
6be43b56 |
22 | my $addr = do { no warnings 'portable'; hex('DEADBEEF' x (PTR_SIZE/4)) }; |
23 | is( poke_address ($str_pv_addr, $addr), PTR_SIZE, 'poke_address works and correct RV' ); |
24 | is( peek_address ($str_pv_addr), $addr, 'peek_address works' ); |
25 | is( $str, pack(PTR_PACK_TYPE, $addr) . substr('for mitigation and mayhem', PTR_SIZE), 'Resulting string correct' ); |
26 | |
27 | # check exceptions |
28 | throws_ok { peek(123) } qr/Peek where and how much/; |
29 | throws_ok { peek('18446744073709551616', 4) } qr/Your system does not support addresses larger than 0xFF.../; |
30 | |
31 | throws_ok { poke(123) } qr/Poke where and what/; |
32 | throws_ok { poke_address(123, '18446744073709551616') } qr/Your system does not support addresses larger than 0xFF.../; |
33 | |
34 | SKIP: { |
35 | skip 'No unicode testing before 5.8', 1 if $] < 5.008; |
36 | |
37 | throws_ok { poke(123, "abc\x{14F}") } qr/Expecting a byte string, but received characters/; |
38 | |
39 | my $itsatrap = "\x{AE}\x{14F}"; |
40 | throws_ok { poke(123, substr($itsatrap, 0, 1)) } |
41 | qr/\QExpecting a byte string, but received what looks like *possible* characters, please utf8_downgrade the input/; |
42 | } |
43 | |
44 | done_testing; |