#!perl -w
use strict;
use Test::More tests => 11;
use Data::Dumper;
use feature 'signatures';
no warnings 'experimental::signatures';
require Filter::signatures;
require B::Deparse;
# Eval code while still expanding it with source filters
sub compile {
my( $str ) = @_;
local $_ = $str;
Filter::signatures::transform_arguments();
return $_
};
sub normalize {
my( $str ) = @_;
my $compiled = eval $str;
die $@ if $@;
my $deparse = B::Deparse->new("-sC");
my $body = $deparse->coderef2text($compiled);
}
sub deparses_identical {
my( $str ) = @_;
my $transformed = normalize(compile($str));
my $native = normalize($str);
is $transformed, $native;
}
# Anonymous
$_ = <<'SUB';
sub ($name, $value) {
return "'$name' is '$value'"
};
SUB
deparses_identical( $_ );
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Anonymous subroutines get converted";
sub { my ($name,$value)=@_;
return "'$name' is '$value'"
};
RESULT
deparses_identical( $_ );
$_ = <<'SUB';
sub foo5 () {
return "We can call a sub without parameters"
};
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Parameterless subroutines don't get converted";
sub foo5 { @_==0 or warn "Subroutine foo5 called with parameters.";
return "We can call a sub without parameters"
};
RESULT
# Function default parameters
$_ = <<'SUB';
sub mylog($msg, $when=time) {
print "[$when] $msg\n";
};
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Function default parameters get converted";
sub mylog { my ($msg,$when)=@_;$when=time if @_ <= 1;
print "[$when] $msg\n";
};
RESULT
# Empty parameter list
$_ = <<'SUB';
sub mysub() {
print "Yey\n";
};
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Functions without parameters get converted properly";
sub mysub { @_==0 or warn "Subroutine mysub called with parameters.";
print "Yey\n";
};
RESULT
# Discarding parameters
$_ = <<'SUB';
sub mysub($) {
print "Yey\n";
};
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Functions with unnamed parameters get converted properly";
sub mysub { my (undef)=@_;
print "Yey\n";
};
RESULT
# Discarding parameters
$_ = <<'SUB';
sub mysub($foo, $, $bar) {
print "Yey, $foo => $bar\n";
};
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Functions without parameters get converted properly";
sub mysub { my ($foo,undef,$bar)=@_;
print "Yey, $foo => $bar\n";
};
RESULT
# Signature-less functions remain unchanged
$_ = <<'SUB';
sub mysub {
print "Yey\n";
};
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Named functions without signature remain unchanged";
sub mysub {
print "Yey\n";
};
RESULT
$_ = <<'SUB';
sub {
print "Yey\n";
};
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "Named functions without signature remain unchanged";
sub {
print "Yey\n";
};
RESULT
$_ = <<'SUB';
sub foo($bar,$baz) { print "Yey\n"; }
SUB
Filter::signatures::transform_arguments();
is $_, <<'RESULT', "RT #xxxxxx Single-line functions work";
sub foo { my ($bar,$baz)=@_; print "Yey\n"; }
RESULT
done_testing;