1use strict; 2use warnings; 3# vim:ts=8:sw=2:et:sta:sts=2 4 5use Test::More 0.88; 6use Module::Metadata; 7 8use lib 't/lib'; 9use GeneratePackage; 10 11# parse package names 12# format: { 13# name => test name 14# code => code snippet (string) 15# package => expected package names 16# } 17my @pkg_names = ( 18{ 19 name => 'package NAME', 20 package => [ 'Simple' ], 21 code => <<'---', 22package Simple; 23--- 24}, 25{ 26 name => 'package NAME::SUBNAME', 27 package => [ 'Simple::Edward' ], 28 code => <<'---', 29package Simple::Edward; 30--- 31}, 32{ 33 name => 'package NAME::SUBNAME::', 34 package => [ 'Simple::Edward::' ], 35 code => <<'---', 36package Simple::Edward::; 37--- 38}, 39{ 40 name => "package NAME'SUBNAME", 41 package => [ "Simple'Edward" ], 42 code => <<'---', 43package Simple'Edward; 44--- 45}, 46{ 47 name => "package NAME'SUBNAME::", 48 package => [ "Simple'Edward::" ], 49 code => <<'---', 50package Simple'Edward::; 51--- 52}, 53{ 54 name => 'package NAME::::SUBNAME', 55 package => [ 'Simple::::Edward' ], 56 code => <<'---', 57package Simple::::Edward; 58--- 59}, 60{ 61 name => 'package ::NAME::SUBNAME', 62 package => [ '::Simple::Edward' ], 63 code => <<'---', 64package ::Simple::Edward; 65--- 66}, 67{ 68 name => 'package NAME:SUBNAME (fail)', 69 package => [ 'main' ], 70 code => <<'---', 71package Simple:Edward; 72--- 73}, 74{ 75 name => "package NAME' (fail)", 76 package => [ 'main' ], 77 code => <<'---', 78package Simple'; 79--- 80}, 81{ 82 name => "package NAME::SUBNAME' (fail)", 83 package => [ 'main' ], 84 code => <<'---', 85package Simple::Edward'; 86--- 87}, 88{ 89 name => "package NAME''SUBNAME (fail)", 90 package => [ 'main' ], 91 code => <<'---', 92package Simple''Edward; 93--- 94}, 95{ 96 name => 'package NAME-SUBNAME (fail)', 97 package => [ 'main' ], 98 code => <<'---', 99package Simple-Edward; 100--- 101}, 102{ 103 name => 'no assumption of package merely if its $VERSION is referenced', 104 package => [ 'Simple' ], 105 code => <<'---', 106package Simple; 107$Foo::Bar::VERSION = '1.23'; 108--- 109}, 110{ 111 name => 'script 7 from t/metadata.t', # TODO merge these 112 package => [ '_private', 'main' ], 113 TODO => '$::VERSION indicates main namespace is referenced', 114 code => <<'---', 115package _private; 116$::VERSION = 0.01; 117$VERSION = '999'; 118--- 119}, 120{ 121 name => 'script 8 from t/metadata.t', # TODO merge these 122 package => [ '_private', 'main' ], 123 TODO => '$::VERSION indicates main namespace is referenced', 124 code => <<'---', 125package _private; 126$VERSION = '999'; 127$::VERSION = 0.01; 128--- 129}, 130{ 131 name => 'class NAME::SUBNAME', 132 package => [ 'Simple::Edward' ], 133 code => <<'---', 134class Simple::Edward; 135--- 136}, 137{ 138 name => 'class NAME::SUBNAME', 139 package => [ 'main', 'Simple::Edward' ], 140 code => <<'---', 141our $foo = 1; 142class Simple::Edward; 143--- 144}, 145); 146 147my $test_num = 0; 148 149my $tmpdir = GeneratePackage::tmpdir(); 150 151foreach my $test_case (@pkg_names) { 152 note '-------'; 153 note $test_case->{name}; 154 my $code = $test_case->{code}; 155 my $expected_name = $test_case->{package}; 156 157 my $warnings = ''; 158 local $SIG{__WARN__} = sub { $warnings .= $_ for @_ }; 159 160 my $pm_info = Module::Metadata->new_from_file(generate_file(File::Spec->catfile($tmpdir, "Simple${test_num}"), 'Simple.pm', $code)); 161 162 # whenever we drop support for 5.6, we can do this: 163 # open my $fh, '<', \(encode('UTF-8', $code, Encode::FB_CROAK)) 164 # or die "cannot open handle to code string: $!"; 165 # my $pm_info = Module::Metadata->new_from_handle($fh, 'lib/Simple.pm'); 166 167 # Test::Builder will prematurely numify objects, so use this form 168 my $errs; 169 my @got = $pm_info->packages_inside(); 170 { 171 local $TODO = $test_case->{TODO}; 172 is_deeply( \@got, $expected_name, 173 "case $test_case->{name}: correct package names (expected '" . join(', ', @$expected_name) . "')" ) 174 or $errs++; 175 } 176 is( $warnings, '', "case $test_case->{name}: no warnings from parsing" ) or $errs++; 177 diag "Got: '" . join(', ', @got) . "'\nModule contents:\n$code" 178 if $errs and not $ENV{PERL_CORE} and ($ENV{AUTHOR_TESTING} or $ENV{AUTOMATED_TESTING}); 179} 180continue { 181 ++$test_num; 182} 183 184done_testing; 185