ALT Linux Sisyphus - Пакет perl-Test-TinyMocker

pax_global_header00006660000000000000000000000064122053764170014521gustar00rootroot0000000000000052 comment=6338b86da47f9ead3b5164eb6be1cb5d97da020a
perl-Test-TinyMocker-0.03/000075500000000000000000000000001220537641700154025ustar00rootroot00000000000000perl-Test-TinyMocker-0.03/.perlcriticrc000064400000000000000000000014631220537641700200740ustar00rootroot00000000000000verbose  = [%p] %m at %f line %l, near '%r'\n
severity = 2

[TestingAndDebugging::RequireUseWarnings]
[-Miscellanea::RequireRcsKeywords]
[-Documentation::RequirePodSections]
[-Documentation::RequirePodLinksIncludeText]
[-Modules::RequireVersionVar]
[-ControlStructures::ProhibitPostfixControls]
[-ErrorHandling::RequireCheckingReturnValueOfEval]

[Variables::ProhibitPunctuationVars]
    allow = $@ $!

[-ValuesAndExpressions::ProhibitNoisyQuotes]

# we export a set of symbols, and we do syntactic sugar
[-Modules::ProhibitAutomaticExportation]
[-Subroutines::ProhibitSubroutinePrototypes]
[-Subroutines::RequireArgUnpacking]
[-Subroutines::RequireFinalReturn]
[-TestingAndDebugging::ProhibitNoStrict]
[-TestingAndDebugging::ProhibitNoWarnings]

[ValuesAndExpressions::ProhibitMagicNumbers]
	allowed_values = 0 1 2 3

perl-Test-TinyMocker-0.03/.perltidyrc000064400000000000000000000022071220537641700175650ustar00rootroot00000000000000-l=79   # Max line width is 79 cols
-i=4    # Indent level is 4 cols
-ci=4   # Continuation indent is 4 cols

-b 
-se     # Errors to STDERR
-vt=2   # Maximal vertical tightness
-cti=0  # No extra indentation for closing brackets
-pt=1   # Medium parenthesis tightness
-bt=1   # Medium brace tightness
-sbt=1  # Medium square bracket tightness
-bbt=1  # Medium block brace tightness
-nsfs   # No space before semicolons
-nolq   # Don't outdent long quoted strings
-wbb="% + - * / x != == >= <= =~ < > | & **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x="
# Break before all operators

# extras/overrides/deviations from PBP
--maximum-line-length=79    # be less generous
--warning-output            # Show warnings
--maximum-consecutive-blank-lines=2 # default is 1
--nohanging-side-comments   # troublesome for commented out code

-isbc   # block comments may only be indented if they have some space characters before the #
-ci=2   # Continuation indent is 2 cols

# we use version control, so just rewrite the file
-b

# for the up-tight folk :)
-pt=2   # High parenthesis tightness
-bt=2   # High brace tightness
-sbt=2  # High square bracket tightness

perl-Test-TinyMocker-0.03/AUTHORS000064400000000000000000000000421220537641700164460ustar00rootroot00000000000000Alexis Sukrieh
Jц╘rц╢me Bourgeois
perl-Test-TinyMocker-0.03/Changes000064400000000000000000000006261220537641700167010ustar00rootroot00000000000000Revision history for Test-TinyMocker

0.03
        [Sawyer X]
        * Supporting arrayrefs for multiple methods, adding "methods".
        * Refactoring symbol flattening.

0.02	08/24/2010
		[Jц╘rц╢me Bourgeois]
		* Support for the 'unmock' function.
		* Make sure it's not possible to mock an unknown mehtod.

0.01    08/22/2010
		[Alexis Sukrieh]
        * First version, provide the 'mock' function.

perl-Test-TinyMocker-0.03/MANIFEST000064400000000000000000000005251220537641700165350ustar00rootroot00000000000000.perlcriticrc
.perltidyrc
AUTHORS
Changes
ignore.txt
lib/Test/TinyMocker.pm
Makefile.PL
MANIFEST
README
t/00-load.t
t/01_mock.t
t/02_unmock.t
t/03_mock_error.t
t/04_unmock_error.t
t/05_multiple_mock.t
t/06_multiple_unmock.t
t/manifest.t
t/pod-coverage.t
t/pod.t
META.yml                                 Module meta-data (added by MakeMaker)
perl-Test-TinyMocker-0.03/META.yml000064400000000000000000000010671220537641700166570ustar00rootroot00000000000000--- #YAML:1.0
name:               Test-TinyMocker
version:            0.03
abstract:           a very simple tool to mock external modules
author:
    - Alexis Sukrieh <sukria@sukria.net>
