#!../../perl
# FT 7/23/97


use Fame;

# change packages to avoid having to write long package names
# for fxns

package Fame::HLI;

# unbuffered output
$|=1;

# remove a test database
system("rm test.db") if -e "test.db";

#
# Fame::HLI
#

print "Fame::HLI....ok\n";

$k=&fameopen("test.db",&HCMODE);
die "open failed [$Fame::HLI::status]" if $k==-1;

$f = &HDAILY;

eval { $n=&hli_freq($f); if ($n eq "") {print "FRB error\n"; $errors++;} };
print "FRB extensions not loaded--not a problem\n" if $@;

eval { $n=&getfrq($f); if ($n eq "") {print "HLILIB error\n"; $errors++;} };
print "HLILIB extensions not loaded--not a problem\n" if $@;

print "dates......";
# test dates
&cfmddat($stat,&HDAILY,$date,1993,5,2);
die "DATE FAILED date prob 1" if $stat != &HSUCC;
&cfmdatd($stat,&HDAILY,$date,$y,$m,$d);
die "DATE FAILED date prob 2" if $stat != &HSUCC;
&cfmddat($stat,&HDAILY,$date2,$y,$m,$d);
die "DATE FAILED date prob 3" if $stat != &HSUCC;
die "DATE FAILED date prob 4" if $date2!=$date;
print "ok\n";

#
# WRITING NUMERIC
#

# create a new object
$name="t1";
&cfmnwob($stat,$k,$name,&HSERIE,&HDAILY,
         &HNUMRC,&HBSDAY,&HOBBEG);

# get the object's information
@d=&famegetinfo($k,$name);

# write some data to the new object
@data=(5,4,3,7,1,2,7,4,3,5,4,6,7,4,2,8,6,4,5,4);

print "writing numeric series....";
$stat = &famewrite($k,$name,1990,1,@data);
if ($stat) {
  print "WRITE FAILED ($stat) !!!\n";
  $errors++;
}
# post
&cfmpodb($stat,$k);
print "ok\n";

# get the object's information
@d=&famegetinfo($k,$name);
# print "Info $name ($k): ",join(",",@d),"\n";

# read that data back
print "reading....";
@l=&fameread($k,$name,$d[5],$d[6],$d[7],$d[8]);

$flag=0;
foreach $x (0..$#data) {
  $flag++ if $data[$x] != $l[$x];
}
if ($flag>0) {
  print "READ/WRITE FAILED for $flag items!\n";
  $errors++;
}
else {
  print "ok\n";
}

#
# WRITING STRINGS
#

# create a new object
$name="t2";
&cfmnwob($stat,$k,$name,&HSERIE,&HDAILY,
         &HSTRNG,&HBSDAY,&HOBBEG);

@data=("One", "Two", "Three");
print "writing string series....";
$stat = &famewrite($k,$name,1990,1,@data);
if ($stat) {
  print "WRITE FAILED ($stat) !!!\n";
  $errors++;
}
# post
&cfmpodb($stat,$k);
print "ok\n";

@d=&famegetinfo($k,$name);
print "reading.....";
@l=&fameread($k,$name,$d[5],$d[6],$d[7],$d[8]);

$flag=0;
foreach $x (0..$#data) {
  $flag++ if $data[$x] ne $l[$x];
  #print "$data[$x]:$l[$x]:\n";
}

if ($flag>0) {
  print "READ/WRITE STRING FAILED for $flag items [$status]!\n";
  $errors++;
}
else {
  print "ok\n";
}

#
# status code
#

print "status codes.....";
$s = &cfmcpob($stat, $k, $k, "abcdefg", "testxyz");
if ($s==0 || $stat==0 || $stat != $s) {
  print "ERROR returning correct status\n";
  $errors++;
}
print "ok\n";

# close
print "closing.....";
if (! &fameclose($k)) {
  print "ERROR closing test database [$Fame::HLI::status]\n";
  $errors++;
}
print "ok\n";

#
# Fame::DB
#

print "Fame::DB Read/Write....";
$p=new Fame::DB "test", &Fame::HLI::HUMODE;
if ($p) {
  $p->Write($name,@data);
  @l = $p->Read($name);
  $flag=0;
  foreach $x (0..$#i-1) {
    $flag++ if $data[$x] != $l[$x];
  }
  if ($flag>0) {
    print "FAILED for $flag items!\n";
    $errors++;
  } else { print "ok\n"; }
  $p->destroy;
}
else {
  print "\nFAILED to open Fame::DB test database [$Fame::HLI::status]\n";
  $errors++;
}

print "Fame::DB TIE.....";
tie %h, Fame::DB, &Fame::HLI::HUMODE, "test";
$h{$name} = \@data;
@l = @{$h{$name}};
$flag=0;
foreach $x (0..$#i-1) {
  $flag++ if $data[$x] != $l[$x];
}
if ($flag>0) {
  print "FAILED for $flag items!\n";
  $errors++;
} else { print "ok\n"; }
untie %h;

#
# Fame::LANG
#

print "Fame::LANG.....";
$x=new Fame::LANG;
if ($x->{status} != &Fame::HLI::HSUCC) {
  print "FAILED to open new object\n";
  $errors++;
}
if ($x->command("open test")->{status} != &Fame::HLI::HSUCC) {
  print "FAILED command() for open\n";
  $errors++;
}
if ($x->command("x=15")->{status} != &Fame::HLI::HSUCC) {
  print "FAILED command() for x=15\n";
  $errors++;
}
($v)=$x->exec("x");
if ($v != 15) {
  print "FAILED exec() [v=$v]!\n";
  $errors++;
} else { print "ok\n"; }
$x->command("close all");
$x->destroy;

#
# terminte
#

if ($errors) {
  print "ERRORS FOUND! See test.db\n";
  exit($errors);
}

print "All tests ok\n";
system("rm test.db");
exit(0);