Perl calling subroutine reference with explicit additional scope as cleanly as possible

user_931154 0
Viewed 82

I'd like to be able to write something like the following...

call_with_scope({
    x => 47,
}, sub {
    printf "$x\n";
    printf "$y\n";
});

Where $y is bound in the environment containing the expression (either lexically or dynamically depending on the symbol).

I've found a way to do it, but it requires no strict "vars" to be in effect in the expression containing call_with_scope(...) and the implementation of call_with_scope uses eval to create local bindings before transferring control to the callback.

Is there a way to avoid either requiring no strict "vars" at the call site or refer to and change the value of a local variable without resorting to eval?

For completeness, the code snippet below implements call_with_scope and prints 47 and then 48.

#!/usr/bin/env perl
use strict;
use warnings;

sub call_with_scope {
    my ($env, $func) = @_;
    my %property;
    my @preamble;
    foreach my $k (keys %$env) {
        $property{$k} = $env->{$k};
        # deliberately omitted: logic to ensure that ${$k} is a well-formed variable
        push @preamble, "local \$$k = \$property{'$k'};";
    }
    # force scalar context
    do {
        my $str = join('', 'no strict "vars";', @preamble, '$_[1]->();');
        return scalar(eval($str));
    };
}                        

do {
    no strict 'vars';
    local $x;
    my $y = 48;
    call_with_scope(
        {
            x => 47,
        },
        sub {
            printf "$x\n";
            printf "$y\n";
        }
    );
};
perl
2 Answers

I'm trying to write something kind of like Test::LectroTest ... except that instead of using a source filter and comments like in Property { ##[ x <- Int, y <- Int ]## <body> } ... I want to write something like Property({x => gen_int, y => gen_int}, sub { <body> }) where $x and $y inside body get their values when an "instantiation" of a property test is performed.

You can do this by defining $x and $y as globals in the caller's package.

no strict 'refs';
my $caller = caller;
for my $var (keys %$properties) {
    *{$caller.'::'.$var} = $properties->{$var};
}
$code->();

But this can't be easily localized. And polluting the caller's namespace with globals potentially leads to mysterious data leaking between tests. In general, use as little magic as possible in a test library; the user will have enough of their own weird magic to debug.

Instead, provide a function which returns the properties. For example, p.

package LectroTest;

use Exporter qw(import);
our @EXPORT = qw(test p);
our $P;

sub test {
    my($props, $test) = @_;

    local $P = $props;
    $test->();
}

sub p {
    return $P;
}

And the test looks like:

use LectroTest;

test(
    { x => 42 }, sub { print p->{x} }
);
user_146600

The problem is that the anon sub is compiled before call_with_scope is called, so there's no chance for call_with_scope to declare variables for that sub.

Any reason you're not using arguments like any other sub?

call_with_scope([ 47 ], sub {
   my ($x) = @_;
   printf "%s\n", $x;
   printf "%s\n", $y;
});

It's not any longer!

Here's an alternative if you're ok in declaring $x outside of the sub.

use strict;
use warnings;

use PadWalker qw( closed_over );

sub call_with_scope {
   my ($inits, $cb) = @_;
   my $captures = closed_over($cb);
   for my $var_name_with_sigil (keys(%$captures)) {
      my ($var_name) = $var_name_with_sigil =~ /^\$(.*)/s
         or next;

      $inits->{$var_name}
         or next;

      ${ $captures->{$var_name_with_sigil} } = $inits->{$var_name};
   }

   return $cb->();
}

{
   my $x;
   my $y = 48;
   call_with_scope({
      x => 47,
   }, sub {
      printf "%s\n", $x;
      printf "%s\n", $y;
  });
}

This works because variables are created at compile-time and cleared on scope exit.

It even works if sub was compiled in a different scope and package than the call to call_with_scope.

{
   my $sub = do {
      my $x;
      my $y = 48;
      sub {
         printf "%s\n", $x;
         printf "%s\n", $y;
      }
   };

   call_with_scope({ x => 47 }, $sub);
}

But do you really want that kind of magic in your program?

user_5899240
Related