[Compbench-devel] CompBenchmarks++/CBM-PI/t 05-CEL.pl,NONE,1.1

[Frederic T. <xf...@us...>]

Update of /cvsroot/compbench/CompBenchmarks++/CBM-PI/t
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv27181

Added Files:
	05-CEL.pl 
Log Message:
First import.

--- NEW FILE: 05-CEL.pl ---
#!/usr/bin/perl -w -I ..
use strict;
use CBM;

my $sys;

push(@INC, "lib");
require "libtest.pl";

use Test::Simple tests => 84;

our $top_srcdir;

my $T;
my $F;

sub test_str {
  my $str = new CBM::CelStr("xYz");
  my $str2 = new CBM::CelStr("000");

  ok($str->Evaluate() eq "xYz", "CelStr works");

  my $c0 = new CBM::CelStrConcat();
  ok($c0->Evaluate() eq "", "CelStrConcat returns an empty string");
  $c0->add($str);
  $c0->add($str2);

  my $e = $c0->Evaluate();
  ok($e eq "xYz000", "CelStrConcat works (has $e)");
}

sub test_logic_or {
  my $or0 = new CBM::CelLogicOr();
  my $or1 = new CBM::CelLogicOr();

  $or0->add($F);
  $or0->add($F);

  ok($or0->Evaluate() eq "0", "F or F is F");

  $or1->add($F);
  $or1->add($T);

  ok($or0->Evaluate() eq "0", "F or T is T");

  $or0->add($or1);
  ok($or0->Evaluate() eq "1", "F or T is T");
}


sub test_logic_and {
  my $and0 = new CBM::CelLogicAnd();
  my $and1 = new CBM::CelLogicAnd();

  $and0->add($F);
  $and0->add($T);

  ok($and0->Evaluate() eq "0", "F and T is F");

  $and1->add($T);
  $and1->add($T);

  ok($and1->Evaluate() eq "1", "T and T is T");

  $and0->add($and1);
  ok($and0->Evaluate() eq "0", "F and T is F");
}

sub test_version_simple {
  my @V = ('0.0.0',
	   '0.0',
	   '0.0.0.0',
	   '0.1',
	   '1.0',
	   '1.0.0.0',
	   '0.1.0',
	   '0.1.0.0',
	   '2.95.0',
	   '2.96.3',
	   '2.96.3.1',
	   '2.96.4.10',
	   '4.2.5');
  my %V = ('0.0.0' => '00000000',
	   '0.0' => '00000000',
	   '0.0.0.0' => '00000000',
	   '0.1' => '00000001',
	   '1.0' => '00000100',
	   '1.0.0.0' => '01000000',
	   '0.1.0' => '00000100',
	   '0.1.0.0' => '00010000',
	   '2.95.0' => '00029500',
	   '2.96.3' => '00029603',
	   '2.96.3.1' => '02960301',
	   '2.96.4.10' => '02960410',
	   '4.2.5' => '00040205');

  my $v;

  foreach $v (@V) {
    my $v0 = new CBM::CelVersion($v);
    my $e;

    $e=$v0->Evaluate();
    ok($e eq $V{$v}, "$v version object is $V{$v} - (has $e)");
  }
}

sub test_math {
  my $v0 = new CBM::CelStr("0");
  my $v1 = new CBM::CelStr("102");
  my $I0 = new CBM::CelMathInc();
  my $I1 = new CBM::CelMathInc();

  $I0->add($v0);
  ok($I0->Evaluate() eq "1", "inc(0) is 1");

  $I1->add($v1);
  ok($I1->Evaluate() eq "103", "inc(102) is 103");

  my $dv0 = new CBM::CelStr("1");
  my $dv1 = new CBM::CelStr("102");
  my $dI0 = new CBM::CelMathDec();
  my $dI1 = new CBM::CelMathDec();

  $dI0->add($dv0);
  ok($dI0->Evaluate() eq "0", "dec(1) is 0");

  $dI1->add($dv1);
  ok($dI1->Evaluate() eq "101", "inc(102) is 101");

}

sub test_logic {
  $T = new CBM::CelLogicTrue();
  $F = new CBM::CelLogicFalse();

  ok($T->Evaluate() eq "1", "True is 1");
  ok($F->Evaluate() eq "0", "False is 0");

  test_logic_or();
  test_logic_and();
  test_version_simple();

  my $n0 = new CBM::CelLogicNot();
  $n0->add($T);

  ok($n0->Evaluate() eq "0", "Not(T) is F");

  my $n1 = new CBM::CelLogicNot();
  $n1->add($F);

  ok($n1->Evaluate() eq "1", "Not(F) is T");
}

