1#!perl 2 3use strict; 4use warnings; 5 6# This doesn't use Test::More because I don't want to clutter %INC 7# with modules that aren't prerequisites. 8 9my $test = 0; 10my $tests_completed; 11 12sub ok ($$) 13{ 14 my ($ok, $name) = @_; 15 16 printf "%sok %d - %s\n", ($ok ? '' : 'not '), ++$test, $name; 17 18 return $ok; 19} # end ok 20 21END { 22 ok(0, 'unknown failure') unless defined $tests_completed; 23 print "1..$tests_completed\n"; 24} 25 26sub get_version 27{ 28 my ($package) = @_; 29 30 local $@; 31 my $version = eval { $package->VERSION }; 32 33 defined $version ? $version : 'undef'; 34} # end get_version 35 36TEST: { 37 ok(open(META, '<META.json'), 'opened META.json') or last TEST; 38 39 while (<META>) { 40 last if /^\s*"prereqs" : \{\s*\z/; 41 } # end while <META> 42 43 ok(defined $_, 'found prereqs') or last TEST; 44 45 while (<META>) { 46 last if /^\s*\},?\s*\z/; 47 ok(/^\s*"(.+)" : \{\s*\z/, "found phase $1") or last TEST; 48 my $phase = $1; 49 50 while (<META>) { 51 last if /^\s*\},?\s*\z/; 52 next if /^\s*"[^"]+"\s*:\s*\{\s*\},?\s*\z/; 53 ok(/^\s*"(.+)" : \{\s*\z/, "found relationship $phase $1") or last TEST; 54 my $rel = $1; 55 56 while (<META>) { 57 last if /^\s*\},?\s*\z/; 58 ok(/^\s*"([^"]+)"\s*:\s*(\S+?),?\s*\z/, "found prereq $1") 59 or last TEST; 60 my ($prereq, $version) = ($1, $2); 61 62 next if $phase ne 'runtime' or $prereq eq 'perl'; 63 64 # Need a special case for if.pm, because "require if;" is a syntax error. 65 my $loaded = ($prereq eq 'if') 66 ? eval "require '$prereq.pm'; 1" 67 : eval "require $prereq; 1"; 68 if ($rel eq 'requires') { 69 ok($loaded, "loaded $prereq") or 70 print STDERR "\n# ERROR: Wanted: $prereq $version\n"; 71 } else { 72 ok(1, ($loaded ? 'loaded' : 'failed to load') . " $prereq"); 73 } 74 if ($loaded and not ($version eq '"0"' or 75 eval "'$prereq'->VERSION($version); 1")) { 76 printf STDERR "\n# WARNING: Got: %s %s\n# Wanted: %s %s\n", 77 $prereq, get_version($prereq), $prereq, $version; 78 } 79 } # end while <META> in prerequisites 80 } # end while <META> in relationship 81 } # end while <META> in phase 82 83 close META; 84 85 # Print version of all loaded modules: 86 if ($ENV{AUTOMATED_TESTING} or 87 (@ARGV and ($ARGV[0] eq '-v' or $ARGV[0] eq '--verbose'))) { 88 print STDERR "# Listing %INC\n"; 89 90 my @packages = grep { s/\.pm\Z// and do { s![\\/]!::!g; 1 } } sort keys %INC; 91 92 my $len = 0; 93 for (@packages) { $len = length if length > $len } 94 $len = 68 if $len > 68; 95 96 for my $package (@packages) { 97 printf STDERR "# %${len}s %s\n", $package, get_version($package); 98 } 99 } # end if AUTOMATED_TESTING 100} # end TEST 101 102$tests_completed = $test; 103 104