First few steps of porting `wrong` to Perl. This is stupid.

Wrong.pm

# `wrong` in Perl. https://github.com/sconover/wrong
#
#

=head1 SYNOPSIS

    #!perl

    use strict;
    use warnings;

    use Test::More;
    use Acme::Wrong;

    my $x = 7;
    my $y = 12;

    Acme::Wrong::wrong(
        "Something something",
        sub {
            ( $x == 7 ) and ( $y == 11 );
        }
    );

    done_testing;

Gives:

    # ($x==7) #=> 1
    #     and
    # ($y==11) #=> ''
    not ok 1 - Something something
    #   Failed test 'Something something'

=cut


package Acme::Wrong;

use strict;
use warnings;

use Test::More;
use PPI::Document;

use PadWalker qw/peek_my/;

sub wrong {
    my ( $name, $block ) = @_;
    my $result = $block->();
    if ($result) {
        ok( 1, $name );
    }
    else {
        warn "Failed";
        use Data::Printer;
        my ( $package, $file, $line ) = caller();

        my $document = PPI::Document->new($file);

        my ($subs) = grep { $_->finish->line_number <= $line; }
            reverse @{ $document->find('PPI::Structure::Block') };

        my ($final_statement)
            = reverse grep { $_->significant } $subs->children;
        $final_statement->prune('PPI::Token::Whitespace');

        my @children
            = ( $final_statement->can('children') )
            ? $final_statement->children
            : ($final_statement);

        my @cache;
        for my $child (@children) {
            my $content = $child->content;
            if ( $child->isa('PPI::Token::Operator') ) {
                diag( "    " . $child->content );
            }
            else {
                my $vars = peek_my(1);
                my $defs = (
                    join '; ',
                    map { 'my ' . $_ . ' = ' . ${ $vars->{$_} } } keys %$vars
                ) . ';undef;';
                diag(
                    $content . " #=> "
                        . (
                        ( ( eval $defs . $content ) // '(undefined)' )
                            || "''"
                        )
                );
            }
        }

        ok( 0, $name );
    }
}

1;