sub test_cmp {
  my $eq0 = new CBM::CelCmpEq();

  ok($eq0->Evaluate() eq "0", "eq on empty atom returns F");

  $eq0->add($T);

  ok($eq0->Evaluate() eq "0", "eq on 1 atom returns F");

  $eq0->add($F);

  ok($eq0->Evaluate() eq "0", "eq on (T,F) returns F");

  my $eq1 = new CBM::CelCmpEq();
  $eq1->add($T);
  $eq1->add($T);

  ok($eq1->Evaluate() eq "1", "eq on (F,F) returns T");


  my @V = ('0.0.1/0.0.2',
	   '0.1.0/0.1.1',
	   '1.0.0/2.0.0',
	   '2.95.0/2.96.0',
	   '1.10.1/1.11.0',
	   '21.5/22.0');
  my $v;

  foreach $v (@V) {
    my ($v0, $v1) = split('/', "$v");

    my $eq2 = new CBM::CelCmpAE();
    my $V0  = new CBM::CelVersion($v0);
    my $V1  = new CBM::CelVersion($v1);
    $eq2->add($V0);
    $eq2->add($V1);

    ok($eq2->Evaluate() eq "1", "ae on ($v0, $v1) returns T");

    my $eq3 = new CBM::CelCmpAE();
    $V0  = new CBM::CelVersion($v1);
    $V1  = new CBM::CelVersion($v0);
    $eq3->add($V0);
    $eq3->add($V1);

    ok($eq3->Evaluate() eq "0", "ae on ($v1, $v0) returns F");
  }
}

sub test_cond {
  my $c0 = new CBM::CelCondIf();

  $c0->add($T);
  $c0->add($F);
  ok($c0->Evaluate() eq "0", "if (T) F returns F");

  my $c1 = new CBM::CelCondIf();

  $c1->add($T);
  $c1->add($T);
  ok($c1->Evaluate() eq "1", "if (T) T returns T");

  my $c2 = new CBM::CelCondIf();

  $c2->add($F);
  $c2->add($F);
  $c2->add($T);
  ok($c2->Evaluate() eq "1", "if (F) F T returns T");


  my $c3 = new CBM::CelCondIf();
  my $n0 = new CBM::CelLogicNot();
  $n0->add($F);
  $c3->add($n0);
  $c3->add($T);

  ok($c3->Evaluate() eq "1", "if (Not(F)) T returns T");
}

sub test_var {
  my $i0  = new CBM::CelStr("x");
  my $i1  = new CBM::CelStr("y");
  my $v0  = new CBM::CelStr("100");
  my $v1  = new CBM::CelStr("201");

  my $cs0 = new CBM::CelVarSet();
  $cs0->add($i0);
  $cs0->add($v0);
  $cs0->Evaluate();

  my $cg0 = new CBM::CelVarGet();
  $cg0->add($i0);
  ok($cg0->Evaluate() eq "100", "Set/Get (x=100)");

  my $cs1 = new CBM::CelVarSet();
  $cs1->add($i1);
  $cs1->add($v0);
  $cs1->Evaluate();

  my $cg1 = new CBM::CelVarGet();
  $cg1->add($i1);
  ok($cg1->Evaluate() eq "100", "Set/Get (y=100)");

  my $cs2 = new CBM::CelVarSet();
  $cs2->add($i1);
  $cs2->add($v1);
  $cs2->Evaluate();

  my $cg2 = new CBM::CelVarGet();
  $cg2->add($i1);
  ok($cg2->Evaluate() eq "201", "Set/Get (y=201) - has " . $cg2->Evaluate());

  my $u = new CBM::CelVarUndef();
  $u->add($i0);
  $u->Evaluate();

  ok($cg0->Evaluate() eq "0", "Undefined");

}


sub test_array_add {
  my $array = shift;
  my $str   = shift;

  my $A = new CBM::CelArrayAdd();
  my $al = new CBM::CelStr($array);
  my $ai = new CBM::CelStr($str);

  $A->add($al);
  $A->add($ai);
  $A->Evaluate();
}