license:            perl
distribution_type:  module
configure_requires:
    ExtUtils::MakeMaker:  0
build_requires:
    ExtUtils::MakeMaker:  0
requires:
    Test::More:  0
no_index:
    directory:
        - t
        - inc
generated_by:       ExtUtils::MakeMaker version 6.55_02
meta-spec:
    url:      http://module-build.sourceforge.net/META-spec-v1.4.html
    version:  1.4
perl-Test-TinyMocker-0.03/Makefile.PL000064400000000000000000000010351220537641700173530ustar00rootroot00000000000000use strict;
use warnings;
use ExtUtils::MakeMaker;

WriteMakefile(
    NAME                => 'Test::TinyMocker',
    AUTHOR              => q{Alexis Sukrieh <sukria@sukria.net>},
    VERSION_FROM        => 'lib/Test/TinyMocker.pm',
    ABSTRACT_FROM       => 'lib/Test/TinyMocker.pm',
    LICENSE             => 'perl',
    PL_FILES            => {},
    PREREQ_PM => {
        'Test::More' => 0,
    },
    dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
    clean               => { FILES => 'Test-TinyMocker-*' },
);
perl-Test-TinyMocker-0.03/README000064400000000000000000000013731220537641700162660ustar00rootroot00000000000000Test-TinyMocker

    use Test::More;
    use Test::TinyMocker;

    mock 'Some::Module'
        => method 'some_method'
        => should {
            return $mocked_value;
        };

    # or 

    mock 'Some::Module::some_method'
        => should {
            return $mocked_value;
        };

    # Some::Module::some_method() will now always return $mocked_value;

This module was inspired by Gugod's blog, after the article published about
mocking in Ruby and Perl: http://gugod.org/2009/05/mocking.html

This module was first part of the test tools provided by Dancer in its own t
directory (previously named C<t::lib::EasyMocker>). A couple of developers asked
me if I could released this module as a real Test:: distribution on CPAN, so
here it is.

perl-Test-TinyMocker-0.03/ignore.txt000064400000000000000000000001751220537641700174310ustar00rootroot00000000000000blib*
Makefile
Makefile.old
Build
Build.bat
_build*
pm_to_blib*
*.tar.gz
.lwpcookies
cover_db
pod2htm*.tmp
Test-TinyMocker-*
perl-Test-TinyMocker-0.03/lib/000075500000000000000000000000001220537641700161505ustar00rootroot00000000000000perl-Test-TinyMocker-0.03/lib/Test/000075500000000000000000000000001220537641700170675ustar00rootroot00000000000000perl-Test-TinyMocker-0.03/lib/Test/TinyMocker.pm000064400000000000000000000131571220537641700215200ustar00rootroot00000000000000package Test::TinyMocker;

use strict;
use warnings;

use Carp qw{ croak };

use vars qw(@EXPORT $VERSION);
use base 'Exporter';

$VERSION = '0.03';
my $mocks = {};

@EXPORT = qw(mock unmock should method methods);

sub method($)  {@_}
sub methods($) {@_}
sub should(&)  {@_}

sub mock {
    croak 'useless use of mock with one or less parameter'
      if scalar @_ < 2;

    my $sub     = pop;
    my @symbols = _flat_symbols(@_);

    foreach my $symbol (@symbols) {
        croak "unknown symbol: $symbol"
          unless _symbol_exists($symbol);

        _save_sub($symbol);
        _bind_coderef_to_symbol($symbol, $sub);
    }
}

sub unmock {
    croak 'useless use of unmock without parameters'
      unless scalar @_;

    my @symbols = _flat_symbols(@_);
    foreach my $symbol (@symbols) {
        croak "unkown method $symbol"
          unless $mocks->{$symbol};

        {
            no strict 'refs';
            no warnings 'redefine', 'prototype';
            *{$symbol} = delete $mocks->{$symbol};
        }
    }
}

sub _flat_symbols {
    if (@_ == 2) {
        return ref $_[1] eq 'ARRAY'
          ? map {qq{$_[0]::$_}} @{$_[1]}
          : qq{$_[0]::$_[1]};
    }
    else {
        return ref $_[0] eq 'ARRAY'
          ? @{$_[0]}
          : $_[0];
    }
}

sub _symbol_exists {
    my ($symbol) = @_;
    {
        no strict 'refs';
        no warnings 'redefine', 'prototype';

        return defined *{$symbol}{CODE};
    }
}

