view release on metacpan or  search on metacpan

t/70builtins.t  view on Meta::CPAN

$prolog->query("loves(ovid,X)");
is $prolog->results, "loves(ovid, perl)", 'assert(X) should let us add new facts to the db';

$prolog->do("assert(loves(bob,stuff))");
$prolog->query('loves(bob,Y)');
is $prolog->results, 'loves(bob, stuff)',
    '... and we should be able to add more than one fact';
$prolog->query("loves(ovid,X)");
is $prolog->results, "loves(ovid, perl)", '... and it shoud not interfere with previous facts';

$prolog->do("assert(loves(sally, X))");
$prolog->query('loves(sally,Y)');
is $prolog->results, 'loves(sally, A)',
    '... and we should be able to assert a fact with a variable';

$prolog->query('loves(sally, food)');
is $prolog->results, 'loves(sally, food)',
    '... and it should behave as expected';
$prolog->query('loves(sally,X)');
is $prolog->results, 'loves(sally, A)',
    '... and the asserted fact should remain unchanged.';

$prolog->do("retract(loves(ovid,perl)).");
$prolog->query("loves(ovid,X)");
ok ! $prolog->results,
    "retract(X) should remove a fact from the database";

my @test_me;
sub test_me {
    my ( $first, $second, $third, $fourth ) = @_;
    @test_me = ( "\L$first", "\U$second", "\u$third", $fourth );
    return;
}
$prolog->query(q{perlcall2( "test_me", ["FIND ME","and me","also me", 42] ).});
ok $prolog->results, 'Called a perl function ok';
is_deeply \@test_me, ["find me","AND ME", "Also me", 42],
    'Perl function got results ok';

@test_me = ();
$prolog->query(q{perlcall2( X, ["Uh..."] ).});
ok ! $prolog->results, "Didn't call an unknown perl function";

TODO: {
    local $TODO = "Can't prohibit unbound values in perlcall/2";
    @test_me = ();
    $prolog->query(q{perlcall2( "test_me", ["Uh...", X] ).});
    ok ! $prolog->results, "Didn't call a perl function w/ unknown variables";
}

ok $prolog = Prolog->new(<<'END_PROLOG'), 'We should be able to parse a cut (!) operator';
append([], X, X) :- !.
append([W|X],Y,[W|Z]) :- append(X,Y,Z).
END_PROLOG
$prolog->query('append(X,Y,[a,b,c,d])');
is $prolog->results, 'append([], [a,b,c,d], [a,b,c,d])',
    '... and it should return the correct results';
ok ! $prolog->results, '... and halt backtracking appropriately';

$prolog = Prolog->new(<<'END_PROLOG');
test_var(VAR,X) :-
  if(var(VAR), eq(X,is_var), eq(X,not_var)).
END_PROLOG
$prolog->query('test_var(X, Y)');
is $prolog->results, 'test_var(A, is_var)', 'var(X) should evaluate to true';
$prolog->query('test_var(42, Y)');
is $prolog->results, 'test_var(42, not_var)',
    '... and var(42) should evaluate to not true';
$prolog->query('test_var(ovid, Y)');
is $prolog->results, 'test_var(ovid, not_var)',
    '... and var(ovid) should evaluate to not true';

{
    my $faux_kb = Test::MockModule->new(KnowledgeBase);
    my @stdout;
    $faux_kb->mock(_print => sub { push @stdout => @_ });
    $prolog->query('listing.');
    $prolog->results;
    my $results = join ''=> @stdout;
    my $count = ($results =~ s/(\d+\.\s+\w+\/\d+:)//g);
    ok $count, 'listing should display a listing of the database';
}