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