view release on metacpan or  search on metacpan

t/basic.t  view on Meta::CPAN

#! perl

################ WARNING : OLD CODE ################

use strict;

require 5.004;

if ( $^O eq "solaris" ) {
    print STDERR <<EOD;

**************** You're running Solaris ****************

The Solaris version of the 'patch' program seems to be extremely buggy.
If this test fails with a message like

  patch: Line must begin with '+ ', '  ', or '! '.

you must install a better version of 'patch', for example, GNU patch.

**************** Let the games begin ****************
EOD
}

my $test = 1;

print "1..8\n";

my $data1 = <<EOD;
Squirrel Consultancy
Cederlaan 6
7875 EB  Exloo
EOD
my $data2 = <<EOD;
Squirrel Consultancy
Cypreslaan 6
7875 EB  Exloo
EOD

chdir("t") if -d "t";
mkdir("d1") unless -f "d1";
mkdir("d2") unless -f "d2";
chdir("..");
print "not " unless -d "t/d1";
print "ok $test\n";
$test++;
print "not " unless -d "t/d2";
print "ok $test\n";
$test++;

open (D, ">", "t/d1/tdata1"); binmode(D); print D $data1; close D;
open (D, ">", "t/d2/tdata1"); binmode(D); print D $data2; close D;
open (D, ">", "t/d1/tdata2"); binmode(D); print D $data2; close D;
open (D, ">", "t/d2/tdata2"); binmode(D); print D $data1; close D;

my $tmpout = "basic.out";

$ENV{MAKEPATCHINIT} = "-test";
@ARGV = qw(-test -quiet -description test t/d1 t/d2);

eval {
    package MakePatch;
    local (*STDOUT);
    open (STDOUT, ">$tmpout");
    local (*STDERR);
    open (STDERR, ">&STDOUT");
    require "blib/script/makepatch";
};

# Should exit Okay.
if ( !$@ || $@ =~ /^Okay/ ) {
   print "ok $test\n";
}
else {
   print "not ok $test\n";
   print $@;
}
$test++;

# Run makepatch's END block
eval {
    MakePatch::cleanup ();
};
# And blank it.
undef &MakePatch::cleanup;
*MakePatch::cleanup = sub {};

# Expect some output.
print "not " unless -s $tmpout > 1300;
print "ok $test\n";
$test++;

my $tmpou2 = "basic.ou2";

@ARGV = qw(-test -dir t/d1 basic.out);

eval {
    package ApplyPatch;
    local (*STDOUT);
    open (STDOUT, ">$tmpou2");
    local (*STDERR);
    open (STDERR, ">&STDOUT");
    require "blib/script/applypatch";
};
# applypatch will chdir to t/d1; change back.
chdir ("../..");

# Should exit Okay.
if ( $@ =~ /^Okay/ ) {
   print "ok $test\n";
}
else {
   print "not ok $test\n";
   print $@;