view release on metacpan or  search on metacpan

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

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);

t/80preprocessor_math.t  view on Meta::CPAN

    0.3
    3.0
    .3
    -7
    +.3
    -.19
/;
foreach my $math_term (@math_terms) {
    ok $CLASS->_simple_math_term($math_term), "$math_term matches : simple math term";
}
my @not_math_terms = qw/
    x
    y_
    .
    _
    _y
    _9
/;
foreach my $not_math_term (@not_math_terms) {
    ok ! $CLASS->_simple_math_term($not_math_term), "$not_math_term should not match : simple math term";
}

foreach my $op (qw{- + * / % **}) {
    ok $CLASS->_op($op), "$op matches : op";
}

foreach my $not_op (qw{ . _ ( ) }) {
    ok ! $CLASS->_op($not_op), "$not_op should not match :  op";
}
 
my @rhs = (
    '3',
    'A%2',
    'A % 2',
    '17.2 * A % 2',
    'A+B+C+D+2',
    '7/2 ** 4',
);
foreach my $simple_rhs (@rhs) {
    ok $CLASS->_simple_rhs($simple_rhs), "$simple_rhs matches : simple rhs";
}

my @not_rhs = (
    '(3)',
    'A]2',
    'A _ 2',
    '3 3',
    '% 3',
    '2 + 2 + Y -',
);
foreach my $not_simple_rhs (@not_rhs) {
    ok ! $CLASS->_simple_rhs($not_simple_rhs), "$not_simple_rhs should not match : simple rhs";
}

my @simple_group_term = (
    '(3)',
    '( A%2)',
    '(A % 2 )',
    '(17.2 * A % 2 )',
    '(A+B/C+D+2)',
);
foreach my $simple_group_term (@simple_group_term) {
    ok $CLASS->_simple_group_term($simple_group_term), "$simple_group_term matches : simple group term";
}

my @not_simple_group_term = (
    '((3))',
    '( A%2',
    '(A % 2 ))',
    '(17.2 * (A) % 2 )',
    '(A+B/)C+D+2)',
);
foreach my $not_simple_group_term (@not_simple_group_term) {
    ok ! $CLASS->_simple_group_term($not_simple_group_term), "$not_simple_group_term should not match : simple group term";
}
my @math_term = (
    '3',
    '0.3',
    '3.0',
    '(3)',
    '.3',
    '-.3',
    '( A%2)',
    '(A % 2 )',
    '(17.2 * A % 2 )',
    '(A+B/C+D+2)',
);
foreach my $math_term (@math_term) {
    ok $CLASS->_math_term($math_term), "$math_term matches : math term";
}

my @not_math_term = (
    'x',
    'y_',
    ' % _',
    '3 + ',
    '- 0.3',
);
foreach my $not_math_term (@not_math_term) {
    ok ! $CLASS->_math_term($not_math_term), "$not_math_term should not match : math term";
}

my @complex_rhs = (
    'X',
    'Y_',
    '3',
    '.3',
    '3.0',
    '(3)',
    '( A%2)',
    '(A % 2 )',
    '(17.2 * A % 2 )',
    '(A+B/C+D+2)',
    '2 + (3)',
    '( A%2) / 3 * (2+2)',
);
foreach my $complex_rhs (@complex_rhs) {
    ok $CLASS->_complex_rhs($complex_rhs), "$complex_rhs matches : complex rhs";
}

my @not_complex_rhs = (
    'x',
    '_Y',
    '3)',
);
foreach my $not_complex_rhs (@not_complex_rhs) {
    ok ! $CLASS->_complex_rhs($not_complex_rhs), "$not_complex_rhs should not match : complex rhs";
}

#print $CLASS->expression;
my @complex_group_term = (
    '( X )',
    '( Y_ )',
    '( 3 )',
    '( .3 )',
    '( 3.0 )',
    '( (3) )',

t/80preprocessor_math.t  view on Meta::CPAN

    '( (A % 2 ) )',
    '( (17.2 * A % 2 ) )',
    '( (A+B/C+D+2))',
    '(2 + (3))',
    '( ( A%2) / 3 * (2+2) )',
);
foreach my $complex_group_term (@complex_group_term) {
    ok $CLASS->_complex_group_term($complex_group_term), "$complex_group_term matches : complex group term";
}

my @not_complex_group_term = (
    '( x )',
    '()',
    '( 3',
    '( .3 ))',
    '(( 3.)0 )',
    '(( A%2 )',
    '( (A+B/(C+D+2))',
    '( ( A%2) (/) 3 * (2+2) )',
);
foreach my $not_complex_group_term (@not_complex_group_term) {
    ok ! $CLASS->_complex_group_term($not_complex_group_term), "$not_complex_group_term should not match : complex group term";
}

can_ok $CLASS, '_lex';
my $rhs = '3';
is_deeply $CLASS->_lex($rhs), [[qw/ ATOM 3 /]], "$rhs : lexes properly";

$rhs = 'A + 3';
is_deeply $CLASS->_lex($rhs), [
    [qw/ ATOM A /],
    [qw/ OP   + /],