Update of /cvsroot/fink/fink/t/Finally
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19510/t/Finally
Modified Files:
ChangeLog finally.t
Added Files:
buildlocks.t
Log Message:
new Finally work
--- NEW FILE: buildlocks.t ---
#!/usr/bin/perl -w
use strict;
use Test::More 'no_plan';
require_ok('Fink::Finally::Buildlock');
# API function check
can_ok('Fink::Finally::Buildlock','initialize');
can_ok('Fink::Finally::Buildlock','finalize');
# dpkg needs BDO pkgs
{
my $prog = 'fink-virtual-pkgs';
my $path;
foreach ('.', '..') {
# test could run with PWD as parent of t/ or t/ itself
if (-r "$_/$prog") {
$path = $_;
last;
}
}
ok(defined $path, "locating $prog");
my( @result, @vers );
@result = `/usr/bin/perl $path/$prog --version`;
foreach (@result) {
last if (@vers = /$prog revision (\d+)\.(\d+)/) == 2; # get major.minor
}
ok(defined $vers[0] && defined $vers[1], "Parse revision of:[EMAIL PROTECTED]");
ok($vers[0] > 1 || ($vers[0] == 1 && $vers[1] >= 14), "$prog revision
$vers[0].$vers[1] >= 1.14\n");
}
Index: finally.t
===================================================================
RCS file: /cvsroot/fink/fink/t/Finally/finally.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- finally.t 22 Mar 2006 22:46:54 -0000 1.3
+++ finally.t 23 Mar 2006 23:11:44 -0000 1.4
@@ -9,8 +9,6 @@
use Fink::Services qw(lock_wait execute);
use Fink::Command qw(touch);
-BEGIN { use_ok 'Fink::Finally'; }
-
sub run_script {
my $script = shift;
my ($out, $ret);
@@ -23,103 +21,267 @@
return wantarray ? ($out, $ret) : $out;
}
-# bad args
+##### TESTS
+
+# use
+BEGIN { use_ok 'Fink::Finally'; }
+
+##### SIMPLE
+
+# simple, bad args
{
- eval { Fink::Finally->new };
- ok($@, 'bad args - no args');
- eval { Fink::Finally->new('not code') };
- ok($@, 'bad args - not a code ref');
+ eval { Fink::Finally::Simple->new };
+ ok($@, 'simple, bad args - no args');
+ eval { Fink::Finally::Simple->new('not code') };
+ ok($@, 'simple, bad args - not a code ref');
}
-# explicit run
+# simple, explicit run
{
my $x = 0;
- my $finally = Fink::Finally->new(sub { $x++ });
- $finally->run;
- is($x, 1, 'explicit run');
+ my $finally = Fink::Finally::Simple->new(sub { $x++ });
+ $finally->cleanup;
+ is($x, 1, 'simple, explicit run');
}
-# run when we fall out of scope
+# simple, run when we fall out of scope
{
my $x = 0;
{
- my $finally = Fink::Finally->new(sub { $x++ });
+ my $finally = Fink::Finally::Simple->new(sub { $x++ });
}
- is($x, 1, 'run when we fall out of scope');
+ is($x, 1, 'simple, run when we fall out of scope');
}
-# run when an exception is thrown
+# simple, run when an exception is thrown
{
my $x = 0;
eval {
- my $finally = Fink::Finally->new(sub { $x++ });
+ my $finally = Fink::Finally::Simple->new(sub { $x++ });
die "exception!";
};
- ok($@, 'run when an exception is thrown - exception thrown');
- is($x, 1, 'run when an exception is thrown - executed');
+ ok($@, 'simple, run when an exception is thrown - exception thrown');
+ is($x, 1, 'simple, run when an exception is thrown - executed');
}
-# only run once
+# simple, only run once
{
my $x = 0;
{
- my $finally = Fink::Finally->new(sub { $x++ });
- $finally->run;
- $finally->run;
+ my $finally = Fink::Finally::Simple->new(sub { $x++ });
+ $finally->cleanup;
+ $finally->cleanup;
# out of scope => automatic run
}
- is($x, 1, 'only run once');
+ is($x, 1, 'simple, only run once');
}
-# run on exit()
+# simple, run on exit()
{
my $out = run_script <<'SCRIPT';
-my $finally = Fink::Finally->new(sub { print "cleanup\n" });
+my $finally = Fink::Finally::Simple->new(sub { print "cleanup\n" });
exit 0;
SCRIPT
- is($out, "cleanup\n", "run on exit()");
+ is($out, "cleanup\n", "simple, run on exit()");
}
-# cancelled finalizers don't run
+# simple, cancelled finalizers don't run
{
my $x = 0;
{
- my $fin = Fink::Finally->new(sub { $x++ });
- $fin->cancel;
- $fin->run;
+ my $fin = Fink::Finally::Simple->new(sub { $x++ });
+ $fin->cancel_cleanup;
+ $fin->cleanup;
} # out of scope
- is($x, 0, "cancelled finalizers don't run");
+ is($x, 0, "simple, cancelled finalizers don't run");
}
-# fork doesn't run Finally objects in the subproc
+# simple, fork
{
- my $dummy;
- ($dummy, my $file) = tempfile("capture.fork.XXXX");
+ (undef, my $file) = tempfile("finally.fork.XXXX");
touch($file);
{
my $fork; # did we fork or not?
- my $fin = Fink::Finally->new(sub { unlink $file });
+ my $fin = Fink::Finally::Simple->new(sub { unlink $file });
$fork = fork;
if ($fork) {
wait;
- ok(-f $file, "fork doesn't run Finally objects in the
subproc");
+ ok(-f $file, "simple, fork - don't run in child");
} else {
exit 0;
}
}
+ ok(!-f $file, "simple, fork - run in parent");
}
-# exit status unchanged
+# simple, exit status unchanged
{
my ($out, $status) = run_script <<'SCRIPT';
-my $finally = Fink::Finally->new(sub { system("echo finalizer") });
+my $finally = Fink::Finally::Simple->new(sub { system("echo finalizer") });
exit 2;
SCRIPT
- is($out, "finalizer\n", 'exit status unchanged - finalizer ran');
- is($status, 2, 'exit status unchanged - correct status');
+ is($out, "finalizer\n", 'simple, exit status unchanged - finalizer
ran');
+ is($status, 2, 'simple, exit status unchanged - correct status');
+}
+
+# simple, exception status unchanged
+{
+ {
+ my $fin = Fink::Finally::Simple->new(sub { eval {}; });
+ eval { die "test\n" };
+ }
+ is($@, "test\n", "simple, exception status unchanged");
+}
+
+##### OO
+
+package FF::Incr;
+use base 'Fink::Finally';
+our $x = 0;
+sub finalize { $x++ }
+
+package main;
+our $ix;
+*ix = *FF::Incr::x;
+
+# OO, explicit run
+{
+ $ix = 0;
+ my $finally = FF::Incr->new;
+ $finally->cleanup;
+ is($ix, 1, 'OO, explicit run');
+}
+
+# OO, run when we fall out of scope
+{
+ $ix = 0;
+ {
+ my $finally = FF::Incr->new;
+ }
+ is($ix, 1, 'OO, run when we fall out of scope');
+}
+
+# OO, run when an exception is thrown
+{
+ $ix = 0;
+ eval {
+ my $finally = FF::Incr->new;
+ die "exception!";
+ };
+ ok($@, 'OO, run when an exception is thrown - exception thrown');
+ is($ix, 1, 'OO, run when an exception is thrown - executed');
}
+# OO, only run once
+{
+ $ix = 0;
+ {
+ my $finally = FF::Incr->new;
+ $finally->cleanup;
+ $finally->cleanup;
+ # out of scope => automatic run
+ }
+ is($ix, 1, 'OO, only run once');
+}
+
+# OO, run on exit()
+{
+ my $out = run_script <<'SCRIPT';
+package FF::Print;
+use base 'Fink::Finally';
+sub finalize { print "cleanup\n" }
+
+package main;
+my $finally = FF::Print->new;
+exit 0;
+SCRIPT
+ is($out, "cleanup\n", "OO, run on exit()");
+}
+
+# OO, cancelled finalizers don't run
+{
+ $ix = 0;
+ {
+ my $fin = FF::Incr->new;
+ $fin->cancel_cleanup;
+ $fin->cleanup;
+ } # out of scope
+ is($x, 0, "OO, cancelled finalizers don't run");
+}
+
+# OO, initializer and private storage
+package FF::Init;
+use base 'Fink::Finally';
+sub initialize {
+ my ($self, $sc) = @_;
+ $self->{sc} = $sc;
+ $self->SUPER::initialize;
+}
+sub finalize { ${$_[0]->{sc}}++ }
+
+package main;
+{
+ my $x = 0;
+ {
+ my $finally = FF::Init->new(\$x);
+ }
+ is($x, 1, 'OO, initializer and private storage');
+}
+
+# OO, fork
+package FF::Unlink;
+use base 'Fink::Finally';
+sub initialize { $_[0]->{file} = $_[1]; $_[0]->SUPER::initialize; }
+sub finalize { unlink $_[0]->{file} }
+
+package main;
+{
+ (undef, my $file) = tempfile("finally.fork.XXXX");
+ touch($file);
+ {
+ my $fork; # did we fork or not?
+ my $fin = FF::Unlink->new($file);
+
+ $fork = fork;
+ if ($fork) {
+ wait;
+ ok(-f $file, "OO, fork - don't run in child");
+ } else {
+ exit 0;
+ }
+ }
+ ok(!-f $file, "OO, fork - run in parent");
+}
+
+# OO, exit status unchanged
+{
+ my ($out, $status) = run_script <<'SCRIPT';
+package FF::Echo;
+use base 'Fink::Finally';
+sub finalize { system("echo finalizer") }
+
+package main;
+my $finally = FF::Echo->new;
+exit 2;
+SCRIPT
+ is($out, "finalizer\n", 'OO, exit status unchanged - finalizer ran');
+ is($status, 2, 'OO, exit status unchanged - correct status');
+}
+
+# OO, exception status unchanged
+package FF::Eval;
+use base 'Fink::Finally';
+sub finalize { eval {}; }
+
+package main;
+{
+ {
+ my $fin = FF::Eval->new;
+ eval { die "test\n" };
+ }
+ is($@, "test\n", "OO, exception status unchanged");
+}
Index: ChangeLog
===================================================================
RCS file: /cvsroot/fink/fink/t/Finally/ChangeLog,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- ChangeLog 22 Mar 2006 22:46:54 -0000 1.3
+++ ChangeLog 23 Mar 2006 23:11:44 -0000 1.4
@@ -1,3 +1,9 @@
+2006-03-23 Dave Vasilevsky <[EMAIL PROTECTED]>
+
+ * finally.t: Add tests for OO API.
+ * buildlocks.t: Moved from ../PkgVersion/buildlocks.t, modified for
+ Fink::Finally::Buildlock.
+
2006-03-22 Dave Vasilevsky <[EMAIL PROTECTED]>
* finally.t: Test whether we keep the exit status.
-------------------------------------------------------
This SF.Net email is sponsored by xPML, a groundbreaking scripting language
that extends applications into web and mobile media. Attend the live webcast
and join the prime developer group breaking into this new coding territory!
http://sel.as-us.falkag.net/sel?cmd=lnk&kid=110944&bid=241720&dat=121642
_______________________________________________
Fink-commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/fink-commits
