15-rw-args.md

use v6;

use lib <lib t/04-nativecall>;
use CompileTestLib;
use NativeCall;
use Test;

plan 22;

compile_test_lib('15-rw-args');

sub SetChar(int8 is rw)            is native('./15-rw-args') { * }
sub PassChar(int8 is rw)           returns int8 is native('./15-rw-args') { * }
sub SetShort(int16 is rw)          is native('./15-rw-args') { * }
sub PassShort(int16 is rw)         returns int16 is native('./15-rw-args') { * }
sub SetLong(long is rw)            is native('./15-rw-args') { * }
sub PassLong(long is rw)           returns long is native('./15-rw-args') { * }
sub SetLongLong(longlong is rw)    is native('./15-rw-args') { * }
sub PassLongLong(longlong is rw)   returns longlong is native('./15-rw-args') { * }
sub SetFloat(num32 is rw)          is native('./15-rw-args') { * }
sub PassFloat(num32 is rw)         returns num32 is native('./15-rw-args') { * }
sub SetDouble(num64 is rw)         is native('./15-rw-args') { * }
sub PassDouble(num64 is rw)        returns num64 is native('./15-rw-args') { * }
sub SetUChar(uint8 is rw)          is native('./15-rw-args') { * }
sub PassUChar(uint8 is rw)         returns uint8 is native('./15-rw-args') { * }
sub SetUShort(uint16 is rw)        is native('./15-rw-args') { * }
sub PassUShort(uint16 is rw)       returns uint16 is native('./15-rw-args') { * }
sub SetULong(ulong is rw)          is native('./15-rw-args') { * }
sub PassULong(ulong is rw)         returns ulong is native('./15-rw-args') { * }
sub SetULongLong(ulonglong is rw)  is native('./15-rw-args') { * }
sub PassULongLong(ulonglong is rw) returns ulonglong is native('./15-rw-args') { * }
sub SetPtrToPtr(Pointer is rw) returns int32 is native('./15-rw-args') { * }

sub ReturnPointerToArray(CArray[CArray[uint8]] is rw) returns long is native('./15-rw-args') { * }
sub VerifyBufferChanged() returns int64 is native('./15-rw-args') { * }

my int8 $c; SetChar($c);
is $c, 97, 'Perl\'s rw variable was set by C (char)';
is PassChar($c), 97, 'Perl\'s rw variable was passed and returned by C (char)';

my int16 $s; SetShort($s);
is $s, 387, 'Perl\'s rw variable was set by C (short)';
is PassShort($s), 387, 'Perl\'s rw variable was passed and returned by C (short)';

my long $l; SetLong($l);
is $l, 777, 'Perl\'s rw variable was set by C (long)';
is PassLong($l), 777, 'Perl\'s rw variable was passed and returned by C (long)';

my longlong $ll; SetLongLong($ll);
is $ll, 15324, 'Perl\'s rw variable was set by C (long long)';
is PassLongLong($ll), 15324, 'Perl\'s rw variable was passed and returned by C (longlong)';

my num32 $f; SetFloat($f);
is-approx $f, 6.66, 'Perl\'s rw variable was set by C (float)';
is-approx PassFloat($f), 6.66, 'Perl\'s rw variable was passed and returned by C (float)';

my num64 $d; SetDouble($d);
is-approx $d, 12.12, 'Perl\'s rw variable was set by C (double)';
is PassDouble($d), 12.12, 'Perl\'s rw variable was passed and returned by C (double)';

my uint8 $uc; SetUChar($uc);
is $uc, 153, 'Perl\'s rw variable was set by C (unsigned char)';
is PassUChar($uc), 153, 'Perl\'s rw variable was passed and returned by C (unsigned char)';

my uint16 $us; SetUShort($us);
is $us, 387, 'Perl\'s rw variable was set by C (unsigned short)';
is PassUShort($us), 387, 'Perl\'s rw variable was passed and returned by C (unsigned short)';

my ulong $ul; SetULong($ul);
is $ul, 777, 'Perl\'s rw variable was set by C (unsigned long)';
is PassULong($ul), 777, 'Perl\'s rw variable was passed and returned by C (unsigned long)';

my ulonglong $ull; SetULongLong($ull);
is $ull, 15324, 'Perl\'s rw variable was set by C (unsigned long long)';
is PassULongLong($ull), 15324, 'Perl\'s rw variable was passed and returned by C (unsigned long long)';

my Pointer $ptr .= new;
ok SetPtrToPtr($ptr), 'Can pass an instantiated pointer with rw-trait to C';
is +$ptr, 42, 'Perl\'s rw variable was set by C (pointer)';

my CArray[CArray[uint8]] $buffer .= new;
$buffer[0] = CArray[uint8].new;

ReturnPointerToArray($buffer);
diag $buffer[0][$_] for ^4;
{
  my $cc = 0;
  for (2, 3, 4, 5) {
    my int8 $vv = $_;
    $buffer[0][$cc] = $vv;
    diag $buffer[0][$cc++];
  }
}

is VerifyBufferChanged(), 14, "buffer has changed";

#include <stdlib.h>
#ifdef _WIN32
#define DLLEXPORT __declspec(dllexport)
#else
#define DLLEXPORT extern
#endif

DLLEXPORT void SetChar(signed char *chr) {
    *chr = 97;
}

DLLEXPORT signed char PassChar(signed char *chr) {
    return *chr;
}

DLLEXPORT void SetShort(short *sht) {
    *sht = 387;
}

DLLEXPORT short PassShort(short *sht) {
    return *sht;
}

DLLEXPORT void SetLong(long *lng) {
    *lng = 777;
}

DLLEXPORT long PassLong(long *lng) {
    return *lng;
}

DLLEXPORT void SetLongLong(long long *llg) {
    *llg = 15324;
}

DLLEXPORT long long PassLongLong(long long *llg) {
    return *llg;
}

DLLEXPORT void SetFloat(float *flt) {
    *flt = 6.66;
}

DLLEXPORT float PassFloat(float *flt) {
    return *flt;
}

DLLEXPORT void SetDouble(double *dbl) {
    *dbl = 12.12;
}

DLLEXPORT double PassDouble(double *dbl) {
    return *dbl;
}

DLLEXPORT void SetUChar(unsigned char *chr) {
    *chr = 153;
}

DLLEXPORT unsigned char PassUChar(unsigned char *chr) {
    return *chr;
}

DLLEXPORT void SetUShort(unsigned short *sht) {
    *sht = 387;
}

DLLEXPORT unsigned short PassUShort(unsigned short *sht) {
    return *sht;
}

DLLEXPORT void SetULong(unsigned long *lng) {
    *lng = 777;
}

DLLEXPORT unsigned long PassULong(unsigned long *lng) {
    return *lng;
}

DLLEXPORT void SetULongLong(unsigned long long *llg) {
    *llg = 15324;
}

DLLEXPORT unsigned long long PassULongLong(unsigned long long *llg) {
    return *llg;
}

DLLEXPORT int SetPtrToPtr(int **ptr) {
    if (ptr == NULL) {
        return 0;
    }

    *ptr = (int *)42;
    return 1;
}

char buffer[32];

DLLEXPORT int ReturnPointerToArray(void **ptr) {
    char index;
    for(index = 0; index < 32; index++)
        buffer[index] = 1;
    *ptr = (void *)buffer;
    return 1;
}

DLLEXPORT long long int VerifyBufferChanged() {
    return buffer[0] + buffer[1] + buffer[2] + buffer[3];
}