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