lib_header.t (1341B)
1 # 2 # Test that the shared memory header is what we expect. 3 # 4 use Modern::Perl; 5 use Test::Cmd; 6 use Test::More tests => 18; 7 8 use lib 't'; 9 require mem; 10 require utils; 11 12 13 my $dir = utils::setup_projdir(); 14 15 $dir->run( prog => $dir->workdir . '/program', args => '1', chdir => $dir->curdir ); 16 is( $dir->stdout, '1', 'inst program stdout correct' ); 17 isnt( $dir->stderr, '', 'inst program stderr not empty' ); 18 is( $? >> 8, 0, 'inst program exit code 0' ); 19 20 my $shm = mem->new(); 21 22 is( $shm->{magic}, 'ctrn', 'file magic correct' ); 23 is( $shm->{major}, 0, 'major 0' ); 24 is( $shm->{minor}, 0, 'minor 0' ); 25 is( $shm->{units}, 3, '3 translation units' ); 26 is( $shm->{loc}, 42, '42 lines of code' ); 27 28 my ($pid, $ppid, $pgrp) = @{ $shm->{pids} }; 29 cmp_ok( $pid, '<', 100 * 1000, 'pid < max pid' ); 30 cmp_ok( $pid, '>', 1, 'pid > min pid' ); 31 32 SKIP: { 33 skip 'win32 has no ppid or pgrp', 4 if ($^O eq "MSWin32"); 34 35 cmp_ok( $ppid, '<', 100 * 1000, 'ppid < max pid' ); 36 cmp_ok( $ppid, '>', 1, 'ppid > min pid' ); 37 cmp_ok( $pgrp, '<', 100 * 1000, 'pgrp < max pid' ); 38 cmp_ok( $pgrp, '>', 1, 'pgrp > min pid' ); 39 } 40 41 my $tmp_dir = $dir->workdir; 42 # Regex doesn't like single '\'s, so replace each with two. 43 $tmp_dir =~ s/\\/\\\\/g; 44 45 like( $shm->{cwd}, qr/.*$tmp_dir/, 'working directory believable' ); 46 like( $shm->{progname}, qr/program/, 'test program name correct' );