r1738 - in packages: . libreturn-value-perl
libreturn-value-perl/branches libreturn-value-perl/branches/upstream
libreturn-value-perl/branches/upstream/current
libreturn-value-perl/branches/upstream/current/lib
libreturn-value-perl/branches/upstream/current/lib/Return
libreturn-value-perl/branches/upstream/current/t
Krzysztof Krzyzaniak
eloy at costa.debian.org
Sat Dec 24 15:10:23 UTC 2005
Author: eloy
Date: 2005-12-24 15:10:22 +0000 (Sat, 24 Dec 2005)
New Revision: 1738
Added:
packages/libreturn-value-perl/
packages/libreturn-value-perl/branches/
packages/libreturn-value-perl/branches/upstream/
packages/libreturn-value-perl/branches/upstream/current/
packages/libreturn-value-perl/branches/upstream/current/Changes
packages/libreturn-value-perl/branches/upstream/current/MANIFEST
packages/libreturn-value-perl/branches/upstream/current/META.yml
packages/libreturn-value-perl/branches/upstream/current/Makefile.PL
packages/libreturn-value-perl/branches/upstream/current/README
packages/libreturn-value-perl/branches/upstream/current/lib/
packages/libreturn-value-perl/branches/upstream/current/lib/Return/
packages/libreturn-value-perl/branches/upstream/current/lib/Return/Value.pm
packages/libreturn-value-perl/branches/upstream/current/t/
packages/libreturn-value-perl/branches/upstream/current/t/failure.t
packages/libreturn-value-perl/branches/upstream/current/t/objects.t
packages/libreturn-value-perl/branches/upstream/current/t/overload.t
packages/libreturn-value-perl/branches/upstream/current/t/pod-coverage.t
packages/libreturn-value-perl/branches/upstream/current/t/pod.t
packages/libreturn-value-perl/branches/upstream/current/t/success.t
packages/libreturn-value-perl/branches/upstream/current/t/use.t
packages/libreturn-value-perl/tags/
Log:
[svn-inject] Installing original source of libreturn-value-perl
Added: packages/libreturn-value-perl/branches/upstream/current/Changes
===================================================================
--- packages/libreturn-value-perl/branches/upstream/current/Changes 2005-12-23 22:17:51 UTC (rev 1737)
+++ packages/libreturn-value-perl/branches/upstream/current/Changes 2005-12-24 15:10:22 UTC (rev 1738)
@@ -0,0 +1,25 @@
+1.20 2005-09-18 23:30
+ minor POD cleanup
+ added pod coverage test (kwalitee suckup)
+
+1.28 2004-12-20 16:00
+ changed bool return to just call ->bool
+ (returning undef crashes 5.6.1, argh! thanks, HDP!)
+
+1.26 2004-12-20 16:00
+ fixed: properties couldn't be undefined after defining
+ "use warnings" removed from tests to keep 5.005 happy
+
+1.24 2004-09-23 09:00
+ allow omission of message
+ ...even with other attributes
+ 100% coverage
+
+1.22 2004-08-30 19:25
+ array and hash dereference will get the return data
+ full test coverage
+ 'type' attribute is key to success/failure
+ POD improved
+
+1.1 2004-07-15
+ Initial Revision.
Added: packages/libreturn-value-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libreturn-value-perl/branches/upstream/current/MANIFEST 2005-12-23 22:17:51 UTC (rev 1737)
+++ packages/libreturn-value-perl/branches/upstream/current/MANIFEST 2005-12-24 15:10:22 UTC (rev 1738)
@@ -0,0 +1,13 @@
+Changes
+lib/Return/Value.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
+t/failure.t
+t/objects.t
+t/overload.t
+t/pod.t
+t/pod-coverage.t
+t/success.t
+t/use.t
Added: packages/libreturn-value-perl/branches/upstream/current/META.yml
===================================================================
--- packages/libreturn-value-perl/branches/upstream/current/META.yml 2005-12-23 22:17:51 UTC (rev 1737)
+++ packages/libreturn-value-perl/branches/upstream/current/META.yml 2005-12-24 15:10:22 UTC (rev 1738)
@@ -0,0 +1,11 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Return-Value
+version: 1.30
+version_from: lib/Return/Value.pm
+installdirs: site
+requires:
+ Test::More: 0.47
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Added: packages/libreturn-value-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libreturn-value-perl/branches/upstream/current/Makefile.PL 2005-12-23 22:17:51 UTC (rev 1737)
+++ packages/libreturn-value-perl/branches/upstream/current/Makefile.PL 2005-12-24 15:10:22 UTC (rev 1738)
@@ -0,0 +1,11 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile (
+ AUTHOR => 'Casey West <casey at geeknest.com>',
+ ABSTRACT => "Polymorphic Return Values",
+ NAME => 'Return::Value',
+ PREREQ_PM => {
+ 'Test::More' => '0.47',
+ },
+ VERSION_FROM => 'lib/Return/Value.pm',
+ );
Added: packages/libreturn-value-perl/branches/upstream/current/README
===================================================================
--- packages/libreturn-value-perl/branches/upstream/current/README 2005-12-23 22:17:51 UTC (rev 1737)
+++ packages/libreturn-value-perl/branches/upstream/current/README 2005-12-24 15:10:22 UTC (rev 1738)
@@ -0,0 +1,142 @@
+NAME
+ Return::Value - Polymorphic Return Values
+
+SYNOPSIS
+ use Return::Value;
+
+ sub send_over_network {
+ my ($net, $send) = @_:
+ if ( $net->transport( $send ) ) {
+ return success;
+ } else {
+ return failure "Was not able to transport info.";
+ }
+ }
+
+ my $result = $net->send_over_network( "Data" );
+
+ # boolean
+ unless ( $result ) {
+ # string
+ print $result;
+ }
+
+ sub build_up_return {
+ my $return = failure;
+
+ if ( ! foo() ) {
+ $return->string("Can't foo!");
+ return $return;
+ }
+
+ if ( ! bar() ) {
+ $return->string("Can't bar");
+ $return->prop(failures => \@bars);
+ return $return;
+ }
+
+ # we're okay if we made it this far.
+ $return++;
+ return $return; # success!
+ }
+
+DESCRIPTION
+ Polymorphic return values are really useful. Often, we just want to know
+ if something worked or not. Other times, we'd like to know what the
+ error text was. Still others, we may want to know what the error code
+ was, and what the error properties were. We don't want to handle objects
+ or data structures for every single return value, but we do want to
+ check error conditions in our code because that's what good programmers
+ do.
+
+ When functions are successful they may return true, or perhaps some
+ useful data. In the quest to provide consistent return values, this gets
+ confusing between complex, informational errors and successful return
+ values.
+
+ This module provides these features with a simple API that should get
+ you what you're looking for in each contex a return value is used in.
+
+ Functions
+ The functional interface is highly recommended for use within functions
+ that are using "Return::Value"s.
+
+ success
+ failure
+
+ Methods
+ The object API is useful in code that is catching "Return::Value"
+ objects.
+
+ new
+ my $return = Return::Value->new(
+ bool => 0,
+ string => "YOU FAIL",
+ prop => {
+ failed_objects => \@objects,
+ },
+ );
+
+ Creates a new "Return::Value" object. You can set the following
+ options.
+
+ "bool", the boolean representation of the result. Defaults to false.
+
+ "errno", the error number. Defaults to 1 or 0 based on the value of
+ "bool".
+
+ "string", the string representation of the result.
+
+ "data", data associated with the result, usually for success.
+
+ "prop", properties assigned to the result.
+
+ bool
+ print "it worked" if $result->bool;
+
+ Returns a boolean describing the result as success or failure.
+
+ errno
+ print "it worked" if $result->errno == 0;
+
+ Returns an errno for the result.
+
+ string
+ print $result->string unless $result->bool;
+
+ Returns a boolean describing the result as success or failure.
+
+ data
+ if ( $result->bool ) {
+ my $data = $result->data;
+ print foreach @{$data};
+ }
+
+ Returns the data structure passed to it.
+
+ prop
+ printf "%s: %s',
+ $result->string, join ' ', @{$result->prop('strings')}
+ unless $result->bool;
+
+ Returns the return value's properties. Accepts the name of a
+ property retured, or returns the properties hash reference if given
+ no name.
+
+ Overloading
+ Several operators are overloaded for "Return::Value" objects. They are
+ listed here.
+
+ Stringify
+ print "$result\n";
+
+ Stringifies to the "string" representation.
+
+ Boolean
+ print $result unless $result;
+
+ Returns the "bool" representation.
+
+ Numeric
+ Also returns the "bool" value.
+
Added: packages/libreturn-value-perl/branches/upstream/current/lib/Return/Value.pm
===================================================================
--- packages/libreturn-value-perl/branches/upstream/current/lib/Return/Value.pm 2005-12-23 22:17:51 UTC (rev 1737)
+++ packages/libreturn-value-perl/branches/upstream/current/lib/Return/Value.pm 2005-12-24 15:10:22 UTC (rev 1738)
@@ -0,0 +1,342 @@
+package Return::Value;
+# vi:et:sw=4 ts=4
+use strict;
+
+use vars qw[$VERSION @EXPORT];
+$VERSION = '1.30';
+ at EXPORT = qw[success failure];
+
+use base qw[Exporter];
+
+=head1 NAME
+
+Return::Value - Polymorphic Return Values
+
+=head1 VERSION
+
+version 1.30
+
+ $Id: Value.pm,v 1.5 2005/01/06 17:15:09 rjbs Exp $
+
+=head1 SYNOPSIS
+
+Used with basic function-call interface:
+
+ use Return::Value;
+
+ sub send_over_network {
+ my ($net, $send) = @_:
+ if ( $net->transport( $send ) ) {
+ return success;
+ } else {
+ return failure "Was not able to transport info.";
+ }
+ }
+
+ my $result = $net->send_over_network( "Data" );
+
+ # boolean
+ unless ( $result ) {
+ # string
+ print $result;
+ }
+
+Or, build your Return::Value as an object:
+
+ sub build_up_return {
+ my $return = failure;
+
+ if ( ! foo() ) {
+ $return->string("Can't foo!");
+ return $return;
+ }
+
+ if ( ! bar() ) {
+ $return->string("Can't bar");
+ $return->prop(failures => \@bars);
+ return $return;
+ }
+
+ # we're okay if we made it this far.
+ $return++;
+ return $return; # success!
+ }
+
+=head1 DESCRIPTION
+
+Polymorphic return values are really useful. Often, we just want to know if
+something worked or not. Other times, we'd like to know what the error text
+was. Still others, we may want to know what the error code was, and what the
+error properties were. We don't want to handle objects or data structures for
+every single return value, but we do want to check error conditions in our code
+because that's what good programmers do.
+
+When functions are successful they may return true, or perhaps some useful
+data. In the quest to provide consistent return values, this gets confusing
+between complex, informational errors and successful return values.
+
+This module provides these features with a simple API that should get you what
+you're looking for in each contex a return value is used in.
+
+=head2 Attributes
+
+All return values have a set of attributes that package up the information
+returned. All attributes can be accessed or changed via methods of the same
+name, unless otherwise noted. Many can also be accessed via overloaded
+operations on the object, as noted below.
+
+=over 4
+
+=item type
+
+A value's type is either "success" or "failure" and (obviously) reflects
+whether the value is returning success or failure.
+
+=item errno
+
+The errno attribute stores the error number of the return value. For
+success-type results, it is by default undefined. For other results, it
+defaults to 1.
+
+=item string
+
+The value's string attribute is a simple message describing the value.
+
+=item data
+
+The data attribute stores a reference to a hash or array, and can be used as a
+simple way to return extra data. Data stored in the data attribute can be
+accessed by dereferencing the return value itself. (See below.)
+
+=item prop
+
+The most generic attribute of all, prop is a hashref that can be used to pass
+an arbitrary number of data structures, just like the data attribute. Unlike
+the data attribute, though, these structures must be retrived via method calls.
+
+=back
+
+=head1 FUNCTIONS
+
+The functional interface is highly recommended for use within functions
+that are using C<Return::Value> for return values. It's simple and
+straightforward, and builds the entire return value in one statement.
+
+=over 4
+
+=cut
+
+# This hack probably impacts performance more than I'd like to know, but it's
+# needed to have a hashref object that can deref into a different hash.
+# _ah($self,$key, [$value) sets or returns the value for the given key on the
+# $self blessed-ref
+
+sub _ah {
+ my ($self, $key, $value) = @_;
+ my $class = ref $self;
+ bless $self => "ain't::overloaded";
+ $self->{$key} = $value if @_ > 2;
+ my $return = $self->{$key};
+ bless $self => $class;
+ return $return;
+}
+
+sub _builder {
+ my %args = (type => shift);
+ $args{string} = shift if (@_ % 2);
+ %args = (%args, @_);
+
+ $args{string} = $args{type} unless defined $args{string};
+
+ $args{errno} = ($args{type} eq 'success' ? undef : 1)
+ unless defined $args{errno};
+
+ __PACKAGE__->new(%args);
+}
+
+=item C<< success >>
+
+The C<success> function returns a C<Return::Value> with the type "success".
+
+Additional named parameters may be passed to set the returned object's
+attributes. The first, optional, parameter is the string attribute and does
+not need to be named. All other parameters must be passed by name.
+
+ # simplest possible case
+ return success;
+
+=cut
+
+sub success { _builder('success', @_) }
+
+=pod
+
+=item C<< failure >>
+
+C<failure> is identical to C<success>, but returns an object with the type
+"failure"
+
+=cut
+
+sub failure { _builder('failure', @_) }
+
+=pod
+
+=back
+
+=head1 METHODS
+
+The object API is useful in code that is catching C<Return::Value> objects.
+
+=over 4
+
+=item new
+
+ my $return = Return::Value->new(
+ type => 'failure',
+ string => "YOU FAIL",
+ prop => {
+ failed_objects => \@objects,
+ },
+ );
+
+Creates a new C<Return::Value> object. Named parameters can be used to set the
+object's attributes.
+
+=cut
+
+sub new {
+ my $class = shift;
+ bless { type => 'failure', string => '', prop => {}, @_ } => $class;
+}
+
+=pod
+
+=item bool
+
+ print "it worked" if $result->bool;
+
+Returns the result in boolean context: true for success, false for failure.
+
+=item prop
+
+ printf "%s: %s',
+ $result->string, join ' ', @{$result->prop('strings')}
+ unless $result->bool;
+
+Returns the return value's properties. Accepts the name of
+a property retured, or returns the properties hash reference
+if given no name.
+
+=item other attribute accessors
+
+Simple accessors exist for the object's other attributes: C<type>, C<errno>,
+C<string>, and C<data>.
+
+=cut
+
+sub bool { _ah($_[0],'type') eq 'success' ? 1 : 0 }
+
+sub type {
+ my ($self, $value) = @_;
+ return _ah($self, 'type') unless @_ > 1;
+ die "invalid result type: $value"
+ unless $value eq 'success' or $value eq 'failure';
+ return _ah($self, 'type', $value);
+};
+
+foreach my $name ( qw[errno string data] ) {
+ no strict 'refs';
+ *{$name} = sub {
+ my ($self, $value) = @_;
+ return _ah($self, $name) unless @_ > 1;
+ return _ah($self, $name, $value);
+ };
+}
+
+sub prop {
+ my ($self, $name, $value) = @_;
+ return _ah($self, 'prop') unless $name;
+ return _ah($self, 'prop')->{$name} unless @_ > 2;
+ return _ah($self, 'prop')->{$name} = $value;
+}
+
+=pod
+
+=back
+
+=head2 Overloading
+
+Several operators are overloaded for C<Return::Value> objects. They are
+listed here.
+
+=over 4
+
+=item Stringif
+
+ print "$result\n";
+
+Stringifies to the string attribute.
+
+=item Boolean
+
+ print $result unless $result;
+
+Returns the C<bool> representation.
+
+=item Numeric
+
+Also returns the C<bool> value.
+
+=item Dereference
+
+Dereferencing the value as a hash or array will return the value of the data
+attribute, if it matches that type, or an empty reference otherwise. You can
+check C<< ref $result->data >> to determine what kind of data (if any) was
+passed.
+
+=cut
+
+use overload
+ '""' => sub { shift->string },
+ 'bool' => sub { shift->bool },
+ '==' => sub { shift->bool == shift },
+ '!=' => sub { shift->bool != shift },
+ '>' => sub { shift->bool > shift },
+ '<' => sub { shift->bool < shift },
+ 'eq' => sub { shift->string eq shift },
+ 'ne' => sub { shift->string ne shift },
+ 'gt' => sub { shift->string gt shift },
+ 'lt' => sub { shift->string lt shift },
+ '++' => sub { _ah(shift,'type','success') },
+ '--' => sub { _ah(shift,'type','failure') },
+ '${}' => sub { my $data = _ah($_[0],'data'); $data ? \$data : \undef },
+ '%{}' => sub { ref _ah($_[0],'data') eq 'HASH' ? _ah($_[0],'data') : {} },
+ '@{}' => sub { ref _ah($_[0],'data') eq 'ARRAY' ? _ah($_[0],'data') : [] },
+ fallback => 1;
+
+=pod
+
+=back
+
+=head1 TODO
+
+No plans!
+
+=head1 AUTHORS
+
+Casey West, <F<casey at geeknest.com>>.
+
+Ricardo Signes, <F<rjbs at cpan.org>>.
+
+=head1 COPYRIGHT
+
+ Copyright (c) 2004 Casey West and Ricardo SIGNES. All rights reserved.
+ This module is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.
+
+=cut
+
+"This return value is true.";
+
+__END__
Added: packages/libreturn-value-perl/branches/upstream/current/t/failure.t
===================================================================
--- packages/libreturn-value-perl/branches/upstream/current/t/failure.t 2005-12-23 22:17:51 UTC (rev 1737)
+++ packages/libreturn-value-perl/branches/upstream/current/t/failure.t 2005-12-24 15:10:22 UTC (rev 1738)
@@ -0,0 +1,73 @@
+use Test::More tests => 31;
+use strict;
+$^W = 1;
+
+my $class;
+
+BEGIN { $class = 'Return::Value'; use_ok($class); }
+
+{
+ my $message = "I've got a bad feelin' about this.";
+ my $value = failure $message;
+
+ isa_ok($value, $class, "failure value");
+
+ ok(not($value), "failure value is false");
+ ok($value == 0, "failure value is 0");
+ ok($value eq $message, "failure value has a bad feelin'");
+ is($value->errno, 1, "failure value errno is default (1)");
+}
+
+{
+ my $message = "I've got a bad feelin' about this.";
+ my $value = failure $message, errno => 501, data => { cause => 'sunspots' };
+
+ isa_ok($value, $class, "failure value");
+
+ ok(not($value), "failure value is false");
+ ok($value == 0, "failure value is 0");
+ ok($value eq $message, "failure value has a bad feelin'");
+ is($value->errno, 501, "failure value has 501 errno");
+
+ is(ref $value->data, 'HASH', "failure value includes hashref");
+ is($value->{cause}, 'sunspots', "failure value derefs correctly");
+}
+
+{
+ my $message = "I've got a bad feelin' about this.";
+ my $value = failure $message, errno => 501, data => [ cause => 'sunspots' ];
+
+ isa_ok($value, $class, "failure value");
+
+ ok(not($value), "failure value is false");
+ ok($value == 0, "failure value is 0");
+ ok($value eq $message, "failure value has a bad feelin'");
+ is($value->errno, 501, "failure value has 501 errno");
+
+ is(ref $value->data, 'ARRAY', "failure value includes hashref");
+ is($value->[1], 'sunspots', "failure value derefs correctly");
+}
+
+{
+ my $value = failure errno => 501, data => [ cause => 'sunspots' ];
+
+ isa_ok($value, $class, "failure value");
+
+ ok(not($value), "failure value is false");
+ ok($value == 0, "failure value is 0");
+ ok($value eq 'failure', "failure value has default stringification");
+ is($value->errno, 501, "failure value has 501 errno");
+
+ is(ref $value->data, 'ARRAY', "failure value includes hashref");
+ is($value->[1], 'sunspots', "failure value derefs correctly");
+}
+
+{
+ my $value = failure;
+
+ isa_ok($value, $class, "failure value");
+
+ ok(not($value), "failure value is true");
+ ok($value == 0, "failure value is 0");
+ ok($value eq 'failure', "failure has default stringification");
+}
Added: packages/libreturn-value-perl/branches/upstream/current/t/objects.t
===================================================================
--- packages/libreturn-value-perl/branches/upstream/current/t/objects.t 2005-12-23 22:17:51 UTC (rev 1737)
+++ packages/libreturn-value-perl/branches/upstream/current/t/objects.t 2005-12-24 15:10:22 UTC (rev 1738)
@@ -0,0 +1,43 @@
+use Test::More tests => 24;
+use strict;
+$^W = 1;
+
+use_ok 'Return::Value';
+
+my $ret = Return::Value->new;
+isa_ok $ret, 'Return::Value';
+ok ! $ret->bool, 'false';
+is $ret->errno, undef, 'errno 0';
+is $ret->string, "", 'empty string';
+ok ! $ret->data, 'no data';
+is scalar(keys %{$ret->prop}), 0, 'no properties';
+
+$ret = Return::Value->new(
+ type => 'success',
+ errno => 128,
+ string => 'string',
+ data => [ 'one' ],
+ prop => { one => 1 },
+);
+
+isa_ok $ret, 'Return::Value';
+ok $ret->bool, 'true';
+is $ret->errno, 128, 'errno 128';
+is $ret->errno(undef), undef, 'errno undef';
+is $ret->errno, undef, 'errno still undef';
+is $ret->string, 'string', 'string is string';
+is ref($ret->data), 'ARRAY', 'data array ref';
+is scalar(@{$ret->data}), 1, 'one element in data';
+is ref($ret->prop), 'HASH', 'hash in prop';
+is $ret->prop->{one}, 1, 'one prop set';
+
+$ret->type('failure');
+ok ! $ret->bool, 'now false';
+is $ret->prop('one'), 1, 'object access for one';
+is $ret->prop(two => 2), 2, 'prop create for two';
+is $ret->errno(10), 10, 'set errno with method';
+is $ret->type(), 'failure', 'type is currently failure';
+is $ret->type("success"), 'success', 'set type with method';
+
+eval { $ret->type("top secret"); };
+like($@, qr/invalid result type/, "death on unknown type");
Added: packages/libreturn-value-perl/branches/upstream/current/t/overload.t
===================================================================
--- packages/libreturn-value-perl/branches/upstream/current/t/overload.t 2005-12-23 22:17:51 UTC (rev 1737)
+++ packages/libreturn-value-perl/branches/upstream/current/t/overload.t 2005-12-24 15:10:22 UTC (rev 1738)
@@ -0,0 +1,45 @@
+use Test::More tests => 18;
+use strict;
+$^W = 1;
+
+BEGIN { use_ok 'Return::Value' };
+
+my $success = success;
+ok $success, 'good';
+
+my $failure = failure;
+ok ! $failure, 'bad';
+
+is ''.success("Good"), "Good", 'stringified good is good';
+
+ok failure() < 1 && failure() > -1 && failure() == 0, 'failure is zero';
+
+my $fail = failure;
+
+$fail++;
+ok $fail, 'failure to success (success is true)';
+
+$fail--;
+ok ! $fail, 'success to failure (failure is false)';
+
+cmp_ok($fail, '==', 0, "failure is == 0");
+cmp_ok($fail, '!=', 1, "failure is != 1");
+
+my $error = failure "stringy error message";
+
+cmp_ok($error, 'eq', "stringy error message");
+cmp_ok($error, 'ne', "some random string");
+
+cmp_ok($error, 'gt', "aaa");
+cmp_ok($error, 'lt', "zzz");
+
+is($$error, undef, "no built-in data");
+
+my $error_array = failure "I died!", data => [qw(array ref)];
+my $error_hash = failure "I died!", data => { hash => 'ref' };
+
+ok(@$error_array, "can deref array data as array");
+ok(%$error_hash, "can deref hash data as hash");
+
+is_deeply({%$error_array}, {}, "can't deref array data as array");
+is_deeply([@$error_hash ], [], "can't deref hash data as hash");
Added: packages/libreturn-value-perl/branches/upstream/current/t/pod-coverage.t
===================================================================
--- packages/libreturn-value-perl/branches/upstream/current/t/pod-coverage.t 2005-12-23 22:17:51 UTC (rev 1737)
+++ packages/libreturn-value-perl/branches/upstream/current/t/pod-coverage.t 2005-12-24 15:10:22 UTC (rev 1738)
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
Added: packages/libreturn-value-perl/branches/upstream/current/t/pod.t
===================================================================
--- packages/libreturn-value-perl/branches/upstream/current/t/pod.t 2005-12-23 22:17:51 UTC (rev 1737)
+++ packages/libreturn-value-perl/branches/upstream/current/t/pod.t 2005-12-24 15:10:22 UTC (rev 1738)
@@ -0,0 +1,6 @@
+use Test::More;
+
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+
+all_pod_files_ok();
Added: packages/libreturn-value-perl/branches/upstream/current/t/success.t
===================================================================
--- packages/libreturn-value-perl/branches/upstream/current/t/success.t 2005-12-23 22:17:51 UTC (rev 1737)
+++ packages/libreturn-value-perl/branches/upstream/current/t/success.t 2005-12-24 15:10:22 UTC (rev 1738)
@@ -0,0 +1,58 @@
+use Test::More tests => 24;
+use strict;
+$^W = 1;
+
+my $class;
+
+BEGIN { $class = 'Return::Value'; use_ok($class); }
+
+{
+ my $message = "Feelin' fine.";
+ my $value = success $message;
+
+ isa_ok($value, $class, "success value");
+
+ ok($value, "success value is true");
+ ok($value == 1, "success value is 1");
+ ok($value eq $message, "success value is feelin' fine");
+ is($value->errno, undef, "success value errno is default (undef)");
+}
+
+{
+ my $message = "Feelin' fine.";
+ my $value = success $message, errno => 200, data => { cause => 'sunshine' };
+
+ isa_ok($value, $class, "success value");
+
+ ok($value, "success value is true");
+ ok($value == 1, "success value is 1");
+ ok($value eq $message, "success value has a bad feelin'");
+ is($value->errno, 200, "success value has 501 errno");
+
+ is(ref $value->data, 'HASH', "success value includes hashref");
+ is(${$value}->{cause}, 'sunshine', "success value derefs correctly");
+}
+
+{
+ my $value = success errno => 200, data => { cause => 'sunshine' };
+
+ isa_ok($value, $class, "success value");
+
+ ok($value, "success value is true");
+ ok($value == 1, "success value is 1");
+ ok($value eq 'success', "success value has a bad feelin'");
+ is($value->errno, 200, "success value has 501 errno");
+
+ is(ref $value->data, 'HASH', "success value includes hashref");
+ is(${$value}->{cause}, 'sunshine', "success value derefs correctly");
+}
+
+{
+ my $value = success;
+
+ isa_ok($value, $class, "success value");
+
+ ok($value, "success value is true");
+ ok($value == 1, "success value is 1");
+ ok($value eq 'success', "success has default stringification");
+}
Added: packages/libreturn-value-perl/branches/upstream/current/t/use.t
===================================================================
--- packages/libreturn-value-perl/branches/upstream/current/t/use.t 2005-12-23 22:17:51 UTC (rev 1737)
+++ packages/libreturn-value-perl/branches/upstream/current/t/use.t 2005-12-24 15:10:22 UTC (rev 1738)
@@ -0,0 +1,3 @@
+use Test::More tests => 1;
+
+BEGIN { use_ok 'Return::Value'; }
More information about the Pkg-perl-cvs-commits
mailing list