sub _bind_coderef_to_symbol {
    my ($symbol, $sub) = @_;
    {
        no strict 'refs';
        no warnings 'redefine', 'prototype';

        *{$symbol} = $sub;
    }
}

sub _save_sub {
    my ($name) = @_;

    {
        no strict 'refs';
        $mocks->{$name} ||= *{$name}{CODE};
    }

    return $name;
}

1;
__END__

=head1 NAME

Test::TinyMocker - a very simple tool to mock external modules

=head1 SYNOPSIS

    use Test::More;
    use Test::TinyMocker;

    mock 'Some::Module'
        => method 'some_method'
        => should {
            return $mocked_value;
        };

    # or

    mock 'Some::Module'
        => methods [ 'this_method', 'that_method' ]
        => should {
            return $mocked_value;
        };

    # or 

    mock 'Some::Module::some_method'
        => should {
            return $mocked_value;
        };

    # Some::Module::some_method() will now always return $mocked_value;

	# To restore the original method

	unmock 'Some::Module::some_method';

	#б═or

	unmock 'Some::Module' => method 'some_method';

    # or

    unmock 'Some::Module' => methods [ 'this_method', 'that_method' ];

=head1 EXPORT

=head2 mock($module, $method_or_methods, $sub)

This function allows you to overwrite the given method with an arbitrary code
block. This lets you simulate soem kind of behaviour for your tests.

Alternatively, this method can be passed only two arguments, the first one will
be the full path of the method (pcakge name + method name) and the second one
the coderef.

Syntactic sugar is provided (C<method>, C<methods> and C<should>) in order to
let you write sweet mock statements:

    # This:
    mock('Foo::Bar', 'a_method', sub { return 42;});

    # is the same as:
    mock 'Foo::Bar' => method 'a_method' => should { return 42 };

    # or:
    mock 'Foo::Bar::a_method' => should { return 42 };

    # or also:
    mock('Foo::Bar::a_method', sub { return 42;});

Using multiple methods at the same time can be done with arrayrefs:

    # This:
    mock('Foo::Bar', ['a_method', 'b_method'], sub { 42 } );

    # is the same as:
    mock 'Foo::Bar' => methods ['a_method', 'b_method'] => should { 42 };

=head2 unmock($module, $method_or_methods)

Syntactic sugar is provided (C<method> and C<methods>) in order to let you write
sweet unmock statements:

    # This:
    unmock('Foo::Bar', 'a_method');

    # is the same as:
    unmock 'Foo::Bar' => method 'a_method';

And using multiple methods at the same time:

    unmock 'Foo::Bar' => methods ['a_method', 'b_method'];

=head2 method

Syntactic sugar for mock()

=head2 methods

Syntactic sugar for mock()

=head2 should

Syntactic sugar for mock()

=head1 AUTHOR

Alexis Sukrieh, C<< <sukria at sukria.net> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-test-tinymocker at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-TinyMocker>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Test::TinyMocker

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-TinyMocker>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Test-TinyMocker>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Test-TinyMocker>

=item * Search CPAN

L<http://search.cpan.org/dist/Test-TinyMocker/>

=back

=head1 ACKNOWLEDGEMENTS

This module was inspired by Gugod's blog, after the article published about
mocking in Ruby and Perl: L<http://gugod.org/2009/05/mocking.html>

This module was first part of the test tools provided by Dancer in its own t
directory (previously named C<t::lib::EasyMocker>). A couple of developers asked
me if I could released this module as a real Test:: distribution on CPAN, so
here it is.

=head1 LICENSE AND COPYRIGHT

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut
perl-Test-TinyMocker-0.03/t/000075500000000000000000000000001220537641700156455ustar00rootroot00000000000000perl-Test-TinyMocker-0.03/t/00-load.t000064400000000000000000000002541220537641700171670ustar00rootroot00000000000000use Test::More tests => 1;

BEGIN {
    use_ok( 'Test::TinyMocker' ) || print "Bail out!
";
}

diag( "Testing Test::TinyMocker $Test::TinyMocker::VERSION, Perl $], $^X" );
perl-Test-TinyMocker-0.03/t/01_mock.t000064400000000000000000000021461220537641700172660ustar00rootroot00000000000000use strict;
use warnings;

use Test::More;
use Test::TinyMocker;

{
    package Foo::Bar;
    sub baz { "day" }
}

# original value
is Foo::Bar::baz(), "day", "initial value is ok";

