#
# test conversion of scalars: S-Lang to Perl
#
# many of these tests shouldn't be direct equality
# since it's floating point
#
use strict;
use Test::More tests => 37;
use Data::Dumper;
# check for approximately equal
# - for these operations an absolute tolerance is okay
#
use constant ABSTOL => 1.0e-10;
sub approx ($$$) {
my ( $a, $b, $text ) = @_;
my $delta = $a-$b;
ok( abs($delta) < ABSTOL, "$text [delta=$delta]" );
}
## Tests
use Inline 'SLang';
my ( $ret1, $ret2, $ret3, @ret );
## Integers
$ret1 = scalari2();
is( $ret1, 2, 'scalar int returned 2' );
( $ret1, $ret2 ) = scalari35();
is( $ret1, 3, 'scalar int returned 3' );
is( $ret2, 5, 'scalar int returned 5' );
$ret1 = scalari35();
is( $ret1, 3, 'scalar int returned 3 & ignored 5' );
# tests if the stack has been cleared
$ret1 = scalari2();
is( $ret1, 2, 'scalar int returned 2 [stack okay]' );
scalari35();
$ret1 = 0;
$ret1 = scalari2();
is( $ret1, 2, 'scalar int returned 2 [stack okay]' );
## Reals
$ret1 = scalarr2_1();
approx( $ret1, 2.1, 'scalar real returned 2.1' );
( $ret1, $ret2 ) = scalarr3_25_4();
approx( $ret1, 3.2, 'scalar real returned 3.2' );
approx( $ret2, 5.4, 'scalar real returned 5.4' );
$ret1 = scalarr3_25_4();
approx( $ret1 , 3.2, 'scalar real returned 3.2 & ignored 5.4' );
# tests if the stack has been cleared
$ret1 = scalarr2_1();
approx( $ret1, 2.1, 'scalar real returned 2.1 [stack okay]' );
scalarr3_25_4();
$ret1 = 0;
$ret1 = scalarr2_1();
approx( $ret1, 2.1, 'scalar real returned 2.1 [stack okay]' );
## Complex numbers
#
# complex support is implemented using Math::Complex,
# which is distributed with Perl
#
$ret1 = scalarc3_4();
isa_ok( $ret1, "Math::Complex" );
is( $ret1->Re, 3, ' and real = 3' );
is( $ret1->Im, 4, ' and imag = 4' );
$ret1 = scalarc3_m45();
ok( $ret1->Re == 3 && $ret1->Im == -4.5, '3-4.5i is returned okay' );
( $ret1, $ret2 ) = scalarca();
ok( $ret1->Re == 2.5 && $ret1->Im == 0, '2.5+0i is returned okay' );
ok( $ret2->Re == 0 && $ret2->Im == 4.7, '0+4.7i is returned okay' );
## Strings
$ret1 = scalarstest();
is( $ret1, "this is a scalar test", 'scalar string okay' );
scalarstest();
$ret1 = scalari2();
is( $ret1, 2, 'scalar string [stack only]' );
## Datatype objects
@ret = get_dtypes();
print Dumper($ret[0]), "\n";
is ( $#ret, 5, "num of datatypes is 6" );
isa_ok( $ret[0], "DataType_Type" );
# check them via stringification and via equality
is ( join( " ", map { "$_"; } @ret ),
"UChar_Type Short_Type Float_Type String_Type DataType_Type Null_Type",
'DataType values are converted correctly' );
# test loading into main package somewhere in the 20's
my $sum = 0;
$sum += $ret[0] == Inline::SLang::UChar_Type();
$sum += $ret[1] eq Inline::SLang::Short_Type();
$sum += $ret[2] == Inline::SLang::Float_Type();
$sum += $ret[3] eq Inline::SLang::String_Type();
$sum += $ret[4] == Inline::SLang::DataType_Type();
$sum += $ret[5] eq Inline::SLang::Null_Type();
is ( $sum, 6, ' testing equality of data types' );
ok ( $ret[0] != $ret[1], ' and inequality of differnt types' );
ok ( $ret[0] ne $ret[2], ' and inequality of differnt types' );
## mixed types
# - mainly just to check out the stack-handling code
( $ret1, $ret2 ) = scalar_aa_45();
is( $ret1, "aa", 'mixed scalars okay' );
is( $ret2, 45, 'mixed scalars okay' );
@ret = scalar_aa_45();
is( $#ret, 1, 'num of mixed scalars == 2' );
is( $ret[0], "aa", 'mixed scalars okay' );
is( $ret[1], 45, 'mixed scalars okay' );
@ret = scalar_45_dtype_aa();
is( $#ret, 2, 'num of mixed scalars/datatypes == 3' );
is( $ret[0], 45, 'mixed scalars/datatypes okay' );
is( "$ret[1]", "DataType_Type",
'mixed scalars/datatypes okay' );
is( $ret[2], "aa", 'mixed scalars/datatypes okay' );
## Need to test the other types (many not yet supported)
$ret1 = retnull();
ok( !defined($ret1), 'NULL returned as undef' );
( $ret1, $ret2, $ret3 ) = retabc();
ok( defined($ret1) && defined($ret3) && !defined($ret2),
"returning NULL's as undef doesn't mess up the stack" );
__END__
__SLang__
%% convert S-Lang to perl
% integers
define scalari2 () { return 2; }
define scalari35 () { return ( 3, 5 ); }
% reals
define scalarr2_1 () { return 2.1; }
define scalarr3_25_4 () { return ( 3.2, 5.4 ); }
% complex
define scalarc3_4 () { return 3 + 4i; }
define scalarc3_m45 () { return 3 - 4.5i; }
define scalarca () { return ( 2.5+0i, 0+4.7i ); }
% strings
define scalarstest() { return "this is a scalar test"; }
% datatypes
define get_dtypes () {
return ( UChar_Type, Short_Type, Float_Type, String_Type, DataType_Type, Null_Type );
}
% mixed
define scalar_aa_45() { return ( "aa", 45 ); }
define scalar_45_dtype_aa() { return ( 45, DataType_Type, "aa" ); }
% NULL
define retnull() { return NULL; }
define retabc() { return ( "a string", NULL, 22.4 ); }