The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#
# 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