#
# test in/out of scalars
#
# many of these tests shouldn't be direct equality
# since it's floating point
#
use strict;
use Test::More tests => 25;
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, @ret );
## perl 2 S-Lang
$ret1 = add2( 3 );
is( $ret1, 5, '2+3 = 5' );
$ret1 = add2( 3.9 );
approx( $ret1, 5.9, '2+3.9 = 5.9' );
$ret1 = concatfoo( "bar" );
is( $ret1, "barfoo", 'bar + foo = barfoo' );
# need to quote the 2 to make it a string
$ret1 = concatfoo( "2" );
is( $ret1, "2foo", '"2" + foo = 2foo' );
## complex numbers
$ret1 = Math::Complex->make(3,-4);
ok( is_complex($ret1), "perl complex translated to S-Lang complex" );
ok( check_complex($ret1), " and the value is okay" );
## Null values
$ret1 = sendnull(undef);
is( $ret1, 1, 'undef (perl) converted to NULL (S-Lang)' );
$ret1 = sendnull('foo');
is( $ret1, 0, '"foo" != NULL' );
## datatypes
# now, Int_Type is a synonym, so let's see if it gets
# converted to Integer_Type?
$ret1 = DataType_Type->new( "Int_Type" );
isa_ok( $ret1, "DataType_Type" );
isa_ok( $ret1, "Inline::SLang::_Type" );
ok( !$ret1->is_struct_type, "and we are not a structure" );
is( "$ret1", "Integer_Type",
"Able to 'stringify' the DataType_Type object" );
ok( $ret1 == Inline::SLang::Integer_Type(), ' this is a repeat check' );
ok( $ret1 != Inline::SLang::Null_Type(), ' this is a repeat check' );
foreach my $type ( qw( DataType_Type UChar_Type Any_Type Assoc_Type ) ) {
ok( is_datatype( $type, DataType_Type->new($type) ),
"Recognises as a datatype: $type" );
}
ok( is_datatype( "Integer_Type", Inline::SLang::Integer_Type() ), "Inline::SLang::Integer_Type ok" );
ok( is_datatype( "FooFooStructType", DataType_Type->new("FooFooStructType") ), "named struct can be used as a datatype" );
ok( is_datatype( "FooFooStructType", Inline::SLang::FooFooStructType() ), "named struct can be used as a datatype" );
# no type
$ret1 = DataType_Type->new();
isa_ok( $ret1, "DataType_Type" );
is( "$ret1", "DataType_Type", "empty constructor converts to DataType_Type" );
# incorrect type
#
$ret1 = DataType_Type->new("FooFooFooFoo");
ok( !defined $ret1, "Can not create an unrecognised type" );
# and check that the error in the S-Lang interpreter
# has been cleared/interpreter restarted
#
is( concatfoo("4.3"), "4.3foo",
"Looks like the interpreter has been restarted" );
__END__
__SLang__
define add2 (a) { return a+2; }
define concatfoo () { variable str = (); return str + "foo"; }
define is_complex (x) { return typeof(x) == Complex_Type; }
define check_complex (x) { return x == 3 - 4i; }
define is_datatype (x,y) { return x == string(y); }
%% check the stack (variable args)
% if we don't clear the stack via _pop_n() we really mess up
define nvarargs () {
variable n = _NARGS;
() = printf( "varargs was sent %d arguments\n", n );
_pop_n(n);
return n;
}
define sumup () {
variable sum = 0.0;
foreach ( __pop_args(_NARGS) ) {
variable arg = ();
sum += arg.value;
}
return sum;
}
define concatall () {
variable str = "";
foreach ( __pop_args(_NARGS) ) {
variable arg = ();
str += arg.value;
}
return str;
}
% NULL value
define sendnull(x) { return x==NULL; }
% only used to test datatype handling
typedef struct { a, b } FooFooStructType;
% end