Skip to content
This repository
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 71 lines (53 sloc) 1.602 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
use lib '.';
use t::CompileTestLib;
use NativeCall;
use Test;

plan(9);

compile_test_lib('08-callbacks');

class Struct is repr('CStruct') {
    has Str $.str;
    has int $.ival;

    method init {
        $!str := 'Tweedledum, tweedledee';
        $!ival = 314;
    }
}

sub TakeACallback(&cb()) is native('./08-callbacks') { * }
sub TakeIntCallback(&cb(int)) is native('./08-callbacks') { * }
sub TakeStringCallback(&cb(Str)) is native('./08-callbacks') { * }
sub TakeStructCallback(&cb(Struct)) is native('./08-callbacks') { * }

sub CheckReturnsFloat(&cb(--> num)) is native('./08-callbacks') { * }
sub CheckReturnsStr(&cb(--> Str)) is native('./08-callbacks') { * }
sub CheckReturnsStruct(&cb(--> Struct)) is native('./08-callbacks') { * }

sub simple_callback() {
    pass 'simple callback';
}

sub int_callback(int $x) {
    is $x, 17, 'int callback argument'
}

sub str_callback(Str $x) {
    is $x, 'lorem ipsum', 'string callback argument'
}

sub struct_callback(Struct $struct) {
    is $struct.str, 'foobar', 'struct callback string argument';
    is $struct.ival, -42, 'struct callback int argument';
}

sub return_float() returns num {
    return 1.23e0;
}

sub return_str() returns Str {
    return 'Herps and derps';
}

sub return_struct() returns Struct {
    my Struct $struct .= new;
    $struct.init;

    return $struct;
}

TakeACallback(&simple_callback);
TakeIntCallback(&int_callback);
TakeStringCallback(&str_callback);
TakeStructCallback(&struct_callback);

CheckReturnsFloat(&return_float);
CheckReturnsStr(&return_str);
CheckReturnsStruct(&return_struct);

# vim:ft=perl6
Something went wrong with that request. Please try again.