# basic syntax
mock('Foo::Bar', 'baz', sub { return $_[0] + 1 });
is Foo::Bar::baz(1), 2, "basic syntax";

mock 'Foo::Bar' => method 'baz' => should { "night" };
is Foo::Bar::baz(), "night", "static mocked value";

my $counter = 0;

mock 'Foo::Bar' 
    => method 'baz' 
    => should { $counter++; };

is Foo::Bar::baz(), 0, "dynamic mocked value";
is Foo::Bar::baz(), 1, "dynamic mocked value";

mock('Foo::Bar::baz', sub { return $_[0] + 3 });
is Foo::Bar::baz(1), 4, "2 args syntax";

mock 'Foo::Bar::baz' 
    => should { $_[0] + 2 };
is Foo::Bar::baz(1), 3, "2 args syntax with sugar";

eval { mock };
like( $@, qr{useless use of mock with one}, "no call of mock without parameter" );

eval { mock 'Foo' };
like( $@, qr{useless use of mock with one}, "no call of mock with one parameter" );

eval { mock 'Foo::Bar' => method 'faked' =>  should { return } };
like( $@, qr{unknown symbol:}, "no mock non exists function" );

done_testing;
perl-Test-TinyMocker-0.03/t/02_unmock.t000064400000000000000000000012421220537641700176260ustar00rootroot00000000000000use strict;
use warnings;

use Test::More;
use Test::TinyMocker;

{
    package Foo::Bar;
    sub baz { "day" }
}

# original value
is Foo::Bar::baz(), "day", "initial value is ok";

# mock new comportement 
mock('Foo::Bar', 'baz', sub { return 'night' });

# unmock
unmock('Foo::Bar', 'baz');
is Foo::Bar::baz(), "day", "original value";

# mock new comportement 
mock('Foo::Bar', 'baz', sub { return 'night' });

# unmock
unmock('Foo::Bar::baz');
is Foo::Bar::baz(), "day", "original value";

# mock new comportement 
mock('Foo::Bar', 'baz', sub { return 'night' });

# unmock
unmock 'Foo::Bar' => method 'baz';
is Foo::Bar::baz(), "day", "original value";

done_testing;
perl-Test-TinyMocker-0.03/t/03_mock_error.t000064400000000000000000000006401220537641700204760ustar00rootroot00000000000000use strict;
use warnings;

use Test::More;
use Test::TinyMocker;

eval { mock };
like( $@, qr{useless use of mock with one}, "no call of mock without parameter" );

eval { mock 'Foo' };
like( $@, qr{useless use of mock with one}, "no call of mock with one parameter" );

eval { mock 'Foo::Bar' => method 'faked' =>  should { return } };
like( $@, qr{unknown symbol:}, "no mock non exists function" );

done_testing;
perl-Test-TinyMocker-0.03/t/04_unmock_error.t000064400000000000000000000006601220537641700210440ustar00rootroot00000000000000use strict;
use warnings;

use Test::More;
use Test::TinyMocker;

eval { unmock };
like( $@, qr{useless use of unmock}, "no call unmock without parameter" );                                                                       

eval { unmock 'Module::Will' => method 'not_exists'  };
like( $@, qr{unkown method}, "no recover nuknown method" );                                                                       

done_testing;
perl-Test-TinyMocker-0.03/t/05_multiple_mock.t000064400000000000000000000041231220537641700212020ustar00rootroot00000000000000use strict;
use warnings;

# this covers the exact same stuff from 01-mock.t
# but uses more than one method to override using "methods"

use Test::More;
use Test::TinyMocker;

{
    package Foo::Bar;
    sub baz { "day" }
    sub qux { "way" }
}

# original value
is Foo::Bar::baz(), "day", "first initial value is ok";
is Foo::Bar::qux(), "way", "second initial value is ok";

# basic syntax
mock('Foo::Bar', [ 'baz', 'qux' ], sub { return $_[0] + 1 });
cmp_ok Foo::Bar::baz(1), '==', 2, "basic syntax for baz";
cmp_ok Foo::Bar::qux(1), '==', 2, "basic syntax for qux";

mock 'Foo::Bar' => methods ['baz','qux'] => should { "night" };
is Foo::Bar::baz(), "night", "static mocked value for baz";
is Foo::Bar::qux(), "night", "static mocked value for qux";

my $counter = 0;

mock 'Foo::Bar' 
    => methods [ 'baz', 'qux' ]
    => should { $counter++; };

