How to implement assert in Perl?

Question

When trying to implement C's assert() macro in Perl, there is some fundamental problem. Consider this code first:

sub assert($$) {
   my ($assertion, $failure_msg) = @_;
   die $failure_msg unless $assertion;
}

# ...
assert($boolean, $message);

While this works, it's not like C: In C I'd write assert($foo <= $bar), but with this implementation I'd have to write assert($foo <= $bar, '$foo <= $bar'), i.e. repeat the condition as string.

Now I wonder how to implement this efficiently. The easy variant seems to pass the string to assert() and use eval to evaluate the string, but you can't access the variables when evaluating eval. Even if it would work, it would be quite inefficient as the condition is parsed and evaluated each time.

When passing the expression, I have no idea how to make a string from it, especially as it's evaluated already.

Another variant using assert(sub { $condition }) where it's likely easier to make a string from the code ref, is considered too ugly.

The construct assert(sub { (eval $_[0], $_[0]) }->("condition")); with

sub assert($)
{
    die "Assertion failed: $_[1]\n" unless $_[0];
}

would do, but is ugly to call. The solution I am looking for is to write the condition to check only once, while being able to reproduce the original (non-evaluated) condition and efficiently evaluate the condition.

So what are more elegant solutions? Obviously solutions would be easier if Perl had a macro or comparable syntax mechanism that allows transforming the input before compiling or evaluating.

Answer 1

Use B::Deparse?

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

use B::Deparse;
my $deparser = B::Deparse->new();

sub assert(&) {
    my($condfunc) = @_;
    my @caller    = caller();
    unless ($condfunc->()) {
        my $src = $deparser->coderef2text($condfunc);
        $src =~ s/^\s*use\s.*$//mg;
        $src =~ s/^\s+(.+?)/$1/mg;
        $src =~ s/(.+?)\s+$/$1/mg;
        $src =~ s/[\r\n]+/ /mg;
        $src =~ s/^\{\s*(.+?)\s*\}$/$1/g;
        $src =~ s/;$//mg;
        die "Assertion failed: $src at $caller[1] line $caller[2].\n";
    }
}

my $var;
assert { 1 };
#assert { 0 };
assert { defined($var) };

exit 0;

Test output:

$ perl dummy.pl
Assertion failed: defined $var at dummy.pl line 26.