package Lambda;

use strict;
use warnings;

use Exporter qw( import );

our @EXPORT = qw( lambda );

sub _on_destroy(&@) {
    return bless([@_], 'Lambda::OnDestroy');
}

sub Lambda::OnDestroy::DESTROY {
    my ($self) = @_;
    my ($cb, @args) = @$self;
    $cb->(@args) if $cb;
}

sub lambda {
    my $xr = \$_[0];
    my $f  =  $_[1];
    return sub {
        my $temp = $$xr;
        $$xr = $_[0];
        my $sentry = _on_destroy { $$xr = $temp; };
        return $f->();
    }
}

1;

##</code><code>##

use strict;
use warnings;

use Test::More tests => 10;

BEGIN { use_ok('Lambda') }

{
   my $x;
   my $f = lambda($x => sub { $x });
   is($f->('lex'), 'lex', 'lex1');
   is($f->('LEX'), 'LEX', 'lex2');
   is($x, undef, 'lex restore');
}

{
   local our $x;
   my $f = lambda($x => sub { $x });
   is($f->('pkg'), 'pkg', 'pkg1');
   is($f->('PKG'), 'PKG', 'pkg2');
   is($x, undef, 'pkg restore');
}

{
    my $f = do {
        my $x;
        lambda($x => sub { $x })
    };

    is($f->('out of scope'), 'out of scope', 'out of scope');
}

{
   my $y = 'test';
   my $x;
   lambda($x => sub { $x = uc($x) })->($y);
   is($y, 'TEST', 'alias');
}

{
    package Unfetchable;
    use Tie::Scalar qw( );
    our @ISA = 'Tie::StdScalar';
    sub FETCH { }
}

{
   tie my $x, 'Unfetchable';
   my $f = lambda($x => sub { $x });
   is($f->('test'), 'test', 'tied');
}

##</code><code>##

1..10
ok 1 - use Lambda;
ok 2 - lex1
ok 3 - lex2
ok 4 - lex restore
ok 5 - pkg1
ok 6 - pkg2
ok 7 - pkg restore
ok 8 - out of scope
not ok 9 - alias
#   Failed test 'alias'
#   at a.pl line 37.
#          got: 'test'
#     expected: 'TEST'
not ok 10 - tied
#   Failed test 'tied'
#   at a.pl line 50.
#          got: undef
#     expected: 'test'
# Looks like you failed 2 tests of 10.

##</code><code>##

package Lambda;

use strict;
use warnings;

use Exporter qw( import );

our @EXPORT = qw( lambda );

sub lambda(&) {
    my ($f) = @_;
    return sub {
        return $f->() for $_[0];
    }
}

1;

##</code><code>##

use strict;
use warnings;

use Test::More tests => 6;

BEGIN { use_ok('Lambda') }

{
   local $_;
   my $f = lambda { $_ };
   is($f->('test'), 'test', 'test1');
   is($f->('TEST'), 'TEST', 'test2');
   is($_, undef, 'restore');
}

{
   my $y = 'test';
   ( lambda { $_ = uc($_) } )->($y);
   is($y, 'TEST', 'alias');
}

{
    package Unfetchable;
    use Tie::Scalar qw( );
    our @ISA = 'Tie::StdScalar';
    sub FETCH { }
}

{
   local $_;
   tie $_, 'Unfetchable';
   my $f = lambda { $_ };
   is($f->('test'), 'test', 'tied');
}

##</code><code>##

1..6
ok 1 - use Lambda;
ok 2 - test1
ok 3 - test2
ok 4 - restore
ok 5 - alias
ok 6 - tied