1use warnings; 2use strict; 3 4use IPC::Shareable; 5use Test::More; 6 7use constant BYTES => 2000000; # ~2MB 8 9# limit 10{ 11 my $size_ok_limit = eval { 12 tie my $var, 'IPC::Shareable', { 13 create => 1, 14 size => 2_000_000_000, 15 destroy => 1 16 }; 17 1; 18 }; 19 20 is $size_ok_limit, undef, "size larger than MAX croaks ok"; 21 like $@, qr/larger than max size/, "...and error is sane"; 22 23 if ($ENV{IPC_MEM}) { 24 my $size_ok_no_limit = eval { 25 tie my $var, 'IPC::Shareable', { 26 limit => 0, 27 create => 1, 28 size => 2_000_000_000, 29 destroy => 1 30 }; 31 1; 32 }; 33 34 is $size_ok_no_limit, 1, "size larger than MAX succeeeds with limit=>0 ok"; 35 } 36 else { 37 warn "IPC_MEM env var not set, skipping the exhaust memory test\n"; 38 } 39} 40 41# beyond RAM limits 42{ 43 my $size_ok = eval { 44 tie my $var, 'IPC::Shareable', { 45 limit => 0, 46 size => 999999999999, 47 destroy => 1 48 }; 49 1; 50 }; 51 52 is $size_ok, undef, "We croak if size is greater than max RAM"; 53 54 like $@, qr/Cannot allocate memory|Out of memory|Invalid argument/, "...and error is sane"; 55} 56 57my $k = tie my $sv, 'IPC::Shareable', { 58 create => 1, 59 destroy => 1, 60 size => BYTES, 61}; 62 63my $seg = $k->seg; 64 65my $id = $seg->id; 66my $size = $seg->size; 67 68my $actual_size; 69 70if ($^O eq 'linux') { 71 my $record = `ipcs -m -i $id`; 72 $actual_size = 0; 73 74 if ($record =~ /bytes=(\d+)/s) { 75 $actual_size = $1; 76 } 77} 78else { 79 $actual_size = 0; 80} 81 82is BYTES, $size, "size param is the same as the segment size"; 83 84# ipcs -i doesn't work on MacOS or FreeBSD, so skip it for now 85 86TODO: { 87 local $TODO = 'Not yet working on FreeBSD or macOS'; 88}; 89 90# ...and only run it on Linux systems 91 92if ($^O eq 'linux') { 93 is $size, $actual_size, "actual size in bytes ok if sending in custom size"; 94} 95 96$k->clean_up_all; 97 98done_testing(); 99