FunctionalPerl

 view release on metacpan or  search on metacpan

lib/FP/Trampoline.pm  view on Meta::CPAN

use warnings;
use warnings FATAL => 'uninitialized';
use Exporter "import";

our @EXPORT      = qw(T TC trampoline);
our @EXPORT_OK   = qw();
our %EXPORT_TAGS = (all => [@EXPORT, @EXPORT_OK]);

use FP::Carp;

sub T (&) {
    bless $_[0], "FP::Trampoline::Continuation"
}

sub TC {
    bless [@_], "FP::Trampoline::Call"
}

sub trampoline {
    @_ == 1 or fp_croak_arity 1;
    my ($v) = @_;

t/examples-csv-to-json.t  view on Meta::CPAN

sub stripCR($str) {
    $str =~ s/\r//;
}

sub cmp_stripCR ($a, $b) {
    stripCR(xslurp($a)) eq stripCR(xslurp($b))
}

# /move

sub t ($direct_mode, $result_file, @options) {
    local $ENV{GIT_PAGER} = "";    # disable git calling a pager
    my $inpath      = "t/examples-csv-to-json.data/a.csv";
    my $result_path = "t/examples-csv-to-json.data/$result_file";
    my $outpath     = $direct_mode ? $result_path : "$result_path-out";
    xxsystem_safe $^X, "examples/csv-to-json", $inpath, @options, $outpath;
    if ($direct_mode) {
        0 == xsystem_safe(qw(git diff --exit-code), $result_path)
    } else {

  # 0 == xxsystem_safe(qw(diff --strip-trailing-cr -u), $result_path, $outpath);

t/perl/__SUB__-gc  view on Meta::CPAN

        # warn "f called";
        my $f = __SUB__;

        sub ($z) {
            $z < 1000 ? $f->($x * $y)->($z + $y) : $z
        }
    }
}

# Now show that this doesn't leak:
sub t ($n) {
    my $res;
    for (1 .. $n) {
        $res = foo(50)->(30)->(30);
    }
    $res
}

warn
    "Please verify manually from outside (e.g. `top`) that this process, pid $$, doesn't increase memory usage over time";

t/perl/goto-leak  view on Meta::CPAN

            $tot
        }
    }
}

# -----------------------------------------------------------
# variant using trampolines to implement tail call optimization, also
# confirming that the algorithm is sane and that it's got something to
# do with how perl handles goto &$coderef / stack memory or so.

sub T (&) {
    bless $_[0], "TrampolineContinuation"
}

sub trampoline {
    @_ == 1 or fp_croak_arity 1;
    my ($v) = @_;
    while (ref($v) eq "TrampolineContinuation") {
        $v = &$v()
    }
    $v