cmp_ok Foo::Bar::baz(), '==', 0, "dynamic mocked value for baz";
cmp_ok Foo::Bar::qux(), '==', 1, "dynamic mocked value for qux";
cmp_ok Foo::Bar::baz(), '==', 2, "dynamic mocked value for baz";
cmp_ok Foo::Bar::qux(), '==', 3, "dynamic mocked value for qux";

mock('Foo::Bar::baz', sub { return $_[0] + 3 });
mock('Foo::Bar::qux', sub { return $_[0] + 3 });
cmp_ok Foo::Bar::baz(1), '==', 4, "2 args syntax for baz";
cmp_ok Foo::Bar::qux(1), '==', 4, "2 args syntax for qux";

mock ['Foo::Bar::baz','Foo::Bar::qux']
    => should { $_[0] + 2 };
is Foo::Bar::baz(1), 3, "2 args syntax with sugar for baz";
is Foo::Bar::qux(1), 3, "2 args syntax with sugar for qux";

eval { mock };
like( $@, qr{useless use of mock with one}, "no call of mock without parameter" );

eval { mock 'Foo' };
like( $@, qr{useless use of mock with one}, "no call of mock with one parameter" );

eval { mock ['Foo','Bar'] };
like( $@, qr{useless use of mock with one}, "no call of mock with one parameter" );

eval { mock 'Foo::Bar' => method 'faked' => should { return } };
like( $@, qr{unknown symbol:}, "no mock non exists function" );

eval { mock 'Foo::Bar' => methods [ 'faked', 'baked' ] => should { return } };
like( $@, qr{unknown symbol:}, "no mock non exists function" );

done_testing;
perl-Test-TinyMocker-0.03/t/06_multiple_unmock.t000064400000000000000000000021521220537641700215460ustar00rootroot00000000000000use strict;
use warnings;

# this covers the exact same stuff from 02-unmock.t
# but uses more than one method to override using "methods"

use Test::More;
use Test::TinyMocker;

{
    package Foo::Bar;
    sub baz { "day" }
    sub qux { "way" }
}

# original value
is Foo::Bar::baz(), "day", "initial value for baz is ok";
is Foo::Bar::qux(), "way", "initial value for qux is ok";

# mock new comportement 
mock('Foo::Bar', [ 'baz', 'qux' ], sub { return 'night' });

# unmock
unmock('Foo::Bar', [ 'baz', 'qux' ]);
is Foo::Bar::baz(), "day", "original value for baz";
is Foo::Bar::qux(), "way", "original value for qux";

# mock new comportement 
mock('Foo::Bar', [ 'baz', 'qux' ], sub { return 'night' });

# unmock
unmock(['Foo::Bar::baz','Foo::Bar::qux']);
is Foo::Bar::baz(), "day", "original value for baz";
is Foo::Bar::qux(), "way", "original value for qux";

# mock new comportement 
mock('Foo::Bar', ['baz', 'qux'], sub { return 'night' });

# unmock
unmock 'Foo::Bar' => methods [ 'baz', 'qux' ];
is Foo::Bar::baz(), "day", "original value for baz";
is Foo::Bar::qux(), "way", "original value for qux";

done_testing;
perl-Test-TinyMocker-0.03/t/manifest.t000064400000000000000000000004201220537641700176340ustar00rootroot00000000000000#!perl -T

use strict;
use warnings;
use Test::More;

unless ( $ENV{RELEASE_TESTING} ) {
    plan( skip_all => "Author tests not required for installation" );
}

eval "use Test::CheckManifest 0.9";
plan skip_all => "Test::CheckManifest 0.9 required" if $@;
ok_manifest();
perl-Test-TinyMocker-0.03/t/pod-coverage.t000064400000000000000000000010471220537641700204070ustar00rootroot00000000000000use strict;
use warnings;
use Test::More;

# Ensure a recent version of Test::Pod::Coverage
my $min_tpc = 1.08;
eval "use Test::Pod::Coverage $min_tpc";
plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
    if $@;

# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
# but older versions don't recognize some common documentation styles
my $min_pc = 0.18;
eval "use Pod::Coverage $min_pc";
plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
    if $@;

all_pod_coverage_ok();
perl-Test-TinyMocker-0.03/t/pod.t000064400000000000000000000003501220537641700166120ustar00rootroot00000000000000#!perl -T

use strict;
use warnings;
use Test::More;

# Ensure a recent version of Test::Pod
my $min_tp = 1.22;
eval "use Test::Pod $min_tp";
plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;

all_pod_files_ok();