#!/usr/bin/env perl
#
# Ugly Test for REXP creation
# Work in progress...
#
# Based on PHP tests for php Rserve client
#
use Rserve;
use Rserve::Connection;
use Rserve::REXP::Integer;
use Data::Dumper;
use strict;
do 'config.pl';
#function testBinary($values, $type, $options = array(), $msg = '') {
sub testBinary(@) {
my $argc = @_;
print "$argc\n";
my $values = shift;
# print ref($values);
# print Dumper($values);
my $type = shift;
my $options = ();
my $msg = "";
if ($argc == 3) {
$options = shift;
}
elsif ($argc == 4) {
$msg = shift;
}
print 'Test '.$type.' '.$msg."\n";
my $cn = 'Rserve::REXP::'.$type;
print "cn = $cn \n";
my $r = new $cn();
print "r is a " . ref($r) . "[$r]\n";
my $tt = lc($type);
if ( $r->isVector()) {
print "r is a Vector\n";
if ($r -> isList() && @$options['named']) {
print "r is a List\n";
$r->setValues($values, Rserve::TRUE);
}
else {
$r->setValues($values);
}
}
else {
$r->setValue($values);
}
my $bin = Rserve::Parser::createBinary($r);
print "bin = ";
print Dumper($bin);
print "end bin\n";
print "debug: \n";
print Dumper(Rserve::Parser::parseDebug($bin, 0));
print "end debug\n";
my $r2 = Rserve::Parser::parseREXP($bin, 0);
print "r2 = ";
print Dumper($r2);
print "end r2\n";
my $cn2 = ref($r2);
if ( lc($cn2) != lc(ref($cn))) {
print 'Different classes';
return Rserve::FALSE;
}
else {
print "Class Type ok\n";
print "cn = $cn\n";
print "cn2 = $cn2\n";
}
}
print "Test 1: ----------------------------------------\n";
testBinary( [1,2,3], 'Integer' );
print "Test 2: ----------------------------------------\n";
testBinary([1.1,2.2,3.3], 'Double' );
print "Test 3: ----------------------------------------\n";
testBinary([Rserve::TRUE, Rserve::FALSE, Rserve::TRUE, []], 'Logical');