view interps/clc-intercal/CLC-INTERCAL-INET-1.-94.-2/t/00use.t @ 9071:581584df6d82

<fizzie> revert 942e964c81c1
author HackBot
date Sun, 25 Sep 2016 20:17:31 +0000
parents 859f9b4339e6
children
line wrap: on
line source

# 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";
    }
}