diff --git a/perl/Makefile b/perl/Makefile index 98f52c9..52cfa76 100644 --- a/perl/Makefile +++ b/perl/Makefile @@ -8,7 +8,7 @@ PWD:= $(shell pwd) LIB:= ${PWD}/lib DESTDIR:= ${PWD}/build -SUBDIRS:= third +SUBDIRS:= CHECKIN_SUBDIRS := Permabit SYMLINKS:= Permabit Pdoc DOCTREES:= \ diff --git a/perl/third/.cvsignore b/perl/third/.cvsignore deleted file mode 100644 index d6cf293..0000000 --- a/perl/third/.cvsignore +++ /dev/null @@ -1,3 +0,0 @@ -bin -man -share diff --git a/perl/third/Config-Properties-0.41/.cvsignore b/perl/third/Config-Properties-0.41/.cvsignore deleted file mode 100644 index 0b5bd39..0000000 --- a/perl/third/Config-Properties-0.41/.cvsignore +++ /dev/null @@ -1,3 +0,0 @@ -Makefile -blib -pm_to_blib diff --git a/perl/third/Config-Properties-0.41/Changes b/perl/third/Config-Properties-0.41/Changes deleted file mode 100644 index f0ee38a..0000000 --- a/perl/third/Config-Properties-0.41/Changes +++ /dev/null @@ -1,43 +0,0 @@ -Revision history for Perl extension Config::Properties. - -0.41 Tue Jul 10 00:00:00 2002 - - Fixed value checks in most methods that incorrectly treated the - value '0' or the empty string as an undefined value. I could not - contact the original author in any way (tried 3 email addresses - and news://comp.lang.perl.modules), so I uploaded this version - myself. Craig Manley (c.manley at skybound.nl). - -0.40 Tue Jul 10 11:32:00 2001 - - 0.4 (almost half-way there) release - - Add format/getFormat/setFormat() to change the appearance of saved properties - (thanks to David Boyce for the idea) - - Added POD documenation for format feature - - Typo fixes in POD - - Add reference to official JavaDoc (idea thanks to David Boyce) - Randy Jay Yarger (ryarger@mediaone.net) - - - Fixed default handling when retrieving a property value - David Boyce (dsb@world.std.com) - -0.03 Sat May 19 21:56:10 2001 - - Corrected Object Oriented behavior (was using class variables for everying, - now using instance variables) - - Skip blank lines (spotted by Eric Zylberstejn and Christian Niles) - - Fixed borked packaging (#$@% Windows!) (spotted by Ken Ho, - Michael Peterson and David Boyce) - - Fixed incorrect version number (spotted by Michael Peterson and David Boyce) - Randy Jay Yarger (ryarger@mediaone.net) - - - Allow the escape characters proscribed by the Java API spec - Christian Niles (can207@nyu.edu) - -0.02 Thu May 03 21:19:00 2001 - - Fixed bug relating to doubled escape characters(\\). - Thanks to David Boyce for the spot. - Randy Jay Yarger (ryarger@mediaone.net) - -0.01 Wed Jan 17 15:38:07 2001 - - original version; created by h2xs 1.20 with options - -X -n Config::Properties - Randy Jay Yarger (ryarger@mediaone.net) - diff --git a/perl/third/Config-Properties-0.41/MANIFEST b/perl/third/Config-Properties-0.41/MANIFEST deleted file mode 100644 index 94f1896..0000000 --- a/perl/third/Config-Properties-0.41/MANIFEST +++ /dev/null @@ -1,6 +0,0 @@ -Changes -Makefile.PL -MANIFEST -Properties.pm -test.pl -README \ No newline at end of file diff --git a/perl/third/Config-Properties-0.41/Makefile.PL b/perl/third/Config-Properties-0.41/Makefile.PL deleted file mode 100644 index ffdad24..0000000 --- a/perl/third/Config-Properties-0.41/Makefile.PL +++ /dev/null @@ -1,8 +0,0 @@ -use ExtUtils::MakeMaker; -# See lib/ExtUtils/MakeMaker.pm for details of how to influence -# the contents of the Makefile that is written. -WriteMakefile( - 'NAME' => 'Config::Properties', - 'VERSION_FROM' => 'Properties.pm', # finds $VERSION - 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 -); diff --git a/perl/third/Config-Properties-0.41/Properties.pm b/perl/third/Config-Properties-0.41/Properties.pm deleted file mode 100644 index e980941..0000000 --- a/perl/third/Config-Properties-0.41/Properties.pm +++ /dev/null @@ -1,293 +0,0 @@ -package Config::Properties; - -use strict; -use warnings; - -our $VERSION = '0.41'; - -# new() - Constructor -# -# The constructor can take one optional argument "$defaultProperties" -# which is an instance of Config::Properties to be used as defaults -# for this object. -sub new { - my $proto = shift; - my $defaultProperties = shift; - my $perlMode = shift; - - my $class = ref($proto) || $proto; - my $self = { - 'PERL_MODE' => (defined($perlMode) && $perlMode) ? 1 : 0, - 'defaults' => $defaultProperties, - 'format' => '%s=%s', - 'properties' => {} - }; - bless($self, $class); - - return $self; -} - -# setProperty() - Set the value for a specific property -sub setProperty { - my $self = shift; - my $key = shift; - my $value = shift; - unless(defined($key) && length($key) && defined($value)) { - die "Config::Properties.setProperty( key, value )"; - } - my $oldValue = $self->{'properties'}{ $key }; - $self->{'properties'}{ $key } = $value; - return $oldValue; -} - -# getProperties() - Return a hashref of all of the properties -sub getProperties { - my $self = shift; - return $self->{'properties'}; -} - -# setFormat() - Set the output format for the properties -sub setFormat { - my $self = shift; - my $format = shift; - unless(defined($format) && length($format)) { - die "Config::Properties.format( string )"; - } - $self->{'format'} = $format; -} - -# format() - Alias for get/setFormat(); -sub format { - my $self = shift; - my $format = shift; - if (defined($format) && length($format)) { - return $self->setFormat($format); - } - else { - return $self->getFormat(); - } -} - -# getFormat() - Return the output format for the properties -sub getFormat { - my $self = shift; - return $self->{'format'}; -} - -# load() - Load the properties from a filehandle -sub load { - my $self = shift; - my $file = shift; - unless(defined($file)) { - die "Config::Properties.load( file )"; - } - while (<$file>) { - $self->process_line($_, $file); - } -} - -# process_line() - Recursive function used to parse a line from the -# properties file. -sub process_line { - my $self = shift; - #print "XXX" . join("::", @_) . "XXX\n"; - my $line = shift; - my $file = shift; - unless(defined($line) && defined($file)) { - die "Config::Properties.process_line( line, file )"; - } - $line =~ s/\015?\012$//; - if ($line =~ /^\s*(\#|\!|$)/) { - return; - } - if ($line =~ /(\\+)$/ and length($1) % 2) { - $line =~ s/\\$//; - my $newline = <$file>; - $newline =~ s/^\s*//; - return $self->process_line($line . $newline, $file); - } - - #print "XXX: " . $line . "\n"; - $line =~ /^\s*([^\s:=]+)(\s*|\s*(\:|\=|\s)\s*(.*?))$/; - #print "1: $1 2: $2 3: $3 4: $4\n"; - unless(defined($1) && length($1)) { - die "Config::Properties.process_line: invalid property line"; - } - - #$properties{ $1 } = ($4 || ""); - #the javadoc for Properties states that both the name and value - #can be escaped. The regex above will break though if ':','=', or - #whitespace are included. - $self->{'properties'}{ unescape($1) } = (defined($4) && length($4)) ? unescape($4) : ''; # Value ($4) may be '0' ! -} - -# unescape() - converts escaped characters to their real counterparts. -sub unescape { - my $value = shift; - - while ($value =~ m/\\(.)/g) { - my $result = $1; - - if ($result eq 't') { - $result = "\t"; - } elsif ($result eq 'n') { - $result = "\n"; - } elsif ($result eq 'r') { - $result = "\r"; - } elsif ($result eq 's') { - $result = ' '; - } - - my $start = (pos $value) - 2; - pos $value = $start; - $value =~ s/\\./$result/; - pos $value = ($start + 1); - } - - return $value; -} - -# reallySave() - Utility function that performs the actual saving of -# the properties file to a filehandle. -sub reallySave { - #print "XXX" . join("::", @_) . "XXX\n"; - my $self = shift; - my $file = shift; - unless(defined($file)) { - die "Config::Properties.reallySave( file )"; - } - foreach (keys %{$self->{properties}}) { - printf $file $self->{'format'} . "\n", $_, $self->{properties}{$_}; - } -} - -# save() - Save the properties to a filehandle with the given header. -sub save { - #print "XXX" . join("::", @_) . "XXX\n"; - my $self = shift; - my $file = shift; - my $header = shift; - unless(defined($file) && defined($header) && length($header)) { - die "Config::Properties.save( file, header )"; - } - print $file "#$header\n"; - print $file '#' . localtime() . "\n"; - $self->reallySave( $file ); -} - -# store() - Synonym for save() -sub store { - my $self = shift; - $self->save(@_); -} - -# getProperty() - Return the value of a property key. Returns the default -# for that key (if there is one) if no value exists for that key. -sub getProperty { - my $self = shift; - my $key = shift; - my $default = shift; - unless(defined($key) && length($key)) { # Key can be '0'! - die "Config::Properties.getProperty( key )"; - } - my $value = $self->{properties}{ $key }; - if ($self->{defaults} && !defined($value)) { # Value can be '0' or empty string! - $value = $self->{defaults}->getProperty($key); - } - return defined($value) ? $value : $default; # $value can be 0 or empty string if key exists! -} - -# propertyName() - Returns an array of the keys of the Properties -sub propertyNames { - my $self = shift; - return keys %{$self->{properties}}; -} - -# list() - Same as store() except that it doesn't include a header. -# Meant for debugging use. -sub list { - my $self = shift; - my $file = shift or die "Config::Properties.list( file )"; - print $file "-- listing properties --"; - $self->reallySave( $file ); -} - -# setPerlMode() - Sets the value (true/false) of the PERL_MODE parameter. -sub setPerlMode { - my $self = shift; - my $mode = shift; - return $self->{'PERL_MODE'} = (defined($mode) && $mode) ? 1 : 0; -} - -# perlMode() - Returns the current PERL_MODE setting (Default is false) -sub perlMode { - my $self = shift; - return $self->{'PERL_MODE'}; -} - -1; -__END__ - -=head1 NAME - -Config::Properties - read Java-style properties files - -=head1 SYNOPSIS - -use Config::Properties; - -my $properties = new Config::Properties(); -$properties->load( $fileHandle ); - -$value = $properties->getProperty( $key ); -$properties->setProperty( $key, $value ); - -$properties->format( '%s => %s' ); -$properties->store( $fileHandle, $header ); - -=head1 DESCRIPTION - -Config::Properties is an near implementation of the java.util.Properties API. -It is designed to allow easy reading, writing and manipulation of Java-style -property files. - -The format of a Java-style property file is that of a key-value pair seperated -by either whitespace, the colon (:) character, or the equals (=) character. -Whitespace before the key and on either side of the seperator is ignored. - -Lines that begin with either a hash (#) or a bang (!) are considered comment -lines and ignored. - -A backslash (\) at the end of a line signifies a continuation and the next -line is counted as part of the current line (minus the backslash, any whitespace -after the backslash, the line break, and any whitespace at the beginning of the next line). - -The official references used to determine this format can be found in the Java API docs -for java.util.Properties at http://java.sun.com/j2se/1.3/docs/api/index.html. - -When a property file is saved it is in the format "key=value" for each line. This can -be changed by setting the format attribute using either $object->format( $format_string ) or -$object->setFormat( $format_string ) (they do the same thing). The format string is fed to -printf and must contain exactly two %s format characters. The first will be replaced with -the key of the property and the second with the value. The string can contain no other -printf control characters, but can be anything else. A newline will be automatically added -to the end of the string. You an get the current format string either by using -$object->format() (with no arguments) or $object->getFormat(). - -If a true third parameter is passed to the constructor, the Config::Properties object -be created in PERL_MODE. This can be set at any time by passing a true or false value -into the setPerlMode() instance method. If in PERL_MODE, the behavior of the object -may be expanded, enhanced and/or just plain different than the Java API spec. - -The following is a list of the current behavior changed under PERL_MODE: - -* Ummm... nothing yet. - -The current (true/false) value of PERL_MODE can be retrieved with the perlMode instance -variable. - -=head1 AUTHOR - -C was developed by Randy Jay Yarger. - -=cut diff --git a/perl/third/Config-Properties-0.41/README b/perl/third/Config-Properties-0.41/README deleted file mode 100644 index 071fcb1..0000000 --- a/perl/third/Config-Properties-0.41/README +++ /dev/null @@ -1,50 +0,0 @@ -Config::Properties -============= - -Description ------------ - -Config::Properties is an near implementation of the java.util.Properties API. -It is designed to allow easy reading, writing and manipulation of Java-style -property files. - -The format of a Java-style property file is that of a key-value pair seperated -by either whitespace, the colon (:) character, or the equals (=) character. -Whitespace before the key and on either side of the seperator is ignored. - -Lines that begin with either a hash (#) or a bang (!) are considered comment -lines and ignored. - -A backslash (\) at the end of a line signifies a continuation and the next -line is counted as part of the current line (minus the backslash, any whitespace -after the backslash, the line break, and any whitespace at the beginning of the next line). - -When a property file is saved it is in the format "key=value" for each line. - -Copyright ---------- - -Copyright (c) 2001 Randy Jay Yarger. All Rights Reserved. - -This program is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -Installation ------------- - -> perl Makefile.PL -> make - -... and if you like - -> make test - -... and then - -> make install -> perldoc Config::Properties - -Author ------- - -Randy Jay Yarger diff --git a/perl/third/Config-Properties-0.41/test.pl b/perl/third/Config-Properties-0.41/test.pl deleted file mode 100644 index eaffa9c..0000000 --- a/perl/third/Config-Properties-0.41/test.pl +++ /dev/null @@ -1,20 +0,0 @@ -# Before `make install' is performed this script should be runnable with -# `make test'. After `make install' it should work as `perl test.pl' - -######################### We start with some black magic to print on failure. - -# Change 1..1 below to 1..last_test_to_print . -# (It may become useful if the test is moved to ./t subdirectory.) - -BEGIN { $| = 1; print "1..1\n"; } -END {print "not ok 1\n" unless $loaded;} -use Config::Properties; -$loaded = 1; -print "ok 1\n"; - -######################### End of black magic. - -# Insert your test code below (better if it prints "ok 13" -# (correspondingly "not ok 13") depending on the success of chunk 13 -# of the test code): - diff --git a/perl/third/IPC-Session-0.05/.cvsignore b/perl/third/IPC-Session-0.05/.cvsignore deleted file mode 100644 index 0b5bd39..0000000 --- a/perl/third/IPC-Session-0.05/.cvsignore +++ /dev/null @@ -1,3 +0,0 @@ -Makefile -blib -pm_to_blib diff --git a/perl/third/IPC-Session-0.05/ChangeLog b/perl/third/IPC-Session-0.05/ChangeLog deleted file mode 100644 index 7c70a88..0000000 --- a/perl/third/IPC-Session-0.05/ChangeLog +++ /dev/null @@ -1,50 +0,0 @@ -2001-04-12 14:11 stevegt - - * Session.pm: significant rewrite to fix csh bug, provide real - detection of remote shell type, flush stderr and stdout before - every send - -2001-02-27 12:25 stevegt - - * MANIFEST, Session.pm, test.pl, test1, t/sh.t, t/timeout.t, - t/csh.t, MANIFEST, Changes: fix errno not getting returned in - scalar context, fix csh incompatibility - -2000-03-02 02:10 stevegt - - * MANIFEST, Session.pm, test3, lib/IPC/Session.pm: releasing to - CPAN - -1998-10-12 22:42 stevegt - - * lib/IPC/Session.pm: checkpoint before working at home mping works - working on how to bypass dead interfaces - -1998-08-13 20:47 stevegt - - * test2: test version of SYNOPSIS - -1998-08-13 20:46 stevegt - - * lib/IPC/Session.pm: clean up CHANGES section - -1998-08-06 17:24 stevegt - - * lib/IPC/Session.pm: Session.pm package v0.02 switch to unbuffered - non-blocking I/O add timeout() remove need for FileHandle.pm add - cloning - -1998-08-05 11:35 stevegt - - * lib/IPC/Session.pm: released package v0.01 - -1998-08-04 15:14 stevegt - - * Changes, MANIFEST, Makefile.PL, test.pl, lib/IPC/Session.pm: - Initial revision - -1998-08-04 15:14 stevegt - - * Changes, MANIFEST, Makefile.PL, test.pl, lib/IPC/Session.pm: - created - diff --git a/perl/third/IPC-Session-0.05/MANIFEST b/perl/third/IPC-Session-0.05/MANIFEST deleted file mode 100644 index b246f4b..0000000 --- a/perl/third/IPC-Session-0.05/MANIFEST +++ /dev/null @@ -1,7 +0,0 @@ -ChangeLog -MANIFEST -Makefile.PL -Session.pm -t/csh.t -t/sh.t -t/timeout.t diff --git a/perl/third/IPC-Session-0.05/Makefile.PL b/perl/third/IPC-Session-0.05/Makefile.PL deleted file mode 100644 index 617a637..0000000 --- a/perl/third/IPC-Session-0.05/Makefile.PL +++ /dev/null @@ -1,7 +0,0 @@ -use ExtUtils::MakeMaker; -# See lib/ExtUtils/MakeMaker.pm for details of how to influence -# the contents of the Makefile that is written. -WriteMakefile( - 'NAME' => 'IPC::Session', - 'VERSION_FROM' => 'Session.pm', # finds $VERSION -); diff --git a/perl/third/IPC-Session-0.05/Session.pm b/perl/third/IPC-Session-0.05/Session.pm deleted file mode 100644 index 3eaeccc..0000000 --- a/perl/third/IPC-Session-0.05/Session.pm +++ /dev/null @@ -1,444 +0,0 @@ -package IPC::Session; - -use strict; -use FileHandle; -use IPC::Open3; -use Time::HiRes qw(sleep); - -use vars qw($VERSION); - -$VERSION = '0.05'; - -=head1 NAME - -IPC::Session - Drive ssh or other interactive shell, local or remote (like 'expect') - -=head1 SYNOPSIS - - use IPC::Session; - - # open ssh session to fred - # -- set timeout of 30 seconds for all send() calls - my $session = new IPC::Session("ssh fred",30); - - $session->send("hostname"); # run `hostname` command on fred - print $session->stdout(); # prints "fred" - $session->send("date"); # run `date` within same ssh - print $session->stdout(); # prints date - - # use like 'expect': - $session->send("uname -s"); - for ($session->stdout) - { - /IRIX/ && do { $netstat = "/usr/etc/netstat" }; - /ConvexOS/ && do { $netstat = "/usr/ucb/netstat" }; - /Linux/ && do { $netstat = "/bin/netstat" }; - } - - # errno returned in scalar context: - $errno = $session->send("$netstat -rn"); - # try this: - $session->send("grep '^$user:' /etc/passwd") - && warn "$user not there"; - - # hash returned in array context: - %netstat = $session->send("$netstat -in"); - print "$netstat{'stdout'}\n"; # prints interface table - print "$netstat{'stderr'}\n"; # prints nothing (hopefully) - print "$netstat{'errno'}\n"; # prints 0 - -=head1 DESCRIPTION - -This module encapsulates the open3() function call (see L) -and its associated filehandles. This makes it easy to maintain -multiple interactive command sessions, such as multiple persistent -'ssh' and/or 'rsh' sessions, within the same perl script. - -The remote shell session is kept open for the life of the object; this -avoids the overhead of repeatedly opening remote shells via multiple -ssh or rsh calls. This persistence is particularly useful if you are -using ssh for your remote shell invocation; it helps you overcome -the high ssh startup time. - -For applications requiring remote command invocation, this module -provides functionality that is similar to 'expect' or Expect.pm, -but in a lightweight more Perlish package, with discrete STDOUT, -STDERR, and return code processing. - -By the way, there's nothing inherently ssh-ish about IPC::Session -- it -doesn't even know anything about ssh, as a matter of fact. It will -work with any interactive shell that supports 'echo'. For instance, -'make test' just drives a local /bin/sh session. - -=head1 METHODS - -=head2 my $session = new IPC::Session("ssh fred",30); - -The constructor accepts the command string to be used to open the remote -shell session, such as ssh or rsh; it also accepts an optional timeout -value, in seconds. It returns a reference to the unique session object. - -If the timeout is not specified then it defaults to 60 seconds. -The timeout value can also be changed later; see L<"timeout()">. - -=cut - -sub new -{ - my $class=shift; - $class = (ref $class || $class); - my $self={}; - bless $self, $class; - - my ($cmd,$timeout,$handler)=@_; - $self->{'handler'} = $handler || sub {die @_}; - $timeout=60 unless defined $timeout; - $self->{'timeout'} = $timeout; - - local(*IN,*OUT,*ERR); # so we can use more than one of these objects - $self->{pid} = open3(\*IN,\*OUT,\*ERR,$cmd); - ($self->{pid}) || &{$self->{'handler'}}($!); - - ($self->{'stdin'},$self->{'stdout'},$self->{'stderr'}) = (*IN,*OUT,*ERR); - - # Set to autoflush. - for (*IN,*OUT,*ERR) { - select; - $|++; - } - select STDOUT; - - # determine target shell - $self->{'shell'} = $self->getshell(); - - return $self; -} - -sub getshell -{ - my $self=shift; - my ($tag, $shout); - - $tag=$self->tx('stdin', "echo;echo csherrno=\$status\n"); - $shout=$self->rx('stdout', $tag); - return "csh" if $shout =~ /csherrno=0/; - - $tag=$self->tx('stdin', "echo;echo bsherrno=\$?\n"); - $shout=$self->rx('stdout', $tag); - return "bsh" if $shout =~ /bsherrno=0/; - - die "unable to determine remote shell\n"; -} - -sub tx -{ - my ($self,$handle,$cmd) = @_; - my $fh=$self->{$handle}; - my $shell = $self->{'shell'} || ""; - - my $eot="_EoT_" . rand() . "_"; - - # run command - print $fh "$cmd\n"; - - print $fh "echo $eot"; - print $fh " errno=\$?" if $shell eq "bsh"; - print $fh " errno=\$status" if $shell eq "csh"; - print $fh "\n"; - - # call /bin/sh to work around csh stupidity -- csh doesn't support - # redirection of stderr... BUG this will only work if there is a - # /bin/sh on target machine - my $stderrcmd; - $stderrcmd="/bin/sh -c 'echo $eot >&2'\n" if $shell eq "csh"; - $stderrcmd= "echo $eot >&2\n" if $shell eq "bsh"; - print $fh $stderrcmd if $shell; - return $eot; -} - -sub rx -{ - my ($self,$handle, $eot, $timeout) = @_; - $timeout = $self->{'timeout'} unless defined($timeout); - my $fh=$self->{$handle}; - - my $rin = my $win = my $ein = ''; - vec($rin,fileno($fh),1) = 1; - $ein = $rin; - - # Why two nested loops? So we can do eot pattern match (below) - # against a full line at a time, while getting one character at a - # time. Do we need to get only one character at a time? Probably - # not, but it evolved this way. It does let us parse and linebreak - # on the \n character, include newlines in the output, but not - # include the eot marker. - - # get full text - my $out=""; - my $errno=""; - while (!select(undef,undef,my $eout=$ein,0)) # while !eof() - { - # get one line of text - my $outl = ""; - while (!select(undef,undef,my $eout=$ein,0)) # while !eof() - { - # wait for output on handle - my $nready=select(my $rout=$rin, undef, undef, $timeout); - return $nready if $timeout==0; - - # handle timeout - &{$self->{'handler'}}("timeout on $handle") unless $nready; - - # read one char - my $outc; - my $ret = sysread($self->{$handle},$outc,1); - if (!$ret) { - my $msg; - if (defined($ret)) { - $msg = "eof read error"; - } else { - $msg = "read error: $!"; - } - $msg .= " from $handle (already read: $out)"; - if ($handle ne 'stderr') { - # This will in most cases not return since stderr is likely - # to be at EOF. - $msg .= ", stderr: " . $self->rx('stderr', $eot, $timeout); - } - &{$self->{'handler'}}($msg); - } - - # include newlines in output - $outl .= $outc; - last if $outc eq "\n"; - } - # store snarfed return code - $outl =~ /$eot errno=(\d+)/ && ($errno = $1); - - # eot pattern match -- don't include eot tag in output - if ($outl =~ s/$eot.*//s) { - $out .= $outl; - last; - } - $out .= $outl; - } - - return $out unless wantarray; - return $out,$errno; -} - -sub rxready -{ - my $self=shift; - my $handle = shift; - return $self->rx($handle,"dummy",0); -} - -sub rxflush -{ - my $self=shift; - my $handle = shift; - my $tag = shift || ".*"; - while($self->rxready($handle)) - { - $self->rx($handle,$tag) - } -} - -=head2 $commandhandle = $session->send("hostname"); - -The send() method accepts a command string to be executed on the remote -host. The command will be executed in the context of the default shell -of the remote user (unless you start a different shell by sending the -appropriate command...). All shell escapes, command line terminators, pipes, -redirectors, etc. are legal and should work, though you of course will -have to escape special characters that have meaning to Perl. - -In a scalar context, this method returns the return code produced by the -command string. - -In an array context, this method returns a hash containing the return code -as well as the full text of the command string's output from the STDOUT -and STDERR file handles. The hash keys are 'stdout', 'stderr', and -'errno'. - -=cut - -sub send -{ - my $self=shift; - my $cmd=join(' ',@_); - - # send the command - $self->rxflush('stdout'); - $self->rxflush('stderr'); - my $tag = $self->tx('stdin',$cmd); - - # snarf the output until we hit eot marker on both streams - my ($stdout,$errno) = $self->rx('stdout', $tag); - my $stderr = $self->rx('stderr', $tag); - - $self->{'out'}{'stdout'} = $stdout; - $self->{'out'}{'stderr'} = $stderr; - $self->{'out'}{'errno'} = $errno; - - return $self->{'out'}{'errno'} unless wantarray; - return ( - errno => $self->{'out'}{'errno'}, - stdout => $self->{'out'}{'stdout'}, - stderr => $self->{'out'}{'stderr'} - ); -} - -=head2 print $session->stdout(); - -Returns the full STDOUT text generated from the last send() command string. - -Also available via array context return codes -- see L<"send()">. - -=cut - -sub stdout -{ - my $self=shift; - return $self->{'out'}{'stdout'}; -} - -=head2 print $session->stderr(); - -Returns the full STDERR text generated from the last send() command string. - -Also available via array context return codes -- see L<"send()">. - -=cut - -sub stderr -{ - my $self=shift; - return $self->{'out'}{'stderr'}; -} - -=head2 print $session->errno(); - -Returns the return code generated from the last send() command string. - -Also available via array context return codes -- see L<"send()">. - -=cut - -sub errno -{ - my $self=shift; - return $self->{'out'}{'errno'}; -} - -=head2 $session->timeout(90); - -Allows you to change the timeout for subsequent send() calls. - -The timeout value is in seconds. Fractional seconds are allowed. -The timeout applies to all send() calls. - -Returns the current timeout if called with no args. - -=cut - -sub timeout -{ - my $self=shift; - $self->{'timeout'} = ( shift || $self->{'timeout'}); - return $self->{'timeout'}; -} - -sub handler -{ - my $self=shift; - $self->{'handler'} = ( shift || $self->{'handler'}); - return $self->{'handler'}; -} - -=head2 $session->close(); - -Kill the child process and then reap it. This will prevent lots of -defunct processes from accumulating. - -=cut - -sub close { - my ($self) = @_; - kill(15, $self->{pid}); - sleep(0.25); - if (kill(0, $self->{pid}) > 0) { - kill(9, $self->{pid}); - } - waitpid($self->{pid}, 0); - $self->{pid} = 0; -} - -sub DESTROY { - my ($self) = @_; - # Preserve EVAL_ERROR so any nested eval{}s won't clear the exception - # that may have caused this destructor to be called. - local $@; - - ($self->{pid}) && ($self->close()); -} - -=head1 BUGS/RESTRICTIONS - -=over 4 - -=item * - -The remote shell command you specify in new() is assumed to not prompt -for any passwords or present any challenge codes; i.e.; you must use -.rhosts, authorized_keys, ssh-agent, or the equivalent, and must be -prepared to answer any passphrase prompt if using ssh. You can -either run ssh-add ahead of time and provide the passphrase, have -your script do that itself, or simply set the passphrase to null (if -your security model allows it). - -=item * - -There must be a working /bin/sh on the target machine. - -=back - -=head1 AUTHOR - - Steve Traugott - -=head1 SEE ALSO - -L, -L, -L, -L, -L - -=cut - -1; - -__END__ - my $vec = ''; - vec($vec,fileno($self->{'stdout'}),1) = 1; - warn unpack("b*",$vec) . "\n"; - select($vec, undef, undef, $self->{'timeout'}) - && sysread($self->{'stdout'},my $shout,9999); - $shell="bsh" if $shout =~ /bsherrno=0/; - - - my $vstderr = ''; - vec($vstderr,fileno($self->{'stdout'}),1) = 1; - warn unpack("b*",$rin) . "\n"; - select($vstderr, undef, undef, $self->{'timeout'}) - - - warn unpack("b*",$rin) . "\n"; - vec($rin,fileno($self->{'stderr'}),1) = 1; - - - die; - - diff --git a/perl/third/IPC-Session-0.05/t/csh.t b/perl/third/IPC-Session-0.05/t/csh.t deleted file mode 100644 index 683cc4a..0000000 --- a/perl/third/IPC-Session-0.05/t/csh.t +++ /dev/null @@ -1,41 +0,0 @@ -# Before `make install' is performed this script should be runnable with -# `make test'. After `make install' it should work as `perl test.pl' - -######################### We start with some black magic to print on failure. - -# Change 1..1 below to 1..last_test_to_print . -# (It may become useful if the test is moved to ./t subdirectory.) - -BEGIN { $| = 1; print "1..10\n"; } -END {print "not ok 1\n" unless $loaded;} -use IPC::Session; -$loaded = 1; -print "ok 1\n"; - -######################### End of black magic. - - -# open local sh session -my $session = new IPC::Session("/bin/csh",15); -print "ok 2\n" if $session; - -$session->send("echo hello"); -chomp(my $hello = $session->stdout()); -print "ok 3\n" if $hello eq "hello"; - -my $uname=`uname`; -print "ok 4\n" if $uname; -$session->send("uname"); -print "ok 5\n" if $uname eq $session->stdout(); -print "ok 6\n" unless $session->stderr(); - -# errno returned in scalar context: -my $errno = $session->send('/bin/sh -c "exit 99"'); -print "ok 7\n" if $errno == 99; - -# hash returned in array context: -my %ls = $session->send("ls t/sh.t doesnotexist"); -print "ok 8\n" if $ls{'stdout'} =~ /t\/sh/; -print "ok 9\n" if $ls{'stderr'} =~ /doesnotexist/; -print "ok 10\n" if $ls{'errno'} != 0; - diff --git a/perl/third/IPC-Session-0.05/t/sh.t b/perl/third/IPC-Session-0.05/t/sh.t deleted file mode 100644 index 4f39227..0000000 --- a/perl/third/IPC-Session-0.05/t/sh.t +++ /dev/null @@ -1,41 +0,0 @@ -# Before `make install' is performed this script should be runnable with -# `make test'. After `make install' it should work as `perl test.pl' - -######################### We start with some black magic to print on failure. - -# Change 1..1 below to 1..last_test_to_print . -# (It may become useful if the test is moved to ./t subdirectory.) - -BEGIN { $| = 1; print "1..10\n"; } -END {print "not ok 1\n" unless $loaded;} -use IPC::Session; -$loaded = 1; -print "ok 1\n"; - -######################### End of black magic. - - -# open local sh session -my $session = new IPC::Session("/bin/sh",15); -print "ok 2\n" if $session; - -$session->send("echo hello"); -chomp(my $hello = $session->stdout()); -print "ok 3\n" if $hello eq "hello"; - -my $uname=`uname`; -print "ok 4\n" if $uname; -$session->send("uname"); -print "ok 5\n" if $uname eq $session->stdout(); -print "ok 6\n" unless $session->stderr(); - -# errno returned in scalar context: -my $errno = $session->send('/bin/sh -c "exit 99"'); -print "ok 7\n" if $errno == 99; - -# hash returned in array context: -my %ls = $session->send("ls t/sh.t doesnotexist"); -print "ok 8\n" if $ls{'stdout'} =~ /t\/sh/; -print "ok 9\n" if $ls{'stderr'} =~ /doesnotexist/; -print "ok 10\n" if $ls{'errno'} != 0; - diff --git a/perl/third/IPC-Session-0.05/t/timeout.t b/perl/third/IPC-Session-0.05/t/timeout.t deleted file mode 100644 index 7b9b911..0000000 --- a/perl/third/IPC-Session-0.05/t/timeout.t +++ /dev/null @@ -1,27 +0,0 @@ - -# Before `make install' is performed this script should be runnable with -# `make test'. After `make install' it should work as `perl test.pl' - -######################### We start with some black magic to print on failure. - -# Change 1..1 below to 1..last_test_to_print . -# (It may become useful if the test is moved to ./t subdirectory.) - -BEGIN { $| = 1; print "1..4\n"; } -END {print "not ok 1\n" unless $loaded;} -use IPC::Session; -$loaded = 1; -print "ok 1\n"; - -######################### End of black magic. - - -# open local sh session -my $session = new IPC::Session("/bin/sh",5); -print "ok 2\n" if $session; - -eval { $session->send("sleep 3") }; -print "ok 3\n" unless $@; -eval { $session->send("sleep 10") }; -print "ok 4\n" if $@; - diff --git a/perl/third/Log-Dispatch-FileRotate-1.11/.cvsignore b/perl/third/Log-Dispatch-FileRotate-1.11/.cvsignore deleted file mode 100644 index 0b5bd39..0000000 --- a/perl/third/Log-Dispatch-FileRotate-1.11/.cvsignore +++ /dev/null @@ -1,3 +0,0 @@ -Makefile -blib -pm_to_blib diff --git a/perl/third/Log-Dispatch-FileRotate-1.11/Changes b/perl/third/Log-Dispatch-FileRotate-1.11/Changes deleted file mode 100644 index 7607830..0000000 --- a/perl/third/Log-Dispatch-FileRotate-1.11/Changes +++ /dev/null @@ -1,42 +0,0 @@ -Revision history for Perl extension Log::Dispatch::FileRotate. - -0.01 Tue Oct 1 01:12:30 2002 - - original version; created by h2xs 1.20 with options - -AX -n Log::Dispatch::FileRotate - -1.01 Tue Oct 1 01:21:54 EST 2002 - - Real code copied over h2xs stuff. - -1.03 Mon Nov 18 17:19:06 EST 2002 - - added multiple writer stuff. Use flock() to handle locks - -1.04 Wed Nov 20 13:43:04 EST 2002 - - added Time based constraints. - -1.05 Thu Nov 21 09:28:42 EST 2002 - - fixed typos in hash key - -1.06 Tue Apr 29 16:08:37 EST 2003 - - moved inode tests around a bit to fix a warning message - -1.07 Sun May 4 23:42:03 EST 2003 - - fixed up locking in a forked environment - - speed up in time mode. Cache recurrences. Much quicker now :-) - -1.08 Thu Jun 5 11:27:49 EST 2003 - - now build log.conf at 'make test' time as we keep having people - fail due to bad TZ settings - - Also added some more testing on the recurrances - -1.09 Thu Jun 5 17:57:46 EST 2003 - - Even better testing of TZ issues. Try to see if we can work around - them by ignoring and then testing results. - -1.10 Mon Jun 23 09:40:34 EST 2003 - - Seems defaulting to size in Megs happened between 1.05 and 1.06 - which is not what people want. So back to bytes now. - -1.11 Thu Sep 25 11:18:04 EST 2003 - - Forgot to update the Doco from 1.10. - - Added some missing log4j recurrence patterns and made them - case insensitive diff --git a/perl/third/Log-Dispatch-FileRotate-1.11/FileRotate.pm b/perl/third/Log-Dispatch-FileRotate-1.11/FileRotate.pm deleted file mode 100644 index 435a7de..0000000 --- a/perl/third/Log-Dispatch-FileRotate-1.11/FileRotate.pm +++ /dev/null @@ -1,867 +0,0 @@ -package Log::Dispatch::FileRotate; - -require 5.005; -use strict; - -use Log::Dispatch::Output; - -use base qw( Log::Dispatch::Output ); - -use Log::Dispatch::File; # We are a wrapper around Log::Dispatch::File - -use Date::Manip; # For time based recurring rotations - -use Params::Validate qw(validate SCALAR BOOLEAN); -Params::Validate::validation_options( allow_extra => 1 ); - -use vars qw[ $VERSION ]; - -$VERSION = sprintf "%d.%02d", q$Revision: 1.11 $ =~ /: (\d+)\.(\d+)/; - -sub new -{ - my $proto = shift; - my $class = ref $proto || $proto; - - my %p = @_; - - my $self = bless {}, $class; - - $self->{'debug'} = 0; - $self->_basic_init(%p); - $self->{'LDF'} = Log::Dispatch::File->new(%p); # Our log - - # Keep a copy of interesting stuff as well - $self->{params} = \%p; - - # Turn ON/OFF debugging as required - $p{'DEBUG'} ? $self->debug(1) : $self->debug(0); - - # Size defaults to 10meg in all failure modes, hopefully - my $ten_meg = 1024*1024*10; - my $two_gig = 1024*1024*1024*2; - my $size = $p{size}; - $size = $ten_meg unless $size =~ /^\d+$/ && $size < $two_gig && $size > 0; - $self->{size} = $size; - - # Max number of files defaults to 1. No limit enforced here. Only - # positive whole numbers allowed - $self->{max} = $p{max}; - $self->{max} = 1 unless $self->{max} =~ /^\d+$/ && $self->{max} ; - - # Get a name for our Lock file - my $name = $self->{params}->{filename}; - my ($dir,$f) = $name =~ m{^(.*/)(.*)$}; - $f = $name unless $f; - $dir = './' unless $dir; - - my $lockfile = $dir.".".$f.".LCK.$$"; - warn "Lock file is $lockfile\n" if $self->{'debug'}; - $self->{'lf'} = $lockfile; - - # Have we been called with a time based rotation pattern then setup - # timebased stuff. TZ is important and must match current TZ or all - # bets are off! - if(defined $p{'TZ'}) - { - Date_Init("TZ=".$p{'TZ'}); # EADT or EAST when not in daylight savings - } - if(defined $p{'DatePattern'}) - { - $self->setDatePattern($p{'DatePattern'}); - } - - return $self; -} - - -########################################################################### -# -# Subroutine setDatePattern -# -# Args: a single string or ArrayRef of strings -# -# Rtns: Nothing -# -# Description: -# Set a recurrance for file rotation. We accept Date::Manip -# recurrances and the log4j/DailyRollingFileAppender patterns -# -# Date:Manip => -# 0:0:0:0:5:30:0 every 5 hours and 30 minutes -# 0:0:0:2*12:30:0 every 2 days at 12:30 (each day) -# 3*1:0:2:12:0:0 every 3 years on Jan 2 at noon -# -# DailyRollingFileAppender => -# yyyy-MM -# yyyy-ww -# yyyy-MM-dd -# yyyy-MM-dd-a -# yyyy-MM-dd-HH -# yyyy-MM-dd-HH-MM -# -# To specify multiple recurances in a single string seperate them with a -# comma: yyyy-MM-dd,0:0:0:2*12:30:0 -# -sub setDatePattern -{ - my $self = shift; # My object - my($arg) = shift; - - local($_); # Don't crap on $_ - my @pats = (); - - my %lookup = ( - # Y:M:W:D:H:M:S - 'yyyy-mm' => '0:1*0:1:0:0:0', # Every Month - 'yyyy-ww' => '0:0:1*0:0:0:0', # Every week - 'yyyy-dd' => '0:0:0:1*0:0:0', # Every day - 'yyyy-mm-dd' => '0:0:0:1*0:0:0', # Every day - 'yyyy-dd-a' => '0:0:0:1*12:0:0', # Every day 12noon - 'yyyy-mm-dd-a' => '0:0:0:1*12:0:0', # Every day 12noon - 'yyyy-dd-hh' => '0:0:0:0:1*0:0', # Every hour - 'yyyy-mm-dd-hh' => '0:0:0:0:1*0:0', # Every hour - 'yyyy-dd-hh-mm' => '0:0:0:0:0:1*0', # Every minute - 'yyyy-mm-dd-hh-mm' => '0:0:0:0:0:1*0', # Every minute - ); - - # Convert arg to array - if( ref($arg) eq 'ARRAY' ) - { - @pats = @$arg; - } - elsif( !ref($arg) ) - { - $arg =~ s/\s+//go; - @pats = split(/;/,$arg); - } - else - { - die "Bad reference type argument ".ref($arg); - } - - # Handle (possibly multiple) recurrances - foreach my $pat (@pats) - { - # Convert any log4j patterns across - if($pat =~ /^yyyy/i) # Then log4j style - { - $pat = lc($pat); # Use lowercase lookup - # Default to daily on bad pattern - unless(grep($pat eq $_,keys %lookup)) - { - warn "Bad Rotation pattern ($pat) using yyyy-dd\n"; - $pat = 'yyyy-dd'; - } - $pat = $lookup{$pat}; - } - - my $abs = $self->_get_next_occurance($pat); - warn "Adding [epoch secs,pat] =>[$abs,$pat]\n" if $self->{debug}; - my $ref = [$abs, $pat]; - push(@{$self->{'recurrance'}}, $ref); - - } - -} - - -sub log_message -{ - my $self = shift; - my %p = @_; - - my $max_size = $self->{size}; - my $numfiles = $self->{max}; - my $name = $self->{params}->{filename}; - my $fh = $self->{LDF}->{fh}; - - # Prime our time based data outside the critical code area - my ($in_time_mode,$time_to_rotate) = $self->time_to_rotate(); - - # Handle critical code for logging. No changes if someone else is in - if( !$self->lfhlock_test() ) - { - warn "$$ waiting on lock\n" if $self->{debug}; - $self->lfhlock() || return; - } - - my $size = (stat($fh))[7]; # Stat the handle to get real size - my $inode = (stat($fh))[1]; # get real inode - my $finode = (stat($name))[1]; # Stat the name for comparision - warn localtime()." $$ s=$size, i=$inode, f=$finode, n=$name\n" if $self->{debug}; - - # If finode and inode are the same then nobody has done a rename - # under us and we can continue. Otherwise just close and reopen. - # Time mode overrides Size mode - if(!defined($finode) || $inode != $finode) - { - # Oops someone moved things on us. So just reopen our log - delete $self->{LDF}; # Should get rid of current LDF - $self->{LDF} = Log::Dispatch::File->new(%{$self->{params}}); # Our log - - warn localtime()." $$ Someone else rotated: normal log\n" if $self->{debug}; - $self->logit($p{message}); - } - elsif($in_time_mode && !$time_to_rotate) - { - warn localtime()." $$ In time mode: normal log\n" if $self->{debug}; - $self->logit($p{message}); - } - elsif(!$in_time_mode && defined($size) && $size < $max_size ) - { - warn localtime()." $$ In size mode: normal log\n" if $self->{debug}; - $self->logit($p{message}); - } - # Need to rotate - elsif(($in_time_mode && $time_to_rotate) || - (!$in_time_mode && $size) - ) - { - # Shut down the log - delete $self->{LDF}; # Should get rid of current LDF - - my $idx = $numfiles -1; - - warn localtime() . " $$ Rotating\n" if $self->{debug}; - while($idx >= 0) - { - if($idx <= 0) - { - warn "$$ rename $name $name.1\n" if $self->{debug}; - rename($name, "$name.1"); - } - else - { - warn "$$ rename $name.$idx $name.".($idx+1)."\n" if $self->{debug}; - rename("$name.$idx", "$name.".($idx+1)); - } - - $idx--; - } - warn localtime() . " $$ Rotating Done\n" if $self->{debug}; - - # reopen the logfile for writing. - $self->{LDF} = Log::Dispatch::File->new(%{$self->{params}}); # Our log - - # Write it out - warn localtime()." $$ rotated: normal log\n" if $self->{debug}; - $self->logit($p{message}); - } - #else size is zero :-} just don't do anything! - - $self->lfhunlock(); -} - -sub DESTROY -{ - my $self = shift; - - if ( $self->{LDF} ) - { - delete $self->{LDF}; # Should get rid of current LDF - } - - # Clean up locks - close $self->{lfh} if $self->{lfh}; - unlink $self->{lf} if -f $self->{lf}; -} - -sub logit -{ - my $self = $_[0]; - - $self->lock(); - $self->{LDF}->log_message(message => $_[1]); - $self->unlock(); - return; -} - - -########################################################################### -# -# Subroutine time_to_rotate -# -# Args: none -# -# Rtns: (1,n) if we are in time mode and its time to rotate -# n defines the number of timers that expired -# (1,0) if we are in time mode but not ready to rotate -# (0,0) otherwise -# -# Description: -# time_to_rotate - update internal clocks and return status as -# defined above -# -# -# my ($in_time_mode,$time_to_rotate) = $self->time_to_rotate(); -sub time_to_rotate -{ - my $self = shift; # My object - my $mode = defined($self->{'recurrance'}); - my $rotate = 0; - - if($mode) - { - # Then do some checking and update ourselves if we think we need - # to rotate. Wether we rotate or not is up to our caller. We - # assume they know what they are doing! - - # Check need for rotation. Loop through our recurrances looking - # for expiration times. Any we find that have expired we update. - my $tm = time(); - my @recur = @{$self->{'recurrance'}}; - @{$self->{'recurrance'}} = (); - for my $rec (@recur) - { - my ($abs,$pat) = @$rec; - - # Extra checking - unless(defined $abs && $abs) - { - warn "Bad time found for recurrance pattern $pat: $abs\n"; - next; - } - my $dorotate = 0; - if($abs <= $tm) - { - # Then we need to rotate - $abs = $self->_get_next_occurance($pat); - unless(defined $abs && $abs) - { - warn "Next occurance is null for $pat\n"; - $abs = 0; - } - $rotate++; - $dorotate++; # Just for debugging - } - push(@{$self->{'recurrance'}},[$abs,$pat]) if $abs; - my $next = localtime($abs); - warn "time_to_rotate(mode,rotate,next) => ($mode,$dorotate,$next)\n" if $self->{debug}; - } - - } - - warn "time_to_rotate(mode,rotate) => ($mode,$rotate)\n" if $self->{debug}; - return wantarray ? ($mode,$rotate) : $rotate; -} - -########################################################################### -# -# Subroutine _gen_occurance -# -# Args: Date::Manip occurance pattern -# -# Rtns: array of epoch seconds for next few events -# -sub _gen_occurance -{ - my $self = shift; # My object - my $pat = shift; - my $range = ''; - - if($pat =~ /^0:0:0:0:0/) # Small recurrance less than 1 hour - { - $range = "4 hours later"; - } - elsif($pat =~ /^0:0:0:0/) # recurrance less than 1 day - { - $range = "4 days later"; - } - elsif($pat =~ /^0:0:0:/) # recurrance less than 1 week - { - $range = "4 weeks later"; - } - elsif($pat =~ /^0:0:/) # recurrance less than 1 month - { - $range = "4 months later"; - } - elsif($pat =~ /^0:/) # recurrance less than 1 year - { - $range = "24 months later"; - } - else # years - { - my($yrs) = m/^(\d+):/; - $yrs = 1 unless $yrs; - my $months = $yrs * 4 * 12; - - $range = "$months months later"; - } - - # The next date must start at least 1 second away from now other wise - # we may rotate for every message we recieve with in this second :-( - my $start = DateCalc("now","+ 1 second"); - - my @dates = ParseRecur($pat,"now",$start,$range); - - # Just in case we have a bad parse or our assumptions are wrong. - # We default to days - unless(scalar @dates >= 2) - { - warn "Failed to parse ($pat). Going daily\n"; - @dates = ParseRecur('0:0:0:1*0:0:0',"now","now","1 months later"); - } - - my @epochs = map {UnixDate($_,'%s')} @dates; - - # Clean out epochs that occur before now, being careful not to loop - # forever (thanks James). - shift(@epochs) while @epochs && $epochs[0] <= time(); - - warn "Recurrances are at: @epochs\n" if $self->{debug}; - warn "No recurrances found! Probably a timezone issue!\n" unless @epochs; - - return @epochs; -} - -########################################################################### -# -# Subroutine _get_next_occurance -# -# Args: Date::Manip occurance pattern -# -# Rtns: epoch seconds for next event -# -# We don't want to call Date::Manip::ParseRecur too often as it is very -# expensive. So, we cache what is returned from _gen_occurance(). -sub _get_next_occurance -{ - my $self = shift; # My object - my $pat = shift; - - # If this is first time or we are close to the end of our current - # list of recurrances then generate some new ones - if(!defined $self->{'epochs'}{$pat} || scalar(@{$self->{'epochs'}{$pat}}) < 2) - { - @{$self->{'epochs'}{$pat}} = $self->_gen_occurance($pat); - } - - return( shift(@{$self->{'epochs'}{$pat}}) ); -} - - -# Lock and unlock routines. For when we need to write a message. -use Fcntl ':flock'; # import LOCK_* constants - -sub lock -{ - my $self = shift; - - flock($self->{LDF}->{fh},LOCK_EX); - - # Make sure we are at the EOF - seek($self->{LDF}->{fh}, 0, 2); - - warn localtime() ." $$ Locked\n" if $self->{debug}; - return; -} - -sub unlock -{ - my $self = shift; - flock($self->{LDF}->{fh},LOCK_UN); - warn localtime() . " $$ unLocked\n" if $self->{debug}; -} - -# Lock and unlock routines. For when we need to roll the logs. -# -# Note: On May 1, Dan Waldheim's good news was: -# I discovered something interesting about forked processes and locking. -# If the parent "open"s the filehandle and then forks, exclusive locks -# don't work properly between the parent and children. Anyone can grab a -# lock while someone else thinks they have it. To work properly the -# "open" has to be done within each process. -# -# Thanks Dan -sub lfhlock_test -{ - my $self = shift; - - if (open(LFH, ">>$self->{lf}")) - { - $self->{lfh} = *LFH; - if (flock($self->{lfh}, LOCK_EX | LOCK_NB)) - { - warn "$$ got lock on Lock File ".$self->{lfh}."\n" if $self->{debug}; - return 1; - } - } - else - { - $self->{lfh} = 0; - warn "$$ couldn't get lock on Lock File\n" if $self->{debug}; - return 0; - } -} - -sub lfhlock -{ - my $self = shift; - - if (!$self->{lfh}) - { - if (!open(LFH, ">>$self->{lf}")) - { - return 0; - } - $self->{lfh} = *LFH; - } - - flock($self->{lfh},LOCK_EX); -} - -sub lfhunlock -{ - my $self = shift; - - if($self->{lfh}) - { - flock($self->{lfh},LOCK_UN); - close $self->{lfh}; - $self->{lfh} = 0; - } -} - -sub debug -{ - $_[0]->{'debug'} = $_[1]; -} - -__END__ - -=head1 NAME - -Log::Dispatch::FileRotate - Log to files that archive/rotate themselves - -=head1 SYNOPSIS - - use Log::Dispatch::FileRotate; - - my $file = Log::Dispatch::FileRotate->new( name => 'file1', - min_level => 'info', - filename => 'Somefile.log', - mode => 'append' , - size => 10, - max => 6, - ); - # or for a time based rotation - - my $file = Log::Dispatch::FileRotate->new( name => 'file1', - min_level => 'info', - filename => 'Somefile.log', - mode => 'append' , - TZ => 'AEDT', - DatePattern => 'yyyy-dd-HH', - ); - - $file->log( level => 'info', message => "your comment\n" ); - -=head1 DESCRIPTION - -This module provides a simple object for logging to files under the -Log::Dispatch::* system, and automatically rotating them according to -different constraints. This is basically a Log::Dispatch::File wrapper -with additions. To that end the arguments - - name, min_level, filename and mode - -behave the same as Log::Dispatch::File. So see its man page -(perldoc Log::Dispatch::File) - -The arguments size and max specify the maximum size and maximum -number of log files created. The size defaults to 10M and the max number -of files defaults to 1. If DatePattern is not defined then we default to -working in size mode. That is, use size values for deciding when to rotate. - -Once DatePattern is defined FileRotate will move into time mode. Once -this happens file rotation ignores size constraints and uses the defined -date pattern constraints. - -If you setup a config file using Log::Log4perl::init_and_watch() or the -like, you can switch between modes just by commenting out the DatePattern -line. - -When using DatePattern make sure TZ is defined correctly and that the TZ -you use is understood by Date::Manip. We use Date::Manip to generate our -recurrences. Bad TZ equals bad recurrences equals surprises! Read the -Date::Manip man page for more details on TZ. - -DatePattern will default to a daily rotate if your entered pattern is -incorrect. You will also get a warning message. - -If you have multiple writers that were started at different times you -will find each writer will try to rotate the log file at a recurrence -calculated from its start time. To sync all the writers just use a config -file and update it after starting your last writer. This will cause -Log::Dispatch::FileRotate->new() to be called by each of the writers -close to the same time, and if your recurrences aren't too close together -all should sync up just nicely. - -We handle multiple writers using flock(). - -=head1 DatePattern - -As I said earlier we use Date::Manip for generating our recurrence -events. This means we can understand Date::Manip's recurrence patterns -and the normal log4j DatePatterns. We don't use DatePattern to define the -extension of the log file though. - -DatePattern can therfore take forms like: - - - Date::Manip style - 0:0:0:0:5:30:0 every 5 hours and 30 minutes - 0:0:0:2*12:30:0 every 2 days at 12:30 (each day) - 3*1:0:2:12:0:0 every 3 years on Jan 2 at noon - - DailyRollingFileAppender log4j style - yyyy-MM every month - yyyy-ww every week - yyyy-MM-dd every day - yyyy-MM-dd-a every day at noon - yyyy-MM-dd-HH every hour - yyyy-MM-dd-HH-MM every minute - -To specify multiple recurrences in a single string separate them with a -semicolon: - yyyy-MM-dd; 0:0:0:2*12:30:0 - -This says we want to rotate every day AND every 2 days at 12:30. Put in -as many as you like. - -A complete description of Date::Manip recurrences is beyond us here -except to quote (from the man page): - - A recur description is a string of the format - Y:M:W:D:H:MN:S . Exactly one of the colons may - optionally be replaced by an asterisk, or an asterisk - may be prepended to the string. - - Any value "N" to the left of the asterisk refers to - the "Nth" one. Any value to the right of the asterisk - refers to a value as it appears on a calendar/clock. - Values to the right can be listed a single values, - ranges (2 numbers separated by a dash "-"), or a comma - separated list of values or ranges. In a few cases, - negative values are appropriate. - - This is best illustrated by example. - - 0:0:2:1:0:0:0 every 2 weeks and 1 day - 0:0:0:0:5:30:0 every 5 hours and 30 minutes - 0:0:0:2*12:30:0 every 2 days at 12:30 (each day) - 3*1:0:2:12:0:0 every 3 years on Jan 2 at noon - 0:1*0:2:12,14:0:0 2nd of every month at 12:00 and 14:00 - 1:0:0*45:0:0:0 45th day of every year - 0:1*4:2:0:0:0 4th tuesday (day 2) of every month - 0:1*-1:2:0:0:0 last tuesday of every month - 0:1:0*-2:0:0:0 2nd to last day of every month - - - -=head1 METHODS - -=over 4 - -=item * new(%p) - -This method takes a hash of parameters. The following options are -valid: - -=item -- name ($) - -The name of the object (not the filename!). Required. - -=item -- size ($) - -The maxium (or close to) size the log file can grow too. - -=item -- max ($) - -The maxium number of log files to create. - - -=item -- TZ ($) - -The TimeZone time based calculations should be done in. This should match -Date::Manip's concept of timezones and of course your machines timezone. -Date::Manip will normally work everything out for you. Except in my case -where EST means Eastern Standard Time in Australia not the US! I had to -use AEST or EADT instead. Here is a list of Date::Manip's timezones -straight from its man page. - - - The following timezone names are currently understood (and - can be used in parsing dates). These are zones defined in - RFC 822. - - Universal: GMT, UT - US zones : EST, EDT, CST, CDT, MST, MDT, PST, PDT - Military : A to Z (except J) - Other : +HHMM or -HHMM - ISO 8601 : +HH:MM, +HH, -HH:MM, -HH - - In addition, the following timezone abbreviations are also - accepted. - - IDLW -1200 International Date Line West - NT -1100 Nome - HST -1000 Hawaii Standard - CAT -1000 Central Alaska - AHST -1000 Alaska-Hawaii Standard - AKST -0900 Alaska Standard - YST -0900 Yukon Standard - HDT -0900 Hawaii Daylight - AKDT -0800 Alaska Daylight - YDT -0800 Yukon Daylight - PST -0800 Pacific Standard - PDT -0700 Pacific Daylight - MST -0700 Mountain Standard - MDT -0600 Mountain Daylight - CST -0600 Central Standard - CDT -0500 Central Daylight - EST -0500 Eastern Standard - SAT -0400 Chile - EDT -0400 Eastern Daylight - AST -0400 Atlantic Standard - ADT -0300 Atlantic Daylight - NDT -0230 Newfoundland Daylight - AT -0200 Azores - WAT -0100 West Africa - GMT +0000 Greenwich Mean - UT +0000 Universal (Coordinated) - UTC +0000 Universal (Coordinated) - WET +0000 Western European - WEST +0000 Alias for Western European - CET +0100 Central European - FWT +0100 French Winter - MET +0100 Middle European - MEZ +0100 Middle European - MEWT +0100 Middle European Winter - SWT +0100 Swedish Winter - BST +0100 British Summer bst=Brazil standard -0300 - GB +0100 GMT with daylight savings - CEST +0200 Central European Summer - EET +0200 Eastern Europe, USSR Zone 1 - FST +0200 French Summer - MEST +0200 Middle European Summer - MESZ +0200 Middle European Summer - METDST +0200 An alias for MEST used by HP-UX - SAST +0200 South African Standard - SST +0200 Swedish Summer sst=South Sumatra +0700 - EEST +0300 Eastern Europe Summer - BT +0300 Baghdad, USSR Zone 2 - MSK +0300 Moscow - IT +0330 Iran - ZP4 +0400 USSR Zone 3 - MSD +0300 Moscow Daylight - ZP5 +0500 USSR Zone 4 - IST +0530 Indian Standard - ZP6 +0600 USSR Zone 5 - CCT +0800 China Coast, USSR Zone 7 - AWST +0800 West Australian Standard - WST +0800 West Australian Standard - PHT +0800 Asia Manila - JST +0900 Japan Standard, USSR Zone 8 - ROK +0900 Republic of Korea - CAST +0930 Central Australian Standard - EAST +1000 Eastern Australian Standard - GST +1000 Guam Standard, USSR Zone 9 gst=Greenland Std - CADT +1030 Central Australian Daylight - EADT +1100 Eastern Australian Daylight - IDLE +1200 International Date Line East - NZST +1200 New Zealand Standard - NZT +1200 New Zealand - NZDT +1300 New Zealand Daylight - - - -=item -- DatePattern ($) - -The DatePattern as defined above. - -=item -- min_level ($) - -The minimum logging level this object will accept. See the -Log::Dispatch documentation for more information. Required. - -=item -- max_level ($) - -The maximum logging level this obejct will accept. See the -Log::Dispatch documentation for more information. This is not -required. By default the maximum is the highest possible level (which -means functionally that the object has no maximum). - -=item -- filename ($) - -The filename to be opened for writing. This is the base name. Rotated log -files will be renamed filename.1 thru to filename.C. Where max is the -paramater defined above. - -=item -- mode ($) - -The mode the file should be opened with. Valid options are 'write', -'>', 'append', '>>', or the relevant constants from Fcntl. The -default is 'write'. - -=item -- autoflush ($) - -Whether or not the file should be autoflushed. This defaults to true. - -=item -- callbacks( \& or [ \&, \&, ... ] ) - -This parameter may be a single subroutine reference or an array -reference of subroutine references. These callbacks will be called in -the order they are given and passed a hash containing the following keys: - - ( message => $log_message, level => $log_level ) - -The callbacks are expected to modify the message and then return a -single scalar containing that modified message. These callbacks will -be called when either the C or C methods are called and -will only be applied to a given message once. - -=item -- DEBUG ($) - -Turn on lots of warning messages to STDERR about what this module is -doing if set to 1. Really only useful to me. - -=item * log_message( message => $ ) - -Sends a message to the appropriate output. Generally this shouldn't -be called directly but should be called through the C method -(in Log::Dispatch::Output). - -=item * setDatePattern( $ or [ $, $, ... ] ) - -Set a new suite of recurrances for file rotation. You can pass in a -single string or a reference to an array of strings. Multiple recurrences -can also be define within a single string by seperating them with a -semi-colon (;) - -See the discussion above regarding the setDatePattern paramater for more -details. - -=back - -=head1 TODO - -compression, signal based rotates, proper test suite - -Could possibly use Logfile::Rotate as well/instead. - -=head1 AUTHOR - -Mark Pfeiffer, inspired by -Dave Rolsky's, , code :-) - -Kevin Goess suggested multiple writers should be -supported. He also conned me into doing the time based stuff. -Thanks Kevin! :-) - -Thanks also to Dan Waldheim for helping with some of the -locking issues in a forked environment. - -=cut - diff --git a/perl/third/Log-Dispatch-FileRotate-1.11/MANIFEST b/perl/third/Log-Dispatch-FileRotate-1.11/MANIFEST deleted file mode 100644 index 3c804ea..0000000 --- a/perl/third/Log-Dispatch-FileRotate-1.11/MANIFEST +++ /dev/null @@ -1,6 +0,0 @@ -Changes -FileRotate.pm -MANIFEST -Makefile.PL -test.pl -README diff --git a/perl/third/Log-Dispatch-FileRotate-1.11/Makefile.PL b/perl/third/Log-Dispatch-FileRotate-1.11/Makefile.PL deleted file mode 100644 index aa79525..0000000 --- a/perl/third/Log-Dispatch-FileRotate-1.11/Makefile.PL +++ /dev/null @@ -1,18 +0,0 @@ -use ExtUtils::MakeMaker; -# See lib/ExtUtils/MakeMaker.pm for details of how to influence -# the contents of the Makefile that is written. -WriteMakefile( - 'NAME' => 'Log::Dispatch::FileRotate', - 'VERSION_FROM' => 'FileRotate.pm', # finds $VERSION - 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 - 'ABSTRACT_FROM' => 'FileRotate.pm', - 'AUTHOR' => '"Mark Pfeiffer" ', - 'clean' => {FILES => "*.log*"}, - PREREQ_PM => { - 'Log::Log4perl' => '0.23', # or a minimum workable version - 'Log::Dispatch::Output' => 0, - 'Date::Manip' => 0, - 'Params::Validate' => 0, - 'Fcntl' => 0, - } -); diff --git a/perl/third/Log-Dispatch-FileRotate-1.11/README b/perl/third/Log-Dispatch-FileRotate-1.11/README deleted file mode 100644 index b6e7482..0000000 --- a/perl/third/Log-Dispatch-FileRotate-1.11/README +++ /dev/null @@ -1,231 +0,0 @@ -NAME - Log::Dispatch::FileRotate - Log to files that archive/rotate themselves - -SYNOPSIS - use Log::Dispatch::FileRotate; - - my $file = Log::Dispatch::FileRotate->new( name => 'file1', - min_level => 'info', - filename => 'Somefile.log', - mode => 'append' , - size => 10, - max => 6, - ); - # or for a time based rotation - - my $file = Log::Dispatch::FileRotate->new( name => 'file1', - min_level => 'info', - filename => 'Somefile.log', - mode => 'append' , - TZ => 'AEDT', - DatePattern => 'yyyy-dd-HH', - ); - - $file->log( level => 'info', message => "your comment\n" ); - -DESCRIPTION - This module provides a simple object for logging to files under the - Log::Dispatch::* system, and automatically rotating them according to - different constraints. This is basically a Log::Dispatch::File wrapper - with additions. To that end the arguments - - name, min_level, filename and mode - - behave the same as Log::Dispatch::File. So see its man page (perldoc - Log::Dispatch::File) - - The arguments size and max specify the maximum size (in meg) and maximum - number of log files created. The size defaults to 10M and the max number - of files defaults to 1. If DatePattern is not defined then we default to - working in size mode. That is, use size values for deciding when to - rotate. - - Once DatePattern is defined FileRotate will move into time mode. Once - this happens file rotation ignores size constraints and uses the defined - date pattern constraints. - - If you setup a config file using Log::Log4perl::init_and_watch() or the - like, you can switch between modes just by commenting out the - DatePattern line. - - When using DatePattern make sure TZ is defined correctly and that the TZ - you use is understood by Date::Manip. We use Date::Manip to generate our - recurrences. Bad TZ equals bad recurrences equals surprises! Read the - Date::Manip man page for more details on TZ. - - DatePattern will default to a daily rotate if your entered pattern is - incorrect. You will also get a warning message. - - If you have multiple writers that were started at different times you - will find each writer will try to rotate the log file at a recurrence - calculated from its start time. To sync all the writers just use a - config file and update it after starting your last writer. This will - cause Log::Dispatch::FileRotate->new() to be called by each of the - writers close to the same time, and if your recurrences aren't too close - together all should sync up just nicely. - - We handle multiple writers using flock(). - -DatePattern - As I said earlier we use Date::Manip for generating our recurrence - events. This means we can understand Date::Manip's recurrence patterns - and the normal log4j DatePatterns. We don't use DatePattern to define - the extension of the log file though. - - DatePattern can therfore take forms like: - - Date::Manip style - 0:0:0:0:5:30:0 every 5 hours and 30 minutes - 0:0:0:2*12:30:0 every 2 days at 12:30 (each day) - 3*1:0:2:12:0:0 every 3 years on Jan 2 at noon - - DailyRollingFileAppender log4j style - yyyy-MM every month - yyyy-ww every week - yyyy-MM-dd every day - yyyy-MM-dd-a every day at noon - yyyy-MM-dd-HH every hour - yyyy-MM-dd-HH-MM every minute - - To specify multiple recurrences in a single string separate them with a - semicolon: yyyy-MM-dd; 0:0:0:2*12:30:0 - - This says we want to rotate every day AND every 2 days at 12:30. Put in - as many as you like. - - A complete description of Date::Manip recurrences is beyond us here - except to quote (from the man page): - - A recur description is a string of the format - Y:M:W:D:H:MN:S . Exactly one of the colons may - optionally be replaced by an asterisk, or an asterisk - may be prepended to the string. - - Any value "N" to the left of the asterisk refers to - the "Nth" one. Any value to the right of the asterisk - refers to a value as it appears on a calendar/clock. - Values to the right can be listed a single values, - ranges (2 numbers separated by a dash "-"), or a comma - separated list of values or ranges. In a few cases, - negative values are appropriate. - - This is best illustrated by example. - - 0:0:2:1:0:0:0 every 2 weeks and 1 day - 0:0:0:0:5:30:0 every 5 hours and 30 minutes - 0:0:0:2*12:30:0 every 2 days at 12:30 (each day) - 3*1:0:2:12:0:0 every 3 years on Jan 2 at noon - 0:1*0:2:12,14:0:0 2nd of every month at 12:00 and 14:00 - 1:0:0*45:0:0:0 45th day of every year - 0:1*4:2:0:0:0 4th tuesday (day 2) of every month - 0:1*-1:2:0:0:0 last tuesday of every month - 0:1:0*-2:0:0:0 2nd to last day of every month - -METHODS - * new(%p) - This method takes a hash of parameters. The following options are - valid: - - -- name ($) - The name of the object (not the filename!). Required. - - -- size ($) - The maxium (or close to) size the log file can grow too. - - -- max ($) - The maxium number of log files to create. - - -- TZ ($) - The TimeZone time based calculations should be done in. This should - match Date::Manip's concept of timezones and of course your machines - timezone. Date::Manip will normally work everything out for you. - Except in my case where EST means Eastern Standard Time in Australia - not the US! I had to use AEST or EADT instead. Here is a list of - Date::Manip's timezones straight from its man page. - - The following timezone names are currently understood (and - can be used in parsing dates). These are zones defined in - RFC 822. - - Universal: GMT, UT - US zones : EST, EDT, CST, CDT, MST, MDT, PST, PDT - Military : A to Z (except J) - Other : +HHMM or -HHMM - ISO 8601 : +HH:MM, +HH, -HH:MM, -HH - - In addition, the following timezone abbreviations are also - accepted. - - [ .. snip ... ] - - -- DatePattern ($) - The DatePattern as defined above. - - -- min_level ($) - The minimum logging level this object will accept. See the - Log::Dispatch documentation for more information. Required. - - -- max_level ($) - The maximum logging level this obejct will accept. See the - Log::Dispatch documentation for more information. This is not - required. By default the maximum is the highest possible level - (which means functionally that the object has no maximum). - - -- filename ($) - The filename to be opened for writing. This is the base name. - Rotated log files will be renamed filename.1 thru to filename."max". - Where max is the paramater defined above. - - -- mode ($) - The mode the file should be opened with. Valid options are 'write', - '>', 'append', '>>', or the relevant constants from Fcntl. The - default is 'write'. - - -- autoflush ($) - Whether or not the file should be autoflushed. This defaults to - true. - - -- callbacks( \& or [ \&, \&, ... ] ) - This parameter may be a single subroutine reference or an array - reference of subroutine references. These callbacks will be called - in the order they are given and passed a hash containing the - following keys: - - ( message => $log_message, level => $log_level ) - - The callbacks are expected to modify the message and then return a - single scalar containing that modified message. These callbacks will - be called when either the "log" or "log_to" methods are called and - will only be applied to a given message once. - - -- DEBUG ($) - Turn on lots of warning messages to STDERR about what this module is - doing if set to 1. Really only useful to me. - - * log_message( message => $ ) - Sends a message to the appropriate output. Generally this shouldn't - be called directly but should be called through the "log()" method - (in Log::Dispatch::Output). - - * setDatePattern( $ or [ $, $, ... ] ) - Set a new suite of recurrances for file rotation. You can pass in a - single string or a reference to an array of strings. Multiple - recurrences can also be define within a single string by seperating - them with a semi-colon (;) - - See the discussion above regarding the setDatePattern paramater for - more details. - -TODO - compression, signal based rotates, proper test suite - - Could possibly use Logfile::Rotate as well/instead. - -AUTHOR - Mark Pfeiffer, inspired by Dave Rolsky's, - , code :-) - - Kevin Goess suggested multiple writers should be - supported. He also conned me into doing the time based stuff. Thanks - Kevin! :-) - diff --git a/perl/third/Log-Dispatch-FileRotate-1.11/test.pl b/perl/third/Log-Dispatch-FileRotate-1.11/test.pl deleted file mode 100644 index b725552..0000000 --- a/perl/third/Log-Dispatch-FileRotate-1.11/test.pl +++ /dev/null @@ -1,126 +0,0 @@ -#!/usr/bin/perl -w - -# Before `make install' is performed this script should be runnable with -# `make test'. After `make install' it should work as `perl test.pl' - -######################### We start with some black magic to print on failure. - -# Change 1..1 below to 1..last_test_to_print . -# (It may become useful if the test is moved to ./t subdirectory.) - -BEGIN { $| = 1; print "1..5\n"; } -END {print "not ok 1\n" unless $loaded;} -use Log::Log4perl; -use Log::Dispatch::FileRotate; -$loaded = 1; -print "ok 1\n"; - -######################### End of black magic. - -# Insert your test code below (better if it prints "ok 13" -# (correspondingly "not ok 13") depending on the success of chunk 13 -# of the test code): - -# First lets build a conf file for use latter -use Date::Manip; -my $tz; -eval '$tz= Date_TimeZone();'; -if($@) -{ - #print "ERROR Unable to determine timezone! Lets see if it matters..\n"; - my $start = DateCalc("now","+ 1 second"); - my @dates = ParseRecur('0:0:0:0:0:1*0',"now",$start,'20 minutes later'); - - # Should get about 20 in the array - my @epochs = map {UnixDate($_,'%s')} @dates; - shift(@epochs) while @epochs && $epochs[0] <= time(); - - # If no epochs left then Timezone issue is going to bite us! - # all bets are off. - if( @epochs ) - { - #print "It looks like we can get by without a timezone. Lucky!\n"; - print "ok 2\n"; - } - else - { - print "**** Time Zone problem: All bets are off. ****\n"; - print "not ok 2\n"; - } - $tz = ''; - -} -else -{ - #print "Your timezone is $tz.\n"; - $tz = "log4j.appender.FILE.TZ=$tz"; - print "ok 2\n"; -} - - -my $config = < log.conf") || die "Can't create log.conf"; -print CONF $config; -close(CONF); - -Log::Log4perl::init_and_watch("log.conf",10); -print "ok 3\n"; - -my $logger = Log::Log4perl->get_logger('nms.cisco.utility'); -my $logger1 = Log::Log4perl->get_logger('nms'); - -print "ok 4\n\n"; - -print "while true; do clear;ls -ltr| grep myerrs; sleep 1; done\n\n"; -print "Type this in another xterm in this directory to see the logs -changing. You can also edit log.conf and change params to see what will -happen to the log files. - -You can also run a number of 'make test' commands to see how we behave -with multiple writers to log files. - -Edit test.pl and uncomment the 'sleep 1' line if you want to -see time rotation happening -"; - -my $i = 4; -while ($i <= 65 ) -{ - $logger->debug($$ . ' this is a debug message'); - $logger->info($$ . ' this is an info message'); - $logger->warn($$ . ' etc'); - $logger->error($$ . ' ..'); - $logger->fatal($$ . ' ..'); - - $logger1->info($$ . ' this is an info message via logger1'); - $i++; -# sleep 1; - print "."; -} -print "\n"; -print "ok 5\n"; - diff --git a/perl/third/Makefile b/perl/third/Makefile deleted file mode 100644 index cf76abe..0000000 --- a/perl/third/Makefile +++ /dev/null @@ -1,40 +0,0 @@ -# Makefile for all perl modules -# -# $Id: //eng/main/src/perl/third/Makefile#17 $ - -PWD:= $(shell pwd) -LIB:= ${PWD}/../lib - -SUBDIRS:= \ - Config-Properties-0.41 \ - IPC-Session-0.05 \ - Log-Dispatch-FileRotate-1.11 \ - Proc-Simple-1.32 \ - Shuffle-1.4 \ - Test-Unit-0.25 \ - interface-0.02 \ - -all: ${SUBDIRS} - -${SUBDIRS}: - ${MAKE} $@/Makefile - ${MAKE} -C $@ - ${MAKE} -C $@ install - -%/Makefile: %/Makefile.PL - cd ${@D}; \ - perl Makefile.PL PERL="/usr/bin/perl -I${LIB}" \ - LIB=${LIB} PREFIX=${PWD} < /dev/null; - -clean: regen-makefiles - for dir in ${SUBDIRS}; do \ - ${MAKE} -C $$dir clean; \ - done - -regen-makefiles: - for dir in ${SUBDIRS}; do \ - rm -f $$dir/Makefile; \ - ${MAKE} $$dir/Makefile; \ - done - -.PHONY:: ${SUBDIRS} all clean regen-makefiles diff --git a/perl/third/Proc-Simple-1.32/.licensizer.yml b/perl/third/Proc-Simple-1.32/.licensizer.yml deleted file mode 100644 index a5265eb..0000000 --- a/perl/third/Proc-Simple-1.32/.licensizer.yml +++ /dev/null @@ -1,18 +0,0 @@ -# .licensizer.yml - -author: - text: | - 1996, Mike Schilli - header: AUTHORS - mode: verbatim - -license: - text: | - Copyright 1996-2011 by Mike Schilli, all rights reserved. - This program is free software, you can redistribute it and/or - modify it under the same terms as Perl itself. - header: LEGALESE - -path_exclude: - - t/ - - blib/ diff --git a/perl/third/Proc-Simple-1.32/Changes b/perl/third/Proc-Simple-1.32/Changes deleted file mode 100644 index 17f479c..0000000 --- a/perl/third/Proc-Simple-1.32/Changes +++ /dev/null @@ -1,105 +0,0 @@ -###################################################################### - Proc::Simple CHANGES -###################################################################### - - 1.32 (2015/11/15) - (ms) [rt.cpan.org #108215] open() calls now use the safe form. - - 1.31 (2012/11/17) - (ms) To better deal with the race condition in the - previous release, kill the newly created child - process first, then send a killpg to its process - group and ignore the outcome. - - (ms) [RT 81203] Jim A Kessler reported a perl 5.16 issue - with the "AutoLoader" line, so I went ahead and removed - all references to "Exporter" and "AutoLoader", as - Proc::Simple isn't using them at all. - - From 1.29: - [RT 69782] Zefram reported race condition in t/sh-c.t, - fixed by adding polling loop. - - Found that kill(-sig, pid) sometimes fails with - 'process id not found' although a previous kill(0, pid) - succeeded. This is a race condition condition caused - by a newly forked child that hasn't called setsid() yet - and therefore its new process group id doesn't exist yet, - although the child responds to poll(). kill() now - deals with this case. - From 1.28: - [RT 69103] Typo fix by Salvatore Bonaccorso - Added support for processes called via 'sh -c' by - system() (see "Shell Processes" note in the manpage). - From 1.27: - [RT 62802] Pod fix by Salvatore Bonaccorso - [RT 63833] Applied patch to stop reaping PIDs of - no longer existing processes (submitted by perlbotics). - Added licensizer - [RT 63833] (second part) Added cleanup() class method - to delete timing data of reaped processes, avoiding - infinite memory growth on long-running processes - - From 1.26: [RT 62285] Pod fix for redirect_output() - Fixed github link - - from 1.25: Localize special variables so that the exit status - from waitpid doesn't leak out, causing exit status - to be incorrect (RT33440, fixed by Brad Cavanagh). - - from 1.24: Added copyright header - - from 1.23: Applied doc patch by Janne Chr. Schulz - - from 1.22: Applied patch by Jeff Holt, providing start - and end time of the forked process via t0() and t1(). - - from 1.21: Added patch by Chip Capelik to provide a wait() - method waiting for a process to terminate. - - from 1.20: Added patch by Tobias Jahn , - to redirect STDOUT or STDERR of the child process upon - request. - - from 1.19: Fixed bug which occurred on failed fork()s, as - reported anonymously on the CPAN bug tracker. - - from 1.18: Added multi-arg start method (proposed by - Clauss Strauch ) - - from 1.17: Fixed Version difference between Makefile.PL - and Simple by using VERSION_FROM (thanks - Andreas Koenig) - - from 1.16: Fixed bug with Proc::Simple instances which - were DESTROYED before they were ever started. - Many thanks to Russell Fulton (r.fulton@auckland.ac.nz) - for pointing this out. - - from 1.15: Added %DESTROYED hash for processes which might - still in zombie state right after their objects - went out of business. THE_REAPER will take care - of them. - - from 1.14: Added exit_status() method and a smart - REAPER which reaps only processes we've started before. - - from 1.13: Replaced two erronous uses of 'exists' by 'defined'. - Thanks to Rolf.Beutner@telekom.de for pointing this - out. - from 1.12: To fight problems with zombies, replaced the wait() - function by a NOWAIT waitpid on systems that - support it. - - Tim Jenness included - kill_on_destroy/sig_on_destroy/pid methods. - - from 1.11: binkley's error: threw out waitpid, wait is - performed by signal handler now. - - from 1.1: Process is now called Proc::Simple to fit in the - CPAN namespace, corrections Andreas Koenig suggested. - -First Release: 05/22/96 - -Michael Schilli procsimple@perlmeister.com diff --git a/perl/third/Proc-Simple-1.32/MANIFEST b/perl/third/Proc-Simple-1.32/MANIFEST deleted file mode 100644 index d0785d7..0000000 --- a/perl/third/Proc-Simple-1.32/MANIFEST +++ /dev/null @@ -1,21 +0,0 @@ -.licensizer.yml -Changes -eg/parproc.pl -Makefile.PL -MANIFEST -MANIFEST.SKIP -META.yml Module meta-data (added by MakeMaker) -README -Simple.pm -t/bin/test-prog -t/destroy.t -t/esub.t -t/exit.t -t/muarg.t -t/mult.t -t/sh-c.t -t/simple.t -t/stdouterr.t -t/time.t -t/wait.t -META.json Module JSON meta-data (added by MakeMaker) diff --git a/perl/third/Proc-Simple-1.32/MANIFEST.SKIP b/perl/third/Proc-Simple-1.32/MANIFEST.SKIP deleted file mode 100644 index 4b8c1e7..0000000 --- a/perl/third/Proc-Simple-1.32/MANIFEST.SKIP +++ /dev/null @@ -1,12 +0,0 @@ -.gz -.git -blib -^Makefile$ -^Makefile.old$ -CVS -.cvsignore -docs -MANIFEST.bak -adm/release -MYMETA.json -MYMETA.yml diff --git a/perl/third/Proc-Simple-1.32/META.json b/perl/third/Proc-Simple-1.32/META.json deleted file mode 100644 index c371d0a..0000000 --- a/perl/third/Proc-Simple-1.32/META.json +++ /dev/null @@ -1,47 +0,0 @@ -{ - "abstract" : "unknown", - "author" : [ - "unknown" - ], - "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.142690", - "license" : [ - "unknown" - ], - "meta-spec" : { - "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", - "version" : "2" - }, - "name" : "Proc-Simple", - "no_index" : { - "directory" : [ - "t", - "inc" - ] - }, - "prereqs" : { - "build" : { - "requires" : { - "ExtUtils::MakeMaker" : "0" - } - }, - "configure" : { - "requires" : { - "ExtUtils::MakeMaker" : "0" - } - }, - "runtime" : { - "requires" : { - "IO::Handle" : "0", - "Test::More" : "0" - } - } - }, - "release_status" : "stable", - "resources" : { - "repository" : { - "url" : "http://github.com/mschilli/proc-simple-perl" - } - }, - "version" : "1.32" -} diff --git a/perl/third/Proc-Simple-1.32/META.yml b/perl/third/Proc-Simple-1.32/META.yml deleted file mode 100644 index bcc35db..0000000 --- a/perl/third/Proc-Simple-1.32/META.yml +++ /dev/null @@ -1,25 +0,0 @@ ---- -abstract: unknown -author: - - unknown -build_requires: - ExtUtils::MakeMaker: '0' -configure_requires: - ExtUtils::MakeMaker: '0' -dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.142690' -license: unknown -meta-spec: - url: http://module-build.sourceforge.net/META-spec-v1.4.html - version: '1.4' -name: Proc-Simple -no_index: - directory: - - t - - inc -requires: - IO::Handle: '0' - Test::More: '0' -resources: - repository: http://github.com/mschilli/proc-simple-perl -version: '1.32' diff --git a/perl/third/Proc-Simple-1.32/Makefile.PL b/perl/third/Proc-Simple-1.32/Makefile.PL deleted file mode 100644 index 6535f64..0000000 --- a/perl/third/Proc-Simple-1.32/Makefile.PL +++ /dev/null @@ -1,21 +0,0 @@ - -use ExtUtils::MakeMaker; - -my $meta_merge = { - META_MERGE => { - resources => { - repository => 'http://github.com/mschilli/proc-simple-perl', - }, - } -}; - -WriteMakefile( - 'VERSION_FROM' => "Simple.pm", - 'NAME' => 'Proc::Simple', - 'dist' => { COMPRESS=>"gzip", SUFFIX=>"gz" }, - PREREQ_PM => { - 'Test::More' => 0, - 'IO::Handle' => 0, - }, - $ExtUtils::MakeMaker::VERSION >= 6.50 ? (%$meta_merge) : (), -); diff --git a/perl/third/Proc-Simple-1.32/README b/perl/third/Proc-Simple-1.32/README deleted file mode 100644 index a262340..0000000 --- a/perl/third/Proc-Simple-1.32/README +++ /dev/null @@ -1,311 +0,0 @@ -###################################################################### - Proc::Simple 1.32 -###################################################################### - -NAME - Proc::Simple -- launch and control background processes - -SYNOPSIS - use Proc::Simple; - - $myproc = Proc::Simple->new(); # Create a new process object - - $myproc->start("shell-command-line"); # Launch an external program - $myproc->start("command", # Launch an external program - "param", ...); # with parameters - - $myproc->start(sub { ... }); # Launch a perl subroutine - $myproc->start(\&subroutine); # Launch a perl subroutine - $myproc->start(\&subroutine, # Launch a perl subroutine - $param, ...); # with parameters - - $running = $myproc->poll(); # Poll Running Process - - $exit_status = $myproc->wait(); # Wait until process is done - - $proc->kill_on_destroy(1); # Set kill on destroy - $proc->signal_on_destroy("KILL"); # Specify signal to be sent - # on destroy - - $myproc->kill(); # Kill Process (SIGTERM) - - - - $myproc->kill("SIGUSR1"); # Send specified signal - - $myproc->exit_status(); # Return exit status of process - - - Proc::Simple::debug($level); # Turn debug on - -DESCRIPTION - The Proc::Simple package provides objects mimicing real-life processes - from a user's point of view. A new process object is created by - - $myproc = Proc::Simple->new(); - - Either external programs or perl subroutines can be launched and - controlled as processes in the background. - - A 10-second sleep process, for example, can be launched as an external - program as in - - $myproc->start("/bin/sleep 10"); # or - $myproc->start("/bin/sleep", "10"); - - or as a perl subroutine, as in - - sub mysleep { sleep(shift); } # Define mysleep() - $myproc->start(\&mysleep, 10); # Launch it. - - or even as - - $myproc->start(sub { sleep(10); }); - - The *start* Method returns immediately after starting the specified - process in background, i.e. there's no blocking. It returns *1* if the - process has been launched successfully and *0* if not. - - The *poll* method checks if the process is still running - - $running = $myproc->poll(); - - and returns *1* if it is, *0* if it's not. Finally, - - $myproc->kill(); - - terminates the process by sending it the SIGTERM signal. As an option, - another signal can be specified. - - $myproc->kill("SIGUSR1"); - - sends the SIGUSR1 signal to the running process. *kill* returns *1* if - it succeeds in sending the signal, *0* if it doesn't. - - The methods are discussed in more detail in the next section. - - A destructor is provided so that a signal can be sent to the forked - processes automatically should the process object be destroyed or if the - process exits. By default this behaviour is turned off (see the - kill_on_destroy and signal_on_destroy methods). - -METHODS - The following methods are available: - - new (Constructor) - Create a new instance of this class by writing - - $proc = new Proc::Simple; - - or - - $proc = Proc::Simple->new(); - - It takes no arguments. - - start - Launches a new process. The "start()" method can be used to launch - both external programs (like "/bin/echo") or one of your - self-defined subroutines (like "foo()") in a new process. - - For an external program to be started, call - - $status = $proc->start("program-name"); - - If you want to pass a couple of parameters to the launched program, - there's two options: You can either pass them in one argument like - in - - $status = $proc->start("/bin/echo hello world"); - - or in several arguments like in - - $status = $proc->start("/bin/echo", "hello", "world"); - - Just as in Perl's function "system()", there's a big difference - between the two methods: If you provide one argument containing a - blank-separated command line, your shell is going to process any - meta-characters (if you choose to use some) before the process is - actually launched: - - $status = $proc->start("/bin/ls -l /etc/initt*"); - - will expand "/etc/initt*" to "/etc/inittab" before running the "ls" - command. If, on the other hand, you say - - $status = $proc->start("/bin/ls", "-l", "*"); - - the "*" will stay unexpanded, meaning you'll look for a file with - the literal name "*" (which is unlikely to exist on your system - unless you deliberately create confusingly named files :). For more - info on this, look up "perldoc -f exec". - - If, on the other hand, you want to start a Perl subroutine in the - background, simply provide the function reference like - - $status = $proc->start(\&your_function); - - or supply an unnamed subroutine: - - $status = $proc->start( sub { sleep(1) } ); - - You can also provide additional parameters to be passed to the - function: - - $status = $proc->start(\&printme, "hello", "world"); - - The *start* Method returns immediately after starting the specified - process in background, i.e. non-blocking mode. It returns *1* if the - process has been launched successfully and *0* if not. - - poll - The *poll* method checks if the process is still running - - $running = $myproc->poll(); - - and returns *1* if it is, *0* if it's not. - - kill - The kill() method: - - $myproc->kill(); - - terminates the process by sending it the SIGTERM signal. As an - option, another signal can be specified. - - $myproc->kill("SIGUSR1"); - - sends the SIGUSR1 signal to the running process. *kill* returns *1* - if it succeeds in sending the signal, *0* if it doesn't. - - kill_on_destroy - Set a flag to determine whether the process attached to this object - should be killed when the object is destroyed. By default, this flag - is set to false. The current value is returned. - - $current = $proc->kill_on_destroy; - $proc->kill_on_destroy(1); # Set flag to true - $proc->kill_on_destroy(0); # Set flag to false - - signal_on_destroy - Method to set the signal that will be sent to the process when the - object is destroyed (Assuming kill_on_destroy is true). Returns the - current setting. - - $current = $proc->signal_on_destroy; - $proc->signal_on_destroy("KILL"); - - redirect_output - Redirects stdout and/or stderr output to a file. Specify undef to - leave the stderr/stdout handles of the process alone. - - # stdout to a file, left stderr unchanged - $proc->redirect_output ("/tmp/someapp.stdout", undef); - - # stderr to a file, left stdout unchanged - $proc->redirect_output (undef, "/tmp/someapp.stderr"); - - # stdout and stderr to a separate file - $proc->redirect_output ("/tmp/someapp.stdout", "/tmp/someapp.stderr"); - - Call this method before running the start method. - - pid Returns the pid of the forked process associated with this object - - $pid = $proc->pid; - - t0 Returns the start time() of the forked process associated with this - object - - $t0 = $proc->t0(); - - t1 Returns the stop time() of the forked process associated with this - object - - $t1 = $proc->t1(); - - DESTROY (Destructor) - Object destructor. This method is called when the object is - destroyed (eg with "undef" or on exiting perl). If kill_on_destroy - is true the process associated with the object is sent the - signal_on_destroy signal (SIGTERM if undefined). - - exit_status - Returns the exit status of the process as the $! variable indicates. - If the process is still running, "undef" is returned. - - wait - The *wait* method: - - $exit_status = $myproc->wait(); - - waits until the process is done and returns its exit status. - - debug - Switches debug messages on and off -- Proc::Simple::debug(1) - switches them on, Proc::Simple::debug(0) keeps Proc::Simple quiet. - - cleanup - Proc::Simple keeps around data of terminated processes, e.g. you can - check via "t0()" and "t1()" how long a process ran, even if it's - long gone. Over time, this data keeps occupying more and more memory - and if you have a long-running program, you might want to run - "Proc::Simple->cleanup()" every once in a while to get rid of data - pertaining to processes no longer in use. - -NOTE - Please keep in mind that there is no guarantee that the SIGTERM signal - really terminates a process. Processes can have signal handlers defined - that avoid the shutdown. If in doubt, whether a process still exists, - check it repeatedly with the *poll* routine after sending the signal. - -Shell Processes - If you pass a shell program to Proc::Simple, it'll use "exec()" to - launch it. As noted in Perl's "exec()" manpage, simple commands for the - one-argument version of "exec()" will be passed to "execvp()" directly, - while commands containing characters like ";" or "*" will be passed to a - shell to make sure those get the shell expansion treatment. - - This has the interesting side effect that if you launch something like - - $p->start("./womper *"); - - then you'll see two processes in your process list: - - $ ps auxww | grep womper - mschilli 9126 11:21 0:00 sh -c ./womper * - mschilli 9127 11:21 0:00 /usr/local/bin/perl -w ./womper ... - - A regular "kill()" on the process PID would only kill the first process, - but Proc::Simple's "kill()" will use a negative signal and send it to - the first process (9126). Since it has marked the process as a process - group leader when it created it previously (via setsid()), this will - cause both processes above to receive the signal sent by "kill()". - -Contributors - Tim Jenness did - kill_on_destroy/signal_on_destroy/pid - - Mark R. Southern worked on EXIT_STATUS - tracking - - Tobias Jahn added redirection to - stdout/stderr - - Clauss Strauch suggested the - multi-arg start()-methods. - - Chip Capelik contributed a patch with the wait() method. - - Jeff Holt provided a patch for time tracking with t0() and t1(). - - Brad Cavanagh fixed RT33440 (unreliable $?) - -AUTHOR - 1996, Mike Schilli - -LICENSE - Copyright 1996-2011 by Mike Schilli, all rights reserved. This program - is free software, you can redistribute it and/or modify it under the - same terms as Perl itself. - diff --git a/perl/third/Proc-Simple-1.32/Simple.pm b/perl/third/Proc-Simple-1.32/Simple.pm deleted file mode 100644 index 8dde0f7..0000000 --- a/perl/third/Proc-Simple-1.32/Simple.pm +++ /dev/null @@ -1,841 +0,0 @@ -###################################################################### -package Proc::Simple; -###################################################################### -# Copyright 1996-2001 by Michael Schilli, all rights reserved. -# -# This program is free software, you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -# The newest version of this module is available on -# http://perlmeister.com/devel -# or on your favourite CPAN site under -# CPAN/modules/by-author/id/MSCHILLI -# -###################################################################### - -=head1 NAME - -Proc::Simple -- launch and control background processes - -=head1 SYNOPSIS - - use Proc::Simple; - - $myproc = Proc::Simple->new(); # Create a new process object - - $myproc->start("shell-command-line"); # Launch an external program - $myproc->start("command", # Launch an external program - "param", ...); # with parameters - - $myproc->start(sub { ... }); # Launch a perl subroutine - $myproc->start(\&subroutine); # Launch a perl subroutine - $myproc->start(\&subroutine, # Launch a perl subroutine - $param, ...); # with parameters - - $running = $myproc->poll(); # Poll Running Process - - $exit_status = $myproc->wait(); # Wait until process is done - - $proc->kill_on_destroy(1); # Set kill on destroy - $proc->signal_on_destroy("KILL"); # Specify signal to be sent - # on destroy - - $myproc->kill(); # Kill Process (SIGTERM) - - - - $myproc->kill("SIGUSR1"); # Send specified signal - - $myproc->exit_status(); # Return exit status of process - - - Proc::Simple::debug($level); # Turn debug on - -=head1 DESCRIPTION - -The Proc::Simple package provides objects mimicing real-life -processes from a user's point of view. A new process object is created by - - $myproc = Proc::Simple->new(); - -Either external programs or perl subroutines can be launched and -controlled as processes in the background. - -A 10-second sleep process, for example, can be launched -as an external program as in - - $myproc->start("/bin/sleep 10"); # or - $myproc->start("/bin/sleep", "10"); - -or as a perl subroutine, as in - - sub mysleep { sleep(shift); } # Define mysleep() - $myproc->start(\&mysleep, 10); # Launch it. - -or even as - - $myproc->start(sub { sleep(10); }); - -The I Method returns immediately after starting the -specified process in background, i.e. there's no blocking. -It returns I<1> if the process has been launched -successfully and I<0> if not. - -The I method checks if the process is still running - - $running = $myproc->poll(); - -and returns I<1> if it is, I<0> if it's not. Finally, - - $myproc->kill(); - -terminates the process by sending it the SIGTERM signal. As an -option, another signal can be specified. - - $myproc->kill("SIGUSR1"); - -sends the SIGUSR1 signal to the running process. I returns I<1> if -it succeeds in sending the signal, I<0> if it doesn't. - -The methods are discussed in more detail in the next section. - -A destructor is provided so that a signal can be sent to -the forked processes automatically should the process object be -destroyed or if the process exits. By default this -behaviour is turned off (see the kill_on_destroy and -signal_on_destroy methods). - -=cut - -require 5.003; -use strict; -use vars qw($VERSION %EXIT_STATUS %INTERVAL - %DESTROYED); - -use POSIX; -use IO::Handle; - -$VERSION = '1.32'; - -###################################################################### -# Globals: Debug and the mysterious waitpid nohang constant. -###################################################################### -my $Debug = 0; -my $WNOHANG = get_system_nohang(); - -###################################################################### - -=head1 METHODS - -The following methods are available: - -=over 4 - -=item new (Constructor) - -Create a new instance of this class by writing - - $proc = new Proc::Simple; - -or - - $proc = Proc::Simple->new(); - -It takes no arguments. - -=cut - -###################################################################### -# $proc_obj=Proc::Simple->new(); - Constructor -###################################################################### -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - - my $self = {}; - - # Init instance variables - $self->{'kill_on_destroy'} = undef; - $self->{'signal_on_destroy'} = undef; - $self->{'pid'} = undef; - $self->{'redirect_stdout'} = undef; - $self->{'redirect_stderr'} = undef; - - bless($self, $class); -} - -###################################################################### - -=item start - -Launches a new process. -The C method can be used to launch both external programs -(like C) or one of your self-defined subroutines -(like C) in a new process. - -For an external program to be started, call - - $status = $proc->start("program-name"); - -If you want to pass a couple of parameters to the launched program, -there's two options: You can either pass them in one argument like -in - - $status = $proc->start("/bin/echo hello world"); - -or in several arguments like in - - $status = $proc->start("/bin/echo", "hello", "world"); - -Just as in Perl's function C, there's a big difference -between the two methods: If you provide one argument containing -a blank-separated command line, your shell is going to -process any meta-characters (if you choose to use some) before -the process is actually launched: - - $status = $proc->start("/bin/ls -l /etc/initt*"); - -will expand C to C before running the C -command. If, on the other hand, you say - - $status = $proc->start("/bin/ls", "-l", "*"); - -the C<*> will stay unexpanded, meaning you'll look for a file with the -literal name C<*> (which is unlikely to exist on your system unless -you deliberately create confusingly named files :). For -more info on this, look up C. - -If, on the other hand, you want to start a Perl subroutine -in the background, simply provide the function reference like - - $status = $proc->start(\&your_function); - -or supply an unnamed subroutine: - - $status = $proc->start( sub { sleep(1) } ); - -You can also provide additional parameters to be passed to the function: - - $status = $proc->start(\&printme, "hello", "world"); - -The I Method returns immediately after starting the -specified process in background, i.e. non-blocking mode. -It returns I<1> if the process has been launched -successfully and I<0> if not. - -=cut - -###################################################################### -# $ret = $proc_obj->start("prg"); - Launch process -###################################################################### -sub start { - my $self = shift; - my ($func, @params) = @_; - - # Reap Zombies automatically - $SIG{'CHLD'} = \&THE_REAPER; - - # Fork a child process - $self->{'pid'} = fork(); - return 0 unless defined $self->{'pid'}; # return Error if fork failed - - if($self->{pid} == 0) { # Child - # Mark it as process group leader, so that we can kill - # the process group later. Note that there's a race condition - # here because there's a window in time (while you're reading - # this comment) between child startup and its new process group - # id being defined. This means that killpg() to the child during - # this time frame will fail. Proc::Simple's kill() method deals l - # with it, see comments there. - POSIX::setsid(); - $self->dprt("setsid called ($$)"); - - if (defined $self->{'redirect_stderr'}) { - $self->dprt("STDERR -> $self->{'redirect_stderr'}"); - open(STDERR, ">", $self->{'redirect_stderr'}) ; - autoflush STDERR 1 ; - } - - if (defined $self->{'redirect_stdout'}) { - $self->dprt("STDOUT -> $self->{'redirect_stdout'}"); - open(STDOUT, ">", $self->{'redirect_stdout'}) ; - autoflush STDOUT 1 ; - } - - if(ref($func) eq "CODE") { - $self->dprt("Launching code"); - $func->(@params); exit 0; # Start perl subroutine - } else { - $self->dprt("Launching $func @params"); - exec $func, @params; # Start shell process - exit 0; # In case something goes wrong - } - } elsif($self->{'pid'} > 0) { # Parent: - $INTERVAL{$self->{'pid'}}{'t0'} = time(); - $self->dprt("START($self->{'pid'})"); - # Register PID - $EXIT_STATUS{$self->{'pid'}} = undef; - $INTERVAL{$self->{'pid'}}{'t1'} = undef; - return 1; # return OK - } else { - return 0; # this shouldn't occur - } -} - -###################################################################### - -=item poll - -The I method checks if the process is still running - - $running = $myproc->poll(); - -and returns I<1> if it is, I<0> if it's not. - -=cut - -###################################################################### -# $ret = $proc_obj->poll(); - Check process status -# 1="running" 0="not running" -###################################################################### -sub poll { - my $self = shift; - - $self->dprt("Polling"); - - # There's some weirdness going on with the signal handler. - # It runs into timing problems, so let's have poll() call - # the REAPER every time to make sure we're getting rid of - # defuncts. - $self->THE_REAPER(); - - if(defined($self->{pid})) { - if(CORE::kill(0, $self->{pid})) { - $self->dprt("POLL($self->{pid}) RESPONDING"); - return 1; - } else { - $self->dprt("POLL($self->{pid}) NOT RESPONDING"); - } - } else { - $self->dprt("POLL(NOT DEFINED)"); - } - - 0; -} - -###################################################################### - -=item kill - -The kill() method: - - $myproc->kill(); - -terminates the process by sending it the SIGTERM signal. As an -option, another signal can be specified. - - $myproc->kill("SIGUSR1"); - -sends the SIGUSR1 signal to the running process. I returns I<1> if -it succeeds in sending the signal, I<0> if it doesn't. - -=cut - -###################################################################### -# $ret = $proc_obj->kill([SIGXXX]); - Send signal to process -# Default-Signal: SIGTERM -###################################################################### -sub kill { - my $self = shift; - my $sig = shift; - - # If no signal specified => SIGTERM-Signal - $sig = POSIX::SIGTERM() unless defined $sig; - - # Use numeric signal if we get a string - if( $sig !~ /^[-\d]+$/ ) { - $sig =~ s/^SIG//g; - $sig = eval "POSIX::SIG${sig}()"; - } - - # Process initialized at all? - if( !defined $self->{'pid'} ) { - $self->dprt("No pid set"); - return 0; - } - - # Send signal - if(CORE::kill($sig, $self->{'pid'})) { - $self->dprt("KILL($sig, $self->{'pid'}) OK"); - - # now kill process group of process to make sure that shell - # processes containing shell characters, which get launched via - # "sh -c" are killed along with their launching shells. - # This might fail because of the race condition explained in - # start(), so we ignore the outcome. - CORE::kill(-$sig, $self->{'pid'}); - } else { - $self->dprt("KILL($sig, $self->{'pid'}) failed ($!)"); - return 0; - } - - 1; -} - -###################################################################### - -=item kill_on_destroy - -Set a flag to determine whether the process attached -to this object should be killed when the object is -destroyed. By default, this flag is set to false. -The current value is returned. - - $current = $proc->kill_on_destroy; - $proc->kill_on_destroy(1); # Set flag to true - $proc->kill_on_destroy(0); # Set flag to false - -=cut - -###################################################################### -# Method to set the kill_on_destroy flag -###################################################################### -sub kill_on_destroy { - my $self = shift; - if (@_) { $self->{kill_on_destroy} = shift; } - return $self->{kill_on_destroy}; -} - -###################################################################### - -=item signal_on_destroy - -Method to set the signal that will be sent to the -process when the object is destroyed (Assuming -kill_on_destroy is true). Returns the current setting. - - $current = $proc->signal_on_destroy; - $proc->signal_on_destroy("KILL"); - -=cut - -###################################################################### -# Send a signal on destroy -# undef means send the default signal (SIGTERM) -###################################################################### -sub signal_on_destroy { - my $self = shift; - if (@_) { $self->{signal_on_destroy} = shift; } - return $self->{signal_on_destroy}; -} - -###################################################################### - -=item redirect_output - -Redirects stdout and/or stderr output to a file. -Specify undef to leave the stderr/stdout handles of the process alone. - - # stdout to a file, left stderr unchanged - $proc->redirect_output ("/tmp/someapp.stdout", undef); - - # stderr to a file, left stdout unchanged - $proc->redirect_output (undef, "/tmp/someapp.stderr"); - - # stdout and stderr to a separate file - $proc->redirect_output ("/tmp/someapp.stdout", "/tmp/someapp.stderr"); - -Call this method before running the start method. - -=cut - -###################################################################### -sub redirect_output { -###################################################################### - - my $self = shift ; - ($self->{'redirect_stdout'}, $self->{'redirect_stderr'}) = @_ ; - - 1 ; -} - -###################################################################### - -=item pid - -Returns the pid of the forked process associated with -this object - - $pid = $proc->pid; - -=cut - -###################################################################### -sub pid { -###################################################################### - my $self = shift; - - # Allow the pid to be set - assume this is only - # done internally so don't document this behaviour in the - # pod. - if (@_) { $self->{'pid'} = shift; } - return $self->{'pid'}; -} - -###################################################################### - -=item t0 - -Returns the start time() of the forked process associated with -this object - - $t0 = $proc->t0(); - -=cut - -###################################################################### -sub t0 { -###################################################################### - my $self = shift; - - return $INTERVAL{$self->{'pid'}}{'t0'}; -} - -###################################################################### - -=item t1 - -Returns the stop time() of the forked process associated with -this object - - $t1 = $proc->t1(); - -=cut - -###################################################################### -sub t1 { -###################################################################### - my $self = shift; - - return $INTERVAL{$self->{'pid'}}{'t1'}; -} - -=item DESTROY (Destructor) - -Object destructor. This method is called when the -object is destroyed (eg with "undef" or on exiting -perl). If kill_on_destroy is true the process -associated with the object is sent the signal_on_destroy -signal (SIGTERM if undefined). - -=cut - -###################################################################### -# Destroy method -# This is run automatically on undef -# Should probably not bother if a poll shows that the process is not -# running. -###################################################################### -sub DESTROY { - my $self = shift; - - # Localize special variables so that the exit status from waitpid - # doesn't leak out, causing exit status to be incorrect. - local( $., $@, $!, $^E, $? ); - - # Processes never started don't have to be cleaned up in - # any special way. - return unless $self->pid(); - - # If the kill_on_destroy flag is true then - # We need to send a signal to the process - if ($self->kill_on_destroy) { - $self->dprt("Kill on DESTROY"); - if (defined $self->signal_on_destroy) { - $self->kill($self->signal_on_destroy); - } else { - $self->dprt("Sending KILL"); - $self->kill; - } - } - delete $EXIT_STATUS{ $self->pid }; - if( $self->poll() ) { - $DESTROYED{ $self->pid } = 1; - } -} - -###################################################################### - -=item exit_status - -Returns the exit status of the process as the $! variable indicates. -If the process is still running, C is returned. - -=cut - -###################################################################### -# returns the exit status of the child process, undef if the child -# hasn't yet exited -###################################################################### -sub exit_status{ - my( $self ) = @_; - return $EXIT_STATUS{ $self->pid }; -} - -###################################################################### - -=item wait - -The I method: - - $exit_status = $myproc->wait(); - -waits until the process is done and returns its exit status. - -=cut - -###################################################################### -# waits until the child process terminates and then -# returns the exit status of the child process. -###################################################################### -sub wait { - my $self = shift; - - local $SIG{CHLD}; # disable until we're done - - my $pid = $self->pid(); - - # test if the signal handler reap'd this pid some time earlier or even just - # a split second before localizing $SIG{CHLD} above; also kickout if - # they've wait'd or waitpid'd on this pid before ... - - return $EXIT_STATUS{$pid} if defined $EXIT_STATUS{$pid}; - - # all systems support FLAGS==0 (accg to: perldoc -f waitpid) - my $res = waitpid $pid, 0; - my $rc = $?; - - $INTERVAL{$pid}{'t1'} = time(); - $EXIT_STATUS{$pid} = $rc; - dprt("", "For $pid, reaped '$res' with exit_status=$rc"); - - return $rc; -} - -###################################################################### -# Reaps processes, uses the magic WNOHANG constant -###################################################################### -sub THE_REAPER { - - # Localize special variables so that the exit status from waitpid - # doesn't leak out, causing exit status to be incorrect. - local( $., $@, $!, $^E, $? ); - - my $child; - my $now = time(); - - if(defined $WNOHANG) { - # Try to reap every process we've ever started and - # whichs Proc::Simple object hasn't been destroyed. - # - # This is getting really ugly. But if we just call the REAPER - # for every SIG{CHLD} event, code like this will fail: - # - # use Proc::Simple; - # $proc = Proc::Simple->new(); $proc->start(\&func); sleep(5); - # sub func { open(PIPE, "/bin/ls |"); @a = ; sleep(1); - # close(PIPE) or die "PIPE failed"; } - # - # Reason: close() doesn't like it if the spawn has - # been reaped already. Oh well. - # - - # First, check if we can reap the processes which - # went out of business because their kill_on_destroy - # flag was set and their objects were destroyed. - foreach my $pid (keys %DESTROYED) { - if(my $res = waitpid($pid, $WNOHANG) > 0) { - # We reaped a zombie - delete $DESTROYED{$pid}; - dprt("", "Reaped: $pid"); - } - } - - foreach my $pid (keys %EXIT_STATUS) { - dprt("", "Trying to reap $pid"); - if( defined $EXIT_STATUS{$pid} ) { - dprt("", "exit status of $pid is defined - not reaping"); - next; - } - if(my $res = waitpid($pid, $WNOHANG) > 0) { - # We reaped a truly running process - $EXIT_STATUS{$pid} = $?; - $INTERVAL{$pid}{'t1'} = $now; - dprt("", "Reaped: $pid"); - } else { - dprt("", "waitpid returned '$res'"); - } - } - } else { - # If we don't have $WNOHANG, we don't have a choice anyway. - # Just reap everything. - dprt("", "reap everything for lack of WNOHANG"); - $child = CORE::wait(); - $EXIT_STATUS{$child} = $?; - $INTERVAL{$child}{'t1'} = $now; - } - - # Don't reset signal handler for crappy sysV systems. Screw them. - # This caused problems with Irix 6.2 - # $SIG{'CHLD'} = \&THE_REAPER; -} - -###################################################################### - -=item debug - -Switches debug messages on and off -- Proc::Simple::debug(1) switches -them on, Proc::Simple::debug(0) keeps Proc::Simple quiet. - -=cut - -# Proc::Simple::debug($level) - Turn debug on/off -sub debug { $Debug = shift; } - -###################################################################### - -=item cleanup - -Proc::Simple keeps around data of terminated processes, e.g. you can check via -C and C how long a process ran, even if it's long gone. Over time, -this data keeps occupying more and more memory and if you have a long-running -program, you might want to run Ccleanup()> every once in a -while to get rid of data pertaining to processes no longer in use. - -=cut - -sub cleanup { - - for my $pid ( keys %INTERVAL ) { - if( !exists $DESTROYED{ $pid } ) { - # process has been reaped already, safe to delete - # its start/stop time - delete $INTERVAL{ $pid }; - } - } -} - -###################################################################### -# Internal debug print function -###################################################################### -sub dprt { - my $self = shift; - if($Debug) { - require Time::HiRes; - my ($seconds, $microseconds) = Time::HiRes::gettimeofday(); - print "[$seconds.$microseconds] ", ref($self), "> @_\n"; - } -} - -###################################################################### -sub get_system_nohang { -###################################################################### -# This is for getting the WNOHANG constant of the system -- but since -# the waitpid(-1, &WNOHANG) isn't supported on all Unix systems, and -# we still want Proc::Simple to run on every system, we have to -# quietly perform some tests to figure out if -- or if not. -# The function returns the constant, or undef if it's not available. -###################################################################### - my $nohang; - - open(SAVEERR, ">&STDERR"); - - # If the system doesn't even know /dev/null, forget about it. - open(STDERR, ">/dev/null") || return undef; - # Close stderr, since some weirdo POSIX modules write nasty - # error messages - close(STDERR); - - # Check for the constant - eval 'use POSIX ":sys_wait_h"; $nohang = &WNOHANG;'; - - # Re-open STDERR - open(STDERR, ">&SAVEERR"); - close(SAVEERR); - - # If there was an error, return undef - return undef if $@; - - return $nohang; -} - -1; - -__END__ - -=back - -=head1 NOTE - -Please keep in mind that there is no guarantee that the SIGTERM -signal really terminates a process. Processes can have signal -handlers defined that avoid the shutdown. -If in doubt, whether a process still exists, check it -repeatedly with the I routine after sending the signal. - -=head1 Shell Processes - -If you pass a shell program to Proc::Simple, it'll use C to -launch it. As noted in Perl's C manpage, simple commands for -the one-argument version of C will be passed to -C directly, while commands containing characters -like C<;> or C<*> will be passed to a shell to make sure those get -the shell expansion treatment. - -This has the interesting side effect that if you launch something like - - $p->start("./womper *"); - -then you'll see two processes in your process list: - - $ ps auxww | grep womper - mschilli 9126 11:21 0:00 sh -c ./womper * - mschilli 9127 11:21 0:00 /usr/local/bin/perl -w ./womper ... - -A regular C on the process PID would only kill the first -process, but Proc::Simple's C will use a negative signal -and send it to the first process (9126). Since it has marked the -process as a process group leader when it created it previously -(via setsid()), this will cause both processes above to receive the -signal sent by C. - -=head1 Contributors - -Tim Jenness - did kill_on_destroy/signal_on_destroy/pid - -Mark R. Southern - worked on EXIT_STATUS tracking - -Tobias Jahn - added redirection to stdout/stderr - -Clauss Strauch -suggested the multi-arg start()-methods. - -Chip Capelik contributed a patch with the wait() method. - -Jeff Holt provided a patch for time tracking with t0() and t1(). - -Brad Cavanagh fixed RT33440 (unreliable $?) - -=head1 AUTHOR - - 1996, Mike Schilli - -=head1 LICENSE - -Copyright 1996-2011 by Mike Schilli, all rights reserved. -This program is free software, you can redistribute it and/or -modify it under the same terms as Perl itself. - diff --git a/perl/third/Proc-Simple-1.32/eg/parproc.pl b/perl/third/Proc-Simple-1.32/eg/parproc.pl deleted file mode 100755 index a0fb42c..0000000 --- a/perl/third/Proc-Simple-1.32/eg/parproc.pl +++ /dev/null @@ -1,36 +0,0 @@ -#!/usr/local/bin/perl -w -###################################################################### -# parproc.pl -- Sample script, runs 10 jobs, 5 at a time. -# -# From the book Perl Power! (Addison-Wesley) by Michael Schilli 1999 -###################################################################### - -use Proc::Simple; - -$| = 1; # debuffer output -$max_parallel_jobs = 5; # jobs processed in parallel -@running = (); # array of running jobs - -foreach $job (1..9) { # create pseudo jobs - push(@todo, "sleep 3"); -} - -###################################################################### - # while there are jobs to do -while($#todo >= 0 || $#running >= 0) { # or started ones are running - @running = grep { $_->poll() } @running; # remove finished jobs - - if($#running + 1 < $max_parallel_jobs && # space free in running? - defined($job = pop(@todo))) { # ... and job available - - print "Starting job '$job' ... "; - $proc = Proc::Simple->new(); # new process - $proc->start($job) || die "Cannot start job $job"; - push(@running, $proc); # include in running list - - print "STARTED. (Remaining: ", $#todo+1, - " Running: ", $#running + 1, ")\n"; - next; # proceed without delay - } - sleep(1); # pause ... and proceed -} diff --git a/perl/third/Proc-Simple-1.32/t/bin/test-prog b/perl/third/Proc-Simple-1.32/t/bin/test-prog deleted file mode 100755 index 376ce4c..0000000 --- a/perl/third/Proc-Simple-1.32/t/bin/test-prog +++ /dev/null @@ -1,13 +0,0 @@ - -# test perl program - -use FindBin qw($Bin); - -my $testfile = "$Bin/../test-prog-running"; - -open FILE, ">$testfile" or die "Can't open $testfile: $!"; -close FILE; - -$SIG{ TERM } = sub { unlink $testfile; }; - -sleep 30; diff --git a/perl/third/Proc-Simple-1.32/t/destroy.t b/perl/third/Proc-Simple-1.32/t/destroy.t deleted file mode 100644 index 1cef54b..0000000 --- a/perl/third/Proc-Simple-1.32/t/destroy.t +++ /dev/null @@ -1,84 +0,0 @@ -#!/usr/bin/perl -w - -# Test the destructor code -# This test code has two parts: -# i) Fork a perl infinite loop -# Retrieve the process id of the forked process -# Undef the object -# Try to kill the forked process - -# ii)Fork a perl infinite loop -# Retrieve the process id of the forked process -# Set the kill_on_destroy flag -# Undef the object -# Try to kill the forked process - -# In the first test the kill should succeed (since the process -# will still be running. In the second test the kill will fail -# since the destructor will have already killed the process. -# A sleep of 1 is inserted to make sure the kill signal arrives -# and the process shuts down before we check. -# We check the process is running by looking at the return -# value from perl kill. - - -use Proc::Simple; -use Test::More; - -plan tests => 5; - -### -### Simple Test of destroy -### - -### Test code - -$coderef = sub { while (1) { sleep(1) } }; # infinite loop - -$psh = Proc::Simple->new(); - -ok($psh->start($coderef)); # 1 - -# Retrieve the process id (so that we can look for it later) - -my $pid = $psh->pid; - -# Destroy object - process should still be running -undef $psh; - -# Process should still be running - now kill it -# The sleep is here to make the test fair with the -# ond_destroy test later -sleep 2; -ok($result = kill "SIGTERM", $pid); # 2 - -ok($result == 1, "check result"); # 3 -# print "Result should equal 1 if process was killed by us: $result\n"; - -# Now try the same thing with the kill_on_destroy flag set - -$psh = Proc::Simple->new(); - -ok($psh->start($coderef)); # 4 - -# Retrieve the process id (so that we can look for it later) - -my $pid2 = $psh->pid; - -# Set flag -$psh->kill_on_destroy(1); - -# Destroy object - after that, process should terminate -undef $psh; - -# Process should no longer be running -# The sleep makes sure that the process has died by the time -# we get there -$i = 0; -while($i++ < 10) { - last unless kill 0, $pid2; - sleep(1); -} - -# Okay if we returned before the 10 secs expired -ok($i<10); diff --git a/perl/third/Proc-Simple-1.32/t/esub.t b/perl/third/Proc-Simple-1.32/t/esub.t deleted file mode 100755 index 3582320..0000000 --- a/perl/third/Proc-Simple-1.32/t/esub.t +++ /dev/null @@ -1,33 +0,0 @@ -#!/usr/bin/perl -w - -use Proc::Simple; - -package EmptySubclass; -@ISA = qw(Proc::Simple); -1; - - -package Main; -use Test::More; -plan tests => 3; - -### -### Empty Subclass test -### -# Proc::Simple::debug(1); - -$psh = EmptySubclass->new(); - -ok($psh->start("sleep 10")); # 1 - -while(!$psh->poll) { - sleep 1; } - -ok($psh->kill()) or die; # 2 - -while($psh->poll) { - sleep 1; } - -ok(1, "the end"); - -1; diff --git a/perl/third/Proc-Simple-1.32/t/exit.t b/perl/third/Proc-Simple-1.32/t/exit.t deleted file mode 100755 index 87bae06..0000000 --- a/perl/third/Proc-Simple-1.32/t/exit.t +++ /dev/null @@ -1,37 +0,0 @@ -#!/usr/bin/perl -w -################################################## -# Check the exit status feature -################################################## - -use Proc::Simple; -use Test::More; -plan tests => 1; - -#Proc::Simple::debug(1); - -$proc = Proc::Simple->new(); - -$proc->start("ls . >/dev/null"); -while($proc->poll()) { - sleep(1); -} - -if(defined $proc->exit_status()) { - $stat = $proc->exit_status(); -} else { - $stat = "undef"; -} -Proc::Simple->dprt("EXIT: '$stat'"); - -open PIPE, "ls |" or die "Cannot open pipe"; -my $data = ; -close PIPE or die "Cannot close pipe"; - -if(defined $proc->exit_status()) { - $stat = $proc->exit_status(); -} else { - $stat = "undef"; -} -Proc::Simple->dprt("EXIT: '$stat'"); - -is $stat, 0, "stat 0"; diff --git a/perl/third/Proc-Simple-1.32/t/muarg.t b/perl/third/Proc-Simple-1.32/t/muarg.t deleted file mode 100755 index f380c77..0000000 --- a/perl/third/Proc-Simple-1.32/t/muarg.t +++ /dev/null @@ -1,20 +0,0 @@ -#!/usr/bin/perl -w - -use Proc::Simple; -use Test::More; - -plan tests => 4; - -$psh = Proc::Simple->new(); - -ok($psh->start("sleep", "1")); # 1 -while($psh->poll) { - sleep 1; } -ok(!$psh->poll()); # 2 Must be dead - -sub mysleep { sleep(@_); } - -ok($psh->start(\&mysleep, 1)); # 3 -while($psh->poll) { - sleep 1; } -ok(!$psh->poll()); # 4 Must have been terminated diff --git a/perl/third/Proc-Simple-1.32/t/mult.t b/perl/third/Proc-Simple-1.32/t/mult.t deleted file mode 100755 index e786c3b..0000000 --- a/perl/third/Proc-Simple-1.32/t/mult.t +++ /dev/null @@ -1,33 +0,0 @@ -#!/usr/bin/perl -w - -use Proc::Simple; -use Test::More; -plan tests => 80; - -### -### Multiple Processes Test -### -#Proc::Simple->debug(1); - -foreach $i (0..19) { - $psh[$i] = Proc::Simple->new(); -} - -foreach $i (@psh) { - ok($i->start("sleep 60")); # 1-20 -} - -foreach $i (@psh) { - while(!$i->poll) { - sleep 1; } - ok($i->poll()); # Check each process, kill it - ok($i->kill()); # and check again: 21-80 - while($i->poll) { - sleep 1; } - ok(!$i->poll()); -} - -Proc::Simple->cleanup(); - -1; - diff --git a/perl/third/Proc-Simple-1.32/t/sh-c.t b/perl/third/Proc-Simple-1.32/t/sh-c.t deleted file mode 100755 index 4bc25eb..0000000 --- a/perl/third/Proc-Simple-1.32/t/sh-c.t +++ /dev/null @@ -1,53 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Proc::Simple; -use Test::More; -use FindBin qw($Bin); - -my $runfile = "$Bin/test-prog-running"; - -plan tests => 3; - -unlink $runfile; # cleanup leftover from previous runs - -my $psh = Proc::Simple->new(); - - # contains a wildcard, so will be launched via sh -c -$psh->start("$^X $Bin/bin/test-prog *"); - -while( ! $psh->poll() ) { - # diag "waiting for process to start"; - sleep 1; -} - -ok 1, "process is up"; - - # wait for shell to spawn perl process -while( !-f $runfile ) { - # diag "waiting for process to create runfile $runfile"; - sleep 1; -} - -$psh->kill(); - -while( $psh->poll() ) { - # diag "waiting for process to shut down"; - sleep 1; -} - -ok 1, "process is down"; - -# as pointed out in [rt.cpan.org #69782], at this point, the grandchild -# might not have terminated yet or deleted the runfile, although its -# parent (the shell process) is gone. Allow 10 seconds max. -for(1..10) { - if( !-f "$Bin/test-prog-running" ) { - last; - } - sleep 1; -} - -ok !-f "$Bin/test-prog-running", "running file unlinked"; - -1; diff --git a/perl/third/Proc-Simple-1.32/t/simple.t b/perl/third/Proc-Simple-1.32/t/simple.t deleted file mode 100755 index bb7ce9c..0000000 --- a/perl/third/Proc-Simple-1.32/t/simple.t +++ /dev/null @@ -1,54 +0,0 @@ -#!/usr/bin/perl -w - -use Proc::Simple; - -package EmptySubclass; -@ISA = qw(Proc::Simple); -1; - -package Main; -use Test::More; - -plan tests => 10; - -### -### Simple Test -### - -### Shell commands - -# Proc::Simple::debug(1); -$psh = Proc::Simple->new(); - -ok($psh->start("sleep 1")); # 1 -while($psh->poll) { - sleep 1; } -ok(!$psh->poll()); # 2 Must have been terminated - -ok($psh->start("sleep 10")); # 3 -while(!$psh->poll) { - sleep 1; } -ok($psh->kill()); # 4 -while($psh->poll) { - sleep 1; } -ok(!$psh->poll()); # 5 Must have been terminated - - -### Perl subroutines -$psub = Proc::Simple->new(); - -ok($psub->start(sub { sleep 1 })); # 6 -while($psub->poll) { - sleep 1; } -ok(!$psub->poll()); # 7 Must have been terminated - -ok($psub->start(sub { sleep 10 })); # 8 -while(!$psub->poll) { - sleep 1; } - -ok($psub->kill("SIGTERM")); # 9 -while($psub->poll) { - sleep 1; } -ok(!$psub->poll()); # 10 Must have been terminated - -1; diff --git a/perl/third/Proc-Simple-1.32/t/stdouterr.t b/perl/third/Proc-Simple-1.32/t/stdouterr.t deleted file mode 100755 index 8a079bb..0000000 --- a/perl/third/Proc-Simple-1.32/t/stdouterr.t +++ /dev/null @@ -1,30 +0,0 @@ -#!/usr/bin/perl -w - -use Proc::Simple; -use Test::More; - -plan tests => 2; - -sub test_output { - print "hello stdout\n"; - print STDERR "hello stderr\n"; -} - -my $p = Proc::Simple->new(); -$p->redirect_output ("stdout.txt", "stderr.txt"); -$p->start(\&test_output); -while($p->poll()) { -} - -open FILE, "; -close FILE; - -open FILE, "; -close FILE; - -is $stderr, "hello stderr\n", "hello stderr"; -is $stdout, "hello stdout\n", "hello stdout"; - -unlink("stdout.txt", "stderr.txt"); diff --git a/perl/third/Proc-Simple-1.32/t/time.t b/perl/third/Proc-Simple-1.32/t/time.t deleted file mode 100644 index 025abb0..0000000 --- a/perl/third/Proc-Simple-1.32/t/time.t +++ /dev/null @@ -1,38 +0,0 @@ -#!/usr/bin/perl -w -################################################## -# Check the exit status feature -################################################## - -use Test::More tests => 9; -use Proc::Simple; - -#Proc::Simple::debug(1); - -my $errortolerance = 2; # this is necessary if the system under test is quite busy -my $proc = Proc::Simple->new(); - -my $t0 = time(); -my $start_rc = $proc->start("sleep 5"); -ok($start_rc, 'start'); - -my $wait_rc = $proc->wait(); -my $t1 = time(); -ok(! $proc->poll(), "process has exited"); -ok(defined $wait_rc, "wait_rc defined"); - -my $exit_rc = $proc->exit_status(); -ok(defined $exit_rc, "exit_rc defined"); - -ok(defined $proc->t0, "t0 defined"); -ok(defined $proc->t1, "t1 defined"); - -my $t0diff = abs($proc->t0 - $t0); -ok($t0diff <= $errortolerance, "t0-proc->t0 <= $errortolerance"); - -my $t1diff = abs($proc->t1 - $t1); -ok($t1diff <= $errortolerance, "t1-proc->t1 <= $errortolerance"); - -my $actela = $t1 - $t0; -my $pmela = $proc->t1 - $proc->t0; -my $eladiff = abs($actela - $pmela); -ok($eladiff < $errortolerance, "eladiff <= $errortolerance"); diff --git a/perl/third/Proc-Simple-1.32/t/wait.t b/perl/third/Proc-Simple-1.32/t/wait.t deleted file mode 100644 index ab21d4e..0000000 --- a/perl/third/Proc-Simple-1.32/t/wait.t +++ /dev/null @@ -1,21 +0,0 @@ -#!/usr/bin/perl -w -################################################## -# Check the exit status feature -################################################## - -use Test::More tests => 4; -use Proc::Simple; - -#Proc::Simple::debug(1); - -my $proc = Proc::Simple->new(); - -my $start_rc = $proc->start("sleep 1"); -ok($start_rc, 'start'); - -my $wait_rc = $proc->wait(); -ok(! $proc->poll(), "process has exited"); -ok(defined $wait_rc, "wait_rc defined"); - -my $exit_rc = $proc->exit_status(); -ok(defined $exit_rc, "exit_rc defined"); diff --git a/perl/third/Shuffle-1.4/.cvsignore b/perl/third/Shuffle-1.4/.cvsignore deleted file mode 100644 index 0b5bd39..0000000 --- a/perl/third/Shuffle-1.4/.cvsignore +++ /dev/null @@ -1,3 +0,0 @@ -Makefile -blib -pm_to_blib diff --git a/perl/third/Shuffle-1.4/MANIFEST b/perl/third/Shuffle-1.4/MANIFEST deleted file mode 100644 index fe1432e..0000000 --- a/perl/third/Shuffle-1.4/MANIFEST +++ /dev/null @@ -1,4 +0,0 @@ -MANIFEST -Makefile.PL -Shuffle.pm -test.pl diff --git a/perl/third/Shuffle-1.4/Makefile.PL b/perl/third/Shuffle-1.4/Makefile.PL deleted file mode 100644 index 1d58b61..0000000 --- a/perl/third/Shuffle-1.4/Makefile.PL +++ /dev/null @@ -1,7 +0,0 @@ -use ExtUtils::MakeMaker; -# See lib/ExtUtils/MakeMaker.pm for details of how to influence -# the contents of the Makefile that is written. -WriteMakefile( - 'NAME' => 'Algorithm::Numerical::Shuffle', - 'VERSION_FROM' => 'Shuffle.pm', # finds $VERSION -); diff --git a/perl/third/Shuffle-1.4/Shuffle.pm b/perl/third/Shuffle-1.4/Shuffle.pm deleted file mode 100644 index c8db2cd..0000000 --- a/perl/third/Shuffle-1.4/Shuffle.pm +++ /dev/null @@ -1,178 +0,0 @@ -package Algorithm::Numerical::Shuffle; - -################################################################################ -# -# $Author: abigail $ -# -# $Date: 2000/03/08 05:57:40 $ -# -# $Id: Shuffle.pm,v 1.4 2000/03/08 05:57:40 abigail Exp abigail $ -# -# $Log: Shuffle.pm,v $ -# Revision 1.4 2000/03/08 05:57:40 abigail -# Fixed bug that prevented in situ shuffling. -# Changed the wording of the license once again. (MIT/X style) -# -# Revision 1.3 1999/03/01 20:54:06 abigail -# Changed package name to Algorithm::* -# Changed license. -# -# Revision 1.2 1998/09/09 20:48:12 abigail -# - Make shuffle() work with empty lists. -# - Changed license to Artistic only. -# -# Revision 1.1 1998/04/23 17:58:07 abigail -# Initial revision -# -# -# -################################################################################ - -use strict; -use Exporter; - - -use vars qw /$VERSION @ISA @EXPORT @EXPORT_OK/; - -@ISA = qw /Exporter/; -@EXPORT = qw //; -@EXPORT_OK = qw /shuffle/; - -($VERSION) = '$Revision: 1.4 $' =~ /(\d+\.\d+)/; - -sub shuffle { - return @_ if !@_ || ref $_ [0] eq 'ARRAY' && !@{$_ [0]}; - my $array = @_ == 1 && ref $_ [0] eq 'ARRAY' ? shift : [@_]; - for (my $i = @$array; -- $i;) { - my $r = int rand ($i + 1); - ($array -> [$i], $array -> [$r]) = ($array -> [$r], $array -> [$i]); - } - wantarray ? @$array : $array; -} - - -__END__ - -=head1 NAME - -Algorithm::Numerical::Shuffle - Shuffle a list. - -=head1 SYNOPSIS - - use Algorithm::Numerical::Shuffle qw /shuffle/; - - @shuffled = shuffle (1, 2, 3, 4, 5, 6, 7); - - $in_situ = [qw /one two three four five six/]; - shuffle $in_situ; - -=head1 DESCRIPTION - -C performs a one pass, fair shuffle on a list. If the list is -passed as a reference to an array, the shuffle is done in situ. - -The subroutine returns the list in list context, and a reference to -the list in scalar context. - -=head1 COMPLEXITY - -The running time of the algorithm is linear in the size of the list. -For an in situ shuffle, the memory overhead is constant; otherwise, -linear extra memory is used. - -=head1 LITERATURE - -The algorithm used is discussed by Knuth [3]. It was first published -by Fisher and Yates [2], and later by Durstenfeld [1]. - -=head1 CAVEAT - -Salfi [4] points to a big caveat. If the outcome of a random generator -is solely based on the value of the previous outcome, like a linear -congruential method, then the outcome of a shuffle depends on exactly -three things: the shuffling algorithm, the input and the seed of the -random generator. Hence, for a given list and a given algorithm, the -outcome of the shuffle is purely based on the seed. Many modern computers -have 32 bit random numbers, hence a 32 bit seed. Hence, there are at -most 2^32 possible shuffles of a list, foreach of the possible algorithms. -But for a list of n elements, there are n! possible permutations. -Which means that a shuffle of a list of 13 elements will not generate -certain permutations, as 13! > 2^32. - -=head1 REFERENCES - -=over - -=item [1] - -R. Durstenfeld: I, B<7>, 1964. pp 420. - -=item [2] - -R. A. Fisher and F. Yates: I. London, 1938. -Example 12. - -=item [3] - -D. E. Knuth: I, Volume 2, Third edition. -Section 3.4.2, Algorithm P, pp 145. Reading: Addison-Wesley, 1997. -ISBN: 0-201-89684-2. - -=item [4] - -R. Salfi: I. Vienna: 1974, pp 28 - 35. - -=back - -=head1 HISTORY - - $Date: 2000/03/08 05:57:40 $ - - $Log: Shuffle.pm,v $ - Revision 1.4 2000/03/08 05:57:40 abigail - Fixed bug that prevented in situ shuffling. - Changed the wording of the license once again. (MIT/X style) - - Revision 1.3 1999/03/01 20:54:06 abigail - Changed package name to Algorithm::* - Changed license. - - Revision 1.2 1998/09/09 20:48:12 abigail - - Make shuffle() work with empty lists. - - Changed license to Artistic only. - - Revision 1.1 1998/04/23 17:58:07 abigail - Initial revision - - -=head1 AUTHOR - -This package was written by Abigail. - -=head1 COPYRIGHT - -Copyright 1998, 1999, 2000 by Abigail. - -=head1 LICENSE - -This program is copyright 1998-2000 by Abigail. - -Permission is hereby granted, free of charge, to any person obtaining a -copy of this software and associated documentation files (the "Software"), -to deal in the Software without restriction, including without limitation -the rights to use, copy, modify, merge, publish, distribute, sublicense, -and/or sell copies of the Software, and to permit persons to whom the -Software is furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included -in all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -THE AUTHOR BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, -WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT -OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN -THE SOFTWARE. - -=cut diff --git a/perl/third/Shuffle-1.4/test.pl b/perl/third/Shuffle-1.4/test.pl deleted file mode 100644 index de26629..0000000 --- a/perl/third/Shuffle-1.4/test.pl +++ /dev/null @@ -1,79 +0,0 @@ -# Before `make install' is performed this script should be runnable with -# `make test'. After `make install' it should work as `perl test.pl' - -######################### We start with some black magic to print on failure. - -# Change 1..1 below to 1..last_test_to_print . -# (It may become useful if the test is moved to ./t subdirectory.) - -BEGIN { $| = 1; print "1..5\n"; } -END {print "not ok 1\n" unless $loaded;} -use Algorithm::Numerical::Shuffle qw /shuffle/; -$loaded = 1; -print "ok 1\n"; - -######################### End of black magic. - -# Insert your test code below (better if it prints "ok 13" -# (correspondingly "not ok 13") depending on the success of chunk 13 -# of the test code): - -my $test_num = 2; - -eval { - my @a = shuffle (); - if (@a) { - print "not ok ", $test_num ++, "\n"; - } - else { - print "ok ", $test_num ++, "\n"; - } -}; - -if ($@) {print "... error: $@\n";} - -eval { - my $a = []; - shuffle $a; - - if (@$a) { - print "not ok ", $test_num ++, "\n"; - } - else { - print "ok ", $test_num ++, "\n"; - } -}; - -if ($@) {print "... error: $@\n";} - -eval { - my @a = (0 .. 9); - my @b = shuffle @a; - my @c = sort {$a <=> $b} @b; - - if (@a != @c || "@a" != "@c") { - print "not ok ", $test_num ++, "\n"; - } - else { - print "ok ", $test_num ++, "\n"; - } -}; - -if ($@) {print "... error: $@\n";} - -eval { - my $A = [0 .. 9]; - my $B = [0 .. 9]; - shuffle $B; - my @C = sort {$a <=> $b} @$B; - - if (@$A != @C || "@$A" != "@C") { - print "not ok ", $test_num ++, "\n"; - } - else { - print "ok ", $test_num ++, "\n"; - } -}; - -if ($@) {print "... error: $@\n";} - diff --git a/perl/third/Test-Unit-0.25/AUTHORS b/perl/third/Test-Unit-0.25/AUTHORS deleted file mode 100644 index 4804ac4..0000000 --- a/perl/third/Test-Unit-0.25/AUTHORS +++ /dev/null @@ -1,70 +0,0 @@ -# PerlUnit was originally written as a port of Kent Beck and Erich -# Gamma's xUnit testing framework by Christian Lemburg and Brian -# Ewins, and is now maintained by Adam Spiers and the rest of the -# PerlUnit team. -# -# The following is an alphabetical list of all the people who've -# contributed code and effort to making PerlUnit what it is today. -# Where possible we have included their Sourceforge usernames and -# preferred email addresses. -# -# The use of this database for anything other than PerlUnit -# development is strictly forbidden. (Passive distribution with the -# PerlUnit source code package is naturally allowed) - -Adam Spiers adamspiers -Brian Ewins ba22a -Cayte Linder cayte -Christian Lemburg clemburg -David Esposito davide -J.E. Fritz jefritz -Kevin Connor wallisalviar -Matthew Astley mca1001 (was mca-gdl) -Michael Schwern/Test::More project for the deep structure comparison routines -Piers Cawley pdcawley -Zhon Johansen zhon - - - -As far as copyright years go (as if anyone cares), this may serve as a -vague starting guide for who put together the bulk of the project: - - 2000 ba22a, clemburg - 2001 clemburg, pdcawley - 2002 adamspiers, pdcawley - -Where specific files in the project have been contributed by one -person and that person has claimed the copyright, I have left their -authorship. - -The rest of the files have moved over to a more boilerplate style -crediting the PerlUnit Development Team and referring to the -Test::Unit docs and this file. This is simply for maintenance sanity. - - - - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself: - ------------------------------------------------------------------------------- - Perl copyright: ------------------------------------------------------------------------------- - Copyright 1989-2001, Larry Wall All rights reserved. - - This program is free software; you can redistribute it and/or modify - it under the terms of either: - - a) the GNU General Public License as published by the Free Software - Foundation; either version 1, or (at your option) any later - version, or - - b) the "Artistic License" which comes with Perl. - ------------------------------------------------------------------------------- - -The GNU GPL version 2 is included here in the file COPYING.GPL-2 . -You may use version 1 instead, but it has been superceded for good -reasons... - -The Artistic License is included here in the file COPYING.Artistic diff --git a/perl/third/Test-Unit-0.25/COPYING.Artistic b/perl/third/Test-Unit-0.25/COPYING.Artistic deleted file mode 100644 index 5f22124..0000000 --- a/perl/third/Test-Unit-0.25/COPYING.Artistic +++ /dev/null @@ -1,131 +0,0 @@ - - - - - The "Artistic License" - - Preamble - -The intent of this document is to state the conditions under which a -Package may be copied, such that the Copyright Holder maintains some -semblance of artistic control over the development of the package, -while giving the users of the package the right to use and distribute -the Package in a more-or-less customary fashion, plus the right to make -reasonable modifications. - -Definitions: - - "Package" refers to the collection of files distributed by the - Copyright Holder, and derivatives of that collection of files - created through textual modification. - - "Standard Version" refers to such a Package if it has not been - modified, or has been modified in accordance with the wishes - of the Copyright Holder as specified below. - - "Copyright Holder" is whoever is named in the copyright or - copyrights for the package. - - "You" is you, if you're thinking about copying or distributing - this Package. - - "Reasonable copying fee" is whatever you can justify on the - basis of media cost, duplication charges, time of people involved, - and so on. (You will not be required to justify it to the - Copyright Holder, but only to the computing community at large - as a market that must bear the fee.) - - "Freely Available" means that no fee is charged for the item - itself, though there may be fees involved in handling the item. - It also means that recipients of the item may redistribute it - under the same conditions they received it. - -1. You may make and give away verbatim copies of the source form of the -Standard Version of this Package without restriction, provided that you -duplicate all of the original copyright notices and associated disclaimers. - -2. You may apply bug fixes, portability fixes and other modifications -derived from the Public Domain or from the Copyright Holder. A Package -modified in such a way shall still be considered the Standard Version. - -3. You may otherwise modify your copy of this Package in any way, provided -that you insert a prominent notice in each changed file stating how and -when you changed that file, and provided that you do at least ONE of the -following: - - a) place your modifications in the Public Domain or otherwise make them - Freely Available, such as by posting said modifications to Usenet or - an equivalent medium, or placing the modifications on a major archive - site such as uunet.uu.net, or by allowing the Copyright Holder to include - your modifications in the Standard Version of the Package. - - b) use the modified Package only within your corporation or organization. - - c) rename any non-standard executables so the names do not conflict - with standard executables, which must also be provided, and provide - a separate manual page for each non-standard executable that clearly - documents how it differs from the Standard Version. - - d) make other distribution arrangements with the Copyright Holder. - -4. You may distribute the programs of this Package in object code or -executable form, provided that you do at least ONE of the following: - - a) distribute a Standard Version of the executables and library files, - together with instructions (in the manual page or equivalent) on where - to get the Standard Version. - - b) accompany the distribution with the machine-readable source of - the Package with your modifications. - - c) give non-standard executables non-standard names, and clearly - document the differences in manual pages (or equivalent), together - with instructions on where to get the Standard Version. - - d) make other distribution arrangements with the Copyright Holder. - -5. You may charge a reasonable copying fee for any distribution of this -Package. You may charge any fee you choose for support of this -Package. You may not charge a fee for this Package itself. However, -you may distribute this Package in aggregate with other (possibly -commercial) programs as part of a larger (possibly commercial) software -distribution provided that you do not advertise this Package as a -product of your own. You may embed this Package's interpreter within -an executable of yours (by linking); this shall be construed as a mere -form of aggregation, provided that the complete Standard Version of the -interpreter is so embedded. - -6. The scripts and library files supplied as input to or produced as -output from the programs of this Package do not automatically fall -under the copyright of this Package, but belong to whoever generated -them, and may be sold commercially, and may be aggregated with this -Package. If such scripts or library files are aggregated with this -Package via the so-called "undump" or "unexec" methods of producing a -binary executable image, then distribution of such an image shall -neither be construed as a distribution of this Package nor shall it -fall under the restrictions of Paragraphs 3 and 4, provided that you do -not represent such an executable image as a Standard Version of this -Package. - -7. C subroutines (or comparably compiled subroutines in other -languages) supplied by you and linked into this Package in order to -emulate subroutines and variables of the language defined by this -Package shall not be considered part of this Package, but are the -equivalent of input as in Paragraph 6, provided these subroutines do -not change the language in any way that would cause it to fail the -regression tests for the language. - -8. Aggregation of this Package with a commercial distribution is always -permitted provided that the use of this Package is embedded; that is, -when no overt attempt is made to make this Package's interfaces visible -to the end user of the commercial distribution. Such use shall not be -construed as a distribution of this Package. - -9. The name of the Copyright Holder may not be used to endorse or promote -products derived from this software without specific prior written permission. - -10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR -IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED -WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. - - The End diff --git a/perl/third/Test-Unit-0.25/COPYING.GPL-2 b/perl/third/Test-Unit-0.25/COPYING.GPL-2 deleted file mode 100644 index d60c31a..0000000 --- a/perl/third/Test-Unit-0.25/COPYING.GPL-2 +++ /dev/null @@ -1,340 +0,0 @@ - GNU GENERAL PUBLIC LICENSE - Version 2, June 1991 - - Copyright (C) 1989, 1991 Free Software Foundation, Inc. - 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -License is intended to guarantee your freedom to share and change free -software--to make sure the software is free for all its users. This -General Public License applies to most of the Free Software -Foundation's software and to any other program whose authors commit to -using it. (Some other Free Software Foundation software is covered by -the GNU Library General Public License instead.) You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -this service if you wish), that you receive source code or can get it -if you want it, that you can change the software or use pieces of it -in new free programs; and that you know you can do these things. - - To protect your rights, we need to make restrictions that forbid -anyone to deny you these rights or to ask you to surrender the rights. -These restrictions translate to certain responsibilities for you if you -distribute copies of the software, or if you modify it. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must give the recipients all the rights that -you have. You must make sure that they, too, receive or can get the -source code. And you must show them these terms so they know their -rights. - - We protect your rights with two steps: (1) copyright the software, and -(2) offer you this license which gives you legal permission to copy, -distribute and/or modify the software. - - Also, for each author's protection and ours, we want to make certain -that everyone understands that there is no warranty for this free -software. If the software is modified by someone else and passed on, we -want its recipients to know that what they have is not the original, so -that any problems introduced by others will not reflect on the original -authors' reputations. - - Finally, any free program is threatened constantly by software -patents. We wish to avoid the danger that redistributors of a free -program will individually obtain patent licenses, in effect making the -program proprietary. To prevent this, we have made it clear that any -patent must be licensed for everyone's free use or not licensed at all. - - The precise terms and conditions for copying, distribution and -modification follow. - - GNU GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. This License applies to any program or other work which contains -a notice placed by the copyright holder saying it may be distributed -under the terms of this General Public License. The "Program", below, -refers to any such program or work, and a "work based on the Program" -means either the Program or any derivative work under copyright law: -that is to say, a work containing the Program or a portion of it, -either verbatim or with modifications and/or translated into another -language. (Hereinafter, translation is included without limitation in -the term "modification".) Each licensee is addressed as "you". - -Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running the Program is not restricted, and the output from the Program -is covered only if its contents constitute a work based on the -Program (independent of having been made by running the Program). -Whether that is true depends on what the Program does. - - 1. You may copy and distribute verbatim copies of the Program's -source code as you receive it, in any medium, provided that you -conspicuously and appropriately publish on each copy an appropriate -copyright notice and disclaimer of warranty; keep intact all the -notices that refer to this License and to the absence of any warranty; -and give any other recipients of the Program a copy of this License -along with the Program. - -You may charge a fee for the physical act of transferring a copy, and -you may at your option offer warranty protection in exchange for a fee. - - 2. You may modify your copy or copies of the Program or any portion -of it, thus forming a work based on the Program, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: - - a) You must cause the modified files to carry prominent notices - stating that you changed the files and the date of any change. - - b) You must cause any work that you distribute or publish, that in - whole or in part contains or is derived from the Program or any - part thereof, to be licensed as a whole at no charge to all third - parties under the terms of this License. - - c) If the modified program normally reads commands interactively - when run, you must cause it, when started running for such - interactive use in the most ordinary way, to print or display an - announcement including an appropriate copyright notice and a - notice that there is no warranty (or else, saying that you provide - a warranty) and that users may redistribute the program under - these conditions, and telling the user how to view a copy of this - License. (Exception: if the Program itself is interactive but - does not normally print such an announcement, your work based on - the Program is not required to print an announcement.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Program, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Program, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote it. - -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Program. - -In addition, mere aggregation of another work not based on the Program -with the Program (or with a work based on the Program) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - - 3. You may copy and distribute the Program (or a work based on it, -under Section 2) in object code or executable form under the terms of -Sections 1 and 2 above provided that you also do one of the following: - - a) Accompany it with the complete corresponding machine-readable - source code, which must be distributed under the terms of Sections - 1 and 2 above on a medium customarily used for software interchange; or, - - b) Accompany it with a written offer, valid for at least three - years, to give any third party, for a charge no more than your - cost of physically performing source distribution, a complete - machine-readable copy of the corresponding source code, to be - distributed under the terms of Sections 1 and 2 above on a medium - customarily used for software interchange; or, - - c) Accompany it with the information you received as to the offer - to distribute corresponding source code. (This alternative is - allowed only for noncommercial distribution and only if you - received the program in object code or executable form with such - an offer, in accord with Subsection b above.) - -The source code for a work means the preferred form of the work for -making modifications to it. For an executable work, complete source -code means all the source code for all modules it contains, plus any -associated interface definition files, plus the scripts used to -control compilation and installation of the executable. However, as a -special exception, the source code distributed need not include -anything that is normally distributed (in either source or binary -form) with the major components (compiler, kernel, and so on) of the -operating system on which the executable runs, unless that component -itself accompanies the executable. - -If distribution of executable or object code is made by offering -access to copy from a designated place, then offering equivalent -access to copy the source code from the same place counts as -distribution of the source code, even though third parties are not -compelled to copy the source along with the object code. - - 4. You may not copy, modify, sublicense, or distribute the Program -except as expressly provided under this License. Any attempt -otherwise to copy, modify, sublicense or distribute the Program is -void, and will automatically terminate your rights under this License. -However, parties who have received copies, or rights, from you under -this License will not have their licenses terminated so long as such -parties remain in full compliance. - - 5. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Program or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Program (or any work based on the -Program), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Program or works based on it. - - 6. Each time you redistribute the Program (or any work based on the -Program), the recipient automatically receives a license from the -original licensor to copy, distribute or modify the Program subject to -these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties to -this License. - - 7. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Program at all. For example, if a patent -license would not permit royalty-free redistribution of the Program by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Program. - -If any portion of this section is held invalid or unenforceable under -any particular circumstance, the balance of the section is intended to -apply and the section as a whole is intended to apply in other -circumstances. - -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system, which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. - -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. - - 8. If the distribution and/or use of the Program is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Program under this License -may add an explicit geographical distribution limitation excluding -those countries, so that distribution is permitted only in or among -countries not thus excluded. In such case, this License incorporates -the limitation as if written in the body of this License. - - 9. The Free Software Foundation may publish revised and/or new versions -of the General Public License from time to time. Such new versions will -be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - -Each version is given a distinguishing version number. If the Program -specifies a version number of this License which applies to it and "any -later version", you have the option of following the terms and conditions -either of that version or of any later version published by the Free -Software Foundation. If the Program does not specify a version number of -this License, you may choose any version ever published by the Free Software -Foundation. - - 10. If you wish to incorporate parts of the Program into other free -programs whose distribution conditions are different, write to the author -to ask for permission. For software which is copyrighted by the Free -Software Foundation, write to the Free Software Foundation; we sometimes -make exceptions for this. Our decision will be guided by the two goals -of preserving the free status of all derivatives of our free software and -of promoting the sharing and reuse of software generally. - - NO WARRANTY - - 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY -FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN -OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES -PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED -OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS -TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE -PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, -REPAIR OR CORRECTION. - - 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR -REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, -INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING -OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED -TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY -YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER -PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE -POSSIBILITY OF SUCH DAMAGES. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -convey the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - -Also add information on how to contact you by electronic and paper mail. - -If the program is interactive, make it output a short notice like this -when it starts in an interactive mode: - - Gnomovision version 69, Copyright (C) year name of author - Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, the commands you use may -be called something other than `show w' and `show c'; they could even be -mouse-clicks or menu items--whatever suits your program. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the program, if -necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the program - `Gnomovision' (which makes passes at compilers) written by James Hacker. - - , 1 April 1989 - Ty Coon, President of Vice - -This General Public License does not permit incorporating your program into -proprietary programs. If your program is a subroutine library, you may -consider it more useful to permit linking proprietary applications with the -library. If this is what you want to do, use the GNU Library General -Public License instead of this License. diff --git a/perl/third/Test-Unit-0.25/ChangeLog b/perl/third/Test-Unit-0.25/ChangeLog deleted file mode 100644 index 0f8e9e9..0000000 --- a/perl/third/Test-Unit-0.25/ChangeLog +++ /dev/null @@ -1,1335 +0,0 @@ -2005-10-15 Matthew Astley - - * doc/release-checklist, doc/TODO, ChangeLog: updates for release - - * lib/Test/Unit.pm: version 0.25 - - * MANIFEST: add licence and class-diagram files, remove old - exmample; keep in "make manifest" generated order - - * t/tlib/AssertTest.pm (test_fail_assert_not_null): extra check, - for SF bug #610499 - - * lib/Test/Unit/Assert.pm (assert_deep_equals): fix comparisons of - cyclic structures (thanks flacoste, SF patch #678422), comparisons - of undefs (thanks flacoste, Debian BTS #249678), comparison of - SCALAR refs - - * t/tlib/AssertTest.pm (test_assert_deep_equals): add modified - test from SF bug #1012115; modified test from flacoste's SF patch - #678422; more tests on SCALAR refs, and improve the regexp - -2005-08-19 Matthew Astley - - * doc/TODO: notes on HarnessUnit, UnitHarness; more on stuff I'd - like to do later - - * examples/README: minor update - -2005-08-03 Matthew Astley - - * doc/class-diagram.{dia,txt,png}: first stab at a UML class - diagram, see how it goes - -2005-08-01 Matthew Astley - - * lib/Test/Unit.pm, lib/Test/Unit/TkTestRunner.pm, lib/Test/Unit/TestRunner.pm: - put links to COPYING.* in Test::Unit; move copyright notices from - testrunner modules to Test::Unit - - * lib/Test/Unit/, t/tlib/AllTests.pm: set AUTHOR POD - sections to the same boilerplate, in files that don't appear to be - single-author -- as described in the top level AUTHORS file - - * AUTHORS: update authors list with SF ids and what I found while - boilerplating the PODs; add explicit copy of the Perl licence, - taken from Debian perl-base package v5.8.4-2 - - * COPYING.Artistic, COPYING.GPL-2: licences copied from Debian - base-files package v3.0.12 - -2005-07-31 Matthew Astley - - * lib/Test/Unit/Assert.pm (is_numeric): change the test to match - only lone numbers. fix SF bug#1014540 - - *** NB. this causes assert_equals to switch from assert_num_equals - to assert_str_equals in some cases - - * t/tlib/AssertTest.pm (test_numericness, test_assert_equals): - tests for new is_numeric - - - * lib/Test/Unit/TkTestRunner.pm: make "Show..." dialog text expand - with window and include annotations. fixes SF bug#1018619 - - * t/try_examples.t: clear out useless 'use lib's; remove dup $^O - check; fix RT bug#3963 (thanks ILYAM); improve skipping of - untested items - - * examples/tester.png: update screenshot of Tk test runner; mark - as binary - - * examples/tester.pl: remove old Tk code - Test::SuiteWrapper went - away 2000-02-21 - -2005-07-30 Matthew Astley - - * t/try_examples.t: - Fix SF bug#908422 (track changing testing output format); - Thanks: dholland, eksiegerman - [aka. SF bug#1245490, RT bug#2244] - - * .cvsignore: ignore build stuff - - - -- other changes Adam made since REL_0_24, but aren't mentioned - already. I list them partly so I know where my towel is: - - * AUTHORS: Adam became maintainer - - * doc/TODO: updated - - * lib/Test/Unit/Decorator.pm: some minor change I've not investigated - - * lib/Test/Unit/Procedural.pm: - fix bug spotted by Matthias Ferber (and Ken) in run() (which is - usually overridden) [SF bug#760491, RT bug#3058] - - * lib/Test/Unit/Runner.pm: improve filtering, POD - - * lib/Test/Unit/TestCase.pm: POD for filtering - - * t/tlib/RunnerTest.pm: new test for T:U:TestRunner, just tests - filtering; uses the new t/tlib/FilteredSuite.pm - -2002-06-20 Adam Spiers - - * lib/Test/Unit/TestCase.pm: document new filtering via coderefs - - * MANIFEST, lib/Test/Unit/Test.pm, lib/Test/Unit/TestSuite.pm, t/tlib/AllTests.pm, t/tlib/FilteredSuite.pm: - - remove ALL filtering hack, and instead allow filtering via coderefs: - - sub filter {{ - foo_tests => sub { - my $method = shift; - return $method =~ /foo/; - }, - everything => sub { 1 }, - - # method lists still work - another_token => [ qw/test_method1 test_method2/ ], - }} - - - add tests for filtering mechanism - -2002-06-14 Adam Spiers - - * lib/Test/Unit.pm: version 0.24 - - * ChangeLog: new stuff for 0.24 - - * MANIFEST: - 'make manifest' revealed more missing files, though none of them crucial - - * AUTHORS: change Adam's email address - - * lib/Test/Unit/TestRunner.pm: - Don't die if the run was unsuccessful; we might want to reuse the runner - for another run. - - * MANIFEST: argh! 0.23's MANIFEST was missing several crucial files. - -2002-06-13 Adam Spiers - - * lib/Test/Unit/Runner/Terminal.pm: forgot to update the pod - - * .cvsignore: ignore tarballs - - * doc/release-checklist: typo - - * README, doc/release-checklist: - cut down on the poor maintainer's workload - - * Changes: deprecate this file - - * ChangeLog: new stuff for 0.23 - - * lib/Test/Unit.pm: version 0.23 - - * doc/TODO: mention that Attribute::Handlers probably won't work - - * t/tlib/TestTest.pm, lib/Test/Unit/Error.pm, lib/Test/Unit/Exception.pm, lib/Test/Unit/Result.pm, lib/Test/Unit/TestCase.pm: - Rework the exception handling mechanisms of run_protected/run_bare so - that run-time exceptions in set_up or tear_down no longer halt the - framework, and neither do user-defined exceptions thrown in the test - methods themselves (where the framework only used to handle - straight-forward exceptions where $@ was a scalar, I think). Some - assumptions about Error.pm internals have had to be made, - unfortunately. - - * lib/Test/Unit/Procedural.pm: remove spurious 'use' line - -2002-06-12 Adam Spiers - - * lib/Test/Unit/Debug.pm: allow debugging to a file with debug_to_file - -2002-06-10 Adam Spiers - - * lib/Test/Unit/Runner/Terminal.pm: - use \e[4A\r instead of \e[4F, which not all terminals support - - * lib/Test/Unit/Runner/Terminal.pm: - Ahem. Forgot to change package name. - - * lib/Test/Unit/TkTestRunner.pm: - check that something is selected when the user clicks 'Show...' - - * lib/Test/Unit/TkTestRunner.pm: disable broken rerun button - - * MANIFEST, lib/Test/Unit/Listener.pm, lib/Test/Unit/Runner.pm, lib/Test/Unit/Runner/Terminal.pm, lib/Test/Unit/TestRunner.pm, lib/Test/Unit/TestSuite.pm: - - new start_suite/end_suite events sent to listeners, to track where - current test is in the suite hierarchy ($runner->suites_running) - - - new T::U::Runner::Terminal runner which uses terminal escape - sequences to show which suites/tests are currently being run - - - result object now stored in the runner - - * lib/Test/Unit/TkTestRunner.pm: clean up of code style - - * lib/Test/Unit/Listener.pm: - pseudo-document the parameters for the listener interface - -2002-05-23 Adam Spiers - - * doc/TODO, lib/Test/Unit/TestCase.pm: - (poorly) document @TESTS and the filtering mechanism - - * lib/Test/Unit.pm: version 0.22 - - * ChangeLog: - get this uptodate by merging auto-generated entries with existing ones - - * lib/Test/Unit/TestSuite.pm: - allow 'ALL' as a magic test name which matches all methods in this class, e.g. - - package MyTest37; - - use base qw(Test::Unit::TestCase); - - ... - - sub filter {{ - skip_thirty_seven => [ 'ALL' ], - slow => [ qw(test_I_am_slow test_I_am_slow_too) ], - }} - - * lib/Test/Unit/Assert.pm, t/tlib/AssertTest.pm: - assert_(str|num)(_not)?_equals now fail with undef parameters, - to avoid tests passing by accident. The user should either use - assert_null/assert_not_null, or check for undef before the assertion. - -2002-05-23 Adam Spiers - - * lib/Test/Unit/TestSuite.pm: - allow 'ALL' as a magic test name which matches all methods in this class, e.g. - - package MyTest37; - - use base qw(Test::Unit::TestCase); - - ... - - sub filter {{ - skip_thirty_seven => [ 'ALL' ], - slow => [ qw(test_I_am_slow test_I_am_slow_too) ], - }} - - * lib/Test/Unit/Assert.pm, t/tlib/AssertTest.pm: - assert_(str|num)(_not)?_equals now fail with undef parameters, - to avoid tests passing by accident. The user should either use - assert_null/assert_not_null, or check for undef before the assertion. - -2002-05-14 Adam Spiers - - * lib/Test/Unit/TestCase.pm: bit more debugging - -2002-03-26 Adam Spiers - - * lib/Test/Unit.pm: version 0.21 - - * lib/Test/Unit/Assert.pm, t/tlib/AssertTest.pm: - avoid UNIVERSAL::isa, which is buggy with 5.6.0 (see perldelta) - -2002-03-18 Adam Spiers - - * t/tlib/AssertTest.pm: - update boolean assertion tests for new failure message - - * doc/TODO: do_run should be public - - * lib/Test/Unit/Assertion/Boolean.pm: - slightly nicer default assertion failure message - -2002-03-04 Adam Spiers - - * lib/Test/Unit/Test.pm, lib/Test/Unit/TestCase.pm: - avoid namespace clashes in TestCase objects (thanks to jonasbn for - pointing this problem out) - - * README: update the prerequisites - -2002-02-20 Adam Spiers - - * lib/Test/Unit/Assert.pm: - reintroduce caveat about $self->assert($foo =~ /$bar/) - -2002-02-12 Adam Spiers - - * lib/Test/Unit/Assert.pm, t/tlib/AssertTest.pm: - make $self->assert([1]); work - -2002-02-05 Adam Spiers - - * lib/Test/Unit/Assert.pm, t/tlib/AssertTest.pm: - assert_deep_equals takes references 'A' and 'B', not 'got' and 'expected' - -2002-02-04 Adam Spiers - - * t/tlib/AllTests.pm, t/tlib/AssertTest.pm, t/tlib/ExceptionChecker.pm, t/tlib/TestObject.pm, t/tlib/WillDie.pm: - - factor out exception checking into ExceptionChecker - - move TestObject class into separate file - - tests for test-case methods which die ( they pass but I am still - getting funny results from my real-world test-cases )-: - - * doc/TODO: @TESTS needs testing - -2002-01-29 Adam Spiers - - * lib/Test/Unit/HarnessUnit.pm, lib/Test/Unit/Runner.pm, lib/Test/Unit/TkTestRunner.pm: - factor create_test_result - - * lib/Test/Unit/Assert.pm, t/tlib/AssertTest.pm: - - new assert_deep_equals for comparing deep structures, mostly - ripped out of Test::More - - some tests weren't getting run because of identical hash keys - when I should have been using arrays (doh!) - -2002-01-23 Adam Spiers - - * doc/TODO: need to document @TESTS - -2002-01-09 Adam Spiers - - * lib/Test/Unit/TestRunner.pm: - missed a rename from output() to annotations() - -2002-01-08 Adam Spiers - - * MANIFEST, lib/Test/Unit/Assert.pm, lib/Test/Unit/Assertion/CodeRef.pm, lib/Test/Unit/Assertion/Exception.pm, lib/Test/Unit/Assertion/Regexp.pm, t/assert.t, t/tlib/AssertTest.pm: - - Fix breakage where coderef assertions were not failing. Coderef - assertions are now expected to throw Test::Unit::Failures - ($self->fail() is a convenient way of doing this; see updated docs). - - New tests for assert(). - - New multi_assert() for using multiple argument sets with one assertion - (plus tests). - - New assert_raises() for asserting that a coderef raises a particular - class of exception (plus tests). - - * t/tlib/TestTest.pm: the famous scalar/regexp problem - -2001-12-20 Adam Spiers - - * lib/Test/Unit/Assertion.pm: whitespace - -2001-12-19 Adam Spiers - - * lib/Test/Unit/TestCase.pm: - missed a print -> annotate change in the pod - - * t/tlib/AssertTest.pm: 3 more tests for ok() - -2001-12-18 Adam Spiers - - * lib/Test/Unit/Loader.pm: - fix problem with symbol tables containing symbol tables - - * lib/Test/Unit/TestCase.pm, lib/Test/Unit/TestRunner.pm: - rename print() to annotate() - -2001-12-11 Adam Spiers - - * lib/Test/Unit/Assert.pm, t/tlib/AssertTest.pm: - - Add new assert_matches() and assert_does_not_match() assertions, - as requested by Matthias Ferber, and new tests for them of course. - - - Start testing for the correct messages in T::U::Failure objects - (see check_exception()). In particular this tests that the optional - MESSAGE args are processed correctly when reporting failures. - - - Improved behaviour of assert_equals() and assert_not_equals() with - undefined parameters. - - - Added more stringent tests for assert_equals() and assert_not_equals(). - Some of these are possibly debatable. I think the assert_equals() - matrix should be retired in favour of the check_failures() style tests - used to check assert_not_equals(), since the latter also check the - failure message and originating file/line (added a #FIXME for this). - - - Fixed reversed got/expected message with $self->ok(sub { 2 + 2 }, 4); - Spotted this as a bonus of the new check_exception(), yay. - - * lib/Test/Unit/TestRunner.pm, t/try_examples.t: - autoflush TestRunner's output stream - -2001-12-07 Adam Spiers - - * lib/Test/Unit/TestRunner.pm: Don't need that \n *either*. Doh! - - * lib/Test/Unit/TestRunner.pm: don't need that \n either - -2001-12-06 Adam Spiers - - * lib/Test/Unit/TestCase.pm: document print() - -2001-12-05 Adam Spiers - - * doc/TODO, lib/Test/Unit/Exception.pm, lib/Test/Unit/Result.pm, lib/Test/Unit/TestCase.pm, lib/Test/Unit/TestRunner.pm: - can now call $self->print("debugging stuff") within test case methods - and if the test fails or "errors" you get to see all the debugging - accumulated from the above calls - -2001-12-04 Adam Spiers - - * doc/TODO: ideas from Test::More - - * doc/TODO: $Error::Depth bug fixed (I think) - - * lib/Test/Unit/Assert.pm: - We seem to have obtained an extra 2 stack frames somewhere along the line. - This makes the new, more stringent exception checking tests in AssertTest.pm - pass. - - * t/tlib/AssertTest.pm: - - Added hairiness to failure/error testing, so it now doesn't just - check that the exception was raised, but also checks that its file() - and line() methods point correctly to the source of the failed assertion. - - Refactored duplicated code from check_failures() and check_errors() into - check_exceptions() - - * lib/Test/Unit/TestCase.pm: tiny cosmetic tweak - - * TestLister.pl, lib/Test/Unit/TestCase.pm, lib/Test/Unit/TestSuite.pm: - simple but pretty script for listing suite structure rather than running it - - * examples/fail_example.pm, lib/Test/Unit/Debug.pm: - missed a few DEBUGs in fail_example.pm - - * Makefile.PL, doc/TODO: - require base.pm version 1, so that a warning is generated for buggy - base.pms - - * lib/Test/Unit.pm: link to AUTHORS file - - * TestRunner.pl: example usage of debugging - - * lib/Test/Unit/Loader.pm: avoid warning - - * AUTHORS: Kevin was listed twice - -2001-12-03 Piers Cawley - - * AUTHORS: Added the list of Authors who've written code for PerlUnit. - Almost certainly incomplete. Add your details please. - -2001-12-03 Adam Spiers - - * lib/Test/Unit/HarnessUnit.pm: don't need that \n - - * doc/TODO: fixed - - * lib/Test/Unit/HarnessUnit.pm, lib/Test/Unit/Loader.pm, lib/Test/Unit/Result.pm, lib/Test/Unit/Setup.pm, lib/Test/Unit/Test.pm, lib/Test/Unit/TestCase.pm, lib/Test/Unit/TestRunner.pm, lib/Test/Unit/TestSuite.pm, lib/Test/Unit/UnitHarness.pm, t/all_tests.t, t/tlib/ListenerTest.pm, MANIFEST, lib/Test/Unit/Assert.pm, lib/Test/Unit/Debug.pm, lib/Test/Unit/Decorator.pm, lib/Test/Unit/Exception.pm: - All debugging now happens through a simple unified debugging class - Test::Unit::Debug. This allows the user to turn debugging on/off - dynamically, still on a per-package basis, but in a more convenient - way. Also eliminates the problem with `make test' failing when - DEBUG is "compiled in". - - * doc/TODO: more jobs - - * t/tlib/TestTest.pm: should have a name - - * t/tlib/TestTest.pm: - give inner classes names to avoid warnings in debugging - -2001-11-30 Adam Spiers - - * lib/Test/Unit/TestCase.pm: - this could come in handy when overriding list_tests() - -2001-11-30 Piers Cawley - - * lib/Test/Unit.pm: - Added a feedback section to Test::Unit's pod, suggesting that users - join perlunit-users and generally give us some feedback. - -2001-11-29 Adam Spiers - - * lib/Test/Unit/Loader.pm: forgot to put this die() in - - * MANIFEST, Makefile.PL, lib/Test/Unit.pm, lib/Test/Unit/Loader.pm, lib/Test/Unit/Procedural.pm, lib/Test/Unit/Test.pm, lib/Test/Unit/TestRunner.pm, lib/Test/Unit/TestSuite.pm, lib/Test/Unit/Warning.pm, t/tlib/AllTests.pm, t/tlib/InheritedSuite/OverrideNew.pm, t/tlib/InheritedSuite/OverrideNewName.pm, t/tlib/InheritedSuite/Simple.pm, t/tlib/InheritedSuite/TestNames.pm, t/tlib/SuiteTest.pm: - some major improvements: - - fixed the existing suite-building API, extended it, documented it fully, - added/improved tests for it - - reintroduced Test/Unit.pm, this time as a placeholder for $VERSION - and some introductory pod containing pointers to the other modules - - massive refactoring of Test::Unit::Loader - - factored out Test::Unit::Suite::_warning into Test::Unit::Warning, so - it could be used elsewhere - [I think he meant Test::Unit::TestSuite::_warning -- mca, - trying to prevent confusion] - - fixed NoTestCaseClass test - - * examples/fail_example.pm, t/try_examples.t: - add a couple of comments now I know what this Decorator/Setup business is about - - * t/try_examples.t: - skip properly, don't just mark as TODO because they aren't TODO - - * lib/Test/Unit/Decorator.pm: whitespace - - * lib/Test/Unit/Setup.pm: don't want those prototypes - - * lib/Test/Unit/UnitHarness.pm: - - @ISA = ('Exporter') line was overriding use base lines - - whitespace now matches conventions we decided on - - * t/all_tests.t, t/assert.t, t/try_examples.t: - these should be executable - -2001-11-28 Adam Spiers - - * examples/README: get this up to date (ish) - - * lib/Test/Unit/Loader.pm: - - get_package_name_from_file() never worked before (missing assignment - to $filename). - - remove dependency on FileHandle; this saves us a bit of code bloat - if we're not using UnitHarness. - - * t/try_examples.t: - I think this is right for fail_example.pm, maybe ... - - * examples/fail_example.pm: - fail_example_testsuite_setup package needs to come second, otherwise - Test::Unit::Loader::get_package_name_from_file returns the wrong suite. - - * t/tlib/ActiveTestTest.pm, t/tlib/Success.pm: - - refactoring: no point having more than one Success test case - - it should really have at least one successful test in it - - * lib/Test/Unit/Loader.pm: fix the pod - - * lib/Test/Unit/Loader.pm: - more suitable variable names - - don't need no strict 'refs' - - cosmetics - - * lib/Test/Unit/TestRunner.pm: - TestRunner can run test cases *and* test suites - - * lib/Test/Unit/HarnessUnit.pm: missing use - - * doc/TODO: copyright stuff - -2001-11-27 Adam Spiers - - * doc/TODO, lib/Test/Unit/TestSuite.pm: - Allow test suites to be derived from Test::Unit::TestSuite! - This turned out to be a relatively small change, and paves - the way for vast improvements IMO. The old API should still - work perfectly. - - * MANIFEST, README, doc/TODO, examples/patch100132, examples/patch100132-1, examples/patch100132-2, lib/Test/Unit.pm, lib/Test/Unit/Procedural.pm: - renamed Test::Unit to Test::Unit::Procedural - - * lib/Test/Unit/Test.pm, lib/Test/Unit/TestRunner.pm: - get the versioning uptodate and CPAN-compliant - - * TestRunner.pl, TkTestRunner.pl: - there's no reason why these shouldn't be executable - -2001-11-16 Adam Spiers - - * doc/TODO: done that - - * lib/Test/Unit/Loader.pm, t/tlib/AllTests.pm, t/tlib/BadSuite/BadUse.pm, t/tlib/BadSuite/SyntaxError.pm, t/tlib/BadSuitesTest.pm: - - might as well have some debugging in Loader if we have DEBUG - - fix misleading error when a suite has a bad dependency - - add tests for correct runner error message in above bad dependency - case, and for a straightforward syntax error - -2001-11-15 Piers Cawley - - * MANIFEST: Added doc/TODO - -2001-11-15 Adam Spiers - - * lib/Test/Unit/Test.pm: forgot to test DEBUG - - * doc/TODO: done some work on runner state and filtering - - * lib/Test/Unit/TestSuite.pm: only add tests via add_test() - - * MANIFEST, lib/Test/Unit/HarnessUnit.pm, lib/Test/Unit/Runner.pm, lib/Test/Unit/Test.pm, lib/Test/Unit/TestCase.pm, lib/Test/Unit/TestRunner.pm, lib/Test/Unit/TestSuite.pm, lib/Test/Unit/TkTestRunner.pm, lib/Test/Unit/UnitHarness.pm: - - add new Runner base class which is an appropriate place for runner state - common between all runners - - - very basic example of its usage: filter tokens - add something like - this to your test case - - sub filter {{ - 'slow' => [ 'test_a_slow_one', 'test_another_slow_one' ], - 'really_slow' => [ 'test_wow_really_slow' ], - }} - - then you can filter out slow tests via - - my $runner = new Test::Unit::TestRunner(); - $runner->filter(qw/slow really_slow/); - $runner->start($class); - - * lib/Test/Unit/TestRunner.pm: - tidy up output a bit - - use T::U::Loader for loading main suite - - * doc/TODO: done that - - * t/all_tests.t, t/assert.t, t/tlib/ActiveTestTest.pm, t/tlib/AllTests.pm, t/tlib/AssertTest.pm, t/tlib/InheritedInheritedTestCase.pm, t/tlib/InheritedTestCase.pm, t/tlib/ListenerTest.pm, t/tlib/NoTestCaseClass.pm, t/tlib/NoTestCases.pm, t/tlib/OneTestCase.pm, t/tlib/OverrideTestCase.pm, t/tlib/Success.pm, t/tlib/SuiteTest.pm, t/tlib/TestAssertionCodeRef.pm, t/tlib/TestTest.pm, t/tlib/TornDown.pm, t/tlib/WasRun.pm, t/try_examples.t, MANIFEST, README, lib/Test/Unit/Assert.pm, lib/Test/Unit/TestCase.pm, lib/Test/Unit/TestRunner.pm, lib/Test/Unit/TestSuite.pm, lib/Test/Unit/TkTestRunner.pm, lib/Test/Unit/Tutorial.pm: - move lib/Test/Unit/tests/*.pm to t/tlib - - * doc/TODO, doc/consensus.txt: moved some stuff to TODO - - * doc/consensus.txt: - removing stuff about new assertion mechanism, this is now in HEAD - and documented (Test::Unit::Assert*) - - * doc/TODO, doc/consensus.txt: new doc/TODO - -2001-11-14 Adam Spiers - - * lib/Test/Unit/Assertion/Boolean.pm: - get optional messages working just like with assert_str_equals etc. - -2001-11-13 Adam Spiers - - * lib/Test/Unit/Assert.pm: - add support to ok() for optional comments - - make ok() raise error not failure with bad args - - fix assert_num_equals ditching optional comment - - * lib/Test/Unit/Assertion/Regexp.pm: making debugging more readable - - * lib/Test/Unit/Assertion/Boolean.pm: - - fix typo which was hiding optional failure comment - - making debugging more readable - - * lib/Test/Unit/Exception.pm: improve legibility of failures - - * lib/Test/Unit/Assert.pm: - finish ok() wrapper, and add tests for it - - some refactoring into new check_failures() in T/U/tests/AssertTest.pm - -2001-11-12 Adam Spiers - - * Makefile.PL: - need 5.005 for qr//, thanks to Quinn Weaver for pointing that out - -2001-11-12 Piers Cawley - - * lib/Test/Unit/Assertion.pm, lib/Test/Unit/Assertion/Boolean.pm, lib/Test/Unit/Assertion/CodeRef.pm, lib/Test/Unit/Assertion/Regexp.pm, lib/Test/Unit/Decorator.pm, lib/Test/Unit/Error.pm, lib/Test/Unit/Exception.pm, lib/Test/Unit/ExceptionError.pm, lib/Test/Unit/ExceptionFailure.pm, lib/Test/Unit/Failure.pm, lib/Test/Unit/HarnessUnit.pm, lib/Test/Unit/InnerClass.pm, lib/Test/Unit/Listener.pm, lib/Test/Unit/Loader.pm, lib/Test/Unit/Result.pm, lib/Test/Unit/Setup.pm, lib/Test/Unit/Test.pm, lib/Test/Unit/TestCase.pm, lib/Test/Unit/TestDecorator.pm, lib/Test/Unit/TestFailure.pm, lib/Test/Unit/TestListener.pm, lib/Test/Unit/TestLoader.pm, lib/Test/Unit/TestResult.pm, lib/Test/Unit/TestRunner.pm, lib/Test/Unit/TestSetup.pm, lib/Test/Unit/TestSuite.pm, lib/Test/Unit/TkTestRunner.pm, lib/Test/Unit/UnitHarness.pm, t/all_tests.t, t/assert.t, t/try_examples.t, .cvsignore, ChangeLog, Changes, MANIFEST, MANIFEST.SKIP, Makefile.PL, examples/README, examples/fail_example.pm, examples/patch100132, examples/procedural-adding-suites-example.pl, examples/procedural-another-package-example.pl, examples/procedural-fail-example.pl, examples/procedural-ok-example.pl, lib/Test/Unit.pm, lib/Test/Unit/Assert.pm: - Merged changes from PDC_REFACTOR branch. - - * Makefile.PL, lib/Test/Unit/TestCase.pm: - Tidied up some formatting in Test::Unit::TestCase and added a dependency - to Makefile.PL - -2001-11-12 Adam Spiers - - * doc/consensus.txt: coding style - -2001-11-07 Adam Spiers - - * lib/Test/Unit/Assert.pm: ok(): support more cases - - * lib/Test/Unit/Assert.pm: - oops, ok() needs to reverse order of got/expected args - - * ChangeLog: - Bring ChangeLog uptodate for this branch. Hmm, maybe we should just - let CVS and rcs2log do the hard work as far as change logs are - concerned. - - * doc/consensus.txt: - only edit consensus.txt in HEAD - - consensus on use vs. require - - * lib/Test/Unit/Exception.pm: cosmetics in failure output - - * lib/Test/Unit/Assert.pm: - cosmetics in failure output - - add missing require (thanks to Hans Donner ) - - add a controversial but very convenient and harmless alias: - &ok -> &assert_equals - - * .cvsignore: New file. - - * .cvsignore: cvs-ignore Makefile - - * doc/consensus.txt: deal with broken base.pm issue - -2001-10-31 Piers Cawley - - * MANIFEST: Tidied up the MANIFEST so make tardist works. - - * MANIFEST, t/try_examples.t: - Fixed t/try_examples.t to recognize a passing test. - -2001-10-30 Piers Cawley - - * lib/Test/Unit/TestRunner.pm, lib/Test/Unit/UnitHarness.pm, Makefile.PL: - Tidied up output of TestRunner - Added prerequisites to Makefile.PL - Removed some dependencies on Test::Unit::InnerClass - -2001-10-26 Adam Spiers - - * lib/Test/Unit/tests/AssertTest.pm: fix barewords error - -2001-10-25 Adam Spiers - - * doc/consensus.txt: todo: check for broken Error.pms - -2001-09-07 pdcawley - - * ChangeLog: Added some stuff in the ChangeLog - - * lib/Test/Unit/Result.pm: More doc fixes. - - * lib/Test/Unit/Result.pm, lib/Test/Unit/TestCase.pm: - Doctored Test::Unit::Result again, so that if $test->run_bare *does* - return false we actually add a failure instead of just leaving things - up in the air (causes a problem with test harnesses if we don't) - - * lib/Test/Unit/Assert.pm, lib/Test/Unit/TestCase.pm, lib/Test/Unit/tests/AssertTest.pm, ChangeLog: - Tidied up the documentation in Test::Unit::Assert. - Made sure that Test::Unit::TestCase::run_bare returns true if it doesn't - throw an exception. - - * lib/Test/Unit/TestCase.pm: An attempt at improving the documentation. - - * lib/Test/Unit/Setup.pm: New file. - - * Changes, MANIFEST, examples/README, examples/fail_example.pm, lib/Test/Unit/Setup.pm, lib/Test/Unit/TestSetup.pm: - Renamed Test::Unit::TestSetup to Test::Unit::Setup - - * lib/Test/Unit/Listener.pm, lib/Test/Unit/tests/ListenerTest.pm: - New file. - - * MANIFEST, lib/Test/Unit/HarnessUnit.pm, lib/Test/Unit/Listener.pm, lib/Test/Unit/TestListener.pm, lib/Test/Unit/TestRunner.pm, lib/Test/Unit/TkTestRunner.pm, lib/Test/Unit/UnitHarness.pm, lib/Test/Unit/tests/AllTests.pm, lib/Test/Unit/tests/ListenerTest.pm, lib/Test/Unit/tests/TestListenerTest.pm: - Renamed Test::Unit::TestListener to Test::Unit::Listener - - * lib/Test/Unit/Decorator.pm: New file. - - * MANIFEST, lib/Test/Unit/Decorator.pm, lib/Test/Unit/TestDecorator.pm, lib/Test/Unit/TestSetup.pm: - Renamed Test::Unit::TestDecorator to Test::Unit::Decorator - - * lib/Test/Unit/Loader.pm: New file. - - * ChangeLog, MANIFEST, lib/Test/Unit/HarnessUnit.pm, lib/Test/Unit/Loader.pm, lib/Test/Unit/TestListener.pm, lib/Test/Unit/TestLoader.pm, lib/Test/Unit/TkTestRunner.pm: - Renamed Test::Unit::TestLoader to Test::Unit::Loader - -2001-09-07 Piers Cawley - - * lib/Test/Unit/TestCase.pm - (run_bare): Made sure it returns true if it doesn't throw an exception. - - * lib/Test/Unit/tests/AssertTest.pm - (test_fail_assert_not_equals): - (test_success_assert_not_equals): Added tests for assert_not_equals. - - * lib/Test/Unit/Assert.pm - Doc fixes. - (assert_not_equals): Aadded the option to assert that things - aren't equal. Also added appropriate - (assert_(str|num)_not_equals) methods. - -2001-09-02 Piers Cawley - - * lib/Test/Unit/Loader.pm - (load): Improved the error message when a file can be found, but - has a syntax error. - - * lib/Test/Unit/TestFailure.pm: - Removed. - - * lib/Test/Unit/InnerClass.pm: - Removed - - * lib/Test/Unit/tests/AssertTest.pm - Switched to a ResultsMatrix style of testing. Seems to work quite - well... - - * lib/Test/Unit/Assert.pm - (is_numeric): Got rid of warnings when the argument isn't numeric. - - * t/all_tests.t: - * t/assert_test.t: - Got rid of C since blib should be handling that. - - * lib/Test/Unit/tests/TestTest.pm: - Basic refactoring to use Class::Inner. - (make_dummy_testcase): New helper method to make anonymous - classes used in many of the tests. - - * lib/Test/Unit/Assertion/Boolean.pm - (do_assertion): Switched to a slightly more sensible way of - generating failure messages. - - * lib/Test/Unit/Loader.pm - (load): Changed the order in which we call C and - C. - - * lib/Test/Unit/TestResult.pm: - Removed dependency on Test::Unit::TestFailure. - - * lib/Test/Unit/ExceptionError.pm - (make_from_error_simple): Fixed things up slightly. This method - maybe needs a leading underscore; Framework users should probably - never see it... - - * lib/Test/Unit/Assertion.pm - (fail): Fixed things to put appropriate information into the - thrown exception. - - * lib/Test/Unit/Assert.pm: - General refactoring work to get things working with the CPAN - modules. - (assert): Now, when an exception is generated, we try and get the - appropriate caller information for setting -line and -file. Which - is nice. - (assert_equals): Fixed to use try/catch. Fixed a nasty bug with @_ - getting silently emptied via try, so now, before we call try, we - copy @_ to @args and use that inside the closure, otherwise - assert_equals would always return true. - (assert_str_equals,assert_num_equals,assert_null,assert_not_null): - All now set $Error::Depth correctly. - - * lib/Test/Unit/Exception.pm - (stringify): Tidied up stringification. - (failed_test, thrown_exception): We now conform to the - Test::Unit::TestFailure interface. Which means that we can get rid - of Test::Unit::TestFailure itself. Which is nice. - - * lib/Test/Unit.pm: - Switched to using Devel::Symdump, Class::Inner and Error - (assert): Moved to the try/catch style. - (create_suite): Vaguely major refactoring. Switched to using - Devel::Symdump and Class::Inner instead of the hand rolled symbol - table manipulation and Test::Unit::InnerClass - -2001-08-31 Piers Cawley - - * lib/Test/Unit.pm: Fixed a silly typo induced bug. - - * MANIFEST, MANIFEST.SKIP, Makefile.PL, examples/patch100132, examples/procedural-adding-suites-example.pl, examples/procedural-another-package-example.pl, examples/procedural-fail-example.pl, examples/procedural-ok-example.pl, lib/Test/Unit.pm, lib/Test/Unit/Assertion.pm, lib/Test/Unit/Assertion/Boolean.pm, lib/Test/Unit/Assertion/CodeRef.pm, lib/Test/Unit/Assertion/Regexp.pm, lib/Test/Unit/Exception.pm, lib/Test/Unit/ExceptionError.pm, lib/Test/Unit/HarnessUnit.pm, lib/Test/Unit/InnerClass.pm, lib/Test/Unit/Test.pm, lib/Test/Unit/TestCase.pm, lib/Test/Unit/TestDecorator.pm, lib/Test/Unit/TestFailure.pm, lib/Test/Unit/TestLoader.pm, lib/Test/Unit/TestResult.pm, lib/Test/Unit/TestRunner.pm, lib/Test/Unit/TestSetup.pm, lib/Test/Unit/TestSuite.pm, t/try_examples.t: - Beginnings of a major refactoring. - - 1. Replace Test::Unit::InnerClass with Class::Inner - 2. Use Error.pm as the basis for exception handling and try/catch/... - in place of eval. - 3. Use Devel::Symdump in place of hand rolled symbol table manipulation. - 4. Also includes an attempt at an 'assert_equals' that does the right - thing in most cases. Tries to make reasonable guesses about numeric or - string comparison, and can make use of object based equality things. - 5. Started to port jUnit tests that make sense in the context of PerlUnit. - - TODO: Need to get the procedural Test::Unit working. Or abandon it. However, - it does do some stuff that Test::More and friends don't (no plan testing - that actually produces a sensible 'test count') - - Write more tests. (Patches welcome) - - * t/assert.t: - Calls the (too) simple set of tests for Test::Unit::Assert and friends. - - * t/assert.t: New file. - -2001-08-30 Piers Cawley - - * lib/Test/Unit/Assert.pm: - Removed some warnings when called with 'undef'. - Also added a stringification of undef to when reporting failures... - -2001-06-18 Christian Lemburg - - * Changes, MANIFEST, examples/README, examples/fail_example.pm, lib/Test/Unit.pm, lib/Test/Unit/TestDecorator.pm, lib/Test/Unit/TestResult.pm, lib/Test/Unit/TestSetup.pm: - added TestSetup and TestDecorator by Kevin Connor - -2001-05-05 Christian Lemburg - - * README, Changes: for version 0.14 - - * t/try_examples.t: do not assume order of tests will be constant - - * lib/Test/Unit/Assertion/Boolean.pm: - fix for problem with use base and older perls - - * lib/Test/Unit/Assert.pm: document Piers additions - - * lib/Test/Unit.pm: new version, updated team member list - -2001-04-27 Matthew Astley - - * t/try_examples.t: add redirection warning for Win32 - -2001-04-09 Matthew Astley - - * doc/consensus.txt: - wittering about packaging, plus my vague plan for things I fancy doing - - * t/try_examples.t: - checks STDOUT & STDERR together, from invoking the examples - doesn't look at return codes - -2001-03-19 Piers Cawley - - * lib/Test/Unit.pm, lib/Test/Unit/InnerClass.pm, lib/Test/Unit/TestSuite.pm, lib/Test/Unit/UnitHarness.pm: - Redid Test::Unit::InnerClass to be more 'classlike'. (ie, calling - Test::Unit::InnerClass::make_inner_class as a class method rather than as a - direct subroutine call) - - Added Test::Unit::InnerClass::make_inner_class_with_coderefs - Instead of taking an extension_text argument, takes a hash of coderefs - and uses the keys as method names. Lets you do closure magic and the like - when creating inner classes. - - Moved Test::Unit::InnerClass::make_inner_class to - T::U::IC::make_inner_class_with_text. The make_inner_class subroutine now - looks at $_[2] to determine whether to dispatch to the _with_text version - of the method or the _with_coderefs version. - - Modified all the clients of Test::Unit::InnerClass to do proper Class based - method dispatch. - - Modified Test::Unit::tests::TestTest to create some of its inner classes using - the 'hash of coderefs' approach. - - Didn't do the documentation yet. - -2001-03-17 Christian Lemburg - - * Makefile.PL: - take version number for distribution file from lib/Test/Unit.pm - - * doc/release-checklist: - changed to take distribution file version number from lib/Test/Unit.pm - - * doc/release-checklist: more documentation on release procedure - - * doc/release-checklist: - added documentation on release procedure and explanation of version number stuff - - * lib/Test/Unit.pm: - Added version number again, it has to be in the module, added explanation - -2001-03-08 Piers Cawley - - * MANIFEST.SKIP, Makefile.PL, lib/Test/Unit/Assert.pm, lib/Test/Unit/Assertion.pm, lib/Test/Unit/Assertion/Boolean.pm, lib/Test/Unit/Assertion/CodeRef.pm, lib/Test/Unit/Assertion/Regexp.pm, lib/Test/Unit/Exception.pm, lib/Test/Unit/TestFailure.pm, lib/Test/Unit/TestRunner.pm, MANIFEST: - Merged the pdc_coderefassert branch. - -2001-03-07 Adam Spiers - - * lib/Test/Unit/TestCase.pm: add missing use - -2001-03-06 Piers Cawley - - * doc/consensus.txt: Added some commentary - - * lib/Test/Unit/Assert.pm: - Stopped Test::Unit::Assert::normalize_assert from dying when passed an - object that can't 'do_assertion'. Instead treats it as the argument for - Test::Unit::Assertion::Boolean::new. - - (Came across this bug while testing some of my 'real' code). - - This should also mean that, if you - - package Foo; - - use overload - bool => sub {...} - - Then assertion will continue to work properly. - - I've added a test for the simple case -- - T:U:t:TestTest::test_assert_with_non_assertion_object (essentially it's - always going to be true in this instance), but not for the case where - 'bool' is overridden. I'll leave that as an exercise for the interested - reader (plus I'm not sure how to make inner classes do overrides). - -2001-03-06 Matthew Astley - - * doc/consensus.txt: updates - -2001-03-05 Piers Cawley - - * lib/Test/Unit/Assert.pm, lib/Test/Unit/Assertion.pm: - Added some appropriate 'require's to these class files. - - * Makefile.PL, lib/Test/Unit/Assertion.pm, lib/Test/Unit/Assertion/Boolean.pm, lib/Test/Unit/Assertion/CodeRef.pm, lib/Test/Unit/Assertion/Regexp.pm: - Added a bunch of documentation to T::U::Assertion and its subclasses. - - Removed the dependency on B::Deparse (I think. If someone who hasn't got - this installed could test it...) - -2001-03-05 Adam Spiers - - * t/fail.t: Removing to avoid misguided fails on `make test'. - Brian can resurrect it if he wants when he resurfaces. - - * lib/Test/Unit/TestResult.pm: - slightly more informative debug message in run() - -2001-03-02 Piers Cawley - - * lib/Test/Unit/Assertion/Regexp.pm: Corrected a typo. - - * lib/Test/Unit/Assertion.pm, lib/Test/Unit/Assertion/Boolean.pm, lib/Test/Unit/Assertion/CodeRef.pm, lib/Test/Unit/Assertion/Regexp.pm: - New file. - - * lib/Test/Unit/Assert.pm, lib/Test/Unit/Assertion.pm, lib/Test/Unit/Assertion/Boolean.pm, lib/Test/Unit/Assertion/CodeRef.pm, lib/Test/Unit/Assertion/Regexp.pm: - Reified assertions. - - Added assertion classes for coderefs, regular expressions and booleans. - - Now Test::Unit::Assert::assert takes the first argument, the assertion, - creates an appropriate assertion object, and calls the object's do_assertion - method. - - This seems to be a win. - - Check out T::U::tests::SuiteTest and the 'basic_assertion' method. This is - possibly using a coderef for the sake of it, but it's one way of testing it - hard... - - If you check out T::U::tests::TestTest you'll see a big win on the - regexp front. - - Instead of - - $self->assert(scalar("foo" =~ /bar/), "Should not match"); - - we have - - $self->assert(qr/bar/, "foo"); - - (I haven't worked out how to name such an assertion, but the default - error message for that would look like: - 'foo' did not match /(?-xism:bar)/ - - which is pretty useful already) - -2001-02-28 Matthew Astley - - * doc/consensus.txt: append - - * lib/Test/Unit/TestCase.pm: Use the class 'isa' not the global one - - * doc/consensus.txt, lib/Test/Unit/TestCase.pm: - fix exceptions that look like object names - -2001-02-27 Matthew Astley - - * doc/consensus.txt: First cut should mention most current issues - -2001-02-27 Piers Cawley - - * Makefile.PL: Added the B::Deparse prerequisite. - - * MANIFEST, lib/Test/Unit/Assert.pm, lib/Test/Unit/Exception.pm, lib/Test/Unit/TestFailure.pm, lib/Test/Unit/TestRunner.pm: - Added an option to call assert with a coderef (currently using the - coderef_assert method, but if this is accepted we'll make the 'assert' - method DTRT.) - - Taken advantage of this to tidy up the kind of error reporting that - gets done. Which is nice. Still needs a pile of work done, but I think it's - a start. - -2001-02-27 Christian Lemburg - - * lib/Test/Unit/TestCase.pm, lib/Test/Unit/TestSuite.pm: - patch by Piers Cawley to fix overriden tests - -2001-02-22 Adam Spiers - - * lib/Test/Unit/Exception.pm: - fixed small bug where new() was assumed to be always used as an - instance method and never as a class method - - * lib/Test/Unit/InnerClass.pm: - - slightly improve legibility and remove need for no strict 'refs' - - die with helpful error if compilation of inner class fails - - * lib/Test/Unit/HarnessUnit.pm: - - make runner output more concise and legible - - do not exit(-1) on failures, as that breaks TestHarness - - output $exception->to_string() rather than $exception->stacktrace() - to avoid hiding valuable error messages - - standardise whitespace - - * lib/Test/Unit/TestListener.pm: fix trivial braino in croak message - -2001-02-22 Matthew Astley - - * doc/release-checklist: - Stash consensus reached so far on the mailing list - -2001-02-20 Matthew Astley - - * lib/Test/Unit/Assert.pm, lib/Test/Unit/Exception.pm, lib/Test/Unit/ExceptionError.pm, lib/Test/Unit/ExceptionFailure.pm, lib/Test/Unit/HarnessUnit.pm, lib/Test/Unit/InnerClass.pm, lib/Test/Unit/Test.pm, lib/Test/Unit/TestCase.pm, lib/Test/Unit/TestFailure.pm, lib/Test/Unit/TestListener.pm, lib/Test/Unit/TestLoader.pm, lib/Test/Unit/TestResult.pm, lib/Test/Unit/TestRunner.pm, lib/Test/Unit/TestSuite.pm, lib/Test/Unit/TkTestRunner.pm, lib/Test/Unit/Tutorial.pm, lib/Test/Unit/UnitHarness.pm, lib/Test/Unit.pm: - Fixes Bug#133287: Remove indentation from pod - -2001-02-17 Christian Lemburg - - * README, Changes, Makefile.PL: version 0.13 - - * lib/Test/Unit.pm: removed misleading version info - - * lib/Test/Unit.pm: - make people aware of message arg - - * examples/procedural-fail-example.pl: - show that procedural interface can handle regex problem - - * lib/Test/Unit.pm: added function prototype for assert() - - * lib/Test/Unit/Assert.pm: - added documentation about regex in boolean context - - * lib/Test/Unit/TkTestRunner.pm: - make the GUI adhere to hide of stacktrace, too - patch by David Esposito - - * lib/Test/Unit/Assert.pm: - mention optional message arg to assert - variant of patch by David Esposito - - * lib/Test/Unit/Assert.pm, lib/Test/Unit/TestCase.pm: - corrected patch to hide backtrace - -2001-02-06 Christian Lemburg - - * Changes, Makefile.PL, README, lib/Test/Unit.pm, lib/Test/Unit/Assert.pm, lib/Test/Unit/Exception.pm, lib/Test/Unit/TestCase.pm: - added patch by Matthew Astley to quell backtrace on failed tests - -2000-07-09 Christian Lemburg - - * lib/Test/Unit/TestCase.pm: - Eliminated two blanks in pod documentation that caused problems - -2000-05-07 Christian Lemburg - - * Changes, MANIFEST, README, test.pl: moved to standard CPAN style - - * examples/README: corrected typo - - * examples/Experimental/Sample.pm, examples/README, examples/patch100132, examples/patch100132-1, examples/patch100132-2: - added explanation of examples, added reply to patch100132 - -2000-04-22 Christian Lemburg - - * lib/Test/Unit.pm, lib/Test/Unit/Assert.pm, lib/Test/Unit/Exception.pm, lib/Test/Unit/ExceptionError.pm, lib/Test/Unit/ExceptionFailure.pm, lib/Test/Unit/HarnessUnit.pm, lib/Test/Unit/InnerClass.pm, lib/Test/Unit/Test.pm, lib/Test/Unit/TestCase.pm, lib/Test/Unit/TestFailure.pm, lib/Test/Unit/TestListener.pm, lib/Test/Unit/TestLoader.pm, lib/Test/Unit/TestResult.pm, lib/Test/Unit/TestRunner.pm, lib/Test/Unit/TestSuite.pm, lib/Test/Unit/TkTestRunner.pm, lib/Test/Unit/Tutorial.pm, lib/Test/Unit/UnitHarness.pm: - added and/or modified documentation - - * lib/Test/Unit/TestResult.pm, lib/Test/Unit/HarnessUnit.pm, lib/Test/Unit/InnerClass.pm, lib/Test/Unit/Test.pm, lib/Test/Unit/TestSuite.pm, lib/Test/Unit/Assert.pm, lib/Test/Unit/Exception.pm, lib/Test/Unit/ExceptionError.pm, lib/Test/Unit/ExceptionFailure.pm, lib/Test/Unit/Tutorial.pm: - added documentation - - * lib/Test/Unit/TestCase.pm, lib/Test/Unit.pm: modified documentation - - * lib/Test/Unit.pm: added documentation - -2000-03-06 Christian Lemburg - - * lib/Test/Unit/TestCase.pm: Fixed bug in POD - - * lib/Test/Unit/TestCase.pm: better documentation - - * lib/Test/Unit.pm: removed useless paranoid reload avoidance code - -2000-03-05 Christian Lemburg - - * lib/Test/Unit/Tutorial.pm: - container for tutorial on unit testing with framework - - * examples/procedural-adding-suites-example.pl: - example for procedural API test suite composition feature - - * README: procedural API can now compose test suites, too - - * lib/Test/Unit.pm: - added procedural API test suites composing feature add_suite() - -2000-03-04 Christian Lemburg - - * README, examples/procedural-another-package-example.pl: - added inter-package suite creation and run features to Procedural API - - * lib/Test/Unit.pm: added inter-package suite creation and run features - - * lib/Test/Unit/Exception.pm: - changed stacktrace to begin at level of caller of Exception->new() - - * lib/Test/Unit/TestCase.pm: - fixed run_bare() debug output to say it comes from run_bare, not _run_bare - - * lib/Test/Unit/HarnessUnit.pm, lib/Test/Unit/TestCase.pm: - removed useless middleman _run() - - * lib/Test/Unit.pm: - exported names will be seen on multiple uses, added filehandle arg to run_suite - - * lib/Test/Unit/TestRunner.pm: - removed _run method, changed exit() to die() and return for ending run - -2000-02-29 Christian Lemburg - - * lib/Test/Unit/TestCase.pm: first start at some documentation - - * lib/Test/Unit/Test.pm, lib/Test/Unit/TestSuite.pm: - enlarged Test interface (name, to_string), TestSuite run() returns result - - * lib/Test/Unit/TestSuite.pm: - fixed bug in eval subroutine run_test in warning() - missing right curly - -2000-02-27 Brian Ewins - - * lib/Test/Unit/TkTestRunner.pm: Fixed copyright notice - -2000-02-27 Christian Lemburg - - * README, examples/procedural-fail-example.pl, examples/procedural-ok-example.pl: - removed use lib from procedural API examples, use -I on commandline instead - -2000-02-26 Christian Lemburg - - * lib/Test/Unit/TestRunner.pm: - TestRunner now also uses Benchmark for timing info - - * examples/procedural-fail-example.pl: - show we also can handle messages ... has not been advertised yet ... - - * README, examples/procedural-fail-example.pl, examples/procedural-ok-example.pl, lib/Test/Unit.pm: - first cut at a procedural API wrapper, with examples (see README) - - * lib/Test/Unit/Exception.pm: nicer output again - - * lib/Test/Unit/Exception.pm, lib/Test/Unit/TestFailure.pm: - modified stringifying methods and their interplay for nicer output on errors - - * lib/Test/Unit/Test.pm, lib/Test/Unit/TestCase.pm: - Test inherits from Assert now, so TestCase and TestSuite can now assert() - -2000-02-25 Christian Lemburg - - * lib/Test/Unit/InnerClass.pm: - removed use of constant module to avoid warnings when reloading in test - -2000-02-25 Brian Ewins - - * lib/Test/Unit/TkTestRunner.pm: Fixed the File and About dialogs. - -2000-02-24 Christian Lemburg - - * lib/Test/Unit/Exception.pm: - separated to_string(), get_message(), and stacktrace() - -2000-02-24 Brian Ewins - - * lib/Test/Unit/TkTestRunner.pm: - Whoops forgot line to set the number of planned tests in - progress bar... - - * TkTestRunner.pl, lib/Test/Unit/TestLoader.pm, lib/Test/Unit/TkTestRunner.pm, lib/Test/Unit/UnitHarness.pm: - Many updates to GUI, now nearer to JUnit. Private stub - exceptions/testcases used in UnitHarness to complete - wrapping. - -2000-02-23 Christian Lemburg - - * MANIFEST, README, lib/Test/Unit/InnerClass.pm, lib/Test/Unit/TestCase.pm, lib/Test/Unit/TestSuite.pm, lib/Test/Unit/UnitHarness.pm: - fixed make_inner_class(), put it in own module, changed calls, added testcase - -2000-02-23 Brian Ewins - - * lib/Test/Unit/HarnessUnit.pm, lib/Test/Unit/TkTestRunner.pm, lib/Test/Unit/UnitHarness.pm, t/fail.t: - Lots of GUI bug fixes. Doh! - - * lib/Test/Unit/TestLoader.pm, lib/Test/Unit/TkTestRunner.pm: - Bugfixes in GUI and Loader now recognizes arbitrary .pm's - - * lib/Test/Unit/TestLoader.pm, lib/Test/Unit/TkTestRunner.pm, lib/Test/Unit/UnitHarness.pm: - Nicer looking but still incomplete GUI with - all-new 'ArrayBar' widget. Support for '.t' tests - added to TestLoader, so now GUI supports them again. - Display of .t fails should be improved next... - GUI shows progress correctly *except* when dealing with - .t tests because 'plan()' method isnt implemented in - TestRunner. - Exception details dialog added. Currently the code to - collect these details for .t tests (ie the 'verbose' - output between ok/not ok messages) is not collected. - -2000-02-22 Christian Lemburg - - * lib/Test/Unit/TestSuite.pm: - fixed extraction of test suite to work across whole inheritance tree - - * lib/Test/Unit/TestResult.pm: - deleted useless sanity check method clone_listeners - - * lib/Test/Unit/TestSuite.pm: - resolved overloading of constructor by introducing string constructor empty_new - - * lib/Test/Unit/TestRunner.pm: - deleted sub extract_class_name and changed suite method test to can() - -2000-02-22 Brian Ewins - - * t/all_tests.t, lib/Test/Unit/HarnessUnit.pm, lib/Test/Unit/TestLoader.pm: - Fleshed out HarnessUnit and implemented (sortof) tests for it. - TestLoader was updated to recognize classes with a suite method. - -2000-02-22 Christian Lemburg - - * lib/Test/Unit/TestCase.pm, lib/Test/Unit/TestResult.pm, lib/Test/Unit/TestRunner.pm, lib/Test/Unit/TestSuite.pm, README, test.pl: - added TestSuite tests - 21 tests running OK - -2000-02-21 Brian Ewins - - * README, TkTestRunner.pl, lib/Test/SuiteWrapper.pm, lib/Test/Unit/HarnessUnit.pm, lib/Test/Unit/TestListener.pm, lib/Test/Unit/TestLoader.pm, lib/Test/Unit/TestResult.pm, lib/Test/Unit/TestRunner.pm, lib/Test/Unit/TkTestRunner.pm, lib/Test/Unit/UnitHarness.pm: - Integrated TkTestRunner. Added partial TestLoader and - fleshed out TestListener. - -2000-02-21 Christian Lemburg - - * lib/Test/Unit.pm: - Deleted Unit.pm - it has been splitted to separate class files - - * MANIFEST, README, TestRunner.pl, lib/Test/Unit/Assert.pm, lib/Test/Unit/Exception.pm, lib/Test/Unit/ExceptionError.pm, lib/Test/Unit/ExceptionFailure.pm, lib/Test/Unit/Test.pm, lib/Test/Unit/TestCase.pm, lib/Test/Unit/TestFailure.pm, lib/Test/Unit/TestListener.pm, lib/Test/Unit/TestResult.pm, lib/Test/Unit/TestRunner.pm, lib/Test/Unit/TestSuite.pm, test.pl: - Running first version, separate class files, CPAN style method names - -2000-02-20 Brian Ewins - - * Changes, MANIFEST, Makefile.PL, examples/tester.pl, examples/tester.png, lib/Test/SuiteWrapper.pm, lib/Test/Unit.pm, test.pl: - A work area for the new 'Test::Unit'. This currently contains: - - standard CPAN bundling - - Christian's test.pl and new Unit.pm (as lib/Test/Unit.pm) - - my own 'Test::SuiteWrapper.pm', which works on test::harness - tests; - - examples/tester.pl - a Tk gui for using SuiteWrapper. - - examples/tester.png - a screenshot. oooh. - diff --git a/perl/third/Test-Unit-0.25/Changes b/perl/third/Test-Unit-0.25/Changes deleted file mode 100644 index dc0d11b..0000000 --- a/perl/third/Test-Unit-0.25/Changes +++ /dev/null @@ -1,52 +0,0 @@ -****************************************************************************** -* Due to lack of time, this file has been deprecated in favour of the -* automatically generated ChangeLog file. Sorry. -****************************************************************************** - - -Revision history for Perl extension Test::Unit. - -0.14 - lots of changes and additions: - Piers Cawley fixed a bad bug that caused inherited tests to - be called on the parent class instead of the inheriting class. - Piers Cawley also put in a lot of new functionality for regular - expression assertions and coderef assertions. - Matthew Astley fixed the POD documentation. - Matthew Astley and Adam Spiers fixed a number of smaller things. - Greatly improved formatting of failure reports. - Version number is now (hopefully) handled correctly for CPAN. - Kevin Connor ported Setup and TestDecorator to Perl. - -0.13 - patched the patch from 0.12, added patches by David Esposito, - (documentation for optional message arg to assert(), make - TkTestRunner use to_string() for exception display), added - documentation on problems in using assert() with regexes and - messages, fixed these problems for the procedural style - interface (where they can be solved) - -0.12 - added patch by Matthew Astley (method to quell backtrace on - failed tests, see Test::Unit::TestCase). - -0.11 - - fixed bugs in self tests that caused failed tests under HPUX - and Solaris - -0.1 - - much revised and extended due to PerlUnit effort - (see http://sourceforge.net/project?group_id=2653) - - INCOMPATIBLE CHANGES: old interface style is discontinued - (if you want support for this, use the old 0.06 version) - - resembles JUnit approach much more closely - - adapters to Test::Harness style tests - - GUI test runner using Tk - - stack traces for errors and failures - - object-oriented implementation approach supporting - test inheritance and test specialization - -0.06 - - first CPAN release -0.05 - - initial release version - -0.01 - 0.04 - - development versions diff --git a/perl/third/Test-Unit-0.25/MANIFEST b/perl/third/Test-Unit-0.25/MANIFEST deleted file mode 100644 index 5742438..0000000 --- a/perl/third/Test-Unit-0.25/MANIFEST +++ /dev/null @@ -1,84 +0,0 @@ -AUTHORS -ChangeLog -Changes -COPYING.Artistic -COPYING.GPL-2 -doc/class-diagram.dia -doc/class-diagram.png -doc/class-diagram.txt -doc/consensus.txt -doc/release-checklist -doc/TODO -examples/Experimental/Sample.pm -examples/fail_example.pm -examples/patch100132 -examples/patch100132-1 -examples/patch100132-2 -examples/README -examples/tester.png -lib/Test/Unit.pm -lib/Test/Unit/Assert.pm -lib/Test/Unit/Assertion.pm -lib/Test/Unit/Assertion/Boolean.pm -lib/Test/Unit/Assertion/CodeRef.pm -lib/Test/Unit/Assertion/Exception.pm -lib/Test/Unit/Assertion/Regexp.pm -lib/Test/Unit/Debug.pm -lib/Test/Unit/Decorator.pm -lib/Test/Unit/Error.pm -lib/Test/Unit/Exception.pm -lib/Test/Unit/Failure.pm -lib/Test/Unit/HarnessUnit.pm -lib/Test/Unit/Listener.pm -lib/Test/Unit/Loader.pm -lib/Test/Unit/Procedural.pm -lib/Test/Unit/Result.pm -lib/Test/Unit/Runner.pm -lib/Test/Unit/Runner/Terminal.pm -lib/Test/Unit/Setup.pm -lib/Test/Unit/Test.pm -lib/Test/Unit/TestCase.pm -lib/Test/Unit/TestRunner.pm -lib/Test/Unit/TestSuite.pm -lib/Test/Unit/TkTestRunner.pm -lib/Test/Unit/Tutorial.pm -lib/Test/Unit/UnitHarness.pm -lib/Test/Unit/Warning.pm -Makefile.PL -MANIFEST -README -t/all_tests.t -t/assert.t -t/tlib/ActiveTestTest.pm -t/tlib/AllTests.pm -t/tlib/AssertTest.pm -t/tlib/BadSuite/BadUse.pm -t/tlib/BadSuite/SyntaxError.pm -t/tlib/BadSuitesTest.pm -t/tlib/ExceptionChecker.pm -t/tlib/FilteredSuite.pm -t/tlib/InheritedInheritedTestCase.pm -t/tlib/InheritedSuite/OverrideNew.pm -t/tlib/InheritedSuite/OverrideNewName.pm -t/tlib/InheritedSuite/Simple.pm -t/tlib/InheritedSuite/TestNames.pm -t/tlib/InheritedTestCase.pm -t/tlib/ListenerTest.pm -t/tlib/NoTestCaseClass.pm -t/tlib/NoTestCases.pm -t/tlib/OneTestCase.pm -t/tlib/OverrideTestCase.pm -t/tlib/RunnerTest.pm -t/tlib/Success.pm -t/tlib/SuiteTest.pm -t/tlib/TestAssertionCodeRef.pm -t/tlib/TestObject.pm -t/tlib/TestTest.pm -t/tlib/TornDown.pm -t/tlib/WasRun.pm -t/tlib/WillDie.pm -t/try_examples.t -TestLister.pl -TestRunner.pl -TkTestRunner.pl -META.yml Module meta-data (added by MakeMaker) diff --git a/perl/third/Test-Unit-0.25/META.yml b/perl/third/Test-Unit-0.25/META.yml deleted file mode 100644 index eadb451..0000000 --- a/perl/third/Test-Unit-0.25/META.yml +++ /dev/null @@ -1,14 +0,0 @@ -# http://module-build.sourceforge.net/META-spec.html -#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# -name: Test-Unit -version: 0.25 -version_from: lib/Test/Unit.pm -installdirs: site -requires: - base: 1 - Class::Inner: 0 - Devel::Symdump: 0 - Error: 0 - -distribution_type: module -generated_by: ExtUtils::MakeMaker version 6.17 diff --git a/perl/third/Test-Unit-0.25/Makefile.PL b/perl/third/Test-Unit-0.25/Makefile.PL deleted file mode 100644 index 0fb3241..0000000 --- a/perl/third/Test-Unit-0.25/Makefile.PL +++ /dev/null @@ -1,17 +0,0 @@ -use ExtUtils::MakeMaker; - -# See lib/ExtUtils/MakeMaker.pm for details of how to influence -# the contents of the Makefile that is written. - -require 5.005; - -WriteMakefile( - 'NAME' => 'Test::Unit', - 'VERSION_FROM' => 'lib/Test/Unit.pm', # finds $VERSION - 'PREREQ_PM' => { - Class::Inner => 0, - Devel::Symdump => 0, - Error => 0, - base => 1, - }, -); diff --git a/perl/third/Test-Unit-0.25/README b/perl/third/Test-Unit-0.25/README deleted file mode 100644 index 35c9cfb..0000000 --- a/perl/third/Test-Unit-0.25/README +++ /dev/null @@ -1,83 +0,0 @@ -NAME - Test::Unit::* - a unit testing framework for Perl - -DESCRIPTION - - Test::Unit::* is a sophisticated unit testing framework for Perl - that is derived from the JUnit testing framework for Java by Kent - Beck and Erich Gamma. - - While this framework is originally intended to support unit - testing in an object-oriented development paradigm (with support - for inheritance of tests etc.), Test::Unit::Procedural is intended - to provide a simpler interface to the framework that is more - suitable for use in a scripting style environment. - - Therefore, Test::Unit::Procedural does not provide much support - for an object-oriented approach to unit testing - if you want - that, please have a look at Test::Unit::TestCase (also included in - this install). - - A short tutorial on the object-oriented approach can be found in - the documentation of Test::Unit::TestCase (the test base class). - The Test::Unit self-test suite (contained in t/tlib) is a good - example of this approach. - - There is also a GUI based interface to the testing framework. - The "TkTestRunner.pl" script shows how to invoke it. - - The testing framework also features adapters for tests in the - Test::Harness style to tests in the unit testing framework style - and vice versa - see Test::Unit::HarnessUnit and - Test::Unit::UnitHarness. An example of this approach is the - self-test of the unit testing framework that you start with the - 'make test' command (see t/all_tests.t). - -PREREQUISITES - Class::Inner, Devel::Symdump and Error.pm are required. A new-ish - version of base.pm (> 1.0) is required to avoid the problem where - earlier versions failed to compile in the parent class. The Tk - module is needed for the GUI. - -INSTALLATION - Once you have installed the prerequisites, just perform the usual - incantation (replacing 'x.yy' with the current version): - - gunzip Test-Unit-x.yy.tar.gz - tar -xvf Test-Unit-x.yy.tar - cd Test-Unit-x.yy - perl Makefile.PL - make - make test - make install - -AUTHOR - Copyright (c) 2000, 2001 Christian Lemburg, . - - All rights reserved. This program is free software; you can - redistribute it and/or modify it under the same terms as - Perl itself. - - Thanks go to the other PerlUnit framework people: - Brian Ewins, Cayte Lindner, J.E. Fritz, Zhon Johansen, - Piers Cawley, Adam Spiers - - Thanks for patches go to: - Matthew Astley, David Esposito. - -SEE ALSO - - Test::Unit::TestCase (included in this install) - - the README file in the examples directory - - Refactoring -- Improving The Design Of Existing Code. - Martin Fowler. Addison-Wesley, 1999. - - http://www.xProgramming.com/ - -EXAMPLES - Use TestRunner.pl like this (lib adjusted for this directory): - - perl -w -I./lib -I./t/tlib TestRunner.pl AllTests - - Use TkTestRunner like this: - - perl -w -I./lib -I./t/tlib TkTestRunner.pl AllTests - diff --git a/perl/third/Test-Unit-0.25/TestLister.pl b/perl/third/Test-Unit-0.25/TestLister.pl deleted file mode 100755 index 73d8281..0000000 --- a/perl/third/Test-Unit-0.25/TestLister.pl +++ /dev/null @@ -1,27 +0,0 @@ -#!/usr/bin/perl -w - -use strict; - -use Getopt::Long; -use Test::Unit::Loader; - -my %opts = (); -GetOptions(\%opts, 'help', 'testcases'); -usage() if $opts{help}; - -foreach my $test (@ARGV) { - my $suite = Test::Unit::Loader::load($test); - print join '', @{ $suite->list($opts{testcases}) }; -} - -sub usage { - die < [ ... ] - -Options: - --testcases, -t List testcases contained in (sub)suites - --help, -h - -Tests can be package names or file names. -EOF -} diff --git a/perl/third/Test-Unit-0.25/TestRunner.pl b/perl/third/Test-Unit-0.25/TestRunner.pl deleted file mode 100755 index f95b469..0000000 --- a/perl/third/Test-Unit-0.25/TestRunner.pl +++ /dev/null @@ -1,13 +0,0 @@ -#!/usr/bin/perl -w - -use strict; - -use Test::Unit::Debug qw(debug_pkgs); -use Test::Unit::TestRunner; - -# Uncomment and edit to debug individual packages. -#debug_pkgs(qw/Test::Unit::TestCase/); - -my $testrunner = Test::Unit::TestRunner->new(); -$testrunner->start(@ARGV); - diff --git a/perl/third/Test-Unit-0.25/TkTestRunner.pl b/perl/third/Test-Unit-0.25/TkTestRunner.pl deleted file mode 100755 index e8356d7..0000000 --- a/perl/third/Test-Unit-0.25/TkTestRunner.pl +++ /dev/null @@ -1,7 +0,0 @@ -#!/usr/bin/perl -w - -use strict; - -use Test::Unit::TkTestRunner; - -Test::Unit::TkTestRunner::main(@ARGV); diff --git a/perl/third/Test-Unit-0.25/doc/TODO b/perl/third/Test-Unit-0.25/doc/TODO deleted file mode 100644 index ffc563e..0000000 --- a/perl/third/Test-Unit-0.25/doc/TODO +++ /dev/null @@ -1,303 +0,0 @@ -PerlUnit TODO -============= - -Here's our roadmap. It should give you an idea of what is planned, -and in some cases when it's planned for and/or who's going to do it. -Only update this file on the main branch! - -See also doc/consensus.txt. - -* Before release 1.0 - -None of these are big jobs, but Adam thinks they should all be done -before 1.0 if we want the framework to gain respect and widespread -usage; after all, many people will check out PerlUnit for the first -time when they hear 1.0 being announced, and first impressions count -for a lot. - -** Rename Test::Unit::HarnessUnit and Test::Unit::UnitHarness - -Not sure what to yet, but we want to get these big API changes out of -the way before we bump the version number. - -*** HarnessUnit -"A Test::Unit::Runner which outputs Test::Harness-style output" - -Used for most of our self-tests. - -*** UnitHarness -"A makeover of Test::Harness to allow its tests to be retrofitted as -unit tests". Seems to need some work, but is neat for running t/*.t - -What uses it? I can't see anything here, but we may have real live -(and quiet) users. - -It's referenced from T:U:Loader, but only used for certain inputs. - -** Get working build on 5.7.2 and 5.8.0 - -Now seems happy on Debian 5.8.4-2, and I'll cheerfully let the -cpan-testers find out about the others. - -** Rename do_run to run_suite - -in the runners. - -Is this to match T:U:Procedural and T:U:TkTestRunner ? - -** Tidy up copyrights, credits, and licensing - -We had copyrights, licenses, and out of date author attributions in -pretty much every file in the distribution. Tidied up 2005-07 mca. - -> It would be good to move all the copyrights and credits into one or -> two files (COPYING or LICENSE or AUTHORS, say), - -There are still some single-author files: - - T:U:Assertion* - - T:U:Decorator - T:U:Setup - - T:U:Tutorial - -> and then to change the licensing/credit bits and pieces in all the -> other files into something which refers to that one file, and also -> states that none of the files should be distributed separately, only -> as an entire package, thereby preventing the copyright-containing -> file from being disassociated from the others. - -Well I've done a chunk of that. It's not clear that the project -licences need or seek to prevent dissociation of files from the -project. - - -* Document stuff better - -** TestRunner::do_run should be public - -Requested by Matthias Ferber, so that suites can be dynamically -generated by providing parameters. - -** Filtering mechanism is poorly documented. - -** Test::Unit::Tutorial is AWOL - -** examples are old and sparse -Useful stuff has been on the lists... - -** class diagram -We have one at doc/class-diagram.* - -Dunno if it's much good. Notes include specific TODOs at the bottom. - - -* Nice to have before 1.0 - -Some of these could be left until after 1.0. Adam thinks it makes -sense to do them before the release, however; none of them are big -jobs. - -** @TESTS isn't tested. - -** Pinch more assertions from Test::More - -I don't think there's even any particular reason against importing -them directly from Test::More. No point in duplicating code across -CPAN modules without good reason. - -I like these ones: - -*** use_ok(), require_ok(), eq_set() - -import straight in - -*** is_deeply() - -either import or write using FreezeThaw::cmpStr or Data::Compare -or whatever - -*** eq_array(), eq_hash() - -Hmm. Test::Unit::Assertion::Array / Test::Unit::Assertion::Hash? - -*** Easier assertion-set extensibility - -mca: I extend test cases by having a standard (for me) superclass, -into which I pile assorted stuff. It would be nice to provide such -functionality easily and without kinking everyone's inheritance tree. - -Also, may need to avoid bloating the standard assertions set. The -overhead for the compiler is small, but the learning curve ends up -looking much steeper than it needs to be. - -Options... - - - provide "simple" and "hedgehog (bristling)" versions of TestCase - - - use import options to determine assertion set - - - leave them all in, but split the documentation - - - spread them into Piers' T:U:A:* structure... need to investigate - - -** Rethink how the tests are split up between the t/*.t. - -Currently we have t/all_tests.t, which is clearly a misnomer, and we -have some tests for the assertion code being run from that rather than -from t/assert.t. - -** Test::Unit::Loader working with whole directories. - -Test::Unit::Loader::load_test_dir() needs to be finished. - -* After 1.0 - -No harm done if they end up being done before 1.0 though, of course. - -** Test filtering - -Piers suggested the beautiful idea of using Attribute::Handlers so you -could do things like: - - sub test_something : todo {...} - sub test_something : skip_if() {...} - sub test_something : skip {...} - -Adam needs this for work ASAP, and will probably implement it very soon. -There is already a primitive filtering mechanism in place which is -controlled by the filter() and filter_method() methods. - -Update: Adam met up with Piers a few months ago and together they -figured out that Attribute::Handlers may be unusable due to its -magic happening in the BEGIN phase, whereas all user test code gets -compiled at run-time via Test::Unit::Loader. Hmm. - -** Tests to add - -*** PerlUnit selftests - -**** die errors that look like variable names [mca] - -A test that fails with an error like - - die '$lotsofdollars'; - -and make sure it gets wrapped into an ExceptionError - -**** doing the right OOP thing in constructors and isa() checks - -Possibly a test that overrides the 'isa' method so Piers' fix to my -patch - - (back to using $exception->isa(C) instead of UNIVERSAL::isa($exception,C)) - -can be exercised. - -Also Adam has patched some of the PerlUnit constructors to allow -passing a classname instead of being invoked as a method. - -**** check for broken Error.pm overloading of exceptions [as] - -Older Error.pms don't do boolean overload, so - - eval { ... }; - if ($@) { - ... - } - -could break. We should check for that. - -*** Generic tests for users to include - -Matthew wrote some. Whether anyone else wants them remains to be seen. - -The potentially useful ones: - -**** test_SubsAllNeedTests - -Checks all subs in a module are tested. Take the code and put it -somewhere else. - -**** test_PodChecker - -Look the sourcecode up in %INC and run it through the Pod::Checker -(which spits out stuff to STDOUT regardless). - -**** test_HaveWarnings - -Check $^W .. a bit cheeky. I was actually after a check for -strictness, after forgetting to use it in some module I broke off, but -this is either tricky or impossible. - -[Impossible I believe. That's kind of the point of lexical scope after all - -- pdc] - -*** Test coverage tests - -There was a big thread on this but it's someone else's turn to write -about that. 8-) -- mca - -Current thinking is to keep test-coverage tests away from the executed -tests, mainly so you can have a script which draws a pretty chart of -how well your code is tested. Adam has some code for this. - -* Personal TODO lists - -Moved here from doc/consensus.txt. - -** Matthew - -tktestrunner: ctrl-q, file menu shortcut - -assert_deep_equals patches: - check Test::More for updates - can we do that direct use linkage? - do I need to backport the patches we have? - -move the scripts somewhere so they get installed in a bin/ - -put version numbers in all modules (my or our or oldestyle?) -as below, - - - if derived from CVS, with a note somewhere about bumping CVS - versions if files take non-linear routes somewhere - - - cd src/Test-Unit; grep -rL VERSION lib/ | grep -v CVS/ - -*** integrate Debianisations and credit the relevant folks -/usr/share/doc/libtest-unit-perl/changelog.Debian.gz - -note, dropped from Debian unstable: - http://bugs.debian.org/279805 - http://bugs.debian.org/317416 - -*** update top-level README - -*** Periodic checks -(should go in doc/release-checklist, or better yet in an installation -test) - -Search for Test::* and check they still exist - -Search for 'package' ... UnitHarness contains >1 - -http://www.cpan.org/modules/04pause.html says: - Please make sure all your *.pm files contain a $VERSION variable that - conforms to the CPAN rules, i.e. the complete computation of $VERSION - must take place on the one first line within the module that assigns - to it. You can test if this is the case by running - - perl -MExtUtils::MakeMaker -le 'print MM->parse_version(shift)' 'file' - -*** Find a neat way to run unit-tested programs without the suite - -It's convenient for medium sized projects to stick the test subs in -the classes they test, but then you have a run-time dependence on perlunit. - -**** Local Variables: -**** mode: outline -**** End: - diff --git a/perl/third/Test-Unit-0.25/doc/class-diagram.dia b/perl/third/Test-Unit-0.25/doc/class-diagram.dia deleted file mode 100644 index caffaf2..0000000 --- a/perl/third/Test-Unit-0.25/doc/class-diagram.dia +++ /dev/null @@ -1,12011 +0,0 @@ - - - - - - - - - - - - - #A4# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::Failure# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::Assert# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #assert# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #normalize_assertion# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #assert_raises# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #do_assertion# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #multi_assert# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #is_numeric# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #assert_equals# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #ok# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #assert_not_equals# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #assert_deep_equals# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #_deep_check# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #_eq_array# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #_eq_hash# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #_format_stack# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #fail# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #error# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #quell_backtrace# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #get_backtrace_on_fail# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::Procedural# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #add_to_suites# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #assert# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #create_suite# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #run_suite# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_suite# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::Error# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #make_new_from_error# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::Result# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #_Listeners# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #_Errors# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #_Failures# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #_Run_tests# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #_Stop# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - - - #new# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #tell_listeners# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_error# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_failure# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_pass# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_listener# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #listeners# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #end_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #error_count# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #errors# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #failure_count# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #failures# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #run# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #run_protected# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #run_count# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #run_count_inc# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #should_stop# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #start_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #stop# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #was_successful# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #to_string# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::Loader# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #obj_load# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #compile# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #compile_class# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #compile_file# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #load# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #load_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #load_test_suite# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #load_test_case# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #extract_testcases# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #load_test_harness_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #load_test_dir# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #get_package_name_from_file# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::Runner::Terminal# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #_last_test# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - - - #start_suite# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #end_suite# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #start_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #end_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_error# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_failure# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_pass# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #_update_status# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #print_result# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::Assertion# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #fail# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #do_assertion# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #new# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::UnitHarness# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #_Name# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #_Names# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - - - #new# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #run# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #name# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #names# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_test_method# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #count_test_cases# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #to_string# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #warning# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::TkTestRunner# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #frame# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #number_of_errors# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #number_of_failures# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #failure_list# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #failed_tests# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #exceptions# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #planned# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #suite_name# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #suite_label# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #suite_field# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #add_text_listener# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #run# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #progress_bar# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #failure_label# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #quit_button# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #rerun_button# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #show_error_button# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #status_line_box# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #runs# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #status_line# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #listbox# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #number_of_runs# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #runner# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #result# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #start_time# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #finish_time# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #run_time# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - - - #new# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #about# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_error# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_failure# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #append_failure# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #plan# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #choose_file# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #create_punit_menu# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #create_menus# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #create_ui# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #end_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #get_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #is_error_selected# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #load_frame_icon# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #main# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #rerun# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #reset# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #run# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #run_failed# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #run_suite# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #show_error_trace# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #show_info# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #show_status# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #start# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #start_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_pass# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #update# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_to_history# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::Assertion::CodeRef# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #new# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #do_assertion# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #to_string# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::HarnessUnit# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #_Print_stream# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - - - #new# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #print_stream# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #_print# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #start_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #not_ok# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #ok# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_error# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_failure# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_pass# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #end_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #do_run# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #main# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #run# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #start# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::Assertion::Exception# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #new# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #do_assertion# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #to_string# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::Setup# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #run# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #set_up# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #tear_down# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::Runner# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #_result# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #_suites_running# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #_filter# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - - - #create_test_result# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #result# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #start_suite# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #end_suite# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #suites_running# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #filter# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #reset_filter# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::Assertion::Boolean# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #new# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #do_assertion# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #to_string# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::UnitHarness::Exception# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #stacktrace# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - - - #new# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #stacktrace# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::TestCase# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #__PACKAGE__ . "_annotations# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #__PACKAGE__ . "_name# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - - - #new# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #annotate# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #annotations# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #count_test_cases# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #create_result# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #name# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #run# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #run_bare# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #run_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #set_up# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #tear_down# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #to_string# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #make_test_from_coderef# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #list_tests# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #get_matching_methods# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #list# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::TestSuite# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #_Name# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - #_Tests# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - - - #empty_new# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #new# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #suite# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #name# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #names# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #list# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #count_test_cases# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #run# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #filter_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #test_at# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #test_count# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #tests# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #to_string# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_warning# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::Exception# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #_hide_backtrace# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - - - #throw_new# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #stacktrace# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #get_message# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #hide_backtrace# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #stringify# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #to_string# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #failed_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #thrown_exception# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::Test# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #count_test_cases# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #run# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #name# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #to_string# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #filter_method# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #filter# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #_find_sym# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #MODIFY_CODE_ATTRIBUTES# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::Listener# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #new# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #start_suite# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #start_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_error# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_failure# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #end_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::Decorator# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #_fTest# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - - - #new# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #basic_run# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #count_test_cases# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #run# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #to_string# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #get_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::Assertion::Regexp# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #new# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #do_assertion# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #to_string# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::TestRunner# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #_Print_stream# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - - - #new# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #print_stream# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #_print# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_error# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_failure# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #add_pass# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #do_run# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #end_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #main# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #print_result# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #print_errors# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #print_failures# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #print_header# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #run# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #run_and_wait# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #start# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #start_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - #Error# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::Warning# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #_message# - - - ## - - - ## - - - ## - - - - - - - - - - - - - - - - #run_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - #new# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #Test::Unit::UnitHarness::TestCase# - - - ## - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #run_test# - - - ## - - - ## - - - - - - ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #(c) 2005 PerlUnit project <http://perlunit.sf.net/> -Class diagram generated by autodia <http://droogs.org/autodia> -and some tweaking, for "v0.24 plus bugfixes and filtering", -the CVS "HEAD" version 2005-07-01# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #See doc/class-diagram.txt for caveats!# - - - - - - - - - - - - - - - - - - - - - diff --git a/perl/third/Test-Unit-0.25/doc/class-diagram.png b/perl/third/Test-Unit-0.25/doc/class-diagram.png deleted file mode 100644 index beeaf43..0000000 Binary files a/perl/third/Test-Unit-0.25/doc/class-diagram.png and /dev/null differ diff --git a/perl/third/Test-Unit-0.25/doc/class-diagram.txt b/perl/third/Test-Unit-0.25/doc/class-diagram.txt deleted file mode 100644 index 1a121b2..0000000 --- a/perl/third/Test-Unit-0.25/doc/class-diagram.txt +++ /dev/null @@ -1,198 +0,0 @@ --*- outline -*- (this mark tells Emacs to use '*' heading levels) - - -* Comments on the class diagrams -Diagram is in early stages so - - - there are probably better ways to carve it up - - - there are bugs in it, take it as an overview - -Please let me know if it's helpful -- mca1001 - - -I've coloured parts of the full diagram, to try to show where to -start. And starting may be all you need. - -** Classes to interact with directly (yellow) -These classes have fairly thorough POD and are intended as the main -interfaces for "the user". - -Test::Unit::Procedural is all you need for simple work, but reduces -flexibility. You don't need it at all for the explicit object -oriented approach. - -Test::Unit::TestCase is what you inherit you tests from, if you take -the explicit OO approach. - -Test::Unit::TestSuite can be used to put your TestCases together in -groups or trees, and make it easier to manage more complex OO test -systems. - -** Test runners (green) -One of these will be used to manage the running of your test suite. -They all do basically the same thing, but their outputs are different: -interactive GUI, terminal and Test::Harness linkage. - -Generally, an instance will be made for you by whatever script you use -to kick off the test run, e.g. TestRunner.pl or TkTestRunner.pl - -** Things you'll probably see (red) -If something die()s during your test - any sort of error - this is -caught and wrapped as a Test::Unit::Error object. - -When a test assertion fails, an instance of Test::Unit::Failure is -created and "thrown". - -These objects then percolate into the depths of the mechanism, to be -collected and reported later. I'm being vague, to spare you the -details. - -Test::Unit::Assert isn't for use explicitly in your code, but the -manpage contains a handy breakdown of the various assert methods you -can use. - - -* Construction of class diagram -** Generate the bulk of the diagram -I fired up "autodia" aka. "autodial" with - - cd $PROJDIR - autodia.pl -d lib/ -rC - dia-gnome autodia.out.xml & - -Then I started moving boxes around. Don't worry, they are joined -together! It helps to set the "autoroute" property on the -connectors... use the "group properties..." dialog? I didn't get as -far as hacking the template to fix this. - -...shuffle boxes until they're close to the relevant thing and you -have a big tangle of class usage. Time to simplify. Probably easier -if you crib my layout. - -[later] It doesn't list inheritance outside the codebase...? Or just -not for "use base". And not for Test::Unit::TestSuite, -Test::Unit::Warning... argh. - -** Remove stuff that isn't helping -There are dependencies in there which don't need to be graphed. - -List of class/what uses it, plus rough notes: - - base - used by many classes - - Config - Test::Unit::UnitHarness - - Error - base class for Test::Unit::Exception, so left on the diagram - also used by - Test::Unit::Procedural - Test::Unit::Assertion::Exception - Test::Unit::Assert - Test::Unit::Result - Test::Unit::TestCase - - File::Basename - Test::Unit::TkTestRunner - - Tk, Tk::BrowseEntry - Test::Unit::TkTestRunner - - - Tk::ROText Tk::ArrayBar (?) should be TkTestRunner - Tk::DialogBox Tk::ArrayBar (?) - Tk::Derived Tk::ArrayBar - Tk::Canvas Tk::ArrayBar - - Devel::Symdump -> what's this all about, then? - Test::Unit::Procedural - Test::Unit::TestCase - - Filehandle - Test::Unit::Loader - Test::Unit::UnitHarness - - Benchmark -> candidate for moving to Test::Unit::Runner - Test::Unit::TestRunner - Test::Unit::TkTestRunner - - Exporter -> (list incomplete) -> may be useful to know... - Test::Unit::Debug - Test::Unit::Procedural - Test::Unit::UnitHarness - - - Class::Inner -> was split off this project at some point? - Test::Unit::Procedural - Test::Unit::UnitHarness - Test::Unit::TestCase - - Tk:ArrayBar -> is part of Test::Unit::TkTestRunner, interesting in its own right, but not relevant here - - - Test::Unit::Debug - used by many things, but basically dull - Test::Unit::Assertion::CodeRef - Test::Unit::Assert - Test::Unit::Assertion::Exception - Test::Unit::TestSuite - Test::Unit::Result - Test::Unit::Test - Test::Unit::TestCase - Test::Unit::UnitHarness - Test::Unit::Loader - - Test::Unit::Loader -> used by many things; headed towards "scary" -> looks like it should be used by the Runner instead? - Test::Unit::Listener - Test::Unit::TestSuite - Test::Unit::HarnessUnit - Test::Unit::TkTestRunner - Test::Unit::TestRunner - uses - Test::Unit::UnitHarness - Test::Unit::TestSuite - - Test::Unit::Warning - mundane helper class - Test::Unit::TestSuite - Test::Unit::Loader - - Test::Unit::Tutorial - contains no code - - Test::Unit - contains only constants - Test::Unit::TestRunner - Test::Unit::TkTestRunner - -** TO DO - -Filter method & members: some detail is obsolete, should be hidden, -takes up too much space. - -Ensure all classes are shown. - -Mark presence of/need for docs, level of detail, position on learning -parabola. - -Um, I'm just about to add more stuff. Doh. - -Check uses & inheritance lines are correct and significant. How -tedious. - -It would be nice to cover all the classes with at least some -explanation of what they are and how they fit in, but there's no point -duplicating POD material. Maybe break out the relevant parts into -another diagram that shows the examples too? - -A similar diagram (sequence diagram?) for how the tests are loaded, -built into suites, run and reported. diff --git a/perl/third/Test-Unit-0.25/doc/consensus.txt b/perl/third/Test-Unit-0.25/doc/consensus.txt deleted file mode 100644 index c761b1e..0000000 --- a/perl/third/Test-Unit-0.25/doc/consensus.txt +++ /dev/null @@ -1,166 +0,0 @@ --*- outline -*- - -* Intro - -We were wondering how we should go about keeping track of the -consensuses (sp?) we reached on the perlunit-devel mailing list. -Matthew was all for a cumbersome set of tags so we could grep the list -for "points". Christian suggested a simple text file in CVS which we -modify as appropriate. This is a compromise - a simple text file -marked up for use with emacs' "outline-mode". Most of the active -developers use emacs. - -Issues currently being discussed on the list can be kept track of here -by listing any suggestions made or conclusions which were reached. -Once it's decided what needs to be done, the details should be moved -to doc/TODO and someone will get on with implementing them. - -Please only update this file on the main branch! - -** Links back to the mailing list - -Might be handy for those with local archives, but dropping message-ids -in this file will make a mess IMHO -- mca - -* Coding conventions - -If in doubt, conform to the style shown in the existing code. - -** use vs. require - -After a discussion on perlunit-devel in March 2001, subject 'Towards -sensible failure messages', we settled on use rather than require, except -where we only want to load a module if we need it, of course. - -** whitespace - -No hard tabs, 4 column indent level. - -* Auto-adding tests, Test::Unit::TestSuite->new() - -** interaction with inheritance - -Broken in v0.13, it will take SUPER::test_foo if test_foo is -an inheritted method in the class being scanned. - -Fixed by Piers. - -** regexps to pull functions called /^test/ - -I think current consensus is to change the default to /^test[_A-Z]/ -but make it configurable. - -I seem to have lost that thread -- mca - -* Debug methods - -Not much agreement yet, here are some of the suggestions - -** $self->debug() - -A dead/unused patch from Matthew, the idea was a default debug in the -base T:U:TestCase class and methods to override it. Messy and -inconvenient. - -** $self->listener->debug($@) - -Some say listeners are Java-ish. Others say that they're good anyway. -9-) - -Arguments are headed towards something like - debug( level => 123, - user => "simple message", - developer => "complicated message" ); -or some variation on the theme. - -This all looks rather verbose so far though. 8-( - -** clever things with caller() - -one vote for [MCA] (provided you can override it) -one vote against? [PDC] - -* Documentation - -** Where? - -Where should it be kept? At the moment it lives almost entirely in POD -and mailing list/message board format, and so is inaccessible. - -A pod2html pass of released software should probably be served on the -website. - -Matthew's (almost finished) cvspublish.pl script could do most of this -but is probably overkill. Also it doesn't grok MANIFEST files. - -There is a documentation manager on SF. The front door is not too -friendly and there is no back door to the data inside it. - -** API & PerlUnit overview - -Current favourite is to point at the JUnit docs. - -There is in 'src/api' a set of basic perl modules containing the -essence of the structure, but they're getting old. - -Also, the SF message boards have some knowledge which needs -distilling. - -* Namespace pollution - -** classes used during self-tests - -We're going to try to avoid it while generating "inner classes" or -whatever, for the self-tests. - -** keys in the TestCase object hash [not yet discussed] - -T:U::TestCase::new is biting into namespace belonging to classes -inherited from T:U::TestCase .. currently it only takes _name ... I'm -wondering whether we should go to '__' prefix in the C tradition for -"magic things", since the perlunit user shouldn't need to mess with -this? -- mca - -Not sure I understand what you're getting at here. The PITA approach would be -to name all the keys used only by T:U::TestCase as - -'Test::Unit::TestCase::keyname', which is a pain to work with, but probably -the best practice. See the discussion in Damian Conway's Object Oriented Perl. - - -- pdc - -* TODO lists - -Moved to doc/TODO. - -* Packaging - -[mca: Christian has SourceForge and CPAN packaging pretty much wrapped -up *cough*, this is documented in another file in this directory] - -** Debian GNU/Linux - -[mca: Since I use perlunit for production work, I'm tempted to roll a -package if it's not too tricky. There is a stack of reading to do -first though (I'm not an official Debian developer) - -Relevant bit from /usr/doc/dh-make-perl/README - - dh-make-perl will create the files required to build - a debian source package out of a perl package. - This works for most simple packages and is also useful - for getting started with packaging perl modules. - - There is an override mechanism in place to handle most of - the little changes that may be needed for some modules - (this hasn't been tested much, though). - - Using this program is no excuse for not reading the - debian developer documentation, including the policy, - the perl policy, the packaging manual and so on. - -See also http://www.uk.debian.org/devel/ ] - -** RedHat - -[mca: I made a RH package a long time ago... don't remember how] diff --git a/perl/third/Test-Unit-0.25/doc/release-checklist b/perl/third/Test-Unit-0.25/doc/release-checklist deleted file mode 100644 index 3612d04..0000000 --- a/perl/third/Test-Unit-0.25/doc/release-checklist +++ /dev/null @@ -1,173 +0,0 @@ - - This is out of date in places. I haven't investigated which places. - - Note that there are multiple bug trackers, listed here in what mca - considers the order of preference, - - http://sourceforge.net/tracker/?group_id=2653&atid=102653 - http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Unit - http://bugs.debian.org/libtest-unit-perl - - Also note use of ChangeLog instead of Changes, and parts of doc/TODO - -------------------------------------------------- -The procedure should be: -------------------------------------------------- - -Prerequisites: -Make sure all the tests run OK. -Make sure all the examples run OK. - -1. Commit new files in src/Test-Unit -2. lib/Test/Unit.pm - put in the new $VERSION for the distribution -3. MANIFEST if files are to be added to the tarball - ("make manifest" will add new files and tell you, but check they're - not local cruft from your working copy. Get a clean checkout of - the working copy to ensure no files are missing, or that you have - removed deleted files from MANIFEST.) -4. cvs rtag -r HEAD REL_0_14 releasemodule - (with the $VERSION number from above) -5. make clean ; perl Makefile.PL ; make tardist -6. upload to incoming as per Sourceforge docs -7. notify current CPAN maintainer to get an upload - - -------------------------------------------------- -Explanation on version number synchronization: -------------------------------------------------- - -The CPAN module will decide to upgrade a module when the version number -of the module installed locally is less than the highest version number -of any version of the module it can find on CPAN. It will find out the -distribution file this module is in, and then install this distribution -file. This can lead to surprising results for distribution files that -contain multiple modules. - -Take this common situation: package Foo-0.22.tar.gz contains modules -Foo, Foo::Bar, and Foo::Baz. Now, something changes in Foo::Bar, and -Foo::Bar gets a new version number. The module author happily uploads -Foo-0.23.tar.gz to CPAN. - -Now, will the CPAN module use Foo-0.23.tar.gz to upgrade package Foo if you -tell it "install Foo"? No. CPAN will look at the version number for Foo, -determine it has not changed compared to the locally installed version, -and do nothing. You have to tell it "install Foo::Bar" to get the new -distribution file, which is bad, since nobody will know she has to -do that. - -The solution is to make sure any time a distribution file gets upgraded, -its top level module should get a new, higher version number. This way, -things will work like people expect them to work. - -Please note that any module on CPAN should have a version number, even -if it is contained in a package with many other modules. This ensures -that people can require a certain version of any module in a given -distribution file. - - -------------------------------------------------- -References -------------------------------------------------- - -Date: Wed, 21 Feb 2001 14:06:35 +0000 -From: Matthew Astley -To: perlunit-devel@lists.sourceforge.net -Subject: Re: [Perlunit-devel] CVS tags / release procedure -Message-ID: <20010221140635.P25661@grantadesign.com> -References: <20010220215614.H25661@grantadesign.com> <000901c09bf0$a1641140$9f0010ac@aixonix.de> <20010221130709.A9412@thelonious.new.ox.ac.uk> <20010220215614.H25661@grantadesign.com> <000901c09bf0$a1641140$9f0010ac@aixonix.de> -In-Reply-To: <000901c09bf0$a1641140$9f0010ac@aixonix.de>; from lemburg@aixonix.de on Wed, Feb 21, 2001 at 11:25:36AM +0100 - -On Wed, Feb 21, 2001 at 11:25:36AM +0100, Christian Lemburg wrote: - -> OK so far, I suggest to replace the manual tar with -> "make clean ; perl Makefile.PL ; make tardist" -> (your perl will do the Right CPAN Thing for you). - -[revised] - - Commit new files in src/Test-Unit-0.1 including - - - Changes (section for release at the top) - - - Makefile.PL (set new $VERSION) - - - README (Version numbers on installation commands .. surely we - could put something generic in here?) - - - MANIFEST if files are to be added to the tarball - - cvs rtag -r HEAD REL_0_14 releasemodule - - cvs exp -r REL_0_14 -d Test-Unit-n.nn src/Test-Unit-0.1 - - make clean ; perl Makefile.PL ; make tardist - - (upload to incoming as per Sourceforge docs) - - -As for the CPAN stuff, is this complicated? Presumably the significant -changes are documented in ExtUtils::MakeMaker? - -Also, since there's filtering via MANIFEST, is there any need to -'export' instead of running from a checked out working copy? Could -Makefile.PL enquire of CVS or the top of the Changes file which -version we're releasing? - -I'm thinking about reducing the number of things that need trivial -tweaks before making a release. - -> > I'm left thinking that it could be handy to tag files as development -> > only, so for example I could drop my GenericTests.pm into place but -> > tag it as mine/not for release. It's rather hard for someone to commit -> > on a patch, I think? - -So we've a solution to this separate problem, but perhaps we should -hold off the feature creep until we've got more tests in? - -(any bright ideas for ways to tie the docs to the tests so the can -fail a test when we tweak things? I'm just about to digress hugely so -I'll save it for another post) - -> > * tag release stuff as STABLE or similar, then do -> > -> > cvs rtag -r STABLE REL_0_14 releasemodule -[patches commands above, nb. "-r HEAD" instead of "-r STABLE"] -> > -> > and export that. -> -> That would be my preferred option. - -Would suit me too, since ATM we've no way to backtrace to a release. -Only thing is, if you can release a checked out copy, the export is a -little wasteful. - - -Matthew #8-) - - -From: "Christian Lemburg" -To: "Matthew Astley" , - -References: <20010220215614.H25661@grantadesign.com> <000901c09bf0$a1641140$9f0010ac@aixonix.de> <20010221130709.A9412@thelonious.new.ox.ac.uk> <20010220215614.H25661@grantadesign.com> <000901c09bf0$a1641140$9f0010ac@aixonix.de> <20010221140635.P25661@grantadesign.com> -Subject: Re: [Perlunit-devel] CVS tags / release procedure -Date: Wed, 21 Feb 2001 15:58:34 +0100 - -> Also, since there's filtering via MANIFEST, is there any need to -> 'export' instead of running from a checked out working copy? Could -> Makefile.PL enquire of CVS or the top of the Changes file which -> version we're releasing? - -No. You can just run from a checked out working copy. -At least that was what I did until now. - -Cheers, - -Christian - - - -_______________________________________________ -Perlunit-devel mailing list -Perlunit-devel@lists.sourceforge.net -http://lists.sourceforge.net/lists/listinfo/perlunit-devel - diff --git a/perl/third/Test-Unit-0.25/examples/Experimental/Sample.pm b/perl/third/Test-Unit-0.25/examples/Experimental/Sample.pm deleted file mode 100644 index 2b60c9d..0000000 --- a/perl/third/Test-Unit-0.25/examples/Experimental/Sample.pm +++ /dev/null @@ -1,33 +0,0 @@ -package Experimental::Sample; - -use strict; -use vars qw($VERSION @ISA @EXPORT $SIGNPOST $test_suite); - -require Exporter; - -@ISA = qw(Exporter); - - -sub new { - my $pkg = shift; - my $self = { @_ }; - - - bless($self, $pkg); - - return $self; -} - -# object methods - public - -sub name { - my ( $self, $name ) = @_; - if( defined( $name ) ){ - $self->{name} = $name; - } - return $self->{name}; -} - - -1; -__END__ diff --git a/perl/third/Test-Unit-0.25/examples/README b/perl/third/Test-Unit-0.25/examples/README deleted file mode 100644 index d29c92c..0000000 --- a/perl/third/Test-Unit-0.25/examples/README +++ /dev/null @@ -1,16 +0,0 @@ -This directory contains examples of the framework in use. -It's a bit out of date now... - -tester.png: ------------ -This is a screenshot of the GUI running (view with a PNG viewer, e.g., -your favorite web browser). Also visible on the SF screenshot page. - -patch100132*, fail_example.pm ------------------------------ - -Very mysterious. They get used by 'make test' via t/try_examples.t -though. fail_example.pm is supposed to be an example for -TestDecorator and Setup. You can run it via: - - perl -I../lib/ ../TestRunner.pl fail_example diff --git a/perl/third/Test-Unit-0.25/examples/fail_example.pm b/perl/third/Test-Unit-0.25/examples/fail_example.pm deleted file mode 100644 index f7acde1..0000000 --- a/perl/third/Test-Unit-0.25/examples/fail_example.pm +++ /dev/null @@ -1,60 +0,0 @@ -package fail_example; # this is the test case to be decorated - -use strict; - -use Test::Unit::Debug qw(debug debugged); -use Test::Unit::TestSuite; - -use base qw(Test::Unit::TestCase); - -sub test_ok { - my $self = shift(); - $self->assert(23 == 23); -} - -sub test_fail { - my $self = shift(); - $DB::single = $DB::single; # avoid 'used only once' warning - $DB::single = 1 if debugged(); #this breaks into the debugger - $self->assert(scalar "born" =~ /loose/, "Born to lose ..."); -} - -sub set_up { - my $self = shift()->SUPER::set_up(@_); - debug("hello world\n"); -} - -sub tear_down { - my $self = shift(); - debug("leaving world again\n"); - $self->SUPER::tear_down(@_); -} - -sub suite { - my $testsuite = Test::Unit::TestSuite->new(__PACKAGE__); - my $wrapper = fail_example_testsuite_setup->new($testsuite); - return $wrapper; -} - -1; - -package fail_example_testsuite_setup; -# this suite will decorate fail_example with additional fixture - -use strict; -use Test::Unit::Debug qw(debug); - -use base qw(Test::Unit::Setup); - -sub set_up { - my $self = shift()->SUPER::set_up(@_); - debug("fail_example_testsuite_setup\n"); -} - -sub tear_down { - my $self = shift(); - debug("fail_example_testsuite_tear_down\n"); - $self->SUPER::tear_down(@_); -} - -1; diff --git a/perl/third/Test-Unit-0.25/examples/patch100132 b/perl/third/Test-Unit-0.25/examples/patch100132 deleted file mode 100644 index 002d5b9..0000000 --- a/perl/third/Test-Unit-0.25/examples/patch100132 +++ /dev/null @@ -1,41 +0,0 @@ -#!/usr/bin/perl -w - -use strict; - -use Experimental::Sample; -use Test::Unit::Procedural; - -use constant DEBUG => 0; - -# code to be tested will be somewhere around here - -# define tests, set_up and tear_down - -sub test_ok_1 { - assert(23 == 23); -} - -sub test_ok_2 { - assert(42 == 42); -} - -sub test_ok_3 { - my $sample = new Experimental::Sample(); - $sample->name( 'Joe' ); - assert( 'Joe' eq $sample->name() ); -} - -sub set_up { - print "hello world\n" if DEBUG; -} - -sub tear_down { - print "leaving world again\n" if DEBUG; -} - -# and run them - - -create_suite( 'Experimental::Sample' ); -create_suite; -run_suite(); diff --git a/perl/third/Test-Unit-0.25/examples/patch100132-1 b/perl/third/Test-Unit-0.25/examples/patch100132-1 deleted file mode 100644 index 8cedb01..0000000 --- a/perl/third/Test-Unit-0.25/examples/patch100132-1 +++ /dev/null @@ -1,50 +0,0 @@ -#!/usr/bin/perl -w - -use strict; - -use Experimental::Sample; -use Test::Unit::Procedural; - -use constant DEBUG => 0; - -# code to be tested will be somewhere around here - -# define tests, set_up and tear_down - -sub test_ok_1 { - assert(23 == 23); -} - -sub test_ok_2 { - assert(42 == 42); -} - -sub test_ok_3 { - my $sample = new Experimental::Sample(); - $sample->name( 'Joe' ); - assert( 'Joe' eq $sample->name() ); -} - -sub set_up { - print "hello world\n" if DEBUG; -} - -sub tear_down { - print "leaving world again\n" if DEBUG; -} - -# and run them - -# This will not work, as the test methods were -# defined in package main: -# -# create_suite( 'Experimental::Sample' ); -# run_suite(); -# -# We need to create the default suite -# (created from package main) to pick -# our test methods up - they just use the -# methods in Experimental::Sample ... - -create_suite(); -run_suite(); diff --git a/perl/third/Test-Unit-0.25/examples/patch100132-2 b/perl/third/Test-Unit-0.25/examples/patch100132-2 deleted file mode 100644 index 1d5af7c..0000000 --- a/perl/third/Test-Unit-0.25/examples/patch100132-2 +++ /dev/null @@ -1,69 +0,0 @@ -#!/usr/bin/perl -w - -use strict; - -use Experimental::Sample; -use Test::Unit::Procedural; - -use constant DEBUG => 0; - -# code to be tested will be somewhere around here - -# define tests, set_up and tear_down - -sub test_ok_1 { - assert(23 == 23); -} - -sub test_ok_2 { - assert(42 == 42); -} - -sub test_ok_3 { - my $sample = new Experimental::Sample(); - $sample->name( 'Joe' ); - assert( 'Joe' eq $sample->name() ); -} - -sub set_up { - print "hello world\n" if DEBUG; -} - -sub tear_down { - print "leaving world again\n" if DEBUG; -} - -# and run them - -# This will not work, as the test methods were -# defined in package main: -# -# create_suite( 'Experimental::Sample' ); -# run_suite(); -# -# We need to create the default suite to pick -# our test methods up - they just use the -# methods in Experimental::Sample ... -# -# The other way is to define the tests in -# package Experimental::Sample itself. -# Then we can proceed as indicated above, -# but we obviously need to run the suite -# we created, not the default suite: - -sub Experimental::Sample::test_ok_1 { - assert(23 == 23); -} - -sub Experimental::Sample::test_ok_2 { - assert(42 == 42); -} - -sub Experimental::Sample::test_ok_3 { - my $sample = new Experimental::Sample(); - $sample->name( 'Joe' ); - assert( 'Joe' eq $sample->name() ); -} - -create_suite( 'Experimental::Sample' ); -run_suite( 'Experimental::Sample' ); diff --git a/perl/third/Test-Unit-0.25/examples/tester.png b/perl/third/Test-Unit-0.25/examples/tester.png deleted file mode 100644 index 5bda5ec..0000000 Binary files a/perl/third/Test-Unit-0.25/examples/tester.png and /dev/null differ diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit.pm deleted file mode 100644 index 2416300..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit.pm +++ /dev/null @@ -1,127 +0,0 @@ -=head1 NAME - -Test::Unit - the PerlUnit testing framework - -=head1 SYNOPSIS - -This package provides only the project version number, copyright -texts, and a framework overview in POD format. - -=head1 DESCRIPTION - -This framework is intended to support unit testing in an -object-oriented development paradigm (with support for -inheritance of tests etc.) and is derived from the JUnit -testing framework for Java by Kent Beck and Erich Gamma. To -start learning how to use this framework, see -L and L. (There -will also eventually be a tutorial in -L. - -However C is the procedural style -interface to a sophisticated unit testing framework for Perl -that . Test::Unit is intended to provide a simpler -interface to the framework that is more suitable for use in a -scripting style environment. Therefore, Test::Unit does not -provide much support for an object-oriented approach to unit -testing. - -=head1 COPYRIGHT - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see the F file included in this distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -That is, under the terms of either of: - -=over 4 - -=item * - -The GNU General Public License as published by the Free Software -Foundation; either version 1, or (at your option) any later version. - -The text of version 2 is included in the PerlUnit distribution package -as F. - -=item * - -The "Artistic License" which comes with Perl. - -The text of this is included in the PerlUnit distribution package as -F. - -=back - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=item * - -L - -=back - -=head1 FEEDBACK - -The Perl Unit development team are humans. In part we develop stuff -because it scratches our collective itch but we'd also really like to -know if it scratches yours. - -Please subscribe to the perlunit-users mailing list at -L and let -us know what you love and hate about PerlUnit and what else you want -to do with it. - -=cut - -package Test::Unit; - -use strict; -use vars qw($VERSION); - -# NOTE: this version number has to be kept in sync with the -# number in the distribution file name (the distribution file -# is the tarball for CPAN release) because the CPAN module -# decides to fetch the tarball by looking at the version of -# this module if you say "install Test::Unit" in the CPAN -# shell. "make tardist" should do this automatically. - -BEGIN { - $VERSION = '0.25'; -} - -# Constants for notices displayed to the user: - -use constant COPYRIGHT_SHORT => < <<'END_COPYRIGHT_NOTICE'; -This is PerlUnit version $Test::Unit::VERSION. -Copyright (C) 2000-2002, 2005 Christian Lemburg, Brian Ewins, et. al. - - -PerlUnit is a Unit Testing framework based on JUnit. -See http://c2.com/cgi/wiki?TestingFrameworks - -PerlUnit is free software, redistributable under the -same terms as Perl. -END_COPYRIGHT_NOTICE - - -1; -__END__ diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Assert.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Assert.pm deleted file mode 100644 index 5d5cde0..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Assert.pm +++ /dev/null @@ -1,726 +0,0 @@ -package Test::Unit::Assert; - - -use strict; - -use Test::Unit::Debug qw(debug); -use Test::Unit::Failure; -use Test::Unit::Error; -use Test::Unit::Exception; - -use Test::Unit::Assertion::CodeRef; - -use Error qw/:try/; -use Carp; - -sub assert { - my $self = shift; - my $assertion = $self->normalize_assertion(shift); - $self->do_assertion($assertion, (caller($Error::Depth))[0 .. 2], @_); -} - -sub normalize_assertion { - my $self = shift; - my $assertion = shift; - - if (!ref($assertion) || ref($assertion) =~ 'ARRAY') { - debug((defined $assertion ? $assertion : '_undef_') . - " normalized as boolean\n"); - require Test::Unit::Assertion::Boolean; - return Test::Unit::Assertion::Boolean->new($assertion); - } - - # If we're this far, we must have a reference. - - if (eval {$assertion->isa('Regexp')}) { - debug("$assertion normalized as Regexp\n"); - require Test::Unit::Assertion::Regexp; - return Test::Unit::Assertion::Regexp->new($assertion); - } - - if (ref($assertion) eq 'CODE') { - debug("$assertion normalized as coderef\n"); - require Test::Unit::Assertion::CodeRef; - return Test::Unit::Assertion::CodeRef->new($assertion); - } - -# if (ref($assertion) eq 'SCALAR') { -# debug("$assertion normalized as scalar ref\n"); -# require Test::Unit::Assertion::Scalar; -# return Test::Unit::Assertion::Scalar->new($assertion); -# } - - if (ref($assertion) !~ /^(GLOB|LVALUE|REF|SCALAR)$/) { - debug("$assertion already an object\n"); - require Test::Unit::Assertion::Boolean; - return $assertion->can('do_assertion') ? $assertion : - Test::Unit::Assertion::Boolean->new($assertion); - } - else { - die "Don't know how to normalize $assertion (ref ", ref($assertion), ")\n"; - } -} - -sub assert_raises { - my $self = shift; - require Test::Unit::Assertion::Exception; - my $assertion = Test::Unit::Assertion::Exception->new(shift); - my ($asserter, $file, $line) = caller($Error::Depth); - my $exception = - $self->do_assertion($assertion, (caller($Error::Depth))[0 .. 2], @_); -} - -sub do_assertion { - my $self = shift; - my $assertion = shift; - my $asserter = shift; - my $file = shift; - my $line = shift; - debug("Asserting [$assertion] from $asserter in $file line $line\n"); - my @args = @_; - try { $assertion->do_assertion(@args) } - catch Test::Unit::Exception with { - my $e = shift; - debug(" Caught $e, rethrowing from $asserter, $file line $line\n"); - $e->throw_new(-package => $asserter, - -file => $file, - -line => $line, - -object => $self); - } -} - -sub multi_assert { - my $self = shift; - my ($assertion, @argsets) = @_; - my ($asserter, $file, $line) = caller($Error::Depth); - foreach my $argset (@argsets) { - try { - $self->assert($assertion, @$argset); - } - catch Test::Unit::Exception with { - my $e = shift; - debug(" Caught $e, rethrowing from $asserter, $file line $line\n"); - $e->throw_new(-package => $asserter, - -file => $file, - -line => $line, - -object => $self); - } - } -} - -sub is_numeric { - my $str = shift; - local $^W; - return defined $str && ! ($str == 0 && $str !~ /^\s*[+-]?0(e0)?\s*$/i); -} - -# First argument determines the comparison type. -sub assert_equals { - my $self = shift; - my($asserter, $file, $line) = caller($Error::Depth); - my @args = @_; - try { - if (! defined($args[0]) and ! defined($args[1])) { - # pass - } - elsif (defined($args[0]) xor defined($args[1])) { - $self->fail('one arg was not defined'); - } - elsif (is_numeric($args[0])) { - $self->assert_num_equals(@args); - } - elsif (eval {ref($args[0]) && $args[0]->isa('UNIVERSAL')}) { - require overload; - if (overload::Method($args[0], '==')) { - $self->assert_num_equals(@args); - } - else { - $self->assert_str_equals(@args); - } - } - else { - $self->assert_str_equals(@args); - } - } - catch Test::Unit::Exception with { - my $e = shift; - $e->throw_new(-package => $asserter, - -file => $file, - -line => $line, - -object => $self); - } -} - -sub ok { # To make porting from Test easier - my $self = shift; - my @args = @_; - local $Error::Depth = $Error::Depth + 1; - if (@args == 1) { - $self->assert($args[0]); # boolean assertion - } - elsif (@args >= 2 && @args <= 3) { - if (ref($args[0]) eq 'CODE') { - my $code = shift @args; - my $expected = shift @args; - $self->assert_equals($expected, $code->(), @args); - } - elsif (eval {$args[1]->isa('Regexp')}) { - my $got = shift @args; - my $re = shift @args; - $self->assert($re, $got, @args); - } - else { - my $got = shift @args; - my $expected = shift @args; - $self->assert_equals($expected, $got, @args); - } - } - else { - $self->error('ok() called with wrong number of args'); - } -} - -sub assert_not_equals { - my $self = shift; - my($asserter,$file,$line) = caller($Error::Depth); - my @args = @_; - try { - if (! defined($args[0]) && ! defined($args[1])) { - my $first = shift @args; - my $second = shift @args; - $self->fail(@args ? join('', @args) : 'both args were undefined'); - } - elsif (defined($args[0]) xor defined($args[1])) { - # succeed - } - elsif (is_numeric($args[0])) { - $self->assert_num_not_equals(@args); - } - elsif (eval {ref($args[0]) && $args[0]->isa('UNIVERSAL')}) { - require overload; - if (overload::Method($args[0], '==')) { - $self->assert_num_not_equals(@args); - } - else { - $self->assert_str_not_equals(@args); - } - } - else { - $self->assert_str_not_equals(@args); - } - } - catch Test::Unit::Exception with { - my $e = shift; - $e->throw_new(-package => $asserter, - -file => $file, - -line => $line, - -object => $self,); - }; -} - -# Shamelessly pinched from Test::More and adapted to Test::Unit. -our %Seen_Refs = (); -our @Data_Stack; -my $DNE = bless [], 'Does::Not::Exist'; -sub assert_deep_equals { - my $self = shift; - my $this = shift; - my $that = shift; - - local $Error::Depth = $Error::Depth + 1; - - if (! ref $this || ! ref $that) { - Test::Unit::Failure->throw( - -text => @_ ? join('', @_) - : 'Both arguments were not references' - ); - } - - local @Data_Stack = (); - local %Seen_Refs = (); - if (! $self->_deep_check($this, $that)) { - Test::Unit::Failure->throw( - -text => @_ ? join('', @_) - : $self->_format_stack(@Data_Stack) - ); - } -} - -sub _deep_check { - my $self = shift; - my ($e1, $e2) = @_; - - if ( ! defined $e1 || ! defined $e2 ) { - return 1 if !defined $e1 && !defined $e2; - push @Data_Stack, { vals => [$e1, $e2] }; - return 0; - } - - return 0 if ( (defined $e1 && $e1 eq $DNE) - || (defined $e2 && $e2 eq $DNE )); - - return 1 if $e1 eq $e2; - if ( ref $e1 && ref $e2 ) { - my $e2_ref = "$e2"; - return 1 if defined $Seen_Refs{$e1} && $Seen_Refs{$e1} eq $e2_ref; - $Seen_Refs{$e1} = $e2_ref; - } - - if (UNIVERSAL::isa($e1, 'ARRAY') and UNIVERSAL::isa($e2, 'ARRAY')) { - return $self->_eq_array($e1, $e2); - } - elsif (UNIVERSAL::isa($e1, 'HASH') and UNIVERSAL::isa($e2, 'HASH')) { - return $self->_eq_hash($e1, $e2); - } - elsif (UNIVERSAL::isa($e1, 'REF') and UNIVERSAL::isa($e2, 'REF')) { - push @Data_Stack, { type => 'REF', vals => [$e1, $e2] }; - my $ok = $self->_deep_check($$e1, $$e2); - pop @Data_Stack if $ok; - return $ok; - } - elsif (UNIVERSAL::isa($e1, 'SCALAR') and UNIVERSAL::isa($e2, 'SCALAR')) { - push @Data_Stack, { type => 'REF', vals => [$e1, $e2] }; - return $self->_deep_check($$e1, $$e2); - } - else { - push @Data_Stack, { vals => [$e1, $e2] }; - return 0; - } -} - -sub _eq_array { - my $self = shift; - my($a1, $a2) = @_; - return 1 if $a1 eq $a2; - - my $ok = 1; - my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2; - for (0..$max) { - my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_]; - my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_]; - - push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [$e1, $e2] }; - $ok = $self->_deep_check($e1,$e2); - pop @Data_Stack if $ok; - - last unless $ok; - } - return $ok; -} - -sub _eq_hash { - my $self = shift; - my($a1, $a2) = @_; - return 1 if $a1 eq $a2; - - my $ok = 1; - my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2; - foreach my $k (keys %$bigger) { - my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE; - my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE; - - push @Data_Stack, { type => 'HASH', idx => $k, vals => [$e1, $e2] }; - $ok = $self->_deep_check($e1, $e2); - pop @Data_Stack if $ok; - - last unless $ok; - } - - return $ok; -} - -sub _format_stack { - my $self = shift; - my @Stack = @_; - - my $var = '$FOO'; - my $did_arrow = 0; - foreach my $entry (@Stack) { - my $type = $entry->{type} || ''; - my $idx = $entry->{'idx'}; - if( $type eq 'HASH' ) { - $var .= "->" unless $did_arrow++; - $var .= "{$idx}"; - } - elsif( $type eq 'ARRAY' ) { - $var .= "->" unless $did_arrow++; - $var .= "[$idx]"; - } - elsif( $type eq 'REF' ) { - $var = "\${$var}"; - } - } - - my @vals = @{$Stack[-1]{vals}}[0,1]; - - my @vars = (); - ($vars[0] = $var) =~ s/\$FOO/ \$a/; - ($vars[1] = $var) =~ s/\$FOO/ \$b/; - - my $out = "Structures begin differing at:\n"; - foreach my $idx (0..$#vals) { - my $val = $vals[$idx]; - $vals[$idx] = !defined $val ? 'undef' : - $val eq $DNE ? "Does not exist" - : "'$val'"; - } - - $out .= "$vars[0] = $vals[0]\n"; - $out .= "$vars[1] = $vals[1]\n"; - - return $out; -} - -{ - my %assert_subs = ( - str_equals => sub { - my $str1 = shift; - my $str2 = shift; - defined $str1 or - Test::Unit::Failure->throw( - -text => @_ ? join('',@_) : - "expected value was undef; should be using assert_null?" - ); - defined $str2 or - Test::Unit::Failure->throw( - -text => @_ ? join('',@_) : "expected '$str1', got undef" - ); - $str1 eq $str2 or - Test::Unit::Failure->throw( - -text => @_ ? join('',@_) : "expected '$str1', got '$str2'" - ); - }, - str_not_equals => sub { - my $str1 = shift; - my $str2 = shift; - defined $str1 or - Test::Unit::Failure->throw( - -text => @_ ? join('',@_) : - "expected value was undef; should be using assert_not_null?" - ); - defined $str2 or - Test::Unit::Failure->throw( - -text => @_ ? join('',@_) : - "expected a string ne '$str1', got undef" - ); - $str1 ne $str2 or - Test::Unit::Failure->throw( - -text => @_ ? join('',@_) : "'$str1' and '$str2' should differ" - ); - }, - num_equals => sub { - my $num1 = shift; - my $num2 = shift; - defined $num1 or - Test::Unit::Failure->throw( - -text => @_ ? join('',@_) : - "expected value was undef; should be using assert_null?" - ); - defined $num2 or - Test::Unit::Failure->throw( - -text => @_ ? join('',@_) : "expected '$num1', got undef" - ); - # silence `Argument "" isn't numeric in numeric eq (==)' warnings - local $^W; - $num1 == $num2 or - Test::Unit::Failure->throw( - -text => @_ ? join('', @_) : "expected $num1, got $num2" - ); - }, - num_not_equals => sub { - my $num1 = shift; - my $num2 = shift; - defined $num1 or - Test::Unit::Failure->throw( - -text => @_ ? join('',@_) : - "expected value was undef; should be using assert_not_null?" - ); - defined $num2 or - Test::Unit::Failure->throw( - -text => @_ ? join('',@_) : - "expected a number != '$num1', got undef" - ); - # silence `Argument "" isn't numeric in numeric ne (!=)' warnings - local $^W; - $num1 != $num2 or - Test::Unit::Failure->throw( - -text => @_ ? join('', @_) : "$num1 and $num2 should differ" - ); - }, - matches => sub { - my $regexp = shift; - eval { $regexp->isa('Regexp') } or - Test::Unit::Error->throw( - -text => "arg 1 to assert_matches() must be a regexp" - ); - my $string = shift; - $string =~ $regexp or - Test::Unit::Failure->throw - (-text => @_ ? join('', @_) : - "$string didn't match /$regexp/"); - }, - does_not_match => sub { - my $regexp = shift; - eval { $regexp->isa('Regexp') } or - Test::Unit::Error->throw( - -text => "arg 1 to assert_does_not_match() must be a regexp" - ); - my $string = shift; - $string !~ $regexp or - Test::Unit::Failure->throw - (-text => @_ ? join('', @_) : - "$string matched /$regexp/"); - }, - null => sub { - my $arg = shift; - !defined($arg) or - Test::Unit::Failure->throw - (-text => @_ ? join('',@_) : "$arg is defined"); - }, - not_null => sub { - my $arg = shift; - defined($arg) or - Test::Unit::Failure->throw - (-text => @_ ? join('', @_) : " unexpected"); - }, - ); - foreach my $type (keys %assert_subs) { - my $assertion = Test::Unit::Assertion::CodeRef->new($assert_subs{$type}); - no strict 'refs'; - *{"Test::Unit::Assert::assert_$type"} = - sub { - local $Error::Depth = $Error::Depth + 3; - my $self = shift; - $assertion->do_assertion(@_); - }; - } -} - -sub fail { - my $self = shift; - debug(ref($self) . "::fail() called\n"); - my($asserter,$file,$line) = caller($Error::Depth); - my $message = join '', @_; - Test::Unit::Failure->throw(-text => $message, - -object => $self, - -file => $file, - -line => $line); -} - -sub error { - my $self = shift; - debug(ref($self) . "::error() called\n"); - my($asserter,$file,$line) = caller($Error::Depth); - my $message = join '', @_; - Test::Unit::Error->throw(-text => $message, - -object => $self, - -file => $file, - -line => $line); -} - -sub quell_backtrace { - my $self = shift; - carp "quell_backtrace deprecated"; -} - -sub get_backtrace_on_fail { - my $self = shift; - carp "get_backtrace_on_fail deprecated"; -} - - - -1; -__END__ - -=head1 NAME - -Test::Unit::Assert - unit testing framework assertion class - -=head1 SYNOPSIS - - # this class is not intended to be used directly, - # normally you get the functionality by subclassing from - # Test::Unit::TestCase - - use Test::Unit::TestCase; - - # more code here ... - - $self->assert($your_condition_here, $your_optional_message_here); - - # or, for regular expression comparisons: - $self->assert(qr/some_pattern/, $result); - - # or, for functional style coderef tests: - $self->assert(sub { - $_[0] == $_[1] - or $self->fail("Expected $_[0], got $_[1]"); - }, 1, 2); - - # or, for old style regular expression comparisons - # (strongly deprecated; see warning below) - $self->assert(scalar("foo" =~ /bar/), $your_optional_message_here); - - # Or, if you don't mind us guessing - $self->assert_equals('expected', $actual [, $optional_message]); - $self->assert_equals(1,$actual); - $self->assert_not_equals('not expected', $actual [, $optional_message]); - $self->assert_not_equals(0,1); - - # Or, if you want to force the comparator - $self->assert_num_equals(1,1); - $self->assert_num_not_equals(1,0); - $self->assert_str_equals('string','string'); - $self->assert_str_not_equals('stringA', 'stringB'); - - # assert defined/undefined status - $self->assert_null(undef); - $self->assert_not_null(''); - -=head1 DESCRIPTION - -This class contains the various standard assertions used within the -framework. With the exception of the C, all -the assertion methods take an optional message after the mandatory -fields. The message can either be a single string, or a list, which -will get concatenated. - -Although you can specify a message, it is hoped that the default error -messages generated when an assertion fails will be good enough for -most cases. - -=head2 Methods - -=over 4 - -=item assert_equals(EXPECTED, ACTUAL [, MESSAGE]) - -=item assert_not_equals(NOTEXPECTED, ACTUAL [, MESSAGE]) - -The catch all assertions of (in)equality. We make a guess about -whether to test for numeric or string (in)equality based on the first -argument. If it looks like a number then we do a numeric test, if it -looks like a string, we do a string test. - -If the first argument is an object, we check to see if the C<'=='> -operator has been overloaded and use that if it has, otherwise we do -the string test. - -=item assert_num_equals - -=item assert_num_not_equals - -Force numeric comparison with these two. - -=item assert_str_equals - -=item assert_str_not_equals - -Force string comparison - -=item assert_matches(qr/PATTERN/, STRING [, MESSAGE]) - -=item assert_does_not_match(qr/PATTERN/, STRING [, MESSAGE]) - -Assert that STRING does or does not match the PATTERN regex. - -=item assert_deep_equals(A, B [, MESSAGE ]) - -Assert that reference A is a deep copy of reference B. The references -can be complex, deep structures. If they are different, the default -message will display the place where they start differing. - -B This is NOT well-tested on circular references. Nor am I -quite sure what will happen with filehandles. - -=item assert_null(ARG [, MESSAGE]) - -=item assert_not_null(ARG [, MESSAGE]) - -Assert that ARG is defined or not defined. - -=item assert(BOOLEAN [, MESSAGE]) - -Checks if the BOOLEAN expression returns a true value that is neither -a CODE ref nor a REGEXP. Note that MESSAGE is almost non optional in -this case, otherwise all the assertion has to go on is the truth or -otherwise of the boolean. - -If you want to use the "old" style for testing regular expression -matching, please be aware of this: the arguments to assert() are -evaluated in list context, e.g. making a failing regex "pull" the -message into the place of the first argument. Since this is usually -just plain wrong, please use scalar() to force the regex comparison -to yield a useful boolean value. - -=item assert(qr/PATTERN/, ACTUAL [, MESSAGE]) - -Matches ACTUAL against the PATTERN regex. If you omit MESSAGE, you -should get a sensible error message. - -=item assert(CODEREF, @ARGS) - -Calls CODEREF->(@ARGS). Assertion fails if this returns false (or -throws Test::Unit::Failure) - -=item assert_raises(EXCEPTION_CLASS, CODEREF [, MESSAGE]) - -Calls CODEREF->(). Assertion fails unless an exception of class -EXCEPTION_CLASS is raised. - -=item multi_assert(ASSERTION, @ARGSETS) - -Calls $self->assert(ASSERTION, @$ARGSET) for each $ARGSET in @ARGSETS. - -=item ok(@ARGS) - -Simulates the behaviour of the L module. B - -=back - -=head1 AUTHOR - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see L or the F file included in this -distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=item * - -L - -=item * - -L - -=item * - -L - -=item * - -L - -=item * - -The framework self-testing suite -(L) - -=back - -=cut diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Assertion.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Assertion.pm deleted file mode 100644 index 948a6e6..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Assertion.pm +++ /dev/null @@ -1,92 +0,0 @@ -package Test::Unit::Assertion; - -use strict; - -use Carp; -use Test::Unit::Failure; - -use overload '""' => 'to_string'; - -sub fail { - my $self = shift; - my($asserter, $file, $line) = caller(2); # We're always called from - # within an Assertion... - Test::Unit::Failure->throw(-object => $self, - -file => $file, - -line => $line, - -text => join '', @_); -} - -sub do_assertion { - Carp::croak("$_[0] forgot to override do_assertion"); -} - -sub new { - Carp::croak("$_[0] forgot to override new"); -} - -1; - -__END__ - -=head1 NAME - -Test::Unit::Assertion - The abstract base class for assertions - -=head1 NAME - -Any assertion class that expects to plug into Test::Unit::Assert needs -to implement this interface. - -=head2 Required methods - -=over 4 - -=item new - -Creates a new assertion object. Takes whatever arguments you desire. -Isn't strictly necessary for the framework to work with this class but -is generally considered a good idea. - -=item do_assertion - -This is the important one. If Test::Unit::Assert::assert is called -with an object as its first argument then it does: - - $_[0]->do_assertion(@_[1 .. $#_]) || - $self->fail("Assertion failed"); - -This means that C should return true if the assertion -succeeds and false if it doesn't. Or, you can fail by throwing a -Test::Unit::Failure object, which will get caught further up -the stack and used to produce a sensible error report. Generally it's -good practice for do_assertion to die with a meaningful error on -assertion failure rather than just returning false. - -=back - - -=head1 AUTHOR - -Copyright (c) 2001 Piers Cawley Epdcawley@iterative-software.comE. - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=item * - -L - -=back diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Assertion/Boolean.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Assertion/Boolean.pm deleted file mode 100644 index 773645b..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Assertion/Boolean.pm +++ /dev/null @@ -1,63 +0,0 @@ -package Test::Unit::Assertion::Boolean; - -use strict; - -# adding this fixes the 'Can't locate object method "fail" via package -# "Test::Unit::Assertion::Boolean"' problem under perl 5.005 - Christian -use Test::Unit::Assertion; -use Test::Unit::Failure; - - -use base 'Test::Unit::Assertion'; - -use overload 'bool' => sub {$ {$_[0]}}; - -sub new { - my $class = shift; - my $bool = shift; - - my $self = \$bool; - bless $self, $class; -} - -sub do_assertion { - my $self = shift; - $$self or $self->fail( @_ ? join('', @_) : "Boolean assertion failed"); -} - -sub to_string { - my $self = shift; - ($$self ? 'TRUE' : 'FALSE') . ' boolean assertion'; -} - -1; - -__END__ - -=head1 NAME - -Test::Unit::Assertion::Boolean - A boolean assertion - -=head1 SYNOPSIS - -Pay no attention to the man behind the curtain. This is simply a -boolean assertion that exists solely to rationalize the way -Test::Unit::Assert::assert does its thing. You should never have to -instantiate one of these directly. Ever. Go away. There's nothing to -see here. - - -=head1 AUTHOR - -Copyright (c) 2001 Piers Cawley Epdcawley@iterative-software.comE. - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -Look, I've told you, there's nothing going on here. If you go looking -at the listing of this module you'll see that it does almost nothing. -Why on earth you're still reading at this point is something of a -mystery to me. After all, if you're hacking on the Test::Unit source -code you'll be able to use the Source. diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Assertion/CodeRef.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Assertion/CodeRef.pm deleted file mode 100644 index e871f04..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Assertion/CodeRef.pm +++ /dev/null @@ -1,125 +0,0 @@ -package Test::Unit::Assertion::CodeRef; - -use strict; -use base qw/Test::Unit::Assertion/; - -use Carp; -use Test::Unit::Debug qw(debug); - -my $deparser; - -sub new { - my $class = shift; - my $code = shift; - croak "$class\::new needs a CODEREF" unless ref($code) eq 'CODE'; - bless \$code => $class; -} - -sub do_assertion { - my $self = shift; - my $possible_object = $_[0]; - debug("Called do_assertion(" . ($possible_object || 'undef') . ")\n"); - if (ref($possible_object) and - ref($possible_object) ne 'Regexp' and - eval { $possible_object->isa('UNIVERSAL') }) - { - debug(" [$possible_object] isa [" . ref($possible_object) . "]\n"); - $possible_object->$$self(@_[1..$#_]); - } - else { - debug(" asserting [$self]" - . (@_ ? " on args " . join(', ', map { $_ || '' } @_) : '') - . "\n"); - $$self->(@_); - } -} - -sub to_string { - my $self = shift; - if (eval "require B::Deparse") { - $deparser ||= B::Deparse->new("-p"); - return join '', "sub ", $deparser->coderef2text($$self); - } - else { - return "sub { - # If you had a working B::Deparse, you'd know what was in - # this subroutine. -}"; - } -} - -1; -__END__ - -=head1 NAME - -Test::Unit::Assertion::CodeRef - A delayed evaluation assertion using a Coderef - -=head1 SYNOPSIS - - require Test::Unit::Assertion::CodeRef; - - my $assert_eq = - Test::Unit::Assertion::CodeRef->new(sub { - $_[0] eq $_[1] - or Test::Unit::Failure->throw(-text => - "Expected '$_[0]', got '$_[1]'\n"); - }); - - $assert_eq->do_assertion('foo', 'bar'); - -Although this is how you'd use Test::Unit::Assertion::CodeRef -directly, it is more usually used indirectly via -Test::Unit::Test::assert, which instantiates a -Test::Unit::Assertion::CodeRef when passed a Coderef as its first -argument. - -=head1 IMPLEMENTS - -Test::Unit::Assertion::CodeRef implements the Test::Unit::Assertion -interface, which means it can be plugged into the Test::Unit::TestCase -and friends' C method with no ill effects. - -=head1 DESCRIPTION - -This class is used by the framework to allow us to do assertions in a -'functional' manner. It is typically used generated automagically in -code like: - - $self->assert(sub { - $_[0] == $_[1] - or $self->fail("Expected $_[0], got $_[1]"); - }, 1, 2); - -(Note that if Damian Conway's Perl6 RFC for currying ever comes to -pass then we'll be able to do this as: - - $self->assert(^1 == ^2 || $self->fail("Expected ^1, got ^2"), 1, 2) - -which will be nice...) - -If you have a working B::Deparse installed with your perl installation -then, if an assertion fails, you'll see a listing of the decompiled -coderef (which will be sadly devoid of comments, but should still be -useful) - -=head1 AUTHOR - -Copyright (c) 2001 Piers Cawley Epdcawley@iterative-software.comE. - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=back diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Assertion/Exception.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Assertion/Exception.pm deleted file mode 100644 index 86d857f..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Assertion/Exception.pm +++ /dev/null @@ -1,90 +0,0 @@ -package Test::Unit::Assertion::Exception; - -use strict; -use base qw/Test::Unit::Assertion/; - -use Carp; -use Error qw/:try/; -use Test::Unit::Debug qw(debug); - -my $deparser; - -sub new { - my $class = shift; - my $exception_class = shift; - croak "$class\::new needs an exception class" unless $exception_class; - bless \$exception_class => $class; -} - -sub do_assertion { - my $self = shift; - my $coderef = shift; - my $exception_class = $$self; - - my $exception; - try { - &$coderef(); - } - catch $exception_class with { - $exception = shift; - }; - - if (! $exception || ! $exception->isa($$self)) { - $self->fail(@_ ? $_[0] : "No $exception_class was raised"); - } - return $exception; # so that it can be stored in the test for the - # user to get at. -} - -sub to_string { - my $self = shift; - return "$$self exception assertion"; -} - -1; -__END__ - -=head1 NAME - -Test::Unit::Assertion::Exception - A assertion for raised exceptions - -=head1 SYNOPSIS - - require Test::Unit::Assertion::Exception; - - my $assert_raised = - Test::Unit::Assertion::Exception->new('MyException'); - - # This should succeed - $assert_eq->do_assertion(sub { MyException->throw() }); - - # This should fail - $assert_eq->do_assertion(sub { }); - -=head1 DESCRIPTION - -Although the SYNOPSIS shows how you'd use -Test::Unit::Assertion::Exception directly, it is more sensibly used -indirectly via C, which -instantiates a C. - -=head1 AUTHOR - -Copyright (c) 2001 Piers Cawley Epdcawley@iterative-software.comE. - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=back diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Assertion/Regexp.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Assertion/Regexp.pm deleted file mode 100644 index c625417..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Assertion/Regexp.pm +++ /dev/null @@ -1,99 +0,0 @@ -package Test::Unit::Assertion::Regexp; - -use strict; -use Test::Unit::Assertion; -use base qw/Test::Unit::Assertion/; - -sub new { - my $class = shift; - my $regex = shift; - - bless \$regex, $class; -} - -sub do_assertion { - my $self = shift; - my $target = shift; - $target =~ $$self or - $self->fail(@_ ? $_[0] : "'$target' did not match /$$self/"); -} - -sub to_string { - my $self = shift; - "/$$self/ regexp assertion"; -} - -1; - -__END__ - -=head1 NAME - -Test::Unit::Assertion::Regexp - Assertion with regex matching - -=head1 SYNOPSIS - - require Test::Unit::Assertion::Regexp; - - my $assert_re = - Test::Unit::Assertion::Regexp->new(qr/a_pattern/); - - $assert_re->do_assertion('a_string'); - -This is rather more detail than the average user will need. -Test::Unit::Assertion::Regexp objects are generated automagically by -Test::Unit::Assert::assert when it is passed a regular expression as -its first parameter. - - sub test_foo { - ... - $self->assert(qr/some_pattern/, $result); - } - -If the assertion fails then the object throws an exception with -details of the pattern and the string it failed to match against. - -Note that if you need to do a 'string does I match this pattern' -type of assertion then you can do: - - $self->assert(qr/(?!some_pattern)/, $some_string) - -ie. Make use of the negative lookahead assertion. - -=head1 IMPLEMENTS - -Test::Unit::Assertion::Regexp implements the Test::Unit::Assertion -interface, which means it can be plugged into the Test::Unit::TestCase -and friends' C method with no ill effects. - -=head1 DESCRIPTION - -The class is used by the framework to provide sensible 'automatic' -reports when a match fails. The old: - - $self->assert(scalar($foo =~ /pattern/), "$foo didn't match /.../"); - -seems rather clumsy compared to this. If the regexp assertion fails, -then the user is given a sensible error message, with the pattern and -the string that failed to match it... - -=head1 AUTHOR - -Copyright (c) 2001 Piers Cawley Epdcawley@iterative-software.comE. - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=back diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Debug.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Debug.pm deleted file mode 100644 index 4fc94c4..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Debug.pm +++ /dev/null @@ -1,118 +0,0 @@ -package Test::Unit::Debug; - -=head1 NAME - -Test::Unit::Debug - framework debugging control - -=head1 SYNOPSIS - - package MyRunner; - - use Test::Unit::Debug qw(debug_to_file debug_pkg); - - debug_to_file('foo.log'); - debug_pkg('Test::Unit::TestCase'); - -=cut - -use strict; - -use base 'Exporter'; -use vars qw(@EXPORT_OK); -@EXPORT_OK = qw(debug debug_to_file - debug_pkg no_debug_pkg debug_pkgs no_debug_pkgs debugged); - -my %DEBUG = (); -my $out = \*STDERR; - -=head1 ROUTINES - -=head2 debug_to_file($file) - -Switch debugging to C<$file>. - -=cut - -sub debug_to_file { - my ($file) = @_; - open(DEBUG, ">$file") or die "Couldn't open $file for writing"; - $out = \*DEBUG; -} - -=head2 debug_to_stderr() - -Switch debugging to STDERR (this is the default). - -=cut - -sub debug_to_stderr { - $out = \*STDERR; -} - -sub debug { - my ($package, $filename, $line) = caller(); - print $out @_ if $DEBUG{$package}; -} - -=head2 debug_pkg($pkg) - -Enable debugging in package C<$pkg>. - -=cut - -sub debug_pkg { - $DEBUG{$_[0]} = 1; -} - -=head2 debug_pkgs(@pkgs) - -Enable debugging in the packages C<@pkgs>. - -=cut - -sub debug_pkgs { - $DEBUG{$_} = 1 foreach @_; -} - -=head2 debug_pkg($pkg) - -Enable debugging in package C<$pkg>. - -=cut - -sub no_debug_pkg { - $DEBUG{$_[0]} = 0; -} - -=head2 debug_pkgs(@pkgs) - -Disable debugging in the packages C<@pkgs>. - -=cut - -sub no_debug_pkgs { - $DEBUG{$_} = 0 foreach @_; -} - -sub debugged { - my ($package, $filename, $line) = caller(); - return $DEBUG{$_[0] || $package}; -} - - -=head1 AUTHOR - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see L or the F file included in this -distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -L - -=cut - -1; diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Decorator.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Decorator.pm deleted file mode 100644 index a49fd05..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Decorator.pm +++ /dev/null @@ -1,72 +0,0 @@ -package Test::Unit::Decorator; -use strict; - -use base qw(Test::Unit::Test); - -sub new { - my $class = shift; - my ($fTest) = @_; - return bless { _fTest => $fTest }, $class; -} - -sub basic_run { - my $self = shift; - my ($result) = @_; - $self->{_fTest}->run($result); -} - -sub count_test_cases() { - my $self = shift; - return $self->{_fTest}->count_test_cases(); -} -sub run { - my $self = shift; - my ($result) = @_; - $self->basic_run($result); -} - -sub to_string { - my $self = shift; - "$self->{_fTest}"; -} - -sub get_test { - my $self = shift; - return $self->{_fTest}; -} - -1; -__END__ - - -=head1 NAME - -Test::Unit::Decorator - unit testing framework helper class - -=head1 SYNOPSIS - - # A Decorator for Tests. Use TestDecorator as the base class - # for defining new test decorators. Test decorator subclasses - # can be introduced to add behaviour before or after a test - # is run. - -=head1 DESCRIPTION - -A Decorator for Tests. Use TestDecorator as the base class -for defining new test decorators. Test decorator subclasses -can be introduced to add behaviour before or after a test -is run. - -=head1 AUTHOR - -Copyright (c) 2001 Kevin Connor - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as -Perl itself. - -=head1 SEE ALSO - -L - -=cut diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Error.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Error.pm deleted file mode 100644 index 0d66152..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Error.pm +++ /dev/null @@ -1,57 +0,0 @@ -package Test::Unit::Error; -use strict; -use base qw(Test::Unit::Exception); - -# This is a hack to effectively rebless an unknown user exception as a -# Test::Unit::Error, which is nice because all Test::Unit::Exceptions -# have nice stringify() methods. -sub make_new_from_error { - my $self = shift; - my $ex = shift; - my $object = shift; - $self->new(%$ex, -object => $object); -} - -1; -__END__ - -=head1 NAME - -Test::Unit::Error - unit testing framework exception class - -=head1 SYNOPSIS - -This class is not intended to be used directly - -=head1 DESCRIPTION - -This class is used by the framework to communicate the occurrence of -run-time errors (that is, syntax errors and the like, not failed -tests, as the latter are classified as failures) generated by user -code. When such an error occurs, an instance of this class will be -thrown and caught internally in the framework. - -=head1 AUTHOR - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see L or the F file included in this -distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=back - -=cut diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Exception.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Exception.pm deleted file mode 100644 index 48ee5d6..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Exception.pm +++ /dev/null @@ -1,103 +0,0 @@ -package Test::Unit::Exception; - -use strict; - -use Carp; -use Error; - -use base 'Error'; - -sub throw_new { - my $self = shift; - my $class = ref $self; - $class->throw(%{$self || {}},@_); -} - -sub stacktrace { - my $self = shift; - warn "Stacktrace is deprecated and no longer works" -} - -sub get_message { - my $self = shift; - $self->text; -} - -sub hide_backtrace { - my $self = shift; - $self->{_hide_backtrace} = 1; -} - -sub stringify { - my $self = shift; - my $file = $self->file; - my $line = $self->line; - my $message = $self->text || 'Died'; - my $object = $self->object; - - my $str = "$file:$line"; - $str .= ' - ' . $object->to_string() if $object && $object->can('to_string'); - $str .= "\n" . $message; - return $str; -} - -sub to_string { - my $self = shift; - $self->stringify; -} - -sub failed_test { - carp "Test::Unit::Exception::failed_test called"; - return $_[0]->object; -} - -sub thrown_exception { - carp "Test::Unit::Exception::thrown_exception called"; - return $_[0]->object; -} - -1; -__END__ - -=head1 NAME - -Test::Unit::Exception - unit testing framework exception class - -=head1 SYNOPSIS - -This class is not intended to be used directly - -=head1 DESCRIPTION - -This class is used by the framework to communicate the result of -assertions, which will throw an instance of a subclass of this class -in case of errors or failures. - -=head1 AUTHOR - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see L or the F file included in this -distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=item * - -L - -=back - -=cut diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Failure.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Failure.pm deleted file mode 100644 index e340fd7..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Failure.pm +++ /dev/null @@ -1,47 +0,0 @@ -package Test::Unit::Failure; -use strict; -use base qw(Test::Unit::Exception); - -1; -__END__ - - -=head1 NAME - -Test::Unit::Failure - unit testing framework exception class - -=head1 SYNOPSIS - -This class is not intended to be used directly - -=head1 DESCRIPTION - -This class is used by the framework to communicate the result of -assertions, which will throw an instance of this class in case of -failures (that is, failed tests, not syntax errors and the like, these -are classified as errors). - -=head1 AUTHOR - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see L or the F file included in this -distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=back - -=cut diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/HarnessUnit.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/HarnessUnit.pm deleted file mode 100644 index 9369ad8..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/HarnessUnit.pm +++ /dev/null @@ -1,157 +0,0 @@ -package Test::Unit::HarnessUnit; -# this is a test runner which outputs in the same -# format that Test::Harness expects. -use strict; - -use base qw(Test::Unit::Runner); - -use Test::Unit::TestSuite; -use Test::Unit::Loader; - -sub new { - my $class = shift; - my ($filehandle) = @_; - # should really use the IO::Handle package here. - # this is very ugly. - $filehandle = \*STDOUT unless $filehandle; - bless { _Print_stream => $filehandle }, $class; -} - -sub print_stream { - my $self = shift; - return $self->{_Print_stream}; -} - -sub _print { - my $self = shift; - my (@args) = @_; - $self->{_Print_stream}->print( @args); -} - -sub start_test { - my $self=shift; - my $test=shift; -} - -sub not_ok { - my $self = shift; - my ($test, $exception) = @_; - $self->_print("\nnot ok ERROR ", - $test->name(), - "\n$exception\n"); -} - -sub ok { - my $self = shift; - my ($test) = @_; - $self->_print("ok PASS " . $test->name() . "\n"); -} - -sub add_error { - my $self = shift; - $self->not_ok(@_); -} - -sub add_failure { - my $self = shift; - $self->not_ok(@_); -} - -sub add_pass { - my $self = shift; - $self->ok(@_); -} - -sub end_test { - my $self = shift; - my ($test) = @_; -} - -sub do_run { - my $self = shift; - my ($suite) = @_; - my $result = $self->create_test_result(); - $result->add_listener($self); - $suite->run($result, $self); -} - -sub main { - my $self = shift; - my $a_test_runner = __PACKAGE__->new; - $a_test_runner->start(@_); -} - -sub run { - my $self = shift; - my ($class) = @_; - my $a_test_runner = Test::Unit::TestRunner->new(); - if ($class->isa("Test::Unit::Test")) { - $a_test_runner->do_run($class, 0); - } else { - $a_test_runner->do_run(Test::Unit::TestSuite->new($class), 0); - } -} - -sub start { - my $self = shift; - my (@args) = @_; - - my $test_case = ""; - my $wait = 0; - my $suite = Test::Unit::Loader::load(@args); - if ($suite) { - my $count=$suite->count_test_cases(); - $self->_print("STARTING TEST RUN\n1..$count\n"); - $self->do_run($suite); - exit(0); - } else { - $self->_print("Invalid argument to test runner: $args[0]\n"); - exit(1); - } -} - -1; -__END__ - - -=head1 NAME - -Test::Unit::HarnessUnit - unit testing framework helper class - -=head1 SYNOPSIS - -This class is not intended to be used directly - -=head1 DESCRIPTION - -This is a test runner which outputs in the same format that -Test::Harness expects. - -=head1 AUTHOR - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see L or the F file included in this -distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=item * - -L - -=back - -=cut diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Listener.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Listener.pm deleted file mode 100644 index 80937de..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Listener.pm +++ /dev/null @@ -1,99 +0,0 @@ -package Test::Unit::Listener; -use Test::Unit::Loader; -use Carp; -use strict; - -sub new { - my $class = shift; - croak "call to abstract constructor ${class}::new"; -} - -sub start_suite { - my $self = shift; - my $class = ref($self); - my ($suite) = @_; - croak "call to abstract method ${class}::start_suite"; -} - -sub start_test { - my $self = shift; - my $class = ref($self); - my ($test) = @_; - croak "call to abstract method ${class}::start_test"; -} - -sub add_error { - my $self = shift; - my $class = ref($self); - my ($test, $exception) = @_; - croak "call to abstract method ${class}::add_error"; -} - -sub add_failure { - my $self = shift; - my $class = ref($self); - my ($test, $exception) = @_; - croak "call to abstract method ${class}::add_failure"; -} - -sub end_test { - my $self = shift; - my $class = ref($self); - my ($test) = @_; - croak "call to abstract method ${class}::end_test"; -} - -1; -__END__ - - -=head1 NAME - -Test::Unit::Listener - unit testing framework abstract base class - -=head1 SYNOPSIS - -This class is not intended to be used directly - -=head1 DESCRIPTION - -This class is used by the framework to define the interface of a test -listener. It is an abstract base class implemented by the test -runners. - -Due to the nature of the Perl OO implementation, this class is not -really needed, but rather serves as documentation of the interface. - -Each of the add_ methods gets two arguments: C and C. -The test is a Test::Unit::Test and the exception is a -Test::Unit::Exception. Typically you want to display -Cname()> and keep the rest as details. - -=head1 AUTHOR - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see L or the F file included in this -distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=item * - -L - -=back - -=cut diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Loader.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Loader.pm deleted file mode 100644 index 3e803fb..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Loader.pm +++ /dev/null @@ -1,211 +0,0 @@ -package Test::Unit::Loader; - -use strict; - -use FileHandle; -use Test::Unit::Debug qw(debug); -use Test::Unit::TestSuite; -use Test::Unit::TestCase; -use Test::Unit::UnitHarness; -use Test::Unit::Warning; - -# should really do something in here about a local @INC. -sub obj_load { shift; load(@_) } - -# Compiles a target. Returns the package if successful. -sub compile { - my $target = shift; - debug("Test::Unit::Loader::compile($target) called\n"); - - if ($target =~ /^\w+(::\w+)*$/) { - compile_class($target); - return $target; - } - elsif ($target =~ /\.pm$/) { - compile_file($target); - # In this case I need to figure out what the class was I just loaded! - return get_package_name_from_file($target); - } - else { - return undef; - } -} - -sub compile_class { - my $classname = shift; - debug(" Test::Unit::Loader::compile_class($classname) called\n"); - # Check if the package exists already. - { - no strict 'refs'; - if (my @keys = grep { ! /::$/ } keys %{"$classname\::"}) { - debug(" package $classname already exists (@keys); not compiling.\n"); - return; - } - } - # No? Try 'require'ing it - eval "require $classname"; - die $@ if $@; - debug(" $classname compiled OK as class name\n"); -} - -sub compile_file { - my $file = shift; - debug(" Test::Unit::Loader::compile_file($file) called\n"); - eval qq{require "$file"}; - die $@ if $@; - debug(" $file compiled OK as filename\n"); -} - -sub load { - my $target = shift; - debug("Test::Unit::Loader::load($target) called\n"); - - my $suite = load_test($target) - || load_test_harness_test($target) - || load_test_dir($target); - return $suite if $suite; - - die "Couldn't load $target in any of the supported ways"; -} - -sub load_test { - my $target = shift; - debug("Test::Unit::Loader::load_test($target) called\n"); - my $package = compile($target); - return unless $package; - debug(" compile returned $package\n"); - my $suite = load_test_suite($package) || load_test_case($package); - die "`$target' was not a valid Test::Unit::Test\n" unless $suite; - return $suite; -} - -sub load_test_suite { - my $package = shift; - debug(" Test::Unit::Loader::load_test_suite($package) called\n"); - if ($package->can("suite")) { - debug(" $package has a suite() method\n"); - return $package->suite(); - } -} - -sub load_test_case { - my $package = shift; - debug(" Test::Unit::Loader::load_test_case($package) called\n"); - if ($package->isa("Test::Unit::TestCase")) { - debug(" $package isa Test::Unit::TestCase\n"); - return Test::Unit::TestSuite->new($package); - } -} - -sub extract_testcases { - my $classname = shift; - - my @testcases = (); - - foreach my $method ($classname->list_tests()) { - if ( my $a_class_instance = $classname->new($method) ) { - push @testcases, $a_class_instance; - } - else { - push @testcases, Test::Unit::Warning->new( - "extract_testcases: Couldn't create a $classname object" - ); - } - } - - push @testcases, Test::Unit::Warning->new("No tests found in $classname") - unless @testcases; - - return @testcases; -} - -sub load_test_harness_test { - my $target = shift; - - foreach my $file ("$target", "$target.t", "t/$target", "t/$target.t" ) { - if (-r $file) { - # are the next 3 lines really necessary? - open(FH, $file) or next; - my $first = ; - close(FH) or next; - return Test::Unit::UnitHarness->new($file); - } - } - return undef; -} - -sub load_test_dir { - my $test_dir = shift; - if (-d $test_dir) { - die "This is a test directory. I haven't implemented that.\n"; - return Test::Unit::UnitHarness::new_dir($test_dir); - } -} - -# The next bit of code is a helper function which attempts -# to identify the class we are trying to use from a '.pm' -# file. If we've reached this point, we managed to 'require' -# the file already, but we dont know the file the package was -# loaded from. Somehow I feel this information is in perl -# somwhere but if it is I dont know where... -sub get_package_name_from_file { - my $filename = shift; - my $real_path = $INC{$filename}; - die "Can't find $filename in @INC: $!" - unless $real_path && open(FH, $real_path); - while () { - if (/^\s*package\s+([\w:]+)/) { - close(FH); - return $1; - } - } - die "Can't find a package in $filename"; -} - -1; -__END__ - - -=head1 NAME - -Test::Unit::Loader - unit testing framework helper class - -=head1 SYNOPSIS - -This class is not intended to be used directly. - -=head1 DESCRIPTION - -This class is used by the framework to load test classes into the -runtime environment. It handles test case and test suite classes -(referenced either via their package names or the files containing -them), Test::Harness style test files, and directory names. - -=head1 AUTHOR - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see L or the F file included in this -distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=item * - -L - -=back - -=cut diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Procedural.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Procedural.pm deleted file mode 100644 index 18ea77b..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Procedural.pm +++ /dev/null @@ -1,211 +0,0 @@ -package Test::Unit::Procedural; - -use strict; - -use Test::Unit::TestSuite; -use Test::Unit::TestRunner; - -use base 'Exporter'; - -use vars qw(@EXPORT); -@EXPORT = qw(assert create_suite run_suite add_suite); - -# Helper classes -use Devel::Symdump; -use Class::Inner; - -# Exception handling -use Error qw/:try/; -use Test::Unit::Exception; -use Test::Unit::Failure; - -# private - -my $test_suite = Test::Unit::TestSuite->empty_new("Test::Unit"); -my %suites = (); -%suites = ('Test::Unit' => $test_suite); - -sub add_to_suites { - my $suite_holder = shift; - if (not exists $suites{$suite_holder}) { - my $test_suite = Test::Unit::TestSuite->empty_new($suite_holder); - $suites{$suite_holder} = $test_suite; - } -} - -# public - -sub assert ($;$) { - my($condition, $message) = @_; - my($asserter,$file,$line) = caller(1); - - add_to_suites($asserter); - try { - $suites{$asserter}->assert($condition, $message); - } - catch Test::Unit::Exception with { - my $e = shift; - $e->throw_new( - -package => $asserter, - -file => $file, - -line => $line); - } -} - -sub create_suite { - my ($test_package_name) = @_; - $test_package_name = caller() unless defined($test_package_name); - add_to_suites($test_package_name); - - no strict 'refs'; - - my $set_up_func = sub {}; - my $tear_down_func = sub {}; - - my $st = Devel::Symdump->new($test_package_name); - my @set_up_candidates = grep /::set_up$/, $st->functions; - $set_up_func = \&{$set_up_candidates[0]} if @set_up_candidates; - - my @tear_down_candidates = grep /::tear_down$/, $st->functions; - $tear_down_func = \&{$tear_down_candidates[0]} if @tear_down_candidates; - - for my $test_method (grep /::test[^:]*$/, $st->functions) { - my($method_name) = $test_method =~ /::(test[^:]*)/; - my $subref = \&{$test_method}; - my $test_case = Class::Inner->new - (parent => 'Test::Unit::TestCase', - methods => {set_up => $set_up_func, - tear_down => $tear_down_func, - $method_name => $subref, - }, - args => [$method_name],); - $suites{$test_package_name}->add_test($test_case); - } -} - -sub run_suite { - my ($test_package_name, $filehandle) = @_; - $test_package_name = caller() unless defined($test_package_name); - my $test_runner = Test::Unit::TestRunner->new($filehandle); - $test_runner->do_run($suites{$test_package_name}); -} - -sub add_suite { - my ($to_be_added, $to_add_to) = @_; - $to_add_to = caller() unless defined($to_add_to); - die "Error: no suite '$to_be_added'" unless exists $suites{$to_be_added}; - die "Error: no suite '$to_add_to'" unless exists $suites{$to_add_to}; - $suites{$to_add_to}->add_test($suites{$to_be_added}); -} - -1; -__END__ - -=head1 NAME - -Test::Unit::Procedural - Procedural style unit testing interface - -=head1 SYNOPSIS - - use Test::Unit::Procedural; - - # your code to be tested goes here - - sub foo { return 23 }; - sub bar { return 42 }; - - # define tests - - sub test_foo { assert(foo() == 23, "Your message here"); } - sub test_bar { assert(bar() == 42, "I will be printed if this fails"); } - - # set_up and tear_down are used to - # prepare and release resources need for testing - - sub set_up { print "hello world\n"; } - sub tear_down { print "leaving world again\n"; } - - # run your test - - create_suite(); - run_suite(); - -=head1 DESCRIPTION - -Test::Unit::Procedural is the procedural style interface to a -sophisticated unit testing framework for Perl that is derived from the -JUnit testing framework for Java by Kent Beck and Erich Gamma. While -this framework is originally intended to support unit testing in an -object-oriented development paradigm (with support for inheritance of -tests etc.), Test::Unit::Procedural is intended to provide a simpler -interface to the framework that is more suitable for use in a -scripting style environment. Therefore, Test::Unit::Procedural does -not provide much support for an object-oriented approach to unit -testing - if you want that, please have a look at -L. - -You test a given unit (a script, a module, whatever) by using -Test::Unit::Procedural, which exports the following routines into your -namespace: - -=over 4 - -=item assert() - -used to assert that a boolean condition is true - -=item create_suite() - -used to create a test suite consisting of all methods with a name -prefix of C - -=item run_suite() - -runs the test suite (text output) - -=item add_suite() - -used to add test suites to each other - -=back - -For convenience, C will automatically build a test -suite for a given package. This will build a test case for each -subroutine in the package given that has a name starting with C -and pack them all together into one TestSuite object for easy testing. -If you dont give a package name to C, the current -package is taken as default. - -Test output is one status line (a "." for every successful test run, -or an "F" for any failed test run, to indicate progress), one result -line ("OK" or "!!!FAILURES!!!"), and possibly many lines reporting -detailed error messages for any failed tests. - -Please remember, Test::Unit::Procedural is intended to be a simple and -convenient interface. If you need more functionality, take the -object-oriented approach outlined in L. - -=head1 AUTHOR - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see L or the F file included in this -distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -the procedural style examples in the examples directory - -=back - -=cut diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Result.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Result.pm deleted file mode 100644 index 203f601..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Result.pm +++ /dev/null @@ -1,254 +0,0 @@ -package Test::Unit::Result; -use strict; - -use Test::Unit::Debug qw(debug); -use Test::Unit::Error; -use Test::Unit::Failure; - -use Error qw/:try/; - -sub new { - my $class = shift; - bless { - _Failures => [], - _Errors => [], - _Listeners => [], - _Run_tests => 0, - _Stop => 0, - }, $class; -} - -sub tell_listeners { - my $self = shift; - my $method = shift; - foreach (@{$self->listeners}) { - $_->$method(@_); - } -} - -sub add_error { - my $self = shift; - debug($self . "::add_error() called\n"); - my ($test, $exception) = @_; - $exception->{-object} = $test; - push @{$self->errors()}, $exception; - $self->tell_listeners(add_error => @_); -} - -sub add_failure { - my $self = shift; - debug($self . "::add_failure() called\n"); - my ($test, $exception) = @_; - $exception->{-object} = $test; - push @{$self->failures()}, $exception; - $self->tell_listeners(add_failure => @_); -} - -sub add_pass { - my $self = shift; - debug($self . "::add_pass() called\n"); - my ($test) = @_; - $self->tell_listeners(add_pass => @_); -} - -sub add_listener { - my $self = shift; - debug($self . "::add_listener() called\n"); - my ($listener) = @_; - push @{$self->listeners()}, $listener; -} - -sub listeners { - my $self = shift; - return $self->{_Listeners}; -} - -sub end_test { - my $self = shift; - my ($test) = @_; - $self->tell_listeners(end_test => $test); -} - -sub error_count { - my $self = shift; - return scalar @{$self->{_Errors}}; -} - -sub errors { - my $self = shift; - return $self->{_Errors}; -} - -sub failure_count { - my $self = shift; - return scalar @{$self->{_Failures}}; -} - -sub failures { - my $self = shift; - return $self->{_Failures}; -} - -sub run { - my $self = shift; - my ($test) = @_; - debug(sprintf "%s::run(%s) called\n", $self, $test->name()); - $self->start_test($test); - - # This closure may look convoluted, but it allows Test::Unit::Setup - # to work cleanly. - $self->run_protected( - $test, - sub { - $test->run_bare() ? - $self->add_pass($test) - : $self->add_failure($test); - } - ); - - $self->end_test($test); -} - -sub run_protected { - my $self = shift; - my $test = shift; - my $protectable = shift; - debug("$self\::run_protected($test, $protectable) called\n"); - - try { - &$protectable(); - } - catch Test::Unit::Failure with { - $self->add_failure($test, shift); - } - catch Error with { - # *Any* exception which isn't a failure or - # Test::Unit::Exception should get rebuilt and added to the - # result as a Test::Unit::Error, so that the stringify() - # method can be called on it for nice reporting. - my $error = shift; - $error = Test::Unit::Error->make_new_from_error($error) - unless $error->isa('Test::Unit::Exception'); - $self->add_error($test, $error); - }; -} - -sub run_count { - my $self = shift; - return $self->{_Run_tests}; -} - -sub run_count_inc { - my $self = shift; - ++$self->{_Run_tests}; - return $self->{_Run_tests}; -} - -sub should_stop { - my $self = shift; - return $self->{_Stop}; -} - -sub start_test { - my $self = shift; - my ($test) = @_; - $self->run_count_inc(); - $self->tell_listeners(start_test => $test); -} - -sub stop { - my $self = shift; - $self->{_Stop} = 1; -} - -sub was_successful { - my $self = shift; - return ($self->failure_count() == 0) && ($self->error_count() == 0); -} - -sub to_string { - my $self = shift; - my $class = ref($self); - debug($class . "::to_string() called\n"); -} - -1; -__END__ - - -=head1 NAME - -Test::Unit::Result - unit testing framework helper class - -=head1 SYNOPSIS - -This class is not intended to be used directly - -=head1 DESCRIPTION - -This class is used by the framework to record the results of tests, -which will throw an instance of a subclass of Test::Unit::Exception in -case of errors or failures. - -To achieve this, this class gets called with a test case as argument. -It will call this test case's run method back and catch any exceptions -thrown. - -It could be argued that Test::Unit::Result is the heart of the -PerlUnit framework, since TestCase classes vary, and you can use one -of several Test::Unit::TestRunners, but we always gather the results -in a Test::Unit::Result object. - -This is the quintessential call tree of the communication needed to -record the results of a given test: - - $aTestCase->run() { - # creates result - $aTestResult->run($aTestCase) { - # catches exception and records it - $aTestCase->run_bare() { - # runs test method inside eval - $aTestCase->run_test() { - # calls method $aTestCase->name() - # and propagates exception - # method will call Assert::assert() - # to cause failure if test fails on - # test assertion - # it finds this because $aTestCase is-a Assert - } - } - } - } - -Note too that, in the presence of Test::Unit::TestSuites, this call -tree can get a little more convoluted, but if you bear the above in -mind it should be apparent what's going on. - -=head1 AUTHOR - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see L or the F file included in this -distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=item * - -L - -=back - -=cut diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Runner.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Runner.pm deleted file mode 100644 index cc2ce7d..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Runner.pm +++ /dev/null @@ -1,100 +0,0 @@ -package Test::Unit::Runner; - -=head1 NAME - -Test::Unit::Runner - abstract base class for test runners - -=head1 SYNOPSIS - - my $runner = Test::Unit::TestRunner->new(); - $runner->filter(@filter_tokens); - $runner->start(...); - -=head1 DESCRIPTION - -This class is a parent class of all test runners, and hence is not -intended to be used directly. It provides functionality such as state -(e.g. run-time options) available to all runner classes. - -=cut - -use strict; - -use Test::Unit::Result; - -use base qw(Test::Unit::Listener); - -sub create_test_result { - my $self = shift; - return $self->{_result} = Test::Unit::Result->new(); -} - -sub result { shift->{_result} } - -sub start_suite { - my $self = shift; - my ($suite) = @_; - push @{ $self->{_suites_running} }, $suite; -} - -sub end_suite { - my $self = shift; - my ($suite) = @_; - pop @{ $self->{_suites_running} }; -} - -=head2 suites_running() - -Returns an array stack of the current suites running. When a new -suite is started, it is pushed on the stack, and it is popped on -completion. Hence the first element in the returned array is -the top-level suite, and the last is the innermost suite. - -=cut - -sub suites_running { - my $self = shift; - return @{ $self->{_suites_running} || [] }; -} - -=head2 filter([ @tokens ]) - -Set the runner's filter tokens to the given list. - -=cut - -sub filter { - my $self = shift; - $self->{_filter} = [ @_ ] if @_; - return @{ $self->{_filter} || [] }; -} - -=head2 reset_filter() - -Clears the current filter. - -=cut - -sub reset_filter { - my $self = shift; - $self->{_filter} = []; -} - -1; - -=head1 AUTHOR - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see L or the F file included in this -distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -L, -L, -L - -=cut diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Runner/Terminal.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Runner/Terminal.pm deleted file mode 100644 index 8a8d410..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Runner/Terminal.pm +++ /dev/null @@ -1,172 +0,0 @@ -package Test::Unit::Runner::Terminal; -use strict; - -use base qw(Test::Unit::TestRunner); - -sub start_suite { - my $self = shift; - $self->SUPER::start_suite(@_); - $self->_update_status; -} - -sub end_suite { - my $self = shift; - $self->SUPER::end_suite(@_); - $self->_update_status; -} - -sub start_test { - my $self = shift; - my ($test) = @_; - $self->{_last_test} = $test->name; - $self->_update_status; -} - -sub end_test { - my $self = shift; - my ($test) = @_; - $self->{_last_test} = ''; - $self->_update_status; -} - -sub add_error { - my $self = shift; - my ($test, $exception) = @_; - $self->_update_status; -} - -sub add_failure { - my $self = shift; - my ($test, $exception) = @_; - $self->_update_status; -} - -sub add_pass { - my $self = shift; - my ($test) = @_; - $self->_update_status; -} - -sub _update_status { - my $self = shift; - my $result = $self->result; - - # \e[2A goes two lines up - # \e[K clears to end of line - # \e[J clears below - # \e7 saves cursor position - # \e8 restores cursor position - my $template = <_print( - sprintf $template, - $result->run_count, - $result->failure_count, - $result->error_count, - join(' -> ', map { $_->name || '?' } $self->suites_running), - $self->{_last_test} || '', - ); -} - -sub print_result { - my $self = shift; - $self->_print("\e[J"); # clear status lines below - $self->SUPER::print_result(@_); -} - -1; -__END__ - - -=head1 NAME - -Test::Unit::Runner::Terminal - unit testing framework helper class - -=head1 SYNOPSIS - - use Test::Unit::Runner::Terminal; - - my $testrunner = Test::Unit::Runner::Terminal->new(); - $testrunner->start($my_test_class); - -=head1 DESCRIPTION - -This class is a test runner for the command line style use -of the testing framework. - -It is similar to its parent class, Test::Unit::TestRunner, but it uses -terminal escape sequences to continually update a more informative -status report as the runner progresses through the tests than just a -string of dots, E's and F's. The status report indicates the number -of tests run, the number of failures and errors encountered, which -test is currently being run, and where it lives in the suite -hierarchy. - -The class needs one argument, which is the name of the class -encapsulating the tests to be run. - -=head1 OPTIONS - -=over 4 - -=item -wait - -wait for user confirmation between tests - -=item -v - -version info - -=back - - -=head1 AUTHOR - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see L or the F file included in this -distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=item * - -L - -=item * - -L - -=item * - -L - -=item * - -For further examples, take a look at the framework self test -collection (t::tlib::AllTests). - -=back - -=cut diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Setup.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Setup.pm deleted file mode 100644 index 823475b..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Setup.pm +++ /dev/null @@ -1,63 +0,0 @@ -package Test::Unit::Setup; -use strict; - -use base qw(Test::Unit::Decorator); - -sub run { - my $self = shift(); - my($result) = @_; - my $protectable = sub { - $self->set_up(); - $self->basic_run($result); - $self->tear_down(); - }; - $result->run_protected($self, $protectable); -} - -# Sets up the fixture. Override to set up additional fixture -# state. - -sub set_up { - print "Suite setup\n"; -} - -# Tears down the fixture. Override to tear down the additional -# fixture state. - -sub tear_down { - print "Suite teardown\n"; -} - -1; -__END__ - - -=head1 NAME - -Test::Unit::Setup - unit testing framework helper class - -=head1 SYNOPSIS - - # A Decorator to set up and tear down additional fixture state. - # Subclass Setup and insert it into your tests when you want - # to set up additional state once before the tests are run. - -=head1 DESCRIPTION - -A Decorator to set up and tear down additional fixture state. -Subclass Setup and insert it into your tests when you want -to set up additional state once before the tests are run. - -=head1 AUTHOR - -Copyright (c) 2001 Kevin Connor - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as -Perl itself. - -=head1 SEE ALSO - -L, L - -=cut diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Test.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Test.pm deleted file mode 100644 index 7f02e36..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Test.pm +++ /dev/null @@ -1,147 +0,0 @@ -package Test::Unit::Test; -use strict; - -use Carp; - -use Test::Unit::Debug qw(debug); - -use base qw(Test::Unit::Assert); - -sub count_test_cases { - my $self = shift; - my $class = ref($self); - croak "call to abstract method ${class}::count_test_cases"; -} - -sub run { - my $self = shift; - my $class = ref($self); - croak "call to abstract method ${class}::run"; -} - -sub name { - my $self = shift; - my $class = ref($self); - croak "call to abstract method ${class}::name"; -} - -sub to_string { - my $self = shift; - return $self->name(); -} - -sub filter_method { - my $self = shift; - my ($token) = @_; - - my $filtered = $self->filter->{$token}; - return unless $filtered; - - if (ref $filtered eq 'ARRAY') { - return grep $self->name eq $_, @$filtered; - } - elsif (ref $filtered eq 'CODE') { - return $filtered->($self->name); - } - else { - die "Didn't understand filtering definition for token $token in ", - ref($self), "\n"; - } -} - -my %filter = (); - -sub filter { \%filter } - -# use Attribute::Handlers; - -# sub Filter : ATTR(CODE) { -# my ($pkg, $symbol, $referent, $attr, $data, $phase) = @_; -# print "attr $attr (data $data) on $pkg\::*{$symbol}{NAME}\n"; -# # return (); -# } - -sub _find_sym { # pinched from Attribute::Handlers - my ($pkg, $ref) = @_; - my $type = ref($ref); - no strict 'refs'; - warn "type $type\n"; - while (my ($name, $sym) = each %{$pkg."::"} ) { - use Data::Dumper; -# warn Dumper(*$sym); - warn "name $name sym $sym (" . (*{$sym}{$type} || '?') . ") matches?\n"; - return \$sym if *{$sym}{$type} && *{$sym}{$type} == $ref; - } -} - -sub MODIFY_CODE_ATTRIBUTES { - my ($pkg, $subref, @attrs) = @_; - my @bad = (); - foreach my $attr (@attrs) { - if ($attr =~ /^Filter\((.*)\)$/) { - my @tokens = split /\s+|\s*,\s*/, $1; - my $sym = _find_sym($pkg, $subref); - if ($sym) { - push @{ $filter{$_} }, *{$sym}{NAME} foreach @tokens; - } - else { - warn "Couldn't find symbol for $subref in $pkg\n" unless $sym; - push @bad, $attr; - } - } - else { - push @bad, $attr; - } - } - return @bad; -} - -1; -__END__ - - -=head1 NAME - -Test::Unit::Test - unit testing framework abstract base class - -=head1 SYNOPSIS - -This class is not intended to be used directly - -=head1 DESCRIPTION - -This class is used by the framework to define the interface of a test. -It is an abstract base class implemented by Test::Unit::TestCase and -Test::Unit::TestSuite. - -Due to the nature of the Perl OO implementation, this class is not -really needed, but rather serves as documentation of the interface. - -=head1 AUTHOR - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see L or the F file included in this -distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=item * - -L - -=back - -=cut diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/TestCase.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/TestCase.pm deleted file mode 100644 index fd9232a..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/TestCase.pm +++ /dev/null @@ -1,441 +0,0 @@ -package Test::Unit::TestCase; -use strict; - -use base qw(Test::Unit::Test); - -use Test::Unit::Debug qw(debug); -use Test::Unit::Failure; -use Test::Unit::Error; -use Test::Unit::Result; - -use Devel::Symdump; -use Class::Inner; -use Error qw/:try/; - -sub new { - my $class = shift; - my ($name) = @_; - bless { - __PACKAGE__ . '_name' => $name, - __PACKAGE__ . '_annotations' => '', - }, $class; -} - -sub annotate { - my $self = shift; - $self->{__PACKAGE__ . '_annotations'} .= join '', @_; -} - -sub annotations { $_[0]->{__PACKAGE__ . '_annotations'} } - -sub count_test_cases { - my $self = shift; - return 1; -} - -sub create_result { - my $self = shift; - return Test::Unit::Result->new(); -} - -sub name { - my $self = shift; - return $self->{__PACKAGE__ . '_name'}; -} - -sub run { - my $self = shift; - debug(ref($self), "::run() called on ", $self->name, "\n"); - my ($result, $runner) = @_; - $result ||= create_result(); - $result->run($self); - return $result; -} - -sub run_bare { - my $self = shift; - debug(" ", ref($self), "::run_bare() called on ", $self->name, "\n"); - $self->set_up(); - # Make sure tear_down happens if and only if set_up() succeeds. - try { - $self->run_test(); - 1; - } - finally { - $self->tear_down; - }; -} - -sub run_test { - my $self = shift; - debug(" ", ref($self) . "::run_test() called on ", $self->name, "\n"); - my $method = $self->name(); - if ($self->can($method)) { - debug(" running `$method'\n"); - $self->$method(); - } else { - $self->fail(" Method `$method' not found"); - } -} - -sub set_up { 1 } - -sub tear_down { 1 } - -sub to_string { - my $self = shift; - my $class = ref($self); - return ($self->name() || "ANON") . "(" . $class . ")"; -} - -sub make_test_from_coderef { - my ($self, $coderef, @args) = @_; - die "Need a coderef argument" unless $coderef; - return Class::Inner->new(parent => ($self || ref $self), - methods => {run_test => $coderef}, - args => [ @args ]); -} - - -# Returns a list of the tests run by this class and its superclasses. -# DO NOT OVERRIDE THIS UNLESS YOU KNOW WHAT YOU ARE DOING! -sub list_tests { - my $class = ref($_[0]) || $_[0]; - my @tests = (); - no strict 'refs'; - if (@{"$class\::TESTS"}) { - push @tests, @{"$class\::TESTS"}; - } - else { - push @tests, $class->get_matching_methods(qr/::(test[^:]*)$/); - } - push @tests, map {$_->can('list_tests') ? $_->list_tests : () } @{"$class\::ISA"}; - my %tests = map {$_ => ''} @tests; - return keys %tests; -} - -sub get_matching_methods { - my $class = ref($_[0]) || $_[0]; - my $re = $_[1]; - my $st = Devel::Symdump->new($class); - return map { /$re/ ? $1 : () } $st->functions(); -} - -sub list { - my $self = shift; - my $show_testcases = shift; - return $show_testcases ? - [ ($self->name() || 'anonymous testcase') . "\n" ] - : []; -} - -1; -__END__ - - - -=head1 NAME - -Test::Unit::TestCase - unit testing framework base class - -=head1 SYNOPSIS - - package FooBar; - use base qw(Test::Unit::TestCase); - - sub new { - my $self = shift()->SUPER::new(@_); - # your state for fixture here - return $self; - } - - sub set_up { - # provide fixture - } - sub tear_down { - # clean up after test - } - sub test_foo { - my $self = shift; - my $obj = ClassUnderTest->new(...); - $self->assert_not_null($obj); - $self->assert_equals('expected result', $obj->foo); - $self->assert(qr/pattern/, $obj->foobar); - } - sub test_bar { - # test the bar feature - } - -=head1 DESCRIPTION - -Test::Unit::TestCase is the 'workhorse' of the PerlUnit framework. -When writing tests, you generally subclass Test::Unit::TestCase, write -C and C functions if you need them, a bunch of -C test methods, then do - - $ TestRunner.pl My::TestCase::Class - -and watch as your tests fail/succeed one after another. Or, if you -want your tests to work under Test::Harness and the standard perlish -'make test', you'd write a t/foo.t that looked like: - - use Test::Unit::HarnessUnit; - my $r = Test::Unit::HarnessUnit->new(); - $r->start('My::TestCase::Class'); - -=head2 How To Use Test::Unit::TestCase - -(Taken from the JUnit TestCase class documentation) - -A test case defines the "fixture" (resources need for testing) to run -multiple tests. To define a test case: - -=over 4 - -=item 1 - -implement a subclass of TestCase - -=item 2 - -define instance variables that store the state of the fixture (I -suppose if you are using Class::MethodMaker this is possible...) - -=item 3 - -initialize the fixture state by overriding C - -=item 4 - -clean-up after a test by overriding C. - -=back - - -Implement your tests as methods. By default, all methods that match -the regex C are taken to be test methods (see -L and L). Note that, by -default all the tests defined in the current class and all of its -parent classes will be run. To change this behaviour, see L. - -By default, each test runs in its own fixture so there can be no side -effects among test runs. Here is an example: - - package MathTest; - use base qw(Test::Unit::TestCase); - - sub new { - my $self = shift()->SUPER::new(@_); - $self->{value_1} = 0; - $self->{value_2} = 0; - return $self; - } - - sub set_up { - my $self = shift; - $self->{value_1} = 2; - $self->{value_2} = 3; - } - -For each test implement a method which interacts with the fixture. -Verify the expected results with assertions specified by calling -C<$self-Eassert()> with a boolean value. - - sub test_add { - my $self = shift; - my $result = $self->{value_1} + $self->{value_2}; - $self->assert($result == 5); - } - -Once the methods are defined you can run them. The normal way to do -this uses reflection to implement C. It dynamically finds -and invokes a method. For this the name of the test case has to -correspond to the test method to be run. The tests to be run can be -collected into a TestSuite. The framework provides different test -runners, which can run a test suite and collect the results. A test -runner either expects a method C as the entry point to get a -test to run or it will extract the suite automatically. - -=head2 Writing Test Methods - -The return value of your test method is completely irrelevant. The -various test runners assume that a test is executed successfully if no -exceptions are thrown. Generally, you will not have to deal directly -with exceptions, but will write tests that look something like: - - sub test_something { - my $self = shift; - # Execute some code which gives some results. - ... - # Make assertions about those results - $self->assert_equals('expected value', $resultA); - $self->assert_not_null($result_object); - $self->assert(qr/some_pattern/, $resultB); - } - -The assert methods throw appropriate exceptions when the assertions fail, -which will generally stringify nicely to give you sensible error reports. - -L has more details on the various different -C methods. - -L describes the Exceptions used within the -C framework. - -=head2 Helper methods - -=over 4 - -=item make_test_from_coderef (CODEREF, [NAME]) - -Takes a coderef and an optional name and returns a Test case that -inherits from the object on which it was called, which has the coderef -installed as its C method. L has more details -on how this is generated. - -=item list_tests - -Returns the list of test methods in this class and its parents. You -can override this in your own classes, but remember to call -C in there too. Uses C. - -=item get_matching_methods (REGEXP) - -Returns the list of methods in this class matching REGEXP. - -=item set_up - -=item tear_down - -If you don't have any setup or tear down code that needs to be run, we -provide a couple of null methods. Override them if you need to. - -=item annotate (MESSAGE) - -You can accumulate helpful debugging for each testcase method via this -method, and it will only be outputted if the test fails or encounters -an error. - -=back - -=head2 How it All Works - -The PerlUnit framework is achingly complex. The basic idea is that you -get to write your tests independently of the manner in which they will -be run, either via a C type script, or through one of the -provided TestRunners, the framework will handle all that for you. And -it does. So for the purposes of someone writing tests, in the majority -of cases the answer is 'It just does.'. - -Of course, if you're trying to extend the framework, life gets a -little more tricky. The core class that you should try and grok is -probably Test::Unit::Result, which, in tandem with whichever -TestRunner is being used mediates the process of running tests, -stashes the results and generally sits at the centre of everything. - -Better docs will be forthcoming. - -=head1 NOTES - -Here's a few things to remember when you're writing your test suite: - -Tests are run in 'random' order; the list of tests in your TestCase -are generated automagically from its symbol table, which is a hash, so -methods aren't sorted there. - -If you need to specify the test order, you can do one of the -following: - -=over 4 - -=item * Set @TESTS - - our @TESTS = qw(my_test my_test_2); - -This is the simplest, and recommended way. - -=item * Override the C method - -to return an ordered list of methodnames - -=item * Provide a C method - -which returns a Test::Unit::TestSuite. - -=back - -However, even if you do manage to specify the test order, be careful, -object data will not be retained from one test to another, if you want -to use persistent data you'll have to use package lexicals or globals. -(Yes, this is probably a bug). - -If you only need to restrict which tests are run, there is a filtering -mechanism available. Override the C method in your testcase -class to return a hashref whose keys are filter tokens and whose -values are either arrayrefs of test method names or coderefs which take -the method name as the sole parameter and return true if and only if it -should be filtered, e.g. - - sub filter {{ - slow => [ qw(my_slow_test my_really_slow_test) ], - matching_foo => sub { - my $method = shift; - return $method =~ /foo/; - } - }} - -Then, set the filter state in your runner before the test run starts: - - # @filter_tokens = ( 'slow', ... ); - $runner->filter(@filter_tokens); - $runner->start(@args); - -This interface is public, but currently undocumented (see -F). - -=head1 BUGS - -See note 1 for at least one bug that's got me scratching my head. -There's bound to be others. - -=head1 AUTHOR - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see L or the F file included in this -distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=item * - -L - -=item * - -L - -=item * - -L - -=item * - -For further examples, take a look at the framework self test -collection (t::tlib::AllTests). - -=back - -=cut diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/TestRunner.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/TestRunner.pm deleted file mode 100644 index 52d94f0..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/TestRunner.pm +++ /dev/null @@ -1,273 +0,0 @@ -package Test::Unit::TestRunner; -use strict; - -use base qw(Test::Unit::Runner); - -use Test::Unit; # for copyright & version number -use Test::Unit::TestSuite; -use Test::Unit::Loader; -use Test::Unit::Result; - -use Benchmark; - -sub new { - my $class = shift; - my ($filehandle) = @_; - $filehandle = \*STDOUT unless $filehandle; - select((select($filehandle), $| = 1)[0]); - bless { _Print_stream => $filehandle }, $class; -} - -sub print_stream { - my $self = shift; - return $self->{_Print_stream}; -} - -sub _print { - my $self = shift; - my (@args) = @_; - $self->print_stream->print(@args); -} - -sub add_error { - my $self = shift; - my ($test, $exception) = @_; - $self->_print("E"); -} - -sub add_failure { - my $self = shift; - my ($test, $exception) = @_; - $self->_print("F"); -} - -sub add_pass { - # in this runner passes are ignored. -} - -sub do_run { - my $self = shift; - my ($suite, $wait) = @_; - my $result = $self->create_test_result(); - $result->add_listener($self); - my $start_time = new Benchmark(); - $suite->run($result, $self); - my $end_time = new Benchmark(); - - $self->print_result($result, $start_time, $end_time); - - if ($wait) { - print " to continue"; # go to STDIN any case - ; - } - - $self->_print("\nTest was not successful.\n") - unless $result->was_successful; - - return $result->was_successful; -} - -sub end_test { -} - -sub main { - my $self = shift; - my $a_test_runner = Test::Unit::TestRunner->new(); - $a_test_runner->start(@_); -} - -sub print_result { - my $self = shift; - my ($result, $start_time, $end_time) = @_; - - my $run_time = timediff($end_time, $start_time); - $self->_print("\n", "Time: ", timestr($run_time), "\n"); - - $self->print_header($result); - $self->print_errors($result); - $self->print_failures($result); -} - -sub print_errors { - my $self = shift; - my ($result) = @_; - return unless my $error_count = $result->error_count(); - my $msg = "\nThere " . - ($error_count == 1 ? - "was 1 error" - : "were $error_count errors") . - ":\n"; - $self->_print($msg); - - my $i = 0; - for my $e (@{$result->errors()}) { - chomp(my $e_to_str = $e); - $i++; - $self->_print("$i) $e_to_str\n"); - $self->_print("\nAnnotations:\n", $e->object->annotations()) - if $e->object->annotations(); - } -} - -sub print_failures { - my $self = shift; - my ($result) = @_; - return unless my $failure_count = $result->failure_count; - my $msg = "\nThere " . - ($failure_count == 1 ? - "was 1 failure" - : "were $failure_count failures") . - ":\n"; - $self->_print($msg); - - my $i = 0; - for my $f (@{$result->failures()}) { - chomp(my $f_to_str = $f); - $self->_print("\n") if $i++; - $self->_print("$i) $f_to_str\n"); - $self->_print("\nAnnotations:\n", $f->object->annotations()) - if $f->object->annotations(); - } -} - -sub print_header { - my $self = shift; - my ($result) = @_; - if ($result->was_successful()) { - $self->_print("\n", "OK", " (", $result->run_count(), " tests)\n"); - } else { - $self->_print("\n", "!!!FAILURES!!!", "\n", - "Test Results:\n", - "Run: ", $result->run_count(), - ", Failures: ", $result->failure_count(), - ", Errors: ", $result->error_count(), - "\n"); - } -} - -sub run { - my $self = shift; - my ($class) = @_; - my $a_test_runner = Test::Unit::TestRunner->new(); - $a_test_runner->do_run(Test::Unit::TestSuite->new($class), 0); -} - -sub run_and_wait { - my $self = shift; - my ($test) = @_; - my $a_test_runner = Test::Unit::TestRunner->new(); - $a_test_runner->do_run(Test::Unit::TestSuite->new($test), 1); -} - -sub start { - my $self = shift; - my (@args) = @_; - - my $test = ""; - my $wait = 0; - - for (my $i = 0; $i < @args; $i++) { - if ($args[$i] eq "-wait") { - $wait = 1; - } elsif ($args[$i] eq "-v") { - print Test::Unit::COPYRIGHT_SHORT; - } else { - $test = $args[$i]; - } - } - if ($test eq "") { - die "Usage: TestRunner.pl [-wait] name, where name is the name of the Test class\n"; - } - - my $suite = Test::Unit::Loader::load($test); - $self->do_run($suite, $wait); -} - -sub start_test { - my $self = shift; - my ($test) = @_; - $self->_print("."); -} - -1; -__END__ - - -=head1 NAME - -Test::Unit::TestRunner - unit testing framework helper class - -=head1 SYNOPSIS - - use Test::Unit::TestRunner; - - my $testrunner = Test::Unit::TestRunner->new(); - $testrunner->start($my_test_class); - -=head1 DESCRIPTION - -This class is the test runner for the command line style use -of the testing framework. - -It is used by simple command line tools like the F -script provided. - -The class needs one argument, which is the name of the class -encapsulating the tests to be run. - -=head1 OPTIONS - -=over 4 - -=item -wait - -wait for user confirmation between tests - -=item -v - -version info - -=back - - -=head1 AUTHOR - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see L or the F file included in this -distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=item * - -L - -=item * - -L - -=item * - -L - -=item * - -For further examples, take a look at the framework self test -collection (t::tlib::AllTests). - -=back - -=cut diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/TestSuite.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/TestSuite.pm deleted file mode 100644 index 356dcb5..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/TestSuite.pm +++ /dev/null @@ -1,360 +0,0 @@ -package Test::Unit::TestSuite; -use strict; - -=head1 NAME - -Test::Unit::TestSuite - unit testing framework base class - -=cut - -use base 'Test::Unit::Test'; - -use Carp; - -use Test::Unit::Debug qw(debug); -use Test::Unit::TestCase; -use Test::Unit::Loader; -use Test::Unit::Warning; - -=head1 SYNOPSIS - - package MySuite; - - use base qw(Test::Unit::TestSuite); - - sub name { 'My very own test suite' } - sub include_tests { qw(MySuite1 MySuite2 MyTestCase1 ...) } - -This is the easiest way of building suites; there are many more. Read on ... - -=head1 DESCRIPTION - -This class provides the functionality for building test suites in -several different ways. - -Any module can be a test suite runnable by the framework if it -provides a C method which returns a C -object, e.g. - - use Test::Unit::TestSuite; - - # more code here ... - - sub suite { - my $class = shift; - - # Create an empty suite. - my $suite = Test::Unit::TestSuite->empty_new("A Test Suite"); - # Add some tests to it via $suite->add_test() here - - return $suite; - } - -This is useful if you want your test suite to be contained in the module -it tests, for example. - -Alternatively, you can have "standalone" test suites, which inherit directly -from C, e.g.: - - package MySuite; - - use base qw(Test::Unit::TestSuite); - - sub new { - my $class = shift; - my $self = $class->SUPER::empty_new(); - # Build your suite here - return $self; - } - - sub name { 'My very own test suite' } - -or if your C is going to do nothing more interesting than add -tests from other suites and testcases via C, you can use the -C method as shorthand: - - package MySuite; - - use base qw(Test::Unit::TestSuite); - - sub name { 'My very own test suite' } - sub include_tests { qw(MySuite1 MySuite2 MyTestCase1 ...) } - -This is the easiest way of building suites. - -=head1 CONSTRUCTORS - -=head2 empty_new ([NAME]) - - my $suite = Test::Unit::TestSuite->empty_new('my suite name'); - -Creates a fresh suite with no tests. - -=cut - -sub empty_new { - my $this = shift; - my $classname = ref $this || $this; - my $name = shift || ''; - - my $self = { - _Tests => [], - _Name => $name, - }; - bless $self, $classname; - - debug(ref($self), "::empty_new($name) called\n"); - return $self; -} - -=head2 new ([ CLASSNAME | TEST ]) - -If a test suite is provided as the argument, it merely returns that -suite. If a test case is provided, it extracts all test case methods -from the test case (see L) into a new -test suite. - -If the class this method is being run in has an C method -which returns an array of class names, it will also automatically add -the tests from those classes into the newly constructed suite object. - -=cut - -sub new { - my $class = shift; - my $classname = shift || ''; # Avoid a warning - debug("$class\::new($classname) called\n"); - - my $self = $class->empty_new(); - - if ($classname) { - Test::Unit::Loader::compile_class($classname); - if (eval { $classname->isa('Test::Unit::TestCase') }) { - $self->{_Name} = "suite extracted from $classname"; - my @testcases = Test::Unit::Loader::extract_testcases($classname); - foreach my $testcase (@testcases) { - $self->add_test($testcase); - } - } - elsif (eval { $classname->can('suite') }) { - return $classname->suite(); - } - else { - my $error = "Class $classname was not a test case or test suite.\n"; - #$self->add_warning($error); - die $error; - } - } - - if ($self->can('include_tests')) { - foreach my $test ($self->include_tests()) { - $self->add_test($test); - } - } - - return $self; -} - -=head1 METHODS - -=cut - -sub suite { - my $class = shift; - croak "suite() is not an instance method" if ref $class; - $class->new(@_); -} - -=head2 name() - -Returns the suite's human-readable name. - -=cut - -sub name { - my $self = shift; - croak "Override name() in subclass to set name\n" if @_; - return $self->{_Name}; -} - -=head2 names() - -Returns an arrayref of the names of all tests in the suite. - -=cut - -sub names { - my $self = shift; - my @test_list = @{$self->tests}; - return [ map {$_->name} @test_list ] if @test_list; -} - -=head2 list (SHOW_TESTCASES) - -Produces a human-readable indented lists of the suite and the subsuites -it contains. If the first parameter is true, also lists any testcases -contained in the suite and its subsuites. - -=cut - -sub list { - my $self = shift; - my $show_testcases = shift; - my $first = ($self->name() || 'anonymous Test::Unit::TestSuite'); - $first .= " - " . ref($self) unless ref($self) eq __PACKAGE__; - $first .= "\n"; - my @lines = ( $first ); - foreach my $test (@{ $self->tests() }) { - push @lines, map " $_", @{ $test->list($show_testcases) }; - } - return \@lines; -} - -=head2 add_test (TEST_CLASSNAME | TEST_OBJECT) - -You can add a test object to a suite with this method, by passing -either its classname, or the object itself as the argument. - -Of course, there are many ways of getting the object too ... - - # Get and add an existing suite. - $suite->add_test('MySuite1'); - - # This is exactly equivalent: - $suite->add_test(Test::Unit::TestSuite->new('MySuite1')); - - # So is this, provided MySuite1 inherits from Test::Unit::TestSuite. - use MySuite1; - $suite->add_test(MySuite1->new()); - - # Extract yet another suite by way of suite() method and add it to - # $suite. - use MySuite2; - $suite->add_test(MySuite2->suite()); - - # Extract test case methods from MyModule::TestCase into a - # new suite and add it to $suite. - $suite->add_test(Test::Unit::TestSuite->new('MyModule::TestCase')); - -=cut - -sub add_test { - my $self = shift; - my ($test) = @_; - debug('+ ', ref($self), "::add_test($test) called\n"); - $test = Test::Unit::Loader::load_test($test) unless ref $test; - croak "`$test' could not be interpreted as a Test::Unit::Test object" - unless eval { $test->isa('Test::Unit::Test') }; - push @{$self->tests}, $test; -} - -sub count_test_cases { - my $self = shift; - my $count; - $count += $_->count_test_cases for @{$self->tests}; - return $count; -} - -sub run { - my $self = shift; - my ($result, $runner) = @_; - - debug("$self\::run($result, ", $runner || 'undef', ") called\n"); - - $result ||= create_result(); - $result->tell_listeners(start_suite => $self); - - $self->add_warning("No tests found in " . $self->name()) - unless @{ $self->tests() }; - - for my $t (@{$self->tests()}) { - if ($runner && $self->filter_test($runner, $t)) { - debug(sprintf "+ skipping '%s'\n", $t->name()); - next; - } - debug(sprintf "+ didn't skip '%s'\n", $t->name()); - - last if $result->should_stop(); - $t->run($result, $runner); - } - - $result->tell_listeners(end_suite => $self); - - return $result; -} - -sub filter_test { - my $self = shift; - my ($runner, $test) = @_; - - debug(sprintf "checking whether to filter '%s'\n", $test->name); - - my @filter_tokens = $runner->filter(); - - foreach my $token (@filter_tokens) { - my $filtered = $test->filter_method($token); - debug(" - by token $token? ", $filtered ? 'yes' : 'no', "\n"); - return 1 if $filtered; - } - - return 0; -} - -sub test_at { - my $self = shift; - my ($index) = @_; - return $self->tests()->[$index]; -} - -sub test_count { - my $self = shift; - return scalar @{$self->tests()}; -} - -sub tests { - my $self = shift; - return $self->{_Tests}; -} - -sub to_string { - my $self = shift; - return $self->name(); -} - -sub add_warning { - my $self = shift; - $self->add_test(Test::Unit::Warning->new(join '', @_)); -} - -1; -__END__ - -=head1 AUTHOR - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see L or the F file included in this -distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=item * - -For further examples, take a look at the framework self test -collection (t::tlib::AllTests). - -=back - -=cut diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/TkTestRunner.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/TkTestRunner.pm deleted file mode 100644 index 595c442..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/TkTestRunner.pm +++ /dev/null @@ -1,697 +0,0 @@ -#!/usr/bin/perl -w - -package Test::Unit::TkTestRunner; - -use strict; - -use base qw(Test::Unit::Runner); - -use Tk; -use Tk::BrowseEntry; -use Benchmark; - -use Test::Unit; # for copyright & version number -use Test::Unit::Result; -use Test::Unit::Loader; - -sub new { - my $self = bless {}, shift; - return $self; -} - -sub about { - my $self = shift; - my $dialog = $self->{frame}->DialogBox( - -title => 'About PerlUnit', - -buttons => [ 'OK' ] - ); - my $text = $dialog->add("ROText"); #, -width => 80, -height => 20); - $text->insert("end", Test::Unit::COPYRIGHT_NOTICE); - $text->pack(); - $dialog->Show(); -} - -sub add_error { - my $self = shift; - $self->{number_of_errors} = $self->{result}->error_count(); - $self->append_failure("Error", @_); - $self->update(); -} - -sub add_failure { - my $self = shift; - $self->{number_of_failures} = $self->{result}->failure_count(); - $self->append_failure("Failure", @_); - $self->update(); -} - -sub append_failure { - my ($self, $kind, $test, $exception)=@_; - my $message = $test->name(); #bad juju!! - if ($message) { - $kind .= ":".substr($message, 0, 100); - } - $self->{failure_list}->insert("end", $message); - push @{$self->{failed_tests}}, $test; - push @{$self->{exceptions}}, $exception; -} - -sub plan{ - my $self = shift; - $self->{planned} = shift; -} - - -sub choose_file { - my $self = shift; - my $name = $self->{suite_name}; - my @types = ([ 'All Files', '*' ]); - my $dir = undef; - if (defined $name) { - require File::Basename; - my $sfx; - ($name, $dir, $sfx) = File::Basename::fileparse($name, '\..*'); - if (defined($sfx) && length($sfx)) { - unshift(@types, [ 'Similar Files', [$sfx]]); - $name .= $sfx; - } - } - my $file = $self->{frame}->getOpenFile( - -title => "Select test case", - -initialdir => $dir, - -initialfile => $name, - -filetypes => \@types - ); - if (defined $file) { - $file=~s/\/+/\//g; - } - $self->{suite_name} = $file; -} - -sub create_punit_menu { - my $self = shift; - my $main_menu = $self->{frame}->Menu( - -type => 'menubar', - -menuitems => [ - [ - cascade => 'F~ile', - -menuitems => [ - [ - command => 'O~pen', - -command => sub { $self->choose_file() } - ], - [ - command => 'Ex~it', - -command => sub { $self->{frame}->destroy() } - ], - ], - ], - [ - cascade => 'H~elp', - -menuitems => [ - [ - command => 'A~bout PerlUnit', - -command => sub { $self->about() } - ], - ], - ], - ], - ); - return $main_menu; -} - -sub create_menus { - my $self = shift; - $self->{frame}->configure(-menu => $self->create_punit_menu()); -} - -sub create_ui { - my $self = shift; - # Lay the window out.... - my $mw = $self->{frame} = MainWindow->new( - -title => 'Run Test Suite', - -width => 200 - ); - # I need stretchy labels, Tk doesnt have them - my $mklabel = sub { - my (@args)=@_; - $self->{$args[0]} = $args[2]; - $mw->Entry( - -textvariable => \$self->{$args[0]}, - -justify => $args[1], - -relief => 'flat', - -state => 'disabled' - ); - }; - $self->create_menus(); - $self->{suite_label} = $mw->Label( - -text => 'Enter the name of the TestCase:' - ); - $self->{suite_name} = "x"; - $self->{suite_field} = $mw->BrowseEntry( - -textvariable => \$self->{suite_name}, - -choices => [], - ); - $self->{add_text_listener} = sub { $self->run_suite() }; - $self->{run} = $mw->Button( - -text => 'Run', - -state => 'normal', - -command => sub { $self->run_suite() } - ); - - my $lab1 = $mw->Label(-text => "Runs:"); - my $lab2 = &{$mklabel}('number_of_runs', 'right', 0); - my $lab3 = $mw->Label(-text => "Errors:"); - my $lab4 = &{$mklabel}('number_of_errors', 'right', 0); - my $lab5 = $mw->Label(-text => "Failures:"); - my $lab6 = &{$mklabel}('number_of_failures', 'right', 0); - - $self->{progress_bar} = $mw->ArrayBar( - -width => 20, - -length => 400, - -colors => [ 'green', 'red', 'grey' ] - ); - $self->{failure_label} = $mw->Label( - -text => 'Errors and Failures:', - -justify => 'left' - ); - $self->{failure_list} = $mw->Scrolled('Listbox', -scrollbars => 'e'); - $self->{failure_list}->insert("end", "", "", "", "", "", ""); - - $self->{quit_button} = $mw->Button( - -text => 'Quit', - -command => sub { $mw->destroy() } - ); - - $self->{rerun_button} = $mw->Button( - -text => 'ReRun', - -state => 'normal', - -command => sub { $self->rerun() } - ); - $self->{show_error_button} = $mw->Button( - -text => 'Show...', - -state => 'normal', - -command => sub { $self->show_error_trace() } - ); - - - $self->{status_line_box}= &{$mklabel}('status_line', 'left', 'Status line'); - $self->{status_line_box}->configure(-relief => 'sunken', -bg => 'grey'); - - # Bindings go here, so objects are already defined. - $self->{failure_list}->bind('' => sub { $self->show_error_trace() }); - - # all geometry management BELOW this point. Otherwise bindings - # wont work. - $self->{suite_label}->form( - -left => [ '%0' ], - -top => [ '%0' ], - -fill => 'x' - ); - $self->{run}->form( - -right => [ '%100' ], - -top => [ $self->{suite_label} ], - ); - $self->{suite_field}->form( - -left => [ '%0' ], - -right => [$self->{run}], - -top => [$self->{suite_label}], -fill => 'x' - ); - - $lab1->form(-left => ['%0'], -top => [$self->{suite_field}, 10]); - $lab2->form(-left => [$lab1], -top => [$self->{suite_field}, 10], -fill => 'x'); - $lab3->form(-left => [$lab2], -top => [$self->{suite_field}, 10]); - $lab4->form(-left => [$lab3], -top => [$self->{suite_field}, 10], -fill => 'x'); - $lab5->form(-left => [$lab4], -top => [$self->{suite_field}, 10]); - $lab6->form(-left => [$lab5], -top => [$self->{suite_field}, 10], -fill => 'x'); - - - $self->{progress_bar}->form(-left => [ '%0' ], -top => [$lab6, 10]); - $self->{failure_label}->form( - -left => [ '%0' ], - -top => [$self->{progress_bar}, 10], - -right => [ '%100' ] - ); - $self->{failure_list}->form( - -left => [ '%0' ], - -top => [$self->{failure_label}], - -right => [ '%100' ], - -fill => 'both' - ); - # this is in a wierd order 'cos Quit keeps trying to resize. - $self->{quit_button}->form( - -right => [ '%100' ], - -bottom => [ '%100' ], - -fill => 'none' - ); - $self->{show_error_button}->form( - -right => [ '%100' ], - -bottom => [$self->{quit_button}], - -top => [$self->{failure_list}] - ); -# Rerun doesn't work yet. -# $self->{rerun_button}->form( -# -right => [$self->{show_error_button}], -# -top => [$self->{failure_list}] -# ); - - $self->{status_line_box}->form( - -left => [ '%0' ], - -right => [$self->{quit_button}], - -bottom => [ '%100' ], - -top => [$self->{show_error_button}], - -fill => 'x' - ); - - $self->reset(); - return $mw; -} - -sub end_test { - my $self = shift; - $self->{runs} = $self->{result}->run_count(); - $self->update(); -} - -sub get_test { - my $self = shift; - my $suite = Test::Unit::Loader->obj_load(shift); - $self->{status_line}=""; - return $suite; -} - -sub is_error_selected { - my $self = shift; - ($self->{listbox}->curselection>=0)?1:0; -} - -sub load_frame_icon { - # not implemented -} - -sub main { - my $main = new Test::Unit::TkTestRunner()->start(@_); -} - -sub rerun { - # not implemented and not going to! - my $self = shift; - my $index = $self->{failure_list}->curselection; - return if $index < 0; - my $test = $self->{failed_tests}->[$index]; - #if (! $test->isa("Test::Unit::TestCase")) { - $self->show_status("Could not reload test."); - #} - # Not sure how to do this... -} - -sub reset { - my $self = shift; - $self->{number_of_errors} = 0; - $self->{number_of_failures} = 0; - $self->{number_of_runs} = 0; - $self->{planned} = 0; - $self->{failure_list}->delete(0, "end"); - $self->{exceptions} = []; - $self->{failed_tests} = []; - $self->{progress_bar}->value(0, 0, 1); -} - -sub run { - my $self = shift; - $self->run_suite(); -} - -sub run_failed { - my $self = shift; - # not implemented -} - -sub run_suite { - my $self = shift; - my $suite; - if (defined($self->{runner})) { - $self->{result}->stop(); - } - else { - $self->add_to_history(); - $self->{run}->configure(-text => "Stop"); - $self->show_info("Initializing..."); - $self->reset(); - $self->show_info("Load Test Case..."); - eval { - $suite = $self->get_test($self->{suite_name}); - }; - if ($@ or !$suite) { - $suite = undef; - $self->show_status("Could not load test!"); - } - if ($suite) { - $self->{runner} = 1; - $self->{planned} = $suite->count_test_cases(); - $self->{result} = $self->create_test_result(); - $self->{result}->add_listener($self); - $self->show_info("Running..."); - $self->{start_time} = new Benchmark(); - $suite->run($self->{result}); - if ($self->{result}->should_stop()) { - $self->show_status("Stopped"); - } - else { - $self->{finish_time} = new Benchmark(); - $self->{run_time} = timediff($self->{finish_time}, - $self->{start_time}); - $self->show_info("Finished: ".timestr($self->{run_time}, 'nop')); - } - } - $self->{runner} = undef; - $self->{result} = undef; - $self->{run}->configure(-text => "Run"); - } -} - -sub show_error_trace { - # pop up a text dialog containing the details. - my $self = shift; - my $dialog = $self->{frame}->DialogBox( - -title => 'Details', - -buttons => [ 'OK' ] - ); - my $selected = $self->{failure_list}->curselection; - return unless defined($selected) && $self->{exceptions}[$selected]; - my $text = $dialog->add("Scrolled", "ROText", -width => 80, -height => 20) - ->pack(-expand => 1, -fill => 'both'); - $text->insert("end", $self->{exceptions}[$selected]->to_string()); - - my $e = $self->{exceptions}[$selected]; - if ($e->object->annotations()) { - foreach my $data ("\n\nAnnotations:\n", $e->object->annotations()) { - $text->insert("end", $data); # third arg would be a tag - } - } - - $dialog->Show(); -} - -sub show_info { - my $self = shift; - $self->{status_line} = shift; - $self->{status_line_box}->configure(-bg => 'grey'); -} - -sub show_status { - my $self = shift; - $self->{status_line} = shift; - $self->{status_line_box}->configure(-bg => 'red'); -} - -sub start { - my $self = shift; - my (@args)=@_; - my $mw = $self->create_ui(); - if (@args) { - $self->{suite_name} = shift @args; - } - MainLoop; -} - -sub start_test { - my $self = shift; - my $test = shift; - $self->{number_of_runs} = $self->{result}->run_count(); - $self->show_info("Running: " . $test->name()); -} - -sub add_pass { - my $self = shift; - my ($test, $exception)=@_; - $self->update(); -} - -sub update { - my $self = shift; - my $result = $self->{result}; - my $total = $result->run_count(); - my $failures = $result->failure_count(); - my $errors = $result->error_count(); - my $passes = $total-$failures-$errors; - my $bad = $failures+$errors; - #$passes = $result->run_count(); - my $todo = ($total>$self->{planned})?0:$self->{planned}-$total; - $self->{progress_bar}->value($passes, $bad, $todo); - # force entry into the event loop. - # this makes it nearly like its threaded... - #sleep 1; - $self->{frame}->update(); -} - -sub add_to_history { - my $self = shift; - my $new_item = $self->{suite_name}; - my $h = $self->{suite_field}; - my $choices = $h->cget('-choices'); - my @choices = (); - if (ref($choices)) { - @choices=@{$h->cget('-choices')}; - } - elsif ($choices) { - # extraordinarily bad - choices is a scalar if theres - # only one, and undefined if there are none! - @choices = ($h->cget('-choices')); - } - @choices = ($new_item, grep {$_ ne $new_item} @choices); - if (@choices>10) { - @choices=@choices[0..9]; - } - $h->configure(-choices => \@choices); -} - -package Tk::ArrayBar; -# progressbar doesnt cut it. -# This expects a variable which is an array ref, and -# a matching list of colours. Sortof like stacked progress bars. -# Heavily - ie almost totally - based on the code in ProgressBar. -use Tk; -use Tk::Canvas; -use Tk::ROText; -use Tk::DialogBox; -use Carp; -use strict; - -use base qw(Tk::Derived Tk::Canvas); - -Construct Tk::Widget 'ArrayBar'; - -sub ClassInit { - my ($class, $mw) = @_; - - $class->SUPER::ClassInit($mw); - - $mw->bind($class, '', [ '_layoutRequest', 1 ]); -} - -sub Populate { - my($c, $args) = @_; - - $c->ConfigSpecs( - -width => [ PASSIVE => undef, undef, 0 ], - '-length' => [ PASSIVE => undef, undef, 0 ], - -padx => [ PASSIVE => 'padX', 'Pad', 0 ], - -pady => [ PASSIVE => 'padY', 'Pad', 0 ], - -colors => [ PASSIVE => undef, undef, undef ], - -relief => [ SELF => 'relief', 'Relief', 'sunken' ], - -value => [ METHOD => undef, undef, undef ], - -variable => [ PASSIVE => undef, undef, [ 0 ] ], - -anchor => [ METHOD => 'anchor', 'Anchor', 'w' ], - -resolution => [ PASSIVE => undef, undef, 1.0 ], - -highlightthickness => [ - SELF => 'highlightThickness', 'HighlightThickness', 0 - ], - -troughcolor => [ - PASSIVE => 'troughColor', 'Background', 'grey55' - ], - ); - - _layoutRequest($c, 1); - $c->OnDestroy([ Destroyed => $c ]); -} - -sub anchor { - my $c = shift; - my $var = \$c->{Configure}{'-anchor'}; - my $old = $$var; - - if (@_) { - my $new = shift; - croak "bad anchor position \"$new\": must be n, s, w or e" - unless $new =~ /^[news]$/; - $$var = $new; - } - - $old; -} - -sub _layoutRequest { - my $c = shift; - my $why = shift; - $c->afterIdle([ '_arrange', $c ]) unless $c->{layout_pending}; - $c->{layout_pending} |= $why; -} - -sub _arrange { - my $c = shift; - my $why = $c->{layout_pending}; - - $c->{layout_pending} = 0; - - my $w = $c->Width; - my $h = $c->Height; - my $bw = $c->cget('-borderwidth') + $c->cget('-highlightthickness'); - my $x = abs(int($c->{Configure}{'-padx'})) + $bw; - my $y = abs(int($c->{Configure}{'-pady'})) + $bw; - my $value = $c->cget('-variable'); - my $horz = $c->{Configure}{'-anchor'} =~ /[ew]/i ? 1 : 0; - my $dir = $c->{Configure}{'-anchor'} =~ /[ne]/i ? -1 : 1; - - if ($w == 1 && $h == 1) { - my $bw = $c->cget('-borderwidth'); - $h = $c->pixels($c->cget('-length')) || 40; - $w = $c->pixels($c->cget('-width')) || 20; - - ($w, $h) = ($h, $w) if $horz; - $c->GeometryRequest($w, $h); - $c->parent->update; - $c->update; - - $w = $c->Width; - $h = $c->Height; - } - - $w -= $x*2; - $h -= $y*2; - - my $length = $horz ? $w : $h; - my $width = $horz ? $h : $w; - # at this point we have the length and width of the - # bar independent of orientation and padding. - # blocks and gaps are not used. - - # unlike progressbar I need to redraw these each time. - # actually resizing them might be better... - my $colors = $c->{Configure}{'-colors'} || [ 'green', 'red', 'grey55' ]; - $c->delete($c->find('all')); - $c->createRectangle( - 0, 0, $w+$x*2, $h+$y*2, - -fill => $c->{Configure}{'-troughcolor'}, - -width => 0, - -outline => undef - ); - my $total; - my $count_value = scalar(@$value)-1; - foreach my $val (@$value) { - $total += $val > 0 ? $val : 0; - } - # prevent div by zero and give a nice initial appearance. - $total = $total ? $total : 1; - my $curx = $x; - my $cury = $y; - foreach my $index (0..$count_value) { - my $size = ($length*$value->[$index])/$total; - my $ud = $horz?$width:$size; - my $lr = $horz?$size:$width; - $c->{cover}->[$index] = $c->createRectangle( - $curx, $cury, $curx+$lr-1, $cury+$ud-1, - -fill => $colors->[$index], - -width => 1, - -outline => 'black' - ); - $curx+=$horz?$lr:0; - $cury+=$horz?0:$ud; - } -} - -sub value { - my $c = shift; - my $val = $c->cget('-variable'); - - if (@_) { - $c->configure(-variable => [@_]); - _layoutRequest($c, 2); - } -} - -sub Destroyed { - my $c = shift; - my $var = delete $c->{'-variable'}; - untie $$var if defined($var) && ref($var); -} - -1; -__END__ - - -=head1 NAME - -Test::Unit::TkTestRunner - unit testing framework helper class - -=head1 SYNOPSIS - - use Test::Unit::TkTestRunner; - Test::Unit::TkTestRunner::main($my_testcase_class); - -=head1 DESCRIPTION - -This class is the test runner for the GUI style use of the testing -framework. - -It is used by simple command line tools like the F -script provided. - -The class needs as arguments the names of the classes encapsulating -the tests to be run. - -=head1 AUTHOR - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see L or the F file included in this -distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=item * - -L - -=item * - -L - -=item * - -L - -=item * - -L - -=item * - -For further examples, take a look at the framework self test -collection (t::tlib::AllTests). - -=back - -=cut diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Tutorial.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Tutorial.pm deleted file mode 100644 index f441b26..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Tutorial.pm +++ /dev/null @@ -1,61 +0,0 @@ -package Test::Unit::Tutorial; - -# this is only a container for the Test::Unit tutorial -# to allow viewing tutorial-style documentation on -# unit testing by way of the perldoc utility. - -1; -__END__ - -=head1 NAME - -Test::Unit::Tutorial - Tutorial on unit testing - -=head1 SYNOPSIS - - perldoc Test::Unit::Tutorial - -=head1 DESCRIPTION - -Here should be extensive documentation on what unit testing is, why it -is useful, and how to do it with the Test::Unit collection of modules. - -Sorry for not implementing this yet. - -Please have a look at the examples in the examples directory and read -the F file that came with this distribution. - -A short tutorial on how to use the unit testing framework is included -in L. - -Further examples can be found by looking at the self test collection, -starting in t::tlib::AllTests. - -=head1 AUTHOR - -Christian Lemburg Elemburg@acm.orgE - -=head1 SEE ALSO - -=over 4 - -=item * - -The module documentation for all modules in the Test::Unit tree. - -=item * - -I -Martin Fowler. Addison-Wesley, 1999. - -=item * - -The JUnit (unit testing framework for Java) documentation. - -=item * - -http://www.xProgramming.com/ - -=back - -=cut diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/UnitHarness.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/UnitHarness.pm deleted file mode 100644 index ae033f4..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/UnitHarness.pm +++ /dev/null @@ -1,236 +0,0 @@ -# This is a makeover of Test::Harness to allow its tests -# to be retrofitted as unit tests. -package Test::Unit::UnitHarness; - -BEGIN {require 5.002;} -use base qw(Test::Unit::Runner Test::Unit::Test Exporter); - -use Config; -use Carp; -use Class::Inner; -use FileHandle; - -use Test::Unit::Debug qw(debug); -use Test::Unit::TestCase; -use Test::Unit::Exception; - -use strict; - -use vars qw($VERSION $verbose $switches $have_devel_corestack $curtest - @EXPORT @EXPORT_OK); -$have_devel_corestack = 0; - -$VERSION = "1.1502"; - -@EXPORT = qw(&runtests); -@EXPORT_OK = qw($verbose $switches); - -$verbose = 0; -$switches = "-w"; - -# class and object methods - -sub new { - my $class = shift; - my ($name) = @_; - - my @_Tests = (); - my $self = { - _Tests => \@_Tests, - _Name => $name, - _Names => [], - }; - bless $self, $class; - debug(ref($self) . "::new($name) called\n"); - - return $self; -} - -sub run { - my $self = shift; - my $result = shift; - my $test = $self->{_Name}; - my $fh = new FileHandle; - my $next = 1; - my $max = 0; - my $message = ""; - - # pass -I flags to children - my $old5lib = $ENV{PERL5LIB}; - local($ENV{'PERL5LIB'}) = join($Config{path_sep}, @INC); - - if ($^O eq 'VMS') { $switches =~ s/-(\S*[A-Z]\S*)/"-$1"/g } - - $fh->open($test) or print "can't open $test. $!\n"; - my $first = <$fh>; - my $s = $switches; - $s .= q[ "-T"] if $first =~ /^#!.*\bperl.*-\w*T/; - $fh->close or print "can't close $test. $!\n"; - my $cmd = "$^X $s $test|"; - $cmd = "MCR $cmd" if $^O eq 'VMS'; - $fh->open($cmd) or print "can't run $test. $!\n"; - for my $line (<$fh>) { - print $line if $verbose; - - if ($line =~ /^1\.\.([0-9]+)/) { - # Not supported in Result - It's needed!!! - #$result->plan($1); - $next = 1; - $max = $1; - $message = ""; - } - elsif ($max && $line =~ /^(not\s+)?ok\b/) { - my $this = $next; - if ($line =~ /^not ok\s*(\d*)/) { - $this = $1 if $1 > 0; - my $testcase = new Test::Unit::TestCase("$test case $this"); - $result->start_test($testcase); - $result->add_failure( - Test::Unit::UnitHarness::TestCase->new("$test case $this"), - Test::Unit::UnitHarness::Exception->new($message) - ); - $result->end_test($testcase); - $message = ""; - } - elsif ($line =~ /^ok\s*(\d*)/) { - $this = $1 if $1; - my $testcase = - Test::Unit::UnitHarness::TestCase->new("$test case $this"); - $result->start_test($testcase); - $result->add_pass($testcase); - $result->end_test($testcase); - $message = ""; - } - $next++; - } - else { - # this is the message, not the medium... - # this wasnt part of the Test::Harness protocol, so it - # must be output from the program. Collect this, it might - # prove useful! - $message .= $line; - } - } - $fh->close; # must close to reap child resource values - if ($^O eq 'VMS') { - if (defined $old5lib) { - $ENV{PERL5LIB} = $old5lib; - } else { - delete $ENV{PERL5LIB}; - } - } -} - -sub name { - my $self = shift; - return $self->{_Name}; -} - -sub names { - my $self = shift; - return $self->{_Names}; -} - -sub add_test { - croak "This is suite is not mutable."; -} - -sub add_test_method { - croak "This suite is not mutable."; -} - -sub count_test_cases { - return 0; -} - -sub to_string { - my $self = shift; - return $self->{_Name}; -} - -sub warning { - my $self = shift; - my ($message) = @_; - return Class::Inner->new( - parent => 'Test::Unit::TestCase', - methods => { run_test => sub { (shift)->fail($message) } }, - args => ['warning'], - ); -} - -package Test::Unit::UnitHarness::TestCase; -use base qw(Test::Unit::TestCase); - -sub run_test { - my $self = shift; - my $class = ref($self); - my $method = $self->name(); - $self->fail("This test is not restartable"); -} - -package Test::Unit::UnitHarness::Exception; -use base qw(Test::Unit::Exception); -use strict; - -sub new { - my $class = shift; - my ($message) = @_; - my $stacktrace = ''; - - $message = '' unless defined($message); - $stacktrace = $class . ": Output from external test\n" - . $message . "\n"; - - bless { stacktrace => $stacktrace }, $class; -} - -sub stacktrace { - my $self = shift; - return $self->{stacktrace}; -} - -1; - -__END__ - -=head1 NAME - -Test::Unit::UnitHarness - unit testing framework helper class - -=head1 SYNOPSIS - -This class is not intended to be used directly - -=head1 DESCRIPTION - -This is a makeover of Test::Harness to allow its tests to be -retrofitted as unit tests. - -=head1 AUTHOR - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see L or the F file included in this -distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=item * - -L - -=back - -=cut diff --git a/perl/third/Test-Unit-0.25/lib/Test/Unit/Warning.pm b/perl/third/Test-Unit-0.25/lib/Test/Unit/Warning.pm deleted file mode 100644 index 3acf4c2..0000000 --- a/perl/third/Test-Unit-0.25/lib/Test/Unit/Warning.pm +++ /dev/null @@ -1,42 +0,0 @@ -package Test::Unit::Warning; - -use strict; -use base 'Test::Unit::TestCase'; - -=head1 NAME - -Test::Unit::Warning - helper TestCase for adding warnings to a suite - -=head1 DESCRIPTION - -Used by L and others to provide messages that -come up when the suite runs. - -=cut - -sub run_test { - my $self = shift; - $self->fail($self->{_message}); -} - -sub new { - my $class = shift; - my $self = $class->SUPER::new('warning'); - $self->{_message} = shift; - return $self; -} - -1; - - -=head1 AUTHOR - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see L or the F file included in this -distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=cut - diff --git a/perl/third/Test-Unit-0.25/t/all_tests.t b/perl/third/Test-Unit-0.25/t/all_tests.t deleted file mode 100644 index f55d5cd..0000000 --- a/perl/third/Test-Unit-0.25/t/all_tests.t +++ /dev/null @@ -1,13 +0,0 @@ -#!/usr/bin/perl -w - -use strict; - -use Test::Unit::Debug qw(debug_pkgs); -use Test::Unit::HarnessUnit; - -#debug_pkgs(qw{Test::Unit::Result}); - -use lib 't/tlib', 'tlib'; - -my $testrunner = Test::Unit::HarnessUnit->new(); -$testrunner->start("AllTests"); diff --git a/perl/third/Test-Unit-0.25/t/assert.t b/perl/third/Test-Unit-0.25/t/assert.t deleted file mode 100644 index c87d2de..0000000 --- a/perl/third/Test-Unit-0.25/t/assert.t +++ /dev/null @@ -1,14 +0,0 @@ -#!/usr/bin/perl -w - -use strict; - -use Test::Unit::HarnessUnit; -use Test::Unit::Debug qw(debug_pkgs); - -#debug_pkgs(qw/Test::Unit::Assert/); -#debug_pkgs(qw/Test::Unit::Assertion::CodeRef/); - -use lib 't/tlib', 'tlib'; - -my $testrunner = Test::Unit::HarnessUnit->new(); -$testrunner->start("AssertTest"); diff --git a/perl/third/Test-Unit-0.25/t/tlib/ActiveTestTest.pm b/perl/third/Test-Unit-0.25/t/tlib/ActiveTestTest.pm deleted file mode 100644 index 4fbff4a..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/ActiveTestTest.pm +++ /dev/null @@ -1,60 +0,0 @@ -package ActiveTestTest; - -use strict; - -use Test::Unit::TestCase (); -use base 'Test::Unit::TestCase'; -use Test::Unit::Result; -use Test::Unit::TestSuite (); -use Success; - -sub testActiveTest { - my $self = shift; - my $test = $self->create_active_test_suite; - my $result = Test::Unit::Result->new; - $test->run($result); - $self->assert_equals(100, $result->run_count); - $self->assert_equals(0, $result->failure_count); - $self->assert_equals(0, $result->error_count); -} - -# sub test_active_repeated_test { -# my $self = shift; -# my $test = Test::Unit::RepeatedTest($self->create_active_test_suite, 5); -# my $result = Result->new; -# $test->run($result); -# $self->assert_equals(500, $result->run_count); -# $self->assert_equals(0, $result->failure_count); -# $self->assert_equals(0, $result->error_count); -# } - -# sub test_active_repeated_test0 { -# my $self = shift; -# my $test = Test::Unit::RepeatedTest($self->create_active_test_suite, 0); -# my $result = Result->new; -# $test->run($result); -# $self->assert_equals(0, $result->run_count); -# $self->assert_equals(0, $result->failure_count); -# $self->assert_equals(0, $result->error_count); -# } - -# sub test_active_repeated_test1 { -# my $self = shift; -# my $test = Test::Unit::RepeatedTest($self->create_active_test_suite, 1); -# my $result = Result->new; -# $test->run($result); -# $self->assert_equals(100, $result->run_count); -# $self->assert_equals(0, $result->failure_count); -# $self->assert_equals(0, $result->error_count); -# } - -sub create_active_test_suite () { - my $self = shift; - my $suite = Test::Unit::TestSuite->new; - for (1 .. 100) { - $suite->add_test(Success->new("test_success")); - } - return $suite; -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/AllTests.pm b/perl/third/Test-Unit-0.25/t/tlib/AllTests.pm deleted file mode 100644 index 9cbaac9..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/AllTests.pm +++ /dev/null @@ -1,86 +0,0 @@ -package AllTests; - -use Test::Unit::TestSuite; -use SuiteTest; -use InheritedSuite::Simple; -use InheritedSuite::TestNames; - -sub new { - my $class = shift; - return bless {}, $class; -} - -sub suite { - my $class = shift; - my $suite = Test::Unit::TestSuite->empty_new("Framework Tests"); - - # We now add the various test cases and suites to this suite - # in deliberately different ways, so as to implicitly test - # the different interfaces by which one can add/construct tests. - - # Add test cases in 3 different ways. The first 3 extract all - # test_* methods, and the last extracts only 1 method. - $suite->add_test(Test::Unit::TestSuite->new('TestTest')); - $suite->add_test('ListenerTest'); - $suite->add_test('BadSuitesTest'); - $suite->add_test('RunnerTest'); - $suite->add_test('WillDie'); - $suite->add_test(InheritedSuite::TestNames->new('test_names')); - - # Add test suites in 4 different ways. - $suite->add_test(SuiteTest->suite()); - $suite->add_test(InheritedSuite::Simple->new()); - $suite->add_test('InheritedSuite::OverrideNew'); -# $suite->add_test(Test::Unit::TestSuite->new('InheritedSuite::OverrideNewName')); - - return $suite; -} - -1; -__END__ - - -=head1 NAME - -AllTests - unit testing framework self tests - -=head1 SYNOPSIS - - # command line style use - - perl TestRunner.pl AllTests - - # GUI style use - - perl TkTestRunner.pl AllTests - - -=head1 DESCRIPTION - -This class is used by the unit testing framework to encapsulate all -the self tests of the framework. - -=head1 AUTHOR - -Copyright (c) 2000-2002, 2005 the PerlUnit Development Team -(see L or the F file included in this -distribution). - -All rights reserved. This program is free software; you can -redistribute it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * - -L - -=item * - -L - -=back - -=cut diff --git a/perl/third/Test-Unit-0.25/t/tlib/AssertTest.pm b/perl/third/Test-Unit-0.25/t/tlib/AssertTest.pm deleted file mode 100644 index 5307aea..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/AssertTest.pm +++ /dev/null @@ -1,584 +0,0 @@ -package AssertTest; - -use strict; - -use ExceptionChecker; -use TestObject; -use Test::Unit::TestCase; -use Test::Unit::Failure; -use Test::Unit::Error; - -use Error qw/:try/; -use Class::Inner; - -use vars qw/@ISA/; -@ISA = qw(Test::Unit::TestCase ExceptionChecker); - - -sub test_assert_equals { - my $self = shift; - my $o = TestObject->new(); - $self->assert_equals($o, $o); - - $self->check_failures - ("expected 'start o:MyClass=HASH(0x1404343f0) | any o:MyClass=HASH(0x1404343f0) e:start | any o:MyClass=HASH(0x1404343f0) e:in', got 'start o: e: | any o:start e: | any o:in e:'" => - # A false-negative that burned me; problem with is_numeric - # Test must be all on one line - [ __LINE__, sub { shift->assert_equals("start o:MyClass=HASH(0x1404343f0) | any o:MyClass=HASH(0x1404343f0) e:start | any o:MyClass=HASH(0x1404343f0) e:in", "start o: e: | any o:start e: | any o:in e:"); } ], - ); -} - -# ...and the root of that problem in test_assert_equals -sub test_numericness { - my $self = shift; - my %tests = - ( 1 => 't', - 0 => 't', - '0xF00' => 'f', # controversial? but if you +=10 then it's == 10 - '15e7' => 't', - '15E7' => 't', - "not 0" => 'f', - "not 4" => 'f', - " \n 5E2" => 't', - " \t 0E0 " => 't', - ); - foreach my $str (keys %tests) { - my $expect = $tests{$str}; - my $actual = Test::Unit::Assert::is_numeric($str) ? 't' : 'f'; - $self->fail("For string '$str', expect $expect but got $actual") - unless $expect eq $actual; - } -} - - -sub test_assert { - my $self = shift; - $self->assert(1); - $self->assert(1, 'should be true'); - $self->assert(qr/foo/, 'foobar'); - $self->assert(qr/foo/, 'foobar', 'should match /foo/'); - my $coderef = sub { - $_[0] eq $_[1] or $self->fail("$_[0] ne $_[1]"); - }; - $self->assert($coderef, 'a', 'a'); - $self->assert([]); - $self->assert([ 'foo', 7 ]); - $self->check_failures( - 'Boolean assertion failed' => [ __LINE__, sub { shift->assert(undef) } ], - 'Boolean assertion failed' => [ __LINE__, sub { shift->assert(0) } ], - 'Boolean assertion failed' => [ __LINE__, sub { shift->assert('') } ], - - 'bang' => [ __LINE__, sub { shift->assert(0, 'bang') } ], - 'bang' => [ __LINE__, sub { shift->assert('', 'bang') } ], - "'qux' did not match /(?-xism:foo)/" - => [ __LINE__, sub { shift->assert(qr/foo/, 'qux') } ], - 'bang' => [ __LINE__, sub { shift->assert(qr/foo/, 'qux', 'bang') } ], - 'a ne b'=> [ __LINE__, sub { shift->assert($coderef, 'a', 'b') } ], - ); -} - -sub test_assert_str_equals { - my $self = shift; - my @pass = ( - ['', ''], - [0, 0], - [1, 1], - ['foo', 'foo'], - ); - foreach my $pair (@pass) { - my ($expected, $got) = @$pair; - $self->assert_str_equals($expected, $got); - $self->assert_str_equals($expected, $got, 'failure message'); - } - $self->check_failures( - 'expected value was undef; should be using assert_null?' => - [ __LINE__, sub { shift->assert_str_equals(undef, undef) } ], - 'expected value was undef; should be using assert_null?' => - [ __LINE__, sub { shift->assert_str_equals(undef, 0) } ], - 'expected value was undef; should be using assert_null?' => - [ __LINE__, sub { shift->assert_str_equals(undef, '') } ], - 'expected value was undef; should be using assert_null?' => - [ __LINE__, sub { shift->assert_str_equals(undef, 'foo') } ], - "expected '', got undef" => - [ __LINE__, sub { shift->assert_str_equals('', undef) } ], - "expected 'foo', got undef" => - [ __LINE__, sub { shift->assert_str_equals('foo', undef) } ], - "expected '', got '0'" => - [ __LINE__, sub { shift->assert_str_equals('', 0) } ], - "expected '0', got ''" => - [ __LINE__, sub { shift->assert_str_equals(0, '') } ], - "expected '0', got undef" => - [ __LINE__, sub { shift->assert_str_equals(0, undef) } ], - "expected '0', got '1'" => - [ __LINE__, sub { shift->assert_str_equals(0, 1) } ], - "expected '0', got '-0'" => - [ __LINE__, sub { shift->assert_str_equals(0, '-0') } ], - "expected '-0', got '0'" => - [ __LINE__, sub { shift->assert_str_equals('-0', 0) } ], - "expected 'foo', got 'bar'" => - [ __LINE__, sub { shift->assert_str_equals('foo', 'bar') } ], - - ); -} - -sub test_multi_assert { - my $self = shift; - my $assertion = sub { - $_[0] =~ /1/ - or Test::Unit::Failure->throw(-text => "first arg missing 1"); - $_[1] eq 'cluck' - or Test::Unit::Failure->throw(-text => "what? no chickens!?"); - }; - - $self->multi_assert( - $assertion, - [ 1, 'cluck' ], - [ 'el1te', 'cluck' ], - ); - - $self->check_failures( - 'first arg missing 1' - => [ __LINE__, sub { shift->multi_assert($assertion, [ 2, 'cluck' ]) - } ], - 'what? no chickens!?' - => [ __LINE__, sub { shift->multi_assert($assertion, [ 1, 'cluck' ], - [ 1, 'moo' ]) - } ], - ); - -} - -sub test_assert_matches { - my $self = shift; - $self->assert_matches(qr/ob/i, 'fooBar'); - $self->check_errors( - 'arg 1 to assert_matches() must be a regexp' - => [ __LINE__, sub { shift->assert_matches(1, 2) } ] - ); -} - -sub test_assert_does_not_match { - my $self = shift; - $self->assert_does_not_match(qr/ob/, 'fooBar'); - $self->check_errors( - 'arg 1 to assert_does_not_match() must be a regexp' - => [ __LINE__, sub { shift->assert_does_not_match(1, 2) } ] - ); -} - -sub test_assert_equals_null { - my $self = shift; - $self->assert_equals(undef, undef); -} - -# sub assertion_has_failed { -# my $error = shift; -# return eval {ref($error) && $error->isa('Test::Unit::Failure')}; -# } - -# Not sure this has meaning in Perl -# sub test_assert_null_not_equals_null { -# my $self = shift; -# eval { $self->assert_equals(undef, TestObject->new()) }; -# $self->fail unless assertion_has_failed($@); -# } - -@AssertTest::Exception::ISA = 'Error'; -sub test_assert_raises { - my $self = shift; - $self->assert_raises( - 'AssertTest::Exception', - sub { AssertTest::Exception->throw(-text => 'boom'); } - ); - $self->assert_str_equals('boom', AssertTest::Exception->prior->{-text}); - $self->assert_raises( - 'Error::Simple', - sub { die "bang"; } - ); - $self->assert_str_equals('bang', AssertTest::Exception->prior->{-text}); - $self->check_failures( - 'No AssertTest::Exception was raised' - => [ - __LINE__ + 1, - sub { shift->assert_raises('AssertTest::Exception', sub {}) } - ], - 'zxc' - => [ - __LINE__ + 1, - sub { shift->assert_raises('AssertTest::Exception', sub {}, 'zxc') } - ], - ); -} - -sub test_ok_boolean { - my $self = shift; - $self->ok(1); - $self->check_failures( - 'Boolean assertion failed' => [ __LINE__, sub { shift->ok(0) } ], - 'Boolean assertion failed' => [ __LINE__, sub { shift->ok('') } ], - 'Boolean assertion failed' => [ __LINE__, sub { shift->ok(undef) } ], - ); -} - -sub test_ok_bad_args { - my $self = shift; - $self->check_errors( - 'ok() called with wrong number of args' - => [ __LINE__, sub { shift->ok() } ], - 'ok() called with wrong number of args' - => [ __LINE__, sub { shift->ok(1, 2, 3, 4) } ], - ); -} - -sub test_ok_equals { - my $self = shift; - foreach my $args ([0, 0], [2, 2], [1.34, 1.34], - ['foo', 'foo'], ['', ''], [undef, undef], - [sub {2+2}, 4], ['fixed', qr/x/]) { - $self->ok(@$args); - $self->ok(@$args, 'comment'); - } -} - -sub test_ok_not_equals { - my $self = shift; - my $adder = sub { 2+2 }; - my @checks = ( - # interface is ok(GOT, EXPECTED); - q{expected 1, got 0} => [ 0, 1 ], - q{expected 0, got 1} => [ 1, 0 ], - q{expected 3, got 2} => [ 2, 3 ], - q{expected -57.001, got -57} => [ -57, -57.001 ], - q{expected 'bar', got 'foo'} => [ 'foo', 'bar' ], - q{expected '', got 'foo'} => [ 'foo', '' ], - q{expected 'foo', got ''} => [ '', 'foo' ], - q{expected 5, got 4} => [ $adder, 5 ], - q{'foo' did not match /(?-xism:x)/} => [ 'foo', qr/x/ ], - ); - my @tests = (); - while (@checks) { - my $expected = shift @checks; - my $args = shift @checks; - push @tests, $expected => [ __LINE__, sub { shift->ok(@$args) } ]; - push @tests, 'failure comment' - => [ __LINE__, sub { shift->ok(@$args, 'failure comment') } ]; - } - $self->check_failures(@tests); -} - -sub test_fail { - my $self = shift; - $self->check_failures( - '' => [ __LINE__, sub { shift->fail() } ], - 'failure message' => [ __LINE__, sub { shift->fail('failure message') } ], - ); -} - -sub test_succeed_assert_null { - my $self = shift; - $self->assert_null(undef); -} - -sub test_fail_assert_null { - my $self = shift; - $self->check_failures( - 'Defined is defined' - => [ __LINE__, sub { shift->assert_null('Defined') } ], - 'Weirdness' - => [ __LINE__, sub { shift->assert_null('Defined', 'Weirdness') } ], - ); -} - -sub test_success_assert_not_equals { - my $self = shift; - $self->assert_not_equals(1, 0); - $self->assert_not_equals(0, 1); - $self->assert_not_equals(0, 1E10); - $self->assert_not_equals(1E10, 0); - $self->assert_not_equals(1, 2); - $self->assert_not_equals('string', 1); - $self->assert_not_equals(1, 'string'); - $self->assert_not_equals('string', 0); - # $self->assert_not_equals(0,'string'); # Numeric comparison done here.. - # $self->assert_not_equals(0, ''); # Numeric comparison done here.. - $self->assert_not_equals('', 0); - $self->assert_not_equals(undef, 0); - $self->assert_not_equals(0, undef); - # $self->assert_not_equals(0, ''); FIXME - $self->assert_not_equals(undef, ''); - $self->assert_not_equals('', undef); -} - -sub test_fail_assert_not_equals { - my $self = shift; - my @pairs = ( - # Some of these are debatable, but at least including the tests - # will alert us if any of the outcomes change. - "0 and 0 should differ" => [ 0, 0 ], - "0 and 0 should differ" => [ 0, '0' ], - "0 and 0 should differ" => [ '0', 0 ], - "0 and 0 should differ" => [ '0', '0' ], - "1 and 1 should differ" => [ 1, 1 ], - "1 and 1 should differ" => [ 1, '1' ], - "1 and 1 should differ" => [ '1', 1 ], - "1 and 1 should differ" => [ '1', '1' ], - "0 and should differ" => [ 0, '' ], # Numeric comparison - "0 and string should differ" => [ 0, 'string' ], # Numeric comparison - "'' and '' should differ" => [ '', '' ], - "both args were undefined" => [ undef, undef ], - ); - my @tests = (); - while (@pairs) { - my $expected = shift @pairs; - my $pair = shift @pairs; - push @tests, $expected - => [ __LINE__, sub { shift->assert_not_equals(@$pair) } ]; - push @tests, "$expected with comment", - => [ __LINE__, sub { shift->assert_not_equals(@$pair, - "$expected with comment") } ]; - } - $self->check_failures(@tests); -} - -sub test_fail_assert_not_null { - my $self = shift; - $self->check_failures( - ' unexpected' - => [ __LINE__, sub { shift->assert_not_null(undef) } ], - ' unexpected' - => [ __LINE__, sub { shift->assert_not_null() } ], - # nb. $self->assert_not_null(@emptylist, "message") is not - # going to do what you expected! - 'Weirdness' - => [ __LINE__, sub { shift->assert_not_null(undef, 'Weirdness') } ] - ); -} - -sub test_succeed_assert_not_null { - my $self = shift; - $self->assert_not_null(TestObject->new); - $self->assert_not_null(''); - $self->assert_not_null('undef'); - $self->assert_not_null(0); - $self->assert_not_null(10); -} - -sub test_assert_deep_equals { - my $self = shift; - - $self->assert_deep_equals([], []); - $self->assert_deep_equals({}, {}); - $self->assert_deep_equals([ 0, 3, 5 ], [ 0, 3, 5 ]); - my $hashref = { a => 2, b => 4 }; - $self->assert_deep_equals($hashref, $hashref); - $self->assert_deep_equals($hashref, { b => 4, a => 2 }); - my $complex = { - array => [ 1, $hashref, 3 ], - undefined => undef, - number => 3.2, - string => 'hi mom', - deeper => { - and => [ - even => [ qw(deeper wahhhhh) ], - { foo => 11, bar => 12 } - ], - }, - }; - $self->assert_deep_equals( - $complex, - { - array => [ 1, $hashref, 3 ], - undefined => undef, - number => 3.2, - string => 'hi mom', - deeper => { - and => [ - even => [ qw(deeper wahhhhh) ], - { - foo => 11, bar => 12 } - ], - }, - }, - ); - - my $differ = sub { - my ($a, $b) = @_; - qr/^Structures\ begin\ differing\ at: $ \n - \S*\s* \$a .* = .* (?-x:$a) .* $ \n - \S*\s* \$b .* = .* (?-x:$b)/mx; - }; - - my %families; # key=test-purpose, value=assorted circular structures - foreach my $key (qw(orig copy bad_copy)) { - my %family = ( john => { name => 'John Doe', - spouse => undef, - children => [], - }, - jane => { name => 'Jane Doe', - spouse => undef, - children => [], - }, - baby => { name => 'Baby Doll', -# spouse => undef, - children => [], - }, - ); - $family{john}{spouse} = $family{jane}; - $family{jane}{spouse} = $family{john}; - push @{$family{john}{children}}, $family{baby}; - push @{$family{jane}{children}}, $family{baby}; - $families{$key} = \%family; - } - $families{bad_copy}->{jane}{spouse} = $families{bad_copy}->{baby}; # was ->{john} - - # Breakage under test is infinite recursion, to memory exhaustion! - # Jump through hoops to avoid killing people's boxes - { - my $old_isa = \&UNIVERSAL::isa; - # Pick on isa() because it'll be called from any deep-ing code - local $^W = 0; - local *UNIVERSAL::isa = sub { - die "Giving up on deep recursion for assert_deep_equals" - if defined caller(500); - return $old_isa->(@_); - }; - $self->assert_deep_equals($families{orig}, $families{copy}); - } - - my ($H, $H2, $G) = qw(hello hello goodbye); - - my @pairs = ( - 'Both arguments were not references' => [ undef, 0 ], - 'Both arguments were not references' => [ 0, undef ], - 'Both arguments were not references' => [ 0, 1 ], - 'Both arguments were not references' => [ 0, '' ], - 'Both arguments were not references' => [ '', 0 ], - $differ->(qw/'ARRAY 'HASH/) => [ [], {} ], - $differ->(qw/'ARRAY 'HASH/) => [ [1,2], {1,2} ], - $differ->( "'ARRAY", " undef" ) => [ { 'test' => []}, - { 'test' => undef } ], - $differ->( "'ARRAY", 'not exist' ) => [ { 'test' => []}, {} ], - $differ->( 'undef', "'ARRAY" ) => [ { 'test' => undef }, - { 'test' => []} ], - $differ->( "''", " undef" ) => [ [ '' ], [ undef ] ], - $differ->( "'undef'", " undef" ) => [ [ 'undef' ], [ undef ] ], - $differ->('not exist', "'3'") => [ [1,2], [1,2,3] ], - $differ->("'3'", "not exist") => [ [1,2,3], [1,2] ], - $differ->("'wahhhhh'", "'wahhhh'") => [ - $complex, - { - array => [ 1, $hashref, 3 ], - undefined => undef, - number => 3.2, - string => 'hi mom', - deeper => { - and => [ - even => [ qw(deeper wahhhh) ], - { foo => 11, bar => 12 } - ], - }, - } - ], - $differ->( 'HASH', 'not exist') => [$families{orig}, $families{bad_copy}], # test may be fragile due to recursion ordering? - $differ->("'3'", "'5'") => [ [ \$H, 3 ], [ \$H2, 5 ] ], - $differ->("'hello'", "'goodbye'") => [ { world => \$H }, { world => \$G } ], - $differ->("'hello'", "'goodbye'") => [ [ \$H, "world" ], [ \$G, "world" ] ], - ); - - my @tests = (); - while (@pairs) { - my $expected = shift @pairs; - my $pair = shift @pairs; - push @tests, $expected, - [ __LINE__, sub { shift->assert_deep_equals(@$pair) } ]; - push @tests, "$expected with comment", - [ __LINE__, sub { shift->assert_deep_equals(@$pair, - "$expected with comment") } ]; - } - $self->check_failures(@tests); -} - -# Key = assert_method -# Value = [[@arg_list],undef/expected exception] -# FIXME: These should probably be merged with the tests for assert_not_equals() -# somehow, since the failures aren't currently tested for the correct message -# via check_exception(), or originating file/line via check_file_and_line(). -my %test_hash = ( - assert_equals => { - success => [ - { args => [0,'foo'], name => "0 == 'foo'" }, - { args => [1,'1.0'], name => "1 == '1.0'" }, - { args => ['1.0', 1], name => "'1.0' == 1" }, - { args => ['foo', 'foo'], name => 'foo eq foo' }, - { args => ['0e0', 0], name => '0E0 == 0' }, - { args => [0, 'foo'], name => "0 == 'foo'" }, - { args => [undef, undef], name => "both undef" }, - { args => [0, 0], name => "0 == 0" }, - { args => [0, 0.0], name => "0 == 0.0" }, - { args => [0.0, 0], name => "0.0 == 0" }, - { args => [0.0, 0.0], name => "0.0 == 0.0" }, - { args => ['', ''], name => "'' == ''" }, - ], - 'Test::Unit::Failure' => [ - { args => [1,'foo'], name => "1 != 'foo'" }, - { args => ['foo', 0], name => "'foo' ne 0" }, - { args => ['foo', 1], name => "'foo' ne 1" }, - { args => [0,1], name => "0 != 1" }, - { args => ['foo', 'bar'], name => "'foo' ne 'bar'" }, - { args => ['foo', undef], name => "'foo' ne undef" }, - { args => [undef, 'foo'], name => "undef ne 'foo'" }, - # { args => [0, ''], name => "0 ne ''" }, # numeric compare - - ], - }, -); - -sub suite { - my $self = shift; - my $suite = Test::Unit::TestSuite->empty_new("Assertion Tests"); - foreach my $test ($self->make_tests_from_matrix(\%test_hash)) { - $suite->add_test($test); - } - foreach my $test ($self->list_tests) { - no strict 'refs'; - $suite->add_test($self->make_test_from_coderef(sub {my $self = shift; $self->$test(@_)},$test)); - } - return $suite; -} - - -sub make_tests_from_matrix { - my $self = shift; - my $matrix = shift; - my @tests; - foreach my $method_name (keys %$matrix) { - # Build 'successful' tests. - foreach my $spec (@{$matrix->{$method_name}{success}}) { - push @tests, $self->make_test_from_coderef - (sub { - my $self = shift; - $self->$method_name(@{$spec->{args}}); - }, $spec->{name}); - } - - foreach my $outcome (grep {$_ ne 'success'} keys %{$matrix->{$method_name}}) { - foreach my $spec (@{$matrix->{$method_name}{$outcome}}) { - push @tests, $self->make_test_from_coderef - (sub { - my $self = shift; - try { - $self->$method_name(@{$spec->{args}}); - 0; - } - catch $outcome with { - 1; - } or Test::Unit::Failure->throw(-text => $spec->{name}, - -object => $self); - }, $spec->{name}); - } - } - } - return @tests; -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/BadSuite/BadUse.pm b/perl/third/Test-Unit-0.25/t/tlib/BadSuite/BadUse.pm deleted file mode 100644 index 214d80e..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/BadSuite/BadUse.pm +++ /dev/null @@ -1,5 +0,0 @@ -package BadSuite::BadUse; - -use TestSuite::NonExistent; - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/BadSuite/SyntaxError.pm b/perl/third/Test-Unit-0.25/t/tlib/BadSuite/SyntaxError.pm deleted file mode 100644 index 4e682da..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/BadSuite/SyntaxError.pm +++ /dev/null @@ -1,7 +0,0 @@ -package BadSuite::SyntaxError; - -sub broken_method { - my $self = -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/BadSuitesTest.pm b/perl/third/Test-Unit-0.25/t/tlib/BadSuitesTest.pm deleted file mode 100644 index ea398ad..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/BadSuitesTest.pm +++ /dev/null @@ -1,28 +0,0 @@ -package BadSuitesTest; - -use strict; - -use Test::Unit::TestCase; -use Test::Unit::TestRunner; - -use base 'Test::Unit::TestCase'; - -sub test_suite_with_syntax_error { - my $self = shift; - my $runner = Test::Unit::TestRunner->new(); - eval { - $runner->start('BadSuite::SyntaxError'); - }; - $self->assert(qr!^syntax error at .*/SyntaxError\.pm!, "$@"); -} - -sub test_suite_with_bad_use { - my $self = shift; - my $runner = Test::Unit::TestRunner->new(); - eval { - $runner->start('BadSuite::BadUse'); - }; - $self->assert(qr!^Can't locate TestSuite/NonExistent\.pm in \@INC!, "$@"); -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/ExceptionChecker.pm b/perl/third/Test-Unit-0.25/t/tlib/ExceptionChecker.pm deleted file mode 100644 index ee07cd8..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/ExceptionChecker.pm +++ /dev/null @@ -1,100 +0,0 @@ -package ExceptionChecker; - -use strict; -use warnings; - -use Test::Unit::Error; -use Test::Unit::Failure; - -use Error qw(:try); - -sub check_failures { - my $self = shift; - $self->check_exceptions('Test::Unit::Failure', @_); -} - -sub check_errors { - my $self = shift; - $self->check_exceptions('Test::Unit::Error', @_); -} - -sub check_exceptions { - my $self = shift; - my ($exception_class, @tests) = @_; - my ($asserter, $file, $line) - = caller($Error::Depth + 1); # EVIL hack! Assumes check_exceptions - # always called via check_{failures,errors}. - # My brain hurts too much right now to think - # of a better way. - while (@tests) { - my $expected = shift @tests; - my $test_components = shift @tests; - my ($test_code_line, $test) = @$test_components; - my $exception; - try { - $self->$test(); - } - catch $exception_class with { - $exception = shift; - } - catch Error::Simple with { - $exception = shift; - } - otherwise { - $exception = 0; - }; - - try { - $self->check_exception($exception_class, $expected, $exception); - $self->check_file_and_line($exception, - $file, - $test_code_line); - } - catch Test::Unit::Failure with { - my $failure = shift; - $failure->throw_new( - -package => $asserter, - -file => $file, - -line => $line, - -object => $self - ); - } - } -} - -sub check_exception { - my $self = shift; - my ($exception_class, $expected, $exception) = @_; - Test::Unit::Failure->throw( - -text => "Didn't get $exception_class `$expected'", - -object => $self, - ) unless $exception; - - my $got = $exception->text(); - Test::Unit::Failure->throw( - -text => "Expected $exception_class `$expected', got `$got'", - -object => $self, - ) unless UNIVERSAL::isa($expected, 'Regexp') - ? $got =~ /$expected/ : $got eq $expected; -} - -sub check_file_and_line { - my $self = shift; - my ($exception, $expected_file, $test_code_line) = @_; - if ($exception->file() ne $expected_file) { - throw Test::Unit::Failure( - -text => "failure's file() should have returned $expected_file" - . " (line $test_code_line), not " . $exception->file(), - -object => $self, - ); - } - if ($exception->line() != $test_code_line) { - throw Test::Unit::Failure( - -text => "failure's line() should have returned " - . "$test_code_line, not " . $exception->line(), - -object => $self, - ); - } -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/FilteredSuite.pm b/perl/third/Test-Unit-0.25/t/tlib/FilteredSuite.pm deleted file mode 100644 index d86d9ba..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/FilteredSuite.pm +++ /dev/null @@ -1,36 +0,0 @@ -package FilteredSuite; - -use base 'Test::Unit::TestCase'; - -sub filter {{ - token_filtering_via_method_list => [ - qw/test_filtered_method1 test_filtered_method2/ - ], - token_filtering_via_sub => sub { - my ($method) = @_; - return 1 if $method =~ /method3$/; - }, - broken_token => 'nonsense', -}} - -sub test_filtered_method1 { - my $self = shift; - die "test_filtered_method1 should get filtered via method list"; -} - -sub test_filtered_method2 { - my $self = shift; - die "test_filtered_method2 should get filtered via method list"; -} - -sub test_filtered_method3 { - my $self = shift; - die "test_filtered_method3 should get filtered via sub"; -} - -sub test_unfiltered_method1 { - my $self = shift; - $self->assert('trooooo'); -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/InheritedInheritedTestCase.pm b/perl/third/Test-Unit-0.25/t/tlib/InheritedInheritedTestCase.pm deleted file mode 100644 index d0feec5..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/InheritedInheritedTestCase.pm +++ /dev/null @@ -1,14 +0,0 @@ -package InheritedInheritedTestCase; - -# Test class used in SuiteTest - -use base qw(InheritedTestCase); - -sub new { - shift()->SUPER::new(@_); -} - -sub test3 { -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/InheritedSuite/OverrideNew.pm b/perl/third/Test-Unit-0.25/t/tlib/InheritedSuite/OverrideNew.pm deleted file mode 100644 index 94171b4..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/InheritedSuite/OverrideNew.pm +++ /dev/null @@ -1,14 +0,0 @@ -package InheritedSuite::OverrideNew; - -use strict; - -use base qw(Test::Unit::TestSuite); - -sub new { - my $class = shift; - my $self = $class->SUPER::empty_new('Inherited suite overriding new()'); - $self->add_test(Test::Unit::TestSuite->new('Success')); - return $self; -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/InheritedSuite/OverrideNewName.pm b/perl/third/Test-Unit-0.25/t/tlib/InheritedSuite/OverrideNewName.pm deleted file mode 100644 index 4be286b..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/InheritedSuite/OverrideNewName.pm +++ /dev/null @@ -1,16 +0,0 @@ -package InheritedSuite::OverrideNewName; - -use strict; - -use base qw(Test::Unit::TestSuite); - -sub new { - my $class = shift; - my $self = $class->SUPER::empty_new(); - $self->add_test(Test::Unit::TestSuite->new('Success')); - return $self; -} - -sub name { 'Inherited suite overriding new() and name()' } - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/InheritedSuite/Simple.pm b/perl/third/Test-Unit-0.25/t/tlib/InheritedSuite/Simple.pm deleted file mode 100644 index c966c23..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/InheritedSuite/Simple.pm +++ /dev/null @@ -1,10 +0,0 @@ -package InheritedSuite::Simple; - -use strict; - -use base qw(Test::Unit::TestSuite); - -sub include_tests { 'Success' } -sub name { 'Simple inherited suite' } - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/InheritedSuite/TestNames.pm b/perl/third/Test-Unit-0.25/t/tlib/InheritedSuite/TestNames.pm deleted file mode 100644 index 1baa964..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/InheritedSuite/TestNames.pm +++ /dev/null @@ -1,28 +0,0 @@ -package InheritedSuite::TestNames; - -# This class is probably overkill :-) - -use strict; - -use base 'Test::Unit::TestCase'; - -use InheritedSuite::Simple; -use InheritedSuite::OverrideNew; -use InheritedSuite::OverrideNewName; - -sub test_names { - my $self = shift; - - my $simple = InheritedSuite::Simple->new(); - $self->assert_str_equals('Simple inherited suite', $simple->name()); - - my $override_new = InheritedSuite::OverrideNew->new(); - $self->assert_str_equals('Inherited suite overriding new()', - $override_new->name()); - - my $override_new_name = InheritedSuite::OverrideNewName->new(); - $self->assert_str_equals('Inherited suite overriding new() and name()', - $override_new_name->name()); -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/InheritedTestCase.pm b/perl/third/Test-Unit-0.25/t/tlib/InheritedTestCase.pm deleted file mode 100644 index 75a3600..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/InheritedTestCase.pm +++ /dev/null @@ -1,14 +0,0 @@ -package InheritedTestCase; - -# Test class used in SuiteTest - -use base qw(OneTestCase); - -sub new { - shift()->SUPER::new(@_); -} - -sub test2 { -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/ListenerTest.pm b/perl/third/Test-Unit-0.25/t/tlib/ListenerTest.pm deleted file mode 100644 index 2a9cd0b..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/ListenerTest.pm +++ /dev/null @@ -1,89 +0,0 @@ -package ListenerTest; - -# Test class used in SuiteTest - -use base qw(Test::Unit::TestCase Test::Unit::Listener); - -use Test::Unit::Result; - -sub new { - my $self = shift()->SUPER::new(@_); - $self->{_my_result} = 0; - $self->{_my_start_count} = 0; - $self->{_my_end_count} = 0; - $self->{_my_failure_count} = 0; - $self->{_my_error_count} = 0; - return $self; -} - -sub add_error { - my $self = shift; - my ($test, $t) = @_; - $self->{_my_error_count}++; -} - -sub add_failure { - my $self = shift; - my ($test, $t) = @_; - $self->{_my_failure_count}++; -} - -sub end_test { - my $self = shift; - my ($test) = @_; - $self->{_my_end_count}++; -} - -sub set_up { - my $self = shift; - $self->{_my_result} = Test::Unit::Result->new(); - $self->{_my_result}->add_listener($self); - $self->{_my_start_count} = 0; - $self->{_my_end_count} = 0; - $self->{_my_failure_count} = 0; -} - -sub start_test { - my $self = shift; - $self->{_my_start_count}++; -} - -sub add_pass { -} - -# the tests -sub make_dummy_testcase { - my $self = shift; - my $sub = pop; - my $method_name = shift || 'run_test'; - - Class::Inner->new(parent => 'Test::Unit::TestCase', - methods => { $method_name => $sub }, - args => [ $method_name ]); -} - -sub test_error { - my $self = shift; - my $test = $self->make_dummy_testcase(sub {die}); - $test->run($self->{_my_result}); - $self->assert(1 == $self->{_my_error_count}); - $self->assert(1 == $self->{_my_end_count}); -} - -sub test_failure { - my $self = shift; - my $test = $self->make_dummy_testcase(sub {shift->fail()}); - $test->run($self->{_my_result}); - $self->assert(1 == $self->{_my_failure_count}); - $self->assert(1 == $self->{_my_end_count}); -} - -sub test_start_stop { - my $self = shift; - my $test = $self->make_dummy_testcase(sub {}); - $test->run($self->{_my_result}); - $self->assert(1 == $self->{_my_start_count}); - $self->assert(1 == $self->{_my_end_count}); -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/NoTestCaseClass.pm b/perl/third/Test-Unit-0.25/t/tlib/NoTestCaseClass.pm deleted file mode 100644 index 2a41acd..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/NoTestCaseClass.pm +++ /dev/null @@ -1,10 +0,0 @@ -package NoTestCaseClass; -use strict; - -sub new { -} - -sub testSuccess { -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/NoTestCases.pm b/perl/third/Test-Unit-0.25/t/tlib/NoTestCases.pm deleted file mode 100644 index 57c0828..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/NoTestCases.pm +++ /dev/null @@ -1,17 +0,0 @@ -package NoTestCases; -use strict; - -use base qw(Test::Unit::TestCase); - -sub new { - my $class = shift; - my ($name) = @_; - my $self = bless {}, $class; - my $a_test_case = $self->SUPER::new($name); - return bless $a_test_case, $class; -} - -sub no_test_case { -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/OneTestCase.pm b/perl/third/Test-Unit-0.25/t/tlib/OneTestCase.pm deleted file mode 100644 index 1951373..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/OneTestCase.pm +++ /dev/null @@ -1,17 +0,0 @@ -package OneTestCase; - -# Test class used in SuiteTest - -use base qw(Test::Unit::TestCase); - -sub new { - shift()->SUPER::new(@_); -} - -sub no_test_case { -} - -sub test_case { -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/OverrideTestCase.pm b/perl/third/Test-Unit-0.25/t/tlib/OverrideTestCase.pm deleted file mode 100644 index 72da562..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/OverrideTestCase.pm +++ /dev/null @@ -1,15 +0,0 @@ -package OverrideTestCase; -use strict; - -# Test class used in SuiteTest - -use base qw(OneTestCase); - -sub new { - shift()->SUPER::new(@_); -} - -sub test_case { -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/RunnerTest.pm b/perl/third/Test-Unit-0.25/t/tlib/RunnerTest.pm deleted file mode 100644 index 5d2918b..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/RunnerTest.pm +++ /dev/null @@ -1,89 +0,0 @@ -package RunnerTest; - -use strict; - -use Test::Unit::TestRunner; - -use base 'Test::Unit::TestCase'; - -sub set_up { - my $self = shift; - open(DEVNULL, '>/dev/null') or die "Couldn't open(>/dev/null): $!"; - $self->{runner} = Test::Unit::TestRunner->new(\*DEVNULL); -} - -sub tear_down { - my $self = shift; - close(DEVNULL); -} - -sub test_reset_filtering { - my $self = shift; - - $self->{runner}->filter('random_token'); - $self->{runner}->reset_filter; - - $self->assert(! $self->{runner}->start('FilteredSuite'), - "run wasn't supposed to succeed"); - my $result = $self->{runner}->result; - $self->assert_num_equals(4, $result->run_count); - $self->assert_num_equals(3, $result->error_count); - $self->assert_num_equals(0, $result->failure_count); -} - -sub test_filter_via_method_list { - my $self = shift; - - $self->{runner}->filter('token_filtering_via_method_list'); - - $self->assert(! $self->{runner}->start('FilteredSuite'), - "run wasn't supposed to succeed"); - my $result = $self->{runner}->result; - $self->assert_num_equals(2, $result->run_count); - $self->assert_num_equals(1, $result->error_count); - $self->assert_num_equals(0, $result->failure_count); -} - -sub test_filter_via_sub { - my $self = shift; - $self->{runner}->filter('token_filtering_via_sub'); - - $self->assert(! $self->{runner}->start('FilteredSuite'), - "run wasn't supposed to succeed"); - my $result = $self->{runner}->result; - $self->assert_num_equals(3, $result->run_count); - $self->assert_num_equals(2, $result->error_count); - $self->assert_num_equals(0, $result->failure_count); -} - -sub test_filter_via_both { - my $self = shift; - $self->{runner}->filter( - 'token_filtering_via_method_list', - 'token_filtering_via_sub', - 'nonexistent_token', # this has to be allowed - ); - - $self->assert($self->{runner}->start('FilteredSuite'), - "run wasn't supposed to fail"); - my $result = $self->{runner}->result; - $self->assert_num_equals(1, $result->run_count); - $self->assert_num_equals(0, $result->error_count); - $self->assert_num_equals(0, $result->failure_count); -} - -sub test_filter_broken_token { - my $self = shift; - $self->{runner}->filter('broken_token'); - - eval { - $self->{runner}->start('FilteredSuite'); - }; - my $exception = $@; # have to save $@ otherwise the assertion messes it up - $self->assert_str_equals( - "Didn't understand filtering definition for token broken_token in FilteredSuite\n", - $exception - ); -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/Success.pm b/perl/third/Test-Unit-0.25/t/tlib/Success.pm deleted file mode 100644 index e100f1b..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/Success.pm +++ /dev/null @@ -1,13 +0,0 @@ -package Success; - -use strict; -use warnings; - -use base 'Test::Unit::TestCase'; - -sub test_success { - my $self = shift; - $self->assert(1); -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/SuiteTest.pm b/perl/third/Test-Unit-0.25/t/tlib/SuiteTest.pm deleted file mode 100644 index e9f8d84..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/SuiteTest.pm +++ /dev/null @@ -1,167 +0,0 @@ -package SuiteTest; - -use strict; - -use base qw(Test::Unit::TestCase); - -use Test::Unit::Result; -use Test::Unit::TestSuite; -use TornDown; -use WasRun; -require Test::Unit::Assertion::CodeRef; - -my %method_hash = (runs => 'run_count', - failures => 'failure_count', - success => 'was_successful', - errors => 'error_count',); -sub new { - my $self = shift()->SUPER::new(@_); - $self->{_my_result} = undef; - $self->{__default_assertion} = - Test::Unit::Assertion::CodeRef->new(sub { - my $arg_hash = shift; - for (qw/runs failures errors/) { - next unless exists $arg_hash->{$_}; - my $method = $method_hash{$_}; - my $expected = $arg_hash->{$_}; - my $got = $self->result->$method(); - $expected == $got or - die "Expected $expected $_, got $got\n"; - } - if (exists $arg_hash->{'success'}) { - my $method = $method_hash{'success'}; - my $expected = $arg_hash->{'success'}; - my $got = $self->result->$method(); - $expected && $got || !$expected && !$got or - die "Expected ", $expected ? 'success,' : 'failure,', - ' got ', $got ? 'success.' : 'failure.', "\n"; - } - 1; - }); - return $self; -} - -sub basic_assertion { - my $self = shift; - $self->{__default_assertion}->do_assertion(ref($_[0]) ? shift : {@_}); -} - -sub result { - my $self = shift; - return $self->{_my_result}; -} - -sub set_up { - my $self = shift; - $self->{_my_result} = Test::Unit::Result->new(); -} - -sub suite { - my $class = shift; - my $suite = Test::Unit::TestSuite->empty_new("Suite Tests"); - $suite->add_test(SuiteTest->new("test_no_test_case_class")); - $suite->add_test(SuiteTest->new("test_no_test_cases")); - $suite->add_test(SuiteTest->new("test_one_test_case")); - $suite->add_test(SuiteTest->new("test_not_existing_test_case")); - $suite->add_test(SuiteTest->new("test_inherited_tests")); - $suite->add_test(SuiteTest->new("test_inherited_inherited_tests")); - $suite->add_test(SuiteTest->new("test_shadowed_tests")); - $suite->add_test(SuiteTest->new("test_complex_inheritance")); - return $suite; -} - -# test subs - -sub test_inherited_tests { - my $self = shift; - my $suite = Test::Unit::TestSuite->new("InheritedTestCase"); - $suite->run($self->result()); - $self->basic_assertion({success => 1, runs => 2}); - $self->assert($self->result()->was_successful()); - $self->assert(2 == $self->result->run_count); -} - -sub test_complex_inheritance { - my $self = shift; - eval q{ - package _SuperClass; - use base qw(Test::Unit::TestCase); - sub test_case { - my $self = shift; - $self->assert($self->override_this_method ); - } - sub override_this_method { 0 ; } - - package _SubClass; - use base qw(_SuperClass); - sub override_this_method { 1 ; } - }; - die $@ if $@; - my $suite = Test::Unit::TestSuite->new("_SubClass"); - my $result = $self->result; - $suite->run($result); - - $self->assert($result->was_successful()); - $self->assert(1 == $self->result->run_count); -} - -sub test_inherited_inherited_tests { - my $self = shift; - my $suite = Test::Unit::TestSuite->new("InheritedInheritedTestCase"); - $suite->run($self->result()); - $self->basic_assertion(success => 1, runs => 3); - $self->assert($self->result()->was_successful()); - $self->assert(3 == $self->result()->run_count()); -} - -sub test_no_test_case_class { - my $self = shift; - eval { - my $suite = Test::Unit::TestSuite->new("NoTestCaseClass"); - }; - $self->assert_str_equals("Class NoTestCaseClass was not a test case or test suite.\n", "$@"); -} - -sub test_no_test_cases { - my $self = shift; - my $t = Test::Unit::TestSuite->new("NoTestCases"); - $t->run($self->result()); - $self->basic_assertion(runs => 1, failures => 1, success => 0); - $self->assert(1 == $self->result()->run_count()); # warning test - $self->assert(1 == $self->result()->failure_count()); - $self->assert(not $self->result()->was_successful()); -} - -sub test_not_existing_test_case { - my $self = shift; - my $t = SuiteTest->new("not_existing_method"); - $t->run($self->result()); - $self->basic_assertion(runs => 1, failures => 1, errors => 0); - $self->assert(1 == $self->result()->run_count()); - $self->assert(1 == $self->result()->failure_count()); - $self->assert(0 == $self->result()->error_count()); -} - -sub test_one_test_case { - my $self = shift; - my $t = Test::Unit::TestSuite->new("OneTestCase"); - $t->run($self->result()); - $self->basic_assertion(runs => 1, failures => 0, errors => 0, success => 1); - $self->assert(1 == $self->result()->run_count()); - $self->assert(0 == $self->result()->failure_count()); - $self->assert(0 == $self->result()->error_count()); - $self->assert($self->result()->was_successful()); -} - -sub test_shadowed_tests { - my $self = shift; - my $t = Test::Unit::TestSuite->new("OverrideTestCase"); - $t->run($self->result()); - $self->basic_assertion(runs => 1); - $self->assert(1 == $self->result()->run_count()); -} - - - -1; - diff --git a/perl/third/Test-Unit-0.25/t/tlib/TestAssertionCodeRef.pm b/perl/third/Test-Unit-0.25/t/tlib/TestAssertionCodeRef.pm deleted file mode 100644 index 32af870..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/TestAssertionCodeRef.pm +++ /dev/null @@ -1,15 +0,0 @@ -package TestAssertionCodeRef; -use strict; - -use base qw(Test::Unit::TestCase); - -sub test_case_to_string { my $self = shift; $self->assert(sub { my -$self = shift; $self->to_string eq shift; }, $self, -"test_noy_to_string(" . ref($self) . ")"); } - -sub test_with_a_regex { - my $self = shift; - $self->assert(qr/foo/, 'foo'); - $self->assert(qr/bar/, 'foo'); -} -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/TestObject.pm b/perl/third/Test-Unit-0.25/t/tlib/TestObject.pm deleted file mode 100644 index 966096d..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/TestObject.pm +++ /dev/null @@ -1,10 +0,0 @@ -package TestObject; - -use strict; - -sub new { - my $class = shift; - bless [@_], $class; -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/TestTest.pm b/perl/third/Test-Unit-0.25/t/tlib/TestTest.pm deleted file mode 100644 index a0dd590..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/TestTest.pm +++ /dev/null @@ -1,290 +0,0 @@ -package TestTest; -use strict; - -use base qw(Test::Unit::TestCase); - -use TornDown; -use WasRun; -use Test::Unit::Error; -use Test::Unit::Failure; -use Class::Inner; -use Error qw/:try/; - -sub verify_error { - my $self = shift; - my ($test) = @_; - my $result = $test->run(); - $self->assert_num_equals(1, $result->run_count()); - $self->assert_num_equals(0, $result->failure_count()); - $self->assert_num_equals(1, $result->error_count()); - $self->assert(! $result->was_successful()); -} - -sub verify_failure { - my $self = shift; - my ($test) = @_; - my $result = $test->run(); - $self->assert_num_equals(1, $result->run_count()); - $self->assert_num_equals(1, $result->failure_count()); - $self->assert_num_equals(0, $result->error_count()); - $self->assert(! $result->was_successful()); -} - -sub verify_success { - my $self = shift; - my ($test) = @_; - my $result = $test->run(); - $self->assert_num_equals(1, $result->run_count()); - $self->assert_num_equals(0, $result->failure_count()); - $self->assert_num_equals(0, $result->error_count()); - $self->assert($result->was_successful()); -} - -# test subs - -sub make_dummy_testcase { - my $self = shift; - my $sub = pop; - my $method_name = shift || 'run_test'; - my $test_name = (caller(1))[3] . '_inner'; - - Class::Inner->new(parent => 'Test::Unit::TestCase', - methods => { $method_name => $sub }, - args => [ $test_name ]); -} - -sub test_case_to_string { - my $self = shift; - $self->assert(qr"test_case_to_string\(TestTest\)", - $self->to_string); - $self->assert($self->to_string() eq "test_case_to_string(TestTest)"); -} - -sub test_error { - my $self = shift; - my $error = $self->make_dummy_testcase( - sub { Test::Unit::Error->throw(-object => $self); } - ); - $self->verify_error($error); -} - -sub test_die { - my $self = shift; - my $fail = $self->make_dummy_testcase(sub { my $self = shift; die "died" }); - $self->verify_error($fail); -} - -sub test_fail { - my $self = shift; - my $fail = $self->make_dummy_testcase(sub { my $self = shift; fail() }); - $self->verify_error($fail); -} - -sub test_failure { - my $self = shift; - my $failure = $self->make_dummy_testcase( - sub { - my $self = shift; - $self->assert(0); - } - ); - $self->verify_failure($failure); -} - -sub test_failure_exception { - my $self = shift; - try { - $self->fail; - } - catch Test::Unit::Failure with { - 1; - } - otherwise { - $self->fail; - } -} - -sub test_run_and_tear_down_both_throw { - my $self = shift; - my $fails = Class::Inner->new( - parent => 'TornDown', - methods => { - run_test => sub { - throw Test::Unit::Error -object => $_[0]; - }, - tear_down => sub { - my $self = shift; - $self->SUPER; - die "this tear_down dies"; - }, - }, - args => [ 'test_run_and_tear_down_both_throw_inner' ], - ); - $self->verify_error($fails); - $self->assert($fails->torn_down()); -} - -sub test_run_and_tear_down_both_throw2 { - my $self = shift; - my $fails = Class::Inner->new( - parent => 'TornDown', - methods => { - run_test => sub { - die "this run_test dies"; - }, - tear_down => sub { - my $self = shift; - $self->SUPER; - throw Test::Unit::Error -object => $_[0]; - }, - }, - args => [ 'test_run_and_tear_down_both_throw2_inner' ], - ); - $self->verify_error($fails); - $self->assert($fails->torn_down()); -} - -sub test_runner_printing { - my $self = shift; - $self->assert("1.05" eq (1050 / 1000)); -} - -sub test_setup_fails { - my $self = shift; - my $fails = Class::Inner->new( - parent => 'Test::Unit::TestCase', - methods => { - set_up => sub { - my $self = shift; - throw Test::Unit::Error -object => $self; - }, - run_test => sub {}, - }, - args => [ 'test_setup_fails_inner' ], - ); - $self->verify_error($fails); -} - -sub test_success { - my $self = shift; - my $success = $self->make_dummy_testcase(sub {shift->assert(1)}); - $self->verify_success($success); -} - -sub test_tear_down_after_error { - my $self = shift; - my $fails = Class::Inner->new( - parent => 'TornDown', - methods => { dummy => sub {} }, - args => [ 'test_tear_down_after_error_inner' ], - ); - $self->verify_error($fails); - $self->assert($fails->torn_down()); -} - -sub test_tear_down_dies { - my $self = shift; - my $fails = Class::Inner->new( - parent => 'Test::Unit::TestCase', - methods => { - tear_down => sub { die "this tear_down dies" }, - run_test => {} - }, - args => [ 'test_tear_down_dies_inner' ], - ); - $self->verify_error($fails); -} - -sub test_tear_down_fails { - my $self = shift; - my $fails = Class::Inner->new( - parent => 'Test::Unit::TestCase', - methods => { - tear_down => sub { - Test::Unit::Error->throw( - -text => "this tear_down throws an Error" - ); - }, - run_test => {} - }, - args => [ 'test_tear_down_fails_inner' ], - ); - $self->verify_error($fails); -} - -sub test_set_up_dies_no_tear_down { - my $self = shift; - my $fails = Class::Inner->new( - parent => 'TornDown', - methods => { set_up => sub { die "this set_up dies" } }, - args => [ 'test_set_up_dies_no_tear_down_inner' ], - ); - $self->verify_error($fails); - $self->assert(! $fails->torn_down()); -} - -sub test_set_up_throws_no_tear_down { - my $self = shift; - my $fails = Class::Inner->new( - parent => 'TornDown', - methods => { - set_up => sub { - Test::Unit::Error->throw( - -text => "this set_up throws an Error" - ); - } - }, - args => [ 'test_set_up_throws_no_tear_down_inner' ], - ); - $self->verify_error($fails); - $self->assert(! $fails->torn_down()); -} - -sub test_was_not_successful { - my $self = shift; - my $failure = $self->make_dummy_testcase(sub { shift->fail }); - $self->verify_failure($failure); -} - -sub test_was_run { - my $self = shift; - my $test = WasRun->new("WasRun"); - $test->run(); - $self->assert($test->was_run()); -} - -sub test_was_successful { - my $self = shift; - my $success = $self->make_dummy_testcase(sub { shift->assert(1) }); - $self->verify_success($success); -} - -sub test_assert_on_matching_regex { - my $self = shift; - my $matching_regex = $self->make_dummy_testcase - (sub { - my $self = shift; - $self->assert(scalar('foo' =~ /foo/), 'foo matches foo (boolean)'); - $self->assert(qr/foo/, 'foo', 'foo matches foo (Assertion::Regex)'); - }); - $self->verify_success($matching_regex); -} - -sub test_assert_on_failing_regex { - my $self = shift; - - my $matching_regex = $self->make_dummy_testcase - (sub { - my $self = shift; - $self->assert(scalar("foo" =~ /bar/), "Should not have matched!"); - $self->assert(qr/bar/, "foo"); - }); - $self->verify_failure($matching_regex); -} - -sub test_assert_with_non_assertion_object { - my $self = shift; - my $obj = bless {}, 'NonExistentClass'; - $self->assert($obj, "Object should eval to true"); -} -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/TornDown.pm b/perl/third/Test-Unit-0.25/t/tlib/TornDown.pm deleted file mode 100644 index f8cba6e..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/TornDown.pm +++ /dev/null @@ -1,27 +0,0 @@ -package TornDown; - -use base qw(Test::Unit::TestCase); - -sub new { - my $self = shift()->SUPER::new(@_); - $self->{_TornDown} = 0; - return $self; -} - -sub tear_down { - my $self = shift; - $self->{_TornDown} = 1; -} - -sub torn_down { - my $self = shift; - return $self->{_TornDown}; -} - -sub run_test { - my $self = shift; - my $e = new Test::Unit::Error(); - die $e; -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/WasRun.pm b/perl/third/Test-Unit-0.25/t/tlib/WasRun.pm deleted file mode 100644 index ac76e91..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/WasRun.pm +++ /dev/null @@ -1,22 +0,0 @@ -package WasRun; -use strict; - -use base qw(Test::Unit::TestCase); - -sub new { - my $self = shift()->SUPER::new(@_); - $self->{_TornDown} = 0; - return $self; -} - -sub run_test { - my $self = shift; - $self->{_WasRun} = 1; -} - -sub was_run { - my $self = shift; - return $self->{_WasRun}; -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/tlib/WillDie.pm b/perl/third/Test-Unit-0.25/t/tlib/WillDie.pm deleted file mode 100644 index 5e49279..0000000 --- a/perl/third/Test-Unit-0.25/t/tlib/WillDie.pm +++ /dev/null @@ -1,22 +0,0 @@ -package WillDie; - -use Error; - -use base qw(Test::Unit::TestCase ExceptionChecker); - -sub test_dies { - my $self = shift; - $self->check_errors( - 'Died' => [ __LINE__, sub { die; } ], - 'BANG' => [ __LINE__, sub { die "BANG"; } ], - ); -} - -sub test_throws_error_simple { - my $self = shift; - $self->check_errors( - 'BANG!' => [ __LINE__, sub { Error::Simple->throw("BANG!"); } ], - ); -} - -1; diff --git a/perl/third/Test-Unit-0.25/t/try_examples.t b/perl/third/Test-Unit-0.25/t/try_examples.t deleted file mode 100644 index 8a04370..0000000 --- a/perl/third/Test-Unit-0.25/t/try_examples.t +++ /dev/null @@ -1,113 +0,0 @@ -#!/usr/bin/perl -w - -use strict; - -# using the standard built-in 'Test' module (assume nothing) -use Test; - - -foreach (qw(Makefile.PL Makefile examples lib t)) { - die("Please run 'make test' from the top-level source directory\n". - "(I can't see $_)\n") - unless -e $_; -} - -my %skip = map { ("examples/$_") => 1 } - qw(. .. CVS Experimental README tester.png); -my @examples = grep { ! $skip{$_} } glob("examples/*"); - -my %guru_checked = ( - - "examples/patch100132" => <<'EGC', -... -Time: 0 wallclock secs ( 0.00 usr + 0.00 sys = 0.00 CPU) - -OK (3 tests) -EGC - - "examples/patch100132-1" => <<'EGC', -... -Time: 0 wallclock secs ( 0.00 usr + 0.00 sys = 0.00 CPU) - -OK (3 tests) -EGC - - "examples/patch100132-2" => <<'EGC', -... -Time: 0 wallclock secs ( 0.01 usr + 0.00 sys = 0.01 CPU) - -OK (3 tests) -EGC - - "examples/fail_example.pm" => <<'EGC', -Suite setup -.F.Suite teardown - -Time: 0 wallclock secs ( 0.01 usr + 0.00 sys = 0.01 CPU) - -!!!FAILURES!!! -Test Results: -Run: 2, Failures: 1, Errors: 0 - -There was 1 failure: -1) examples/fail_example.pm:19 - test_fail(fail_example) -Born to lose ... - -Test was not successful. -EGC - - ); - -plan(tests => scalar(@examples)); - -foreach my $e (keys %guru_checked) { - warn("Guru ".(defined $guru_checked{$e} ? 'answer' : 'excuse'). - " exists for '$e' but there is no test file\n") - unless grep { $_ eq $e } @examples; -} - - -warn("\n > The STDERR redirection may not work or may behave differently under\n". - " > your OS '$^O'. That will probably cause this test to fail.\n") - if grep { $^O =~ $_ } ( qr/win/i ); -# This will apply to various OSes. Is there a "capable of doing unix -# redirections" flag somewhere? - - -# Attempt to get hold of the correct perl to run the examples. I -# think we want $ENV{FULLPERLRUN} when running "make test", but that -# doesn't filter down to us. $ENV{PERL5LIB} is set correctly though. -my $perl = $^X || "perl"; -# warn "running examples with \$perl='$perl'\n under \@INC=(@INC)\n with PERL5LIB=$ENV{PERL5LIB}\n"; - - -foreach my $e (@examples) { - if (defined $guru_checked{$e}) { - # get program output - my $runner = $e =~ /\.pm$/ ? './TestRunner.pl ' : ''; - my $cmd = "$perl -I examples $runner$e 2>&1"; -# warn "cmd $cmd\n"; - my $out = `$cmd`; - foreach ($out, $guru_checked{$e}) { - # mess about with start & end newlines - s/^\n+//; - $_ .= "\n" unless /\n$/; - # bin the naughty carriage returns - s/\r//g; - # we can't assume the order of tests will be the same - s/^[.F]+\n?Suite teardown$/TEST-RUN-SUMMARY/sm; - s/::Load[0-9_]+Anonymous[0-9_]+/::LOAD_ANONYMOUS_CLASSNAME/; - # indent lines with '# ' so they're comments if the test fails - s/\n/\n# /g; - # hide things that look like CPU usage - s{Time:\s+[\d\.]+\s+wallclock secs \([\d\s\.]+usr\s+\+[\d\s\.]+sys\s+=[\d\s\.]+CPU\)} - {TIME-SUMMARY}g; - } - ok($out, $guru_checked{$e}); - } else { - skip( (exists $guru_checked{$e} - ? "Skip $e: not yet checked" - : 0), - "nothing", "data at \$guru_checked{$e}"); - } -} diff --git a/perl/third/interface-0.02/.cvsignore b/perl/third/interface-0.02/.cvsignore deleted file mode 100644 index 0b5bd39..0000000 --- a/perl/third/interface-0.02/.cvsignore +++ /dev/null @@ -1,3 +0,0 @@ -Makefile -blib -pm_to_blib diff --git a/perl/third/interface-0.02/Makefile.PL b/perl/third/interface-0.02/Makefile.PL deleted file mode 100644 index 8681fa5..0000000 --- a/perl/third/interface-0.02/Makefile.PL +++ /dev/null @@ -1,7 +0,0 @@ -use ExtUtils::MakeMaker; -# See lib/ExtUtils/MakeMaker.pm for details of how to influence -# the contents of the Makefile that is written. -WriteMakefile( - 'NAME' => 'interface', - 'VERSION_FROM' => 'interface.pm', # finds $VERSION -); diff --git a/perl/third/interface-0.02/interface.pm b/perl/third/interface-0.02/interface.pm deleted file mode 100755 index 57b4f61..0000000 --- a/perl/third/interface-0.02/interface.pm +++ /dev/null @@ -1,294 +0,0 @@ -package interface; - -# -# given the name of package that specifies an interface, verify that we do -# indeed implement everything required by that interface. -# - -use 5.006; - -# we just aren't the kind of module you'd bring home to meet the parents - -# use strict; -# use warnings; - -our $VERSION = '0.02'; - -# per-package locks to avoid reentry when we make them finish loading - -my %locks; - -sub import { - - my $callerpackage = caller; - - return 1 if($locks{$callerpackage}); $locks{$callerpackage} = 1; - - shift; my @interfaces = @_; - - # they need to finish loading before we can inspect what methods they've defined - eval "use $callerpackage;"; - - my $gripes; my $newgripes; - - foreach my $i (@interfaces) { - - do { - eval "package $callerpackage; use $i;"; - die "$callerpackage: interface $i could not be loaded: $@" if($@); - }; - - $newgripes = check_implements($i, $callerpackage); - $gripes .= ", and " if($gripes and $newgripes); - $gripes .= $newgripes if($newgripes); - - # since they implement all required methods, nothing in $i will ever be called. - # however, we need this so that $callerpackage->isa($i) is true. - - push @{$callerpackage.'::ISA'}, $i; - - } - - if($gripes) { - - die "$callerpackage is missing methods: $gripes"; - - } - - undef $locks{$callerpackage}; - -} - - -sub check_implements { - - my $implements = shift; - my $callerpackage = shift; - my $gripes; - - my $gripesf = 0; - - foreach my $i (grep { defined &{$implements.'::'.$_} } keys %{$implements.'::'}) { - - - # unless(defined &{$callerpackage.'::'.$i}) - - unless($callerpackage->can($i)) { - $gripesf = 1; - $gripes .= ', ' if $gripes; - $gripes .= $i; - } - - } - - return $gripes . " from $implements" if($gripesf); - return $gripes; - -} - -1; - -__END__ - -=head1 NAME - -interface - simple compile time interface checking for OO Perl - -=head1 SYNOPSIS - - package Foo; - - use interface 'Iterator', 'Generator', 'Clonable', 'DBI::DBD'; - -=head1 ABSTRACT - -Compile-time interface compliance testing. Inspects the methods defined -in your module, and compares them against the methods defined in the -modules you list. Requires no special or additional syntax. - -Should you fail to implement any method contained in any of the listed -classes, compile will abort with an error message. - -=head1 DESCRIPTION - -Methods starting with an underscore are ignored, and assumed not to -be part of the interface. - -The modules listed on the C line will be added to your -C<@ISA> array. This isn't done to re-use code from them - interface -definitions should be empty code stubs, or perhaps a reference -implementation. It is done so that your module asses the C<< ->isa() >> -test for the name of the package that you're implementing the interface -of. This tells Perl that your module may be used in place of the -modules you implement the interface of. - -Sample interface definition: - - package TestInterface; - - sub foo { } - - sub bar { } - - sub baz { } - - 1; - -A package claiming to implement the interface "TestInterface" would need to -define the methods C, C, and C. - -An "interface" may need some explaination. It's an Object Orientation -idea, also known as polymorphism, that says that you should be able -to use interchangeable objects interchangably. Thank heavens the OO -people came and showed us the light! - -The flip side of polymorphism is type safety. In Perl, C<< ->isa() >> lets -you check to make sure something is derived from a base class. The -logic goes that if its derived from a base class, and we're looking -for an object that fills the need of the base class, then the subclass -will work just as well, and we can accept it. Extending objects is -done by subclassing base classes and passing off the subclasses as -versions of the original. - -While this OO rote might almost have you convinced that the world -works this way, this turns out to be almostly completely useless. -In the real world, there are only a few reasons that one object is -used in place of another: Someone wrote some really horrible code, -and you want to swap out their object with a better version of the -same thing. You're switching to an object that does the same thing -but in a different way, for example using a database store instead -of a flat file store. You're making some minor changes to an existing -object and you want to be able to extend the base class in other -directions in the future. Only in the last case is inherited code -with subclassing even useful. -In fact, there is a move towards using composition (has-a) instead -of inheritance (is-a) across the whole -industry, mainly because they got tired of people pointing out that -OO sucks because inheritance only serves to make a great big mess -of otherwise clean code. - -Seperating the interface from the implementation lets you make -multiple implementations of an idea. They can share code with -each other, but they don't have to. The programmer has assured -us that their module does what is required by stating that it -implements the interface. While this isn't proof that the -code works, climaing to implement an interface is a kind of -contract. The programmer knows what work is required of him and -she has agreed to deliver on it. - -The interface definition can be a package full of stub methods -that don't do anything, or it could be an actual working -implementation of an object you're striving for compatability -with. The first case is cleanist, and the package full of stubs -serves as good documentation. The second case can be handy -in cases where the first case wasn't done but someone ignored -the Wisdom of the Interface and wrote a package anyway. - -The Wisdom of the Interface says to write an interface for each -new kind of object that could have multiple implementations. -The interfaces serves as a contract for the minimum features -needed to implement an object of that type. When working with -objects - creating them, checking types when you accept them, etc - -always work with the interface type, never the type of an -individual implementation. This keeps your code generic. - -In order to do the composition thing (has-a), you contain one or -more objects that you need to do your work, you implement an -interface that dispatches method calls to those objects. Perhaps -your new() method creates those objects and stores them in instance -variables. - -=head2 EXPORT - -None. EXPORT is silly. You stay in your namespace, I'll stay in mine. - -=head1 DIAGNOSTICS - -Failing to implement a required method will generate a fatal similar to the following: - -Baz is missing methods: bar from Stub, and import from your, and import from ImplicitThis at interface.pm line 47. -BEGIN failed--compilation aborted at Baz.pm line 5. - -=head2 AGNOSTICS - -Hear the one about the insomniac dyslexic agnostic? He stayed up all night wondering -if there was a Dog. - -=head1 SEE ALSO - -See http://www.perldesignpatterns.com/ for more on Perl OO, including information -about how and why to use interfaces. - -Damian Conway. Speaking of Damian, this is a cheap knockoff of his Class::Contract module. -However, we have no special syntax! - -Speaking of speaking of Damian Conway, if you ever get a chance to see him talk, you -should go. - -NEXT.pm, by Damian Conway. - -Object::Lexical, also by myself. - -protocol.pm, by James Smith, also on CPAN - -=head1 CHANGES - - 0.01: Initial release. - 0.02: Stephen Nelson submitted a typo report. Thanks! - Mention of protocol.pm by James Smith - An object is now considered to implemenant an interface if it ->can() - do something, not just if it has a method. - Hacked on docs a bit. - -=head1 BUGS - -Yes. - -This will very likely break highly introspective code, for example, anything -Damian Conway might write. - -Does not work with packages not stored in a file where "use" can find them. This -bug applies to programs run from "perl -e" and in subpackages burried in -other packages. Code in the "main" package cannot use this module for this reason. - -Does not work when AUTOLOAD is used to dispatch method calls. Modules that use AUTOLOAD -cannot be used as an interface definition, and modules that use AUTOLOAD cannot be -tested to comply with an interface definition. - -It should be an error to use two different interfaces that both declare a method -of the same name, as it would be ambigious which you are intending to implement. -I haven't decided. Perhaps I'll just make this warning. - -This module was done in pragma-style without permission. I'm interested on -feedback on how to handle this. - -Another arrangement worth considering is to create a Class::Interface thing -that the interface uses, not your code. When you use that interface, the code -is awaken, and import() inspects your code without exporting anything. This -would just move the logic around. Interfaces would be marked interfaces -rather than the people who use the interfaces making them as interfaces. -Once again, thoughts and suggestions encouraged. - -The code is frightening. - -There are spelling and grammar errors in this POD documentation. - -My Wiki is really slow because my computer is slow, doesn't have much memory, and -its 4000 lines of code. I need to trim that down. I think I could do it in about 400 -lines. Update: TinyWiki is borne. TinyWiki is no more than 100 lines, now by -definition. It is fast enough. - -=head1 AUTHOR - -Scott Walters, SWALTERS, Root of all Evil, Escott@slowass.netE - -=head1 COPYRIGHT AND LICENSE - -Copyright 2002, 2003 by Scott Walters - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. If you don't believe in free -software, just remember that free software programmers are gnome-like. -I wouldn't want to be visited by gnomes. - -=cut