#!/usr/bin/perl # '$Id: 70builtins.t,v 1.7 2005/08/06 23:28:40 ovid Exp $'; use warnings; use strict; use Test::More; BEGIN { eval q{ use Test::MockModule; use Test::Differences}; if ($@) { plan skip_all => "Test::MockModule, Test::Differences required for this"; } else { plan tests => 39; } } #use Test::More qw/no_plan/; use Clone qw/clone/; BEGIN { chdir 't' if -d 't'; unshift @INC => '../lib'; } use aliased 'AI::Prolog'; use aliased 'AI::Prolog::Engine'; use aliased 'AI::Prolog::KnowledgeBase'; my $database = <<'END_PROLOG'; thief(badguy). thief(thug). steals(PERP,X) :- if(thief(PERP), eq(X,rubies), eq(X,nothing)). p(X) :- call(steals(badguy,rubies)). q(X) :- call(steals(badguy,X)). valuable(gold). valuable(rubies). END_PROLOG Engine->formatted(1); my $prolog = Prolog->new($database); $prolog->query("p(ovid)"); is $prolog->results, 'p(ovid)', 'call(X) should behave correctly'; # # I think it's failing because the call contains an if and # if is defined in terms of once() and once is defined with # a cut and I don't quite have the cut correct # my $boostrap_db = clone($database); eq_or_diff $database, $boostrap_db, '... and the database should not change after its bootstrapped'; $prolog->query("q(X)"); is $prolog->results, 'q(rubies)', '... even if called with a variable'; $prolog->query('eq(this,this)'); is $prolog->results, "eq(this, this)", 'eq(X,Y) should succeed if the predicate are equal'; $prolog->query("eq(this,that)."); ok ! $prolog->results, '... and it should fail if the predicate are not equal'; $prolog->query("steals(badguy,X)."); is $prolog->results, 'steals(badguy, rubies)', 'if(X,Y,Z) should call Y if X is satisfied'; ok ! $prolog->results, '... and it should only provide correct results'; $prolog->query("steals(ovid,X)."); is $prolog->results, 'steals(ovid, nothing)', '... and it should call Z if X cannot be satisfied'; ok ! $prolog->results, '... and it should only provide correct results'; my $faux_engine = Test::MockModule->new(Engine); my @stdout; $faux_engine->mock(_print => sub { push @stdout => @_ }); $prolog->query("nl."); $prolog->results; is_deeply \@stdout, ["\n"], "nl should print a newline"; $prolog->query("not(thief(ovid))."); is $prolog->results, 'not(thief(ovid))', 'not() should succeed if query cannot be proven'; $prolog->query("not(thief(badguy))."); ok ! $prolog->results, '... and it should fail if the query can be proven'; $prolog->query("once(valuable(X))."); is $prolog->results, 'once(valuable(gold))', 'once should return the first successful goal'; ok ! $prolog->results, '... but it should not return more results even if they exist'; $prolog->query("or(thief(badguy),thief(ovid))."); is $prolog->results, 'or(thief(badguy), thief(ovid))', 'or should succeed if one of its goals can succeed.'; $prolog->query("or(thief(ovid),thief(badguy))."); is $prolog->results, 'or(thief(ovid), thief(badguy))', '... regardless of the order they are in'; $prolog->query("or(thief(thug),thief(badguy))."); is $prolog->results, 'or(thief(thug), thief(badguy))', '... and it should succeed if both of its goals can succeed'; $prolog->query("or(thief(kudra),thief(ovid))."); ok ! $prolog->results, '... but it should fail if none of its goals can succeed'; @stdout = (); $prolog->query("print(badguy)."); $prolog->results; is_deeply \@stdout, ["badguy"], "print/1 should print what we give it."; @stdout = (); $prolog->query("println(badguy)."); $prolog->results; is_deeply \@stdout, ["badguy\n"], "println/1 should print what we give it, but with a newline at the end."; @stdout = (); $prolog->query("if(steals(ovid,X),print(X),print(false))."); $prolog->results; is_deeply \@stdout, ["nothing"], '... even if it is printing a variable'; $prolog->do("assert(loves(ovid,perl))."); $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'; }