1*5759b3d2Safresh1#!perl -w 2*5759b3d2Safresh1use strict; 3*5759b3d2Safresh1 4*5759b3d2Safresh1# Test the load_module() core API function. 5*5759b3d2Safresh1# 6*5759b3d2Safresh1# Note that this function can be passed arbitrary and illegal module 7*5759b3d2Safresh1# names which would already have been caught if a require statement had 8*5759b3d2Safresh1# been compiled. So check that load_module() can catch such bad things. 9*5759b3d2Safresh1 10*5759b3d2Safresh1use Test::More; 11*5759b3d2Safresh1use XS::APItest; 12*5759b3d2Safresh1 13*5759b3d2Safresh1# This isn't complete yet. In particular, we don't test import lists, or 14*5759b3d2Safresh1# the other flags. But it's better than nothing. 15*5759b3d2Safresh1 16*5759b3d2Safresh1is($INC{'less.pm'}, undef, "less isn't loaded"); 17*5759b3d2Safresh1load_module(PERL_LOADMOD_NOIMPORT, 'less'); 18*5759b3d2Safresh1like($INC{'less.pm'}, qr!(?:\A|/)lib/less\.pm\z!, "less is now loaded"); 19*5759b3d2Safresh1 20*5759b3d2Safresh1delete $INC{'less.pm'}; 21*5759b3d2Safresh1delete $::{'less::'}; 22*5759b3d2Safresh1 23*5759b3d2Safresh1is(eval { load_module(PERL_LOADMOD_NOIMPORT, 'less', 1); 1}, undef, 24*5759b3d2Safresh1 "expect load_module() to fail"); 25*5759b3d2Safresh1like($@, qr/less version 1 required--this is only version 0\./, 26*5759b3d2Safresh1 'with the correct error message'); 27*5759b3d2Safresh1 28*5759b3d2Safresh1is(eval { load_module(PERL_LOADMOD_NOIMPORT, 'less', 0.03); 1}, 1, 29*5759b3d2Safresh1 "expect load_module() not to fail"); 30*5759b3d2Safresh1 31*5759b3d2Safresh1# 32*5759b3d2Safresh1# Check for illegal module names 33*5759b3d2Safresh1 34*5759b3d2Safresh1for (["", qr!\ABareword in require maps to empty filename!], 35*5759b3d2Safresh1 ["::", qr!\ABareword in require must not start with a double-colon: "::"!], 36*5759b3d2Safresh1 ["::::", qr!\ABareword in require must not start with a double-colon: "::::"!], 37*5759b3d2Safresh1 ["::/", qr!\ABareword in require must not start with a double-colon: "::/!], 38*5759b3d2Safresh1 ["/", qr!\ABareword in require maps to disallowed filename "/\.pm"!], 39*5759b3d2Safresh1 ["::/WOOSH", qr!\ABareword in require must not start with a double-colon: "::/WOOSH!], 40*5759b3d2Safresh1 [".WOOSH", qr!\ABareword in require maps to disallowed filename "\.WOOSH\.pm"!], 41*5759b3d2Safresh1 ["::.WOOSH", qr!\ABareword in require must not start with a double-colon: "::.WOOSH!], 42*5759b3d2Safresh1 ["WOOSH::.sock", qr!\ABareword in require contains "/\."!], 43*5759b3d2Safresh1 ["WOOSH::.sock", qr!\ABareword in require contains "/\."!], 44*5759b3d2Safresh1 ["WOOSH/.sock", qr!\ABareword in require contains "/\."!], 45*5759b3d2Safresh1 ["WOOSH/..sock", qr!\ABareword in require contains "/\."!], 46*5759b3d2Safresh1 ["WOOSH/../sock", qr!\ABareword in require contains "/\."!], 47*5759b3d2Safresh1 ["WOOSH::..::sock", qr!\ABareword in require contains "/\."!], 48*5759b3d2Safresh1 ["WOOSH::.::sock", qr!\ABareword in require contains "/\."!], 49*5759b3d2Safresh1 ["WOOSH::./sock", qr!\ABareword in require contains "/\."!], 50*5759b3d2Safresh1 ["WOOSH/./sock", qr!\ABareword in require contains "/\."!], 51*5759b3d2Safresh1 ["WOOSH/.::sock", qr!\ABareword in require contains "/\."!], 52*5759b3d2Safresh1 ["WOOSH/..::sock", qr!\ABareword in require contains "/\."!], 53*5759b3d2Safresh1 ["WOOSH::../sock", qr!\ABareword in require contains "/\."!], 54*5759b3d2Safresh1 ["WOOSH::../..::sock", qr!\ABareword in require contains "/\."!], 55*5759b3d2Safresh1 ["WOOSH\0sock", qr!\ACan't locate WOOSH\\0sock.pm:!], 56*5759b3d2Safresh1 ) 57*5759b3d2Safresh1{ 58*5759b3d2Safresh1 my ($module, $error) = @$_; 59*5759b3d2Safresh1 my $module2 = $module; # load_module mangles its first argument 60*5759b3d2Safresh1 no warnings 'syscalls'; 61*5759b3d2Safresh1 is(eval { load_module(PERL_LOADMOD_NOIMPORT, $module); 1}, undef, 62*5759b3d2Safresh1 "expect load_module() for '$module2' to fail"); 63*5759b3d2Safresh1 like($@, $error, "check expected error for $module2"); 64*5759b3d2Safresh1} 65*5759b3d2Safresh1 66*5759b3d2Safresh1done_testing(); 67