view release on metacpan or  search on metacpan

t/with.t  view on Meta::CPAN

#!/usr/bin/perl

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

# We are testing a PadWalker-based implementation of:
#
#   with(\%hash, sub { ... });
#
# Contract:
#   - First arg: hashref
#   - Second arg: coderef
#   - Lexicals to be aliased (e.g. $a, $x) must be declared
#	 in the *outer* scope and closed over by the coderef.
#
# Example:
#   my %h = ( a => 'b' );
#   my ($a);
#   with(\%h, sub { print $a });   # $a aliases $h{a}
#
# This is required because PadWalker::closed_over only sees
# lexicals that are closed over, not those declared inside
# the coderef itself.

use_ok('Syntax::Feature::With');

# ----------------------------------------------------------------------
# Basic aliasing: $a should alias $h{a}
# ----------------------------------------------------------------------

{
	my %h = ( a => 'b' );

	# Declare the lexical in the outer scope so the coderef closes over it.
	my $a;

	my $result = with(\%h, sub {
		# $a is *not* declared here; it is closed over from outside.
		return $a;
	});

	is($result, 'b', 'basic aliasing: $a aliases $h{a}');
}

# ----------------------------------------------------------------------
# Read/write aliasing: assignments should write back into the hash
# ----------------------------------------------------------------------

{
	my %h = ( x => 10, y => 20 );

	my ($x, $y);

	with(\%h, sub {
		$x += 5;   # should update $h{x}
		$y = 99;   # should update $h{y}
	});

	is($h{x}, 15, 'writeback: $x += 5 updates $h{x}');
	is($h{y}, 99, 'writeback: $y = 99 updates $h{y}');
}

# ----------------------------------------------------------------------
# Only valid Perl identifiers should be aliased
# Keys like "1abc" or "foo-bar" should be ignored
# ----------------------------------------------------------------------

{
	my %h = (
		good	  => 'ok',
		'1bad'	=> 'no',
		'foo-bar' => 'nope',
	);

	my $good;   # only this one is a valid identifier

	my $seen;

	with(\%h, sub {
		$seen = $good;
	});