|
996
|
1 # just checking your version of Perl does not barf when seeing this
|
|
|
2
|
|
|
3 # Copyright (c) 2006-2008 Claudio Calvelli, all rights reserved.
|
|
|
4
|
|
|
5 # CLC-INTERCAL is copyrighted software. However, permission to use, modify,
|
|
|
6 # and distribute it is granted provided that the conditions set out in the
|
|
|
7 # licence agreement are met. See files README and COPYING in the distribution.
|
|
|
8
|
|
|
9 use ExtUtils::MakeMaker;
|
|
|
10
|
|
|
11 open(MANIFEST, 'MANIFEST') or do { print "1..0\n"; exit };
|
|
|
12
|
|
|
13 my @module_tests = ();
|
|
|
14 my @script_tests = ();
|
|
|
15 while (<MANIFEST>) {
|
|
|
16 chomp;
|
|
|
17 my $orig = $_;
|
|
|
18 m#^(INTERCAL/\S+)\.pm\s*(\S+)$# and do {
|
|
|
19 my ($mod, $perv) = ($1, $2);
|
|
|
20 $orig =~ s/\s+\S+$//;
|
|
|
21 push @module_tests, [$mod, $perv, $orig];
|
|
|
22 };
|
|
|
23 m#^bin/(\S+)\s*(\S+)$#
|
|
|
24 and push @script_tests, [$1, "bin/$1", $2];
|
|
|
25 }
|
|
|
26
|
|
|
27 $| = 1;
|
|
|
28 my $testno = 3 * (@module_tests + @script_tests);
|
|
|
29
|
|
|
30 print "1..$testno\n";
|
|
|
31
|
|
|
32 my $exit = 0;
|
|
|
33 $testno = 1;
|
|
|
34 for my $m (@module_tests) {
|
|
|
35 my ($mfile, $perv, $ofile) = @$m;
|
|
|
36 my $mname = $mfile;
|
|
|
37 $mname =~ s#/+#::#g;
|
|
|
38 $mname =~ s#^/*#Language::#;
|
|
|
39 mtest($testno, $mname, $perv, $mfile, $ofile);
|
|
|
40 $testno += 2;
|
|
|
41 vtest($testno, $ofile, $perv);
|
|
|
42 $testno++
|
|
|
43 }
|
|
|
44
|
|
|
45 for my $s (@script_tests) {
|
|
|
46 my ($sfile, $ofile, $perv) = @$s;
|
|
|
47 stest($testno, $sfile, $perv);
|
|
|
48 $testno += 2;
|
|
|
49 vtest($testno, $ofile, $perv);
|
|
|
50 $testno++
|
|
|
51 }
|
|
|
52
|
|
|
53 exit $exit;
|
|
|
54
|
|
|
55 sub etest {
|
|
|
56 my ($test, $eval, $err) = @_;
|
|
|
57 eval $eval;
|
|
|
58 if ($@) {
|
|
|
59 $err ||= $eval;
|
|
|
60 print STDERR "$err: $@";
|
|
|
61 print 'not ';
|
|
|
62 $exit = 1;
|
|
|
63 }
|
|
|
64 print "ok $test\n";
|
|
|
65 }
|
|
|
66
|
|
|
67 sub mtest {
|
|
|
68 my ($test, $module, $perv, $mfile, $ofile) = @_;
|
|
|
69 etest($test, "use $module $perv");
|
|
|
70 my $ok = eval "defined \$${module}::PERVERSION";
|
|
|
71 my $regex = qr/^CLC-INTERCAL\/\S+ \Q$ofile $perv\E$/;
|
|
|
72 $ok &&= eval("\$${module}::PERVERSION") =~ $regex;
|
|
|
73 etest($test + 1, $ok ? '1' : 'die("PerVersion string mismatch\n")',
|
|
|
74 'Check Perversion Number');
|
|
|
75 }
|
|
|
76
|
|
|
77 sub stest {
|
|
|
78 my ($test, $script, $perv) = @_;
|
|
|
79 my $src = -f "blib/script/$script" ? "blib/script/$script" : "bin/$script";
|
|
|
80 if (open(SCRIPT, '<', $src)) {
|
|
|
81 my $text = '';
|
|
|
82 my $pervcode = undef;
|
|
|
83 my $in_string = undef;
|
|
|
84 while (<SCRIPT>) {
|
|
|
85 last if ! defined $in_string && /^__(?:END|DATA)__$/;
|
|
|
86 $text .= $_;
|
|
|
87 if (defined $in_string) {
|
|
|
88 if (substr($_, 0, length $in_string) eq $in_string) {
|
|
|
89 $in_string = undef;
|
|
|
90 }
|
|
|
91 } elsif (/<<\s*(\w+)/) {
|
|
|
92 $in_string = $1;
|
|
|
93 }
|
|
|
94 next if defined $pervcode || ! /PERVERSION\s*=/;
|
|
|
95 chomp;
|
|
|
96 $pervcode = $_;
|
|
|
97 }
|
|
|
98 close SCRIPT;
|
|
|
99 eval "local \$^W = 0; no strict; no warnings; sub SUB$test { $text }";
|
|
|
100 if ($@) {
|
|
|
101 print STDERR "$script: $@";
|
|
|
102 print "not ok ", $test++, "\n";
|
|
|
103 print "not ok ", $test++, "\n";
|
|
|
104 } else {
|
|
|
105 undef &{"SUB$test"};
|
|
|
106 print "ok ", $test++, "\n";
|
|
|
107 if (defined $pervcode) {
|
|
|
108 my $perversion = eval "$pervcode; \$PERVERSION";
|
|
|
109 if ($@) {
|
|
|
110 print STDERR $@;
|
|
|
111 print "not ok ", $test++, "\n";
|
|
|
112 } elsif ( $perversion =~ /^CLC-INTERCAL\/\S+ \Qbin\/$script $perv\E$/) {
|
|
|
113 print "ok ", $test++, "\n";
|
|
|
114 } else {
|
|
|
115 print STDERR "Perversion string mismatch ($perversion)\n";
|
|
|
116 print "not ok ", $test++, "\n";
|
|
|
117 }
|
|
|
118 } else {
|
|
|
119 print "not ok ", $test++, "\n";
|
|
|
120 }
|
|
|
121 }
|
|
|
122 } else {
|
|
|
123 print "not ok ", $test++, "\n";
|
|
|
124 print "not ok ", $test++, "\n";
|
|
|
125 }
|
|
|
126 }
|
|
|
127
|
|
|
128 sub vtest {
|
|
|
129 # check that $ofile has a version number in a way ExtUtils::MakeMaker understands
|
|
|
130 my ($test, $ofile, $perv) = @_;
|
|
|
131 eval {
|
|
|
132 my $v = MM->parse_version($ofile);
|
|
|
133 $v eq $perv or die "$ofile: inconsistent version number (parsed: $v, expected: $perv)\n";
|
|
|
134 };
|
|
|
135 if ($@) {
|
|
|
136 print STDERR $@;
|
|
|
137 print "not ok $test\n";
|
|
|
138 } else {
|
|
|
139 print "ok $test\n";
|
|
|
140 }
|
|
|
141 }
|
|
|
142
|
