t/01basic.t

   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
  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
  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;