# New Ticket Created by Itsuki Toyota
# Please include the string: [perl #129784]
# in the subject line of all future correspondence about this issue.
# <URL: https://rt.perl.org/Ticket/Display.html?id=129784 >
See the following codes and results. ( Sorry, it's little bit long. )
* codes *
t/01-basic.t
-----------------------------------------
use v6;
use Test;
use NativeCall;
use lib <lib t>;
use CompileTestLib;
compile_test_lib('01-basic');
sub ary_assign_malloc(CArray[int32] is rw) is native("./01-basic") { * }
sub ptr_assign_malloc(Pointer[int32] is rw) is native("./01-basic") { * }
sub new_malloc() returns Pointer[int32] is native("./01-basic") { * }
subtest {
my CArray[int32] $a = nativecast(CArray[int32], new_malloc());
is $a[100], 100;
}, "correct way";
subtest {
my CArray[int32] $a;
ary_assign_malloc($a);
my $aa = nativecast(CArray[int32], $a);
is $aa[100], 100;
my CArray[int32] $b .= new;
ary_assign_malloc($b);
my $bb = nativecast(CArray[int32], $b);
is $bb[100], 100;
}, "ary_assign test";
subtest {
my Pointer[int32] $a;
ptr_assign_malloc($a);
my $aa = nativecast(CArray[int32], $a);
is $aa[100], 100;
my Pointer[int32] $b .= new;
ptr_assign_malloc($b);
my $bb = nativecast(CArray[int32], $b);
is $bb[100], 100;
}, "ptr_assign test";
done-testing;
-----------------------------------------
t/01-basic.c
-----------------------------------------
#else
#define DLLEXPORT extern
#endif
DLLEXPORT void ptr_assign_malloc(int* item)
{
int i = 0;
item = (int*)malloc(sizeof(int) * 1000);
for(; i < 1000; i++) {
item[i] = i;
}
}
DLLEXPORT void ary_assign_malloc(int* item)
{
int i = 0;
item = (int*)malloc(sizeof(int) * 1000);
for(; i < 1000; i++) {
item[i] = i;
}
}
DLLEXPORT int* new_malloc()
{
int i = 0;
int* item = (int*)malloc(sizeof(int) * 1000);
for(; i < 1000; i++) {
item[i] = i;
}
return item;
}
-----------------------------------------
t/01-basic.h
-----------------------------------------
#if ! defined(HEADER_BASIC_H)
#define HEADER_BASIC_H
#ifdef __cplusplus
extern "C" {
#endif
#ifdef __cplusplus
} /* closing brace for extern "C" */
#endif
#endif /* HEADER_BASIC_H */
-----------------------------------------
t/CompileTestLib.pm
(short version of rakudo's one)
-----------------------------------------
unit module CompileTestLib;
my @cleanup; # files to be cleaned up afterwards
sub compile_test_lib($name) is export {
my ($c_line, $l_line);
my $VM := $*VM;
my $cfg := $VM.config;
my $libname = $VM.platform-library-name($name.IO);
if $VM.name eq 'moar' {
my $o = $cfg<obj>;
# MoarVM exposes exposes GNU make directives here, but we cannot pass
this to gcc directly.
my $ldshared = $cfg<ldshared>.subst(/'--out-implib,lib$(notdir $@).a'/,
"--out-implib,$libname.a");
$c_line = "$cfg<cc> -c $cfg<ccshared> $cfg<ccout>$name$o $cfg<cflags>
t/$name.c";
$l_line = "$cfg<ld> $ldshared $cfg<ldflags> $cfg<ldlibs>
$cfg<ldout>$libname $name$o";
@cleanup = << "$libname" "$name$o" >>;
}
elsif $VM.name eq 'jvm' {
$c_line = "$cfg<nativecall.cc> -c $cfg<nativecall.ccdlflags>
-o$name$cfg<nativecall.o> $cfg<nativecall.ccflags> t/04-nativecall/$name.c";
$l_line = "$cfg<nativecall.ld> $cfg<nativecall.perllibs>
$cfg<nativecall.lddlflags> $cfg<nativecall.ldflags>
$cfg<nativecall.ldout>$libname $name$cfg<nativecall.o>";
@cleanup = << $libname "$name$cfg<nativecall.o>" >>;
}
else {
die "Unknown VM; don't know how to compile test libraries";
}
shell($c_line);
shell($l_line);
}
END {
# say "cleaning up @cleanup[]";
unlink @cleanup;
}
-----------------------------------------
* codes end *
* results *
-----------------------------------------
$ mi6 test -v
==> Set PERL6LIB=/home/itoyota/Programs/p6-Foo/lib
==> prove -e /home/itoyota/.rakudobrew/bin/../moar-nom/install/bin/perl6 -r -v
./t/01-basic.t ..
ok 1 -
1..1
ok 1 - correct way
not ok 1 -
# Failed test at ./t/01-basic.t line 21
# expected: '100'
# got: (Any)
not ok 2 -
# Failed test at ./t/01-basic.t line 26
# expected: '100'
# got: '0'
1..2
# Looks like you failed 2 tests of 2
not ok 2 - ary_assign test
# Failed test 'ary_assign test'
# at ./t/01-basic.t line 17
not ok 1 -
# Failed test at ./t/01-basic.t line 33
# expected: '100'
# got: (Any)
not ok 2 -
# Failed test at ./t/01-basic.t line 38
1..2
# expected: '100'
# got: (Any)
# Looks like you failed 2 tests of 2
not ok 3 - ptr_assign test
# Failed test 'ptr_assign test'
# at ./t/01-basic.t line 29
1..3
# Looks like you failed 2 tests of 3
Dubious, test returned 2 (wstat 512, 0x200)
Failed 2/3 subtests
Test Summary Report
-------------------
./t/01-basic.t (Wstat: 512 Tests: 3 Failed: 2)
Failed tests: 2-3
Non-zero exit status: 2
Files=1, Tests=3, 1 wallclock secs ( 0.03 usr 0.00 sys + 0.65 cusr 0.06
csys = 0.74 CPU)
Result: FAIL
-----------------------------------------
* results end *
I think:
1) The 3rd subtest (i.e. "ptr_assign test" subtest) should work correctly same
as the 1st subtest (i.e. "correct way" subtest).
2) The 2nd subtest (i.e. "ary_assign test" subtest) should return the compile
error message, because malloc returns not CArray[int32] but Pointer[int32].
titsuki
