Perl closure demonstration

closures.t

package main;

use strict;
use warnings;

use Test::More 0.88;

my ( $add_two, $mul_two, $chg_two ) = make_closures( 2 );
my ( $add_four, $mul_four, $chg_four ) = make_closures( 4 );

note ' $add_two is ', $add_two;
note '$add_four is ', $add_four;
cmp_ok $add_two, '!=', $add_four,
    '$add_two != $add_four, though both execute the same code';

cmp_ok $add_two->( 3 ), '==', 5, '$add_two->( 3 ) gives 5';
cmp_ok $mul_two->( 3 ), '==', 6, '$mul_two->( 3 ) gives 6';
cmp_ok $add_four->( 3 ), '==', 7, '$add_four->( 3 ) gives 7';
cmp_ok $mul_four->( 3 ), '==', 12, '$mul_four->( 3 ) gives 12';

cmp_ok add_first( 3 ), '==', 5, 'add_first( 3 ) gives 5';

note 'Change the $add_two and $mul_two operand to 5';
$chg_two->( 5 );

cmp_ok $add_two->( 3 ), '==', 8, '$add_two->( 3 ) now gives 8';
cmp_ok $mul_two->( 3 ), '==', 15, '$mul_two->( 3 ) now gives 15';
cmp_ok $add_four->( 3 ), '==', 7, '$add_four->( 3 ) is still 7';
cmp_ok $mul_four->( 3 ), '==', 12, '$mul_four->(3 ) is still 12';

cmp_ok add_first( 3 ), '==', 8, 'add_first( 3 ) now gives 8';

cmp_ok increment(), '==', 0, 'First call to increment() gives 0';
cmp_ok increment(), '==', 1, 'Second call to increment() gives 1';
cmp_ok value(), '==', 2, 'value() gives 2, because increment() does a post-increment';
cmp_ok decrement(), '==', 1, 'First call to decrement() gives 1';
cmp_ok decrement(), '==', 0, 'Decond call to decrement() gives 0';

done_testing;

{
    my $number = 0;
    sub increment {
        return $number++;
    }
    sub decrement {
	return --$number;
    }
    sub value {
	return $number;
    }
}

sub make_closures {
    my ( $operand ) = @_;
    return(
	sub { $operand + $_[0] },
	sub { $operand * $_[0] },
	sub { $operand = $_[0] },
    );
    no warnings qw{ closure };
    sub add_first { $operand + $_[0] }
}

1;

# ex: set textwidth=72 :