sub test_array {
  my $A   = new CBM::CelArrayDef();

  my $an  = new CBM::CelStr("a");

  $A->add($an);
  ok($A->Evaluate() eq "1", "array definition works");

  my $AS  = new CBM::CelArraySize();
  my $ans = new CBM::CelStr("a");

  $AS->add($an);
  ok($AS->Evaluate() eq "0", "array a is empty");

  test_array_add("a", "y");
  ok($AS->Evaluate() eq "1", "array a has one element");

  my $AG = new CBM::CelArrayGet();
  my $ags = new CBM::CelStr("a");
  my $agi = new CBM::CelStr("0");
  $AG->add($ags);
  $AG->add($agi);

  my $e = $AG->Evaluate();
  ok($e eq "y", "first element in a is 'y' (has $e)");


  test_array_add("a", "z");

  ok($AS->Evaluate() eq "2", "array a has two element");


  ok($AG->Evaluate() eq "y", "first element in a is 'y'");

  my $AG2 = new CBM::CelArrayGet();
  my $ags2 = new CBM::CelStr("a");
  my $agi2 = new CBM::CelStr("1");
  $AG2->add($ags2);
  $AG2->add($agi2);

  $e=$AG2->Evaluate();
  ok($e eq "z", "second element in a is 'z' (has $e)");

}

sub test_function_noargs {
  my $fd = new CBM::CelFunctionDef();
  my $fn = new CBM::CelStr("func0");
  $fd->add($fn);

  my $c = new CBM::CelCondIf();

  $c->add($F);
  $c->add($F);
  $c->add($T);

  $fd->add($c);

  ok ($fd->Evaluate() eq "1", "func0() can be declared");

  my $fc = new CBM::CelFunctionCall();
  my $fnc = new CBM::CelStr("func0");
  $fc->add($fnc);

  my $e = $fc->Evaluate();
  ok($e eq "1", "func0() returns T (has $e)");

  $e = $fc->Evaluate();
  ok($e eq "1", "func0() returns T (has $e) - 2d time");

}

sub test_i_stack_pop {
  my $p = new CBM::CelStackPop();

  return($p->Evaluate());
}

sub test_i_stack_push {
  my $str = shift;

  my $p = new CBM::CelStackPush();

  my $v = new CBM::CelStr($str);
  $p->add($v);

  return($p->Evaluate());
}

sub test_stack {
  my @v = ('5', 'x', '20');

  ok(test_i_stack_pop() eq "0", "stack is empty");

  foreach(@v) {
    ok(test_i_stack_push($_) eq 1, "can push $_ on stack");
  }

  foreach(reverse @v) {
    ok(test_i_stack_pop() eq $_, "stack (pop) returns $_");
  }

  ok(test_i_stack_pop() eq "0", "stack is empty");
}

sub test_i_function_and_call {
  my $fd = new CBM::CelFunctionCall();
  my $fn = new CBM::CelStr("func1");
  $fd->add($fn);

  return($fd->Evaluate());
}

sub test_block {
  my $e;

  my $b  = new CBM::CelBlock();
  my $i0 = new CBM::CelStr("a");
  my $i1 = new CBM::CelStr("b");

  $b->add($i0);
  $b->add($i1);
  ok($b->Evaluate() eq "b", "Block evaluated to 'b'");

}

sub test_function {
  my $e;

  my $fd = new CBM::CelFunctionDef();
  my $fn = new CBM::CelStr("func1");
  $fd->add($fn);

  my $i0 = new CBM::CelStr("func1_v0");
  my $pop0 = new CBM::CelStackPop();
  my $cs0 = new CBM::CelVarSet();
  $cs0->add($i0);
  $cs0->add($pop0);
  $fd->add($cs0);


  my $i1 = new CBM::CelStr("func1_v1");
  my $pop1 = new CBM::CelStackPop();
  my $cs1 = new CBM::CelVarSet();
  $cs1->add($i1);
  $cs1->add($pop1);
  $fd->add($cs1);


  my $and = new CBM::CelLogicAnd();

  my $ig0 = new CBM::CelStr("func1_v0");
  my $cg0 = new CBM::CelVarGet();
  $cg0->add($ig0);
  $and->add($cg0);

  my $ig1 = new CBM::CelStr("func1_v1");
  my $cg1 = new CBM::CelVarGet();
  $cg1->add($ig1);
  $and->add($cg1);

  my $gp = new CBM::CelStackPush();
  $gp->add($and);
  $fd->add($gp);


  my $iu0 = new CBM::CelStr("func1_v0");
  my $u0 = new CBM::CelVarUndef();
  $u0->add($i0);
  $fd->add($u0);

  my $iu1 = new CBM::CelStr("func1_v1");
  my $u1 = new CBM::CelVarUndef();
  $u1->add($i1);
  $fd->add($u1);

  my $gpop = new CBM::CelStackPop();
  $fd->add($gpop);

  ok($fd->Evaluate() eq "1", "func1 declared");

  $e=test_i_function_and_call();
  ok($e eq "0", "func1 without argument returns F (has $e)");

  test_i_stack_push("0");
  test_i_stack_push("0");
  $e=test_i_function_and_call();
  ok($e eq "0", "func1(F,F) returns F (has $e)");
  ok(test_i_stack_pop() eq "0", "stack is empty");

  test_i_stack_push("1");
  test_i_stack_push("0");
  $e=test_i_function_and_call();
  ok($e eq "0", "func1(T,F) returns F (has $e)");
  $e=test_i_stack_pop();
  ok($e eq "0", "stack is empty (has $e)");

  test_i_stack_push("1");
  test_i_stack_push("1");
  $e=test_i_function_and_call();
  ok($e eq "1", "func1(T,T) returns T (has $e)");
  $e=test_i_stack_pop();
  ok($e eq "0", "stack is empty (has $e)");
}

sub test_function_return {
  my $e;

  my $fd = new CBM::CelFunctionDef();
  my $fn = new CBM::CelStr("func2");
  $fd->add($fn);

  my $r0 = new CBM::CelFunctionReturn();
  my $v0 = new CBM::CelStr("v0");
  $r0->add($v0);

  my $r1 = new CBM::CelFunctionReturn();
  my $v1 = new CBM::CelStr("v1");
  $r1->add($v1);

  $fd->add($r0);
  $fd->add($r1);

  $fd->Evaluate();

  my $fc = new CBM::CelFunctionCall();
  my $cn = new CBM::CelStr("func2");
  $fc->add($cn);

  $e = $fc->Evaluate();
  ok($e eq "v0", "func2() returns v0 (has $e)");
}

sub test_loop_break {
  my $L = new CBM::CelLoop();

  my $C = new CBM::CelCmpEq();

  my $a0 = new CBM::CelStr("x0");
  $C->add($a0);

  my $a1 = new CBM::CelStr("x0");
  $C->add($a1);

  $L->add($C);

  my $ca0 = new CBM::CelStr("x0");
  my $ca1 = new CBM::CelStr("x1");

  my $b0 = new CBM::CelLoopBreak();
  $L->add($ca0);
  $L->add($b0);
  $L->add($ca1);

  my $e = $L->Evaluate();
  ok($e eq "x0", "break works in loops (returns $e)");
}

sub test_loop {
  my $B = new CBM::CelBlock();

  my $i0  = new CBM::CelStr("x");
  my $v0  = new CBM::CelStr("10");

  my $cs0 = new CBM::CelVarSet();
  $cs0->add($i0);
  $cs0->add($v0);
  $B->add($cs0);

  my $L = new CBM::CelLoop();

  $B->add($L);

  my $N = new CBM::CelLogicNot();
  $L->add($N);

  my $C = new CBM::CelCmpEq();

  my $a0 = new CBM::CelVarGet();
  my $ai0 = new CBM::CelStr("x");
  my $v01  = new CBM::CelStr("10");

  $a0->add($ai0);
  $C->add($a0);
  $C->add($v01);
  $N->add($C);

  my $i2  = new CBM::CelStr("x");

  my $cs01 = new CBM::CelVarSet();
  $cs01->add($i2);

  my $a1 = new CBM::CelMathInc();
  my $a1g = new CBM::CelVarGet();
  my $ai1g = new CBM::CelStr("x");
  $a1g->add($ai1g);
  $a1->add($a1g);
  $cs01->add($a1);
  $L->add($cs01);

  my $a2g = new CBM::CelVarGet();
  my $ai2g = new CBM::CelStr("x");
  $a2g->add($ai2g);
  $B->add($a2g);

  my $e = $B->Evaluate();


  ok($e eq '10', "while(i++<10); eq 10 (has $e)");
}


$sys = CBM::Init();
test_str();
test_logic();
test_math();
test_cmp();
test_cond();
test_var();
test_array();
test_function_noargs();
test_stack();
test_block();
test_function();
test_function_return();
test_loop_break();
test_loop();

$sys->done();