1*256a93a4Safresh1#!/usr/bin/perl 2*256a93a4Safresh1 3*256a93a4Safresh1use strict; 4*256a93a4Safresh1use warnings; 5*256a93a4Safresh1 6*256a93a4Safresh1use Test::More; 7*256a93a4Safresh1 8*256a93a4Safresh1plan tests => 3; 9*256a93a4Safresh1 10*256a93a4Safresh1use Errno qw( EINVAL ); 11*256a93a4Safresh1 12*256a93a4Safresh1# Keep this unit test in a file of its own because we need to override 13*256a93a4Safresh1# connect() globally 14*256a93a4Safresh1BEGIN { 15*256a93a4Safresh1 *CORE::GLOBAL::connect = sub { $! = EINVAL; return undef }; 16*256a93a4Safresh1} 17*256a93a4Safresh1 18*256a93a4Safresh1my $EINVAL_STR = do { local $! = EINVAL; "$!" }; 19*256a93a4Safresh1 20*256a93a4Safresh1use IO::Socket; 21*256a93a4Safresh1 22*256a93a4Safresh1# test that error strings turn up in both places 23*256a93a4Safresh1my $sock = IO::Socket::INET->new( 24*256a93a4Safresh1 PeerHost => "localhost", 25*256a93a4Safresh1 PeerPort => 1, 26*256a93a4Safresh1); 27*256a93a4Safresh1my $e = $@; 28*256a93a4Safresh1 29*256a93a4Safresh1ok(!defined $sock, 'fails to connect with CORE::GLOBAL::connect override'); 30*256a93a4Safresh1 31*256a93a4Safresh1is($IO::Socket::errstr, "IO::Socket::INET: connect: $EINVAL_STR", 32*256a93a4Safresh1 'error message appears in $IO::Socket::errstr'); 33*256a93a4Safresh1is($e, "IO::Socket::INET: connect: $EINVAL_STR", 34*256a93a4Safresh1 'error message appeared in $@'); 35