#!/usr/bin/perl package Blondie::TestPrograms; use base qw/Exporter/; use strict; use warnings; use Blondie::Nodes; use Test::Deep; use Test::Exception; our @EXPORT = qw/smoke_runtime/; my @progs = ( { ast => App( Sym('&infix:<+>'), Val(2), Val(2) ), result => 4, name => "simple addition", }, { ast => App( Sym('&infix:<+>'), App( Sym('&infix:<+>'), Val(1), Val(2) ), App( Sym('&infix:<+>'), Val(3), Val(4) ), ), result => 10, name => "nested addition", }, { ast => App( Sym('&infix:<~>'), Val('foo'), Val('bar'), ), result => 'foobar', name => "simple concatenation", }, { ast => App( Sym('&infix:<*>'), Val(2), Val(3), ), result => 6, name => "simple multiplication", }, { ast => App( Val( Thunk( Seq( Param('$x'), App( Sym('&infix:<+>'), Sym('$x'), Val(2), ), ), ), ), Val(2), ), result => 4, name => "user sub as value", }, { ast => App( Val( Thunk( Seq( Param('&f'), App( Sym('&f'), Val(2), ), ), ), ), Val( Thunk( Seq( Param('$x'), App( Sym('&infix:<+>'), Val(2), Sym('$x'), ), ), ), ), ), result => 4, name => "higher order function", }, { ast => App( Val( Thunk( Seq( Param('&fact'), App( Sym('&fact'), Val(5), ), ), ), ), Val( Thunk( Seq( Param('$n'), App( Sym('&control_structure:'), App( Sym('&infix:<==>'), Sym('$n'), Val(0), ), Val( Thunk( Val(1), ), ), Val( Thunk( App( Sym('&infix:<*>'), Sym('$n'), App( Sym('&fact'), App( Sym('&infix:<->'), Sym('$n'), Val(1), ), ), ), ), ), ), ), ), ), ), result => 120, name => "recursion via dynamic scope", }, ); sub smoke_runtime { my $runtime_class = shift; foreach my $prog (@progs) { my $r = $runtime_class->new; my $result; lives_ok { $result = $r->run($prog->{ast}); } "${runtime_class}->run($prog->{name}) is non-fatal"; cmp_deeply( $result, $prog->{result}, "correct results for $prog->{name}", ); } } __PACKAGE__; __END__ =pod =head1 NAME Blondie::TestPrograms - =head1 SYNOPSIS use Blondie::TestPrograms; =head1 DESCRIPTION =cut