diff interps/clc-intercal/CLC-INTERCAL-UI-Line-1.-94.-2/t/00use.t @ 996:859f9b4339e6

<Gregor> tar xf egobot.tar.xz
author HackBot
date Sun, 09 Dec 2012 19:30:08 +0000
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/interps/clc-intercal/CLC-INTERCAL-UI-Line-1.-94.-2/t/00use.t	Sun Dec 09 19:30:08 2012 +0000
@@ -0,0 +1,142 @@
+# just checking your version of Perl does not barf when seeing this
+
+# Copyright (c) 2006-2008 Claudio Calvelli, all rights reserved.
+
+# CLC-INTERCAL is copyrighted software. However, permission to use, modify,
+# and distribute it is granted provided that the conditions set out in the
+# licence agreement are met. See files README and COPYING in the distribution.
+
+use ExtUtils::MakeMaker;
+
+open(MANIFEST, 'MANIFEST') or do { print "1..0\n"; exit };
+
+my @module_tests = ();
+my @script_tests = ();
+while (<MANIFEST>) {
+    chomp;
+    my $orig = $_;
+    m#^(INTERCAL/\S+)\.pm\s*(\S+)$# and do {
+	my ($mod, $perv) = ($1, $2);
+	$orig =~ s/\s+\S+$//;
+	push @module_tests, [$mod, $perv, $orig];
+    };
+    m#^bin/(\S+)\s*(\S+)$#
+	and push @script_tests, [$1, "bin/$1", $2];
+}
+
+$| = 1;
+my $testno = 3 * (@module_tests + @script_tests);
+
+print "1..$testno\n";
+
+my $exit = 0;
+$testno = 1;
+for my $m (@module_tests) {
+    my ($mfile, $perv, $ofile) = @$m;
+    my $mname = $mfile;
+    $mname =~ s#/+#::#g;
+    $mname =~ s#^/*#Language::#;
+    mtest($testno, $mname, $perv, $mfile, $ofile);
+    $testno += 2;
+    vtest($testno, $ofile, $perv);
+    $testno++
+}
+
+for my $s (@script_tests) {
+    my ($sfile, $ofile, $perv) = @$s;
+    stest($testno, $sfile, $perv);
+    $testno += 2;
+    vtest($testno, $ofile, $perv);
+    $testno++
+}
+
+exit $exit;
+
+sub etest {
+    my ($test, $eval, $err) = @_;
+    eval $eval;
+    if ($@) {
+	$err ||= $eval;
+	print STDERR "$err: $@";
+	print 'not ';
+	$exit = 1;
+    }
+    print "ok $test\n";
+}
+
+sub mtest {
+    my ($test, $module, $perv, $mfile, $ofile) = @_;
+    etest($test, "use $module $perv");
+    my $ok = eval "defined \$${module}::PERVERSION";
+    my $regex = qr/^CLC-INTERCAL\/\S+ \Q$ofile $perv\E$/;
+    $ok &&= eval("\$${module}::PERVERSION") =~ $regex;
+    etest($test + 1, $ok ? '1' : 'die("PerVersion string mismatch\n")',
+	  'Check Perversion Number');
+}
+
+sub stest {
+    my ($test, $script, $perv) = @_;
+    my $src = -f "blib/script/$script" ? "blib/script/$script" : "bin/$script";
+    if (open(SCRIPT, '<', $src)) {
+	my $text = '';
+	my $pervcode = undef;
+	my $in_string = undef;
+	while (<SCRIPT>) {
+	    last if ! defined $in_string && /^__(?:END|DATA)__$/;
+	    $text .= $_;
+	    if (defined $in_string) {
+		if (substr($_, 0, length $in_string) eq $in_string) {
+		    $in_string = undef;
+		}
+	    } elsif (/<<\s*(\w+)/) {
+		$in_string = $1;
+	    }
+	    next if defined $pervcode || ! /PERVERSION\s*=/;
+	    chomp;
+	    $pervcode = $_;
+	}
+	close SCRIPT;
+	eval "local \$^W = 0; no strict; no warnings; sub SUB$test { $text }";
+	if ($@) {
+	    print STDERR "$script: $@";
+	    print "not ok ", $test++, "\n";
+	    print "not ok ", $test++, "\n";
+	} else {
+	    undef &{"SUB$test"};
+	    print "ok ", $test++, "\n";
+	    if (defined $pervcode) {
+		my $perversion = eval "$pervcode; \$PERVERSION";
+		if ($@) {
+		    print STDERR $@;
+		    print "not ok ", $test++, "\n";
+		} elsif ( $perversion =~ /^CLC-INTERCAL\/\S+ \Qbin\/$script $perv\E$/) {
+		    print "ok ", $test++, "\n";
+		} else {
+		    print STDERR "Perversion string mismatch ($perversion)\n";
+		    print "not ok ", $test++, "\n";
+		}
+	    } else {
+		print "not ok ", $test++, "\n";
+	    }
+	}
+    } else {
+	print "not ok ", $test++, "\n";
+	print "not ok ", $test++, "\n";
+    }
+}
+
+sub vtest {
+    # check that $ofile has a version number in a way ExtUtils::MakeMaker understands
+    my ($test, $ofile, $perv) = @_;
+    eval {
+	my $v = MM->parse_version($ofile);
+	$v eq $perv or die "$ofile: inconsistent version number (parsed: $v, expected: $perv)\n";
+    };
+    if ($@) {
+	print STDERR $@;
+	print "not ok $test\n";
+    } else {
+	print "ok $test\n";
+    }
+}
+