File: core_sysopen.t

package info (click to toggle)
libcrypt-urandom-perl 0.55-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 212 kB
  • sloc: perl: 559; makefile: 3
file content (42 lines) | stat: -rw-r--r-- 1,063 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
#! /usr/bin/perl -w

use strict;
use warnings;
use Test::More;
use English();
use Carp();
use POSIX();
use English qw( -no_match_vars );
use Exporter();
use XSLoader();
use constant;
use overload;

SKIP: {
	if ($^O eq 'MSWin32') {
		skip("No functions to override in Win32", 1);
	} else {
		no warnings;
		*CORE::GLOBAL::sysopen = sub { $! = POSIX::EACCES(); return };
		use warnings;
		my $required_error_message = q[(?:] . (quotemeta POSIX::strerror(POSIX::EACCES())) . q[|Permission[ ]denied)];
		require FileHandle;
		@INC = qw(blib/lib); # making sure we're testing pure perl version
		require Crypt::URandom;
		my $generated = 0;
		eval {
			Crypt::URandom::urandom(1);
			$generated = 1;
		};
		chomp $@;
		ok(!$generated && $@ =~ /$required_error_message/smx, "Correct exception thrown when sysopen is overridden:$@");
		$generated = 0;
		eval {
			Crypt::URandom::urandom(1);
			$generated = 1;
		};
		chomp $@;
		ok(!$generated && $@ =~ /$required_error_message/smx, "Correct exception thrown when sysopen is overridden twice:$@");
	}
}
done_testing();