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