Skip Menu |
Report information
Id: 130187
Status: new
Priority: 0/
Queue: perl6

Owner: Nobody
Requestors: cookbook_000 [at] yahoo.co.jp <titsuki [at] cpan.org>
Cc:
AdminCc:

Severity: (no value)
Tag: Bug
Platform: (no value)
Patch Status: (no value)
VM: (no value)



Date: Sun, 27 Nov 2016 13:03:35 +0900 (JST)
To: "rakudobug [...] perl.org" <rakudobug [...] perl.org>
From: cookbook_000 [...] yahoo.co.jp
Subject: [BUG][NATIVECALL][RFC] CArray cannot allocate contiguous memory
Download (untitled) / with headers
text/plain 6.5k
See the following codes and results: *** codes *** * t/05-pointer.c ---- #include <stdio.h> #include <string.h> #include <stdlib.h> #include "05-pointer.h" #ifdef _WIN32 #define DLLEXPORT __declspec(dllexport) #else #define DLLEXPORT extern #endif double dot(struct Feature* lhs, struct Feature* rhs) {     double sum = 0.0;     while(lhs->index != -1 && rhs->index != -1) {         if (lhs->index == rhs->index) {             sum += lhs->value * rhs->value;             lhs++;             rhs++;         }         else if (lhs->index < rhs->index) {             lhs++;         }         else {             rhs++;         }     }     return sum; } ---- *t/05-pointer.h ---- #if ! defined(HEADER_POINTER_H) #define HEADER_POINTER_H #ifdef __cplusplus extern "C" { #endif struct Feature {   int index;   double value; } Feature; double dot(struct Feature*, struct Feature*); #ifdef __cplusplus } /* closing brace for extern "C" */ #endif #endif /* HEADER_POINTER_H */ ---- * t/CompileTestLib.pm ---- 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); } sub compile_cpp_test_lib($name) is export {     my @cmds;     my $VM  := $*VM;     my $cfg := $VM.config;     my $libname = $VM.platform-library-name($name.IO);     @cleanup = $libname;     if $*DISTRO.is-win {         @cmds    = "cl /LD /EHsc /Fe$libname t/$name.cpp",                    "g++ --shared -fPIC -o $libname t/$name.cpp",     }     else {         @cmds    = "g++ --shared -fPIC -o $libname t/$name.cpp",                    "clang++ -stdlib=libc++ --shared -fPIC -o $libname t/$name.cpp",     }     my (@fails, $succeeded);     for @cmds -> $cmd {         my $handle = shell("$cmd 2>&1", :out);         my $output = $handle.out.slurp-rest;         if $handle.out.close.status {             @fails.push: "Running '$cmd':\n$output"         }         else {             $succeeded = 1;             last         }     }     fail @fails.join('=' x 80 ~ "\n") unless $succeeded; } END {     #    say "cleaning up @cleanup[]";     unlink @cleanup; } ---- * t/05-pointer.t ---- use v6; use Test; use NativeCall; use lib <lib t>; use CompileTestLib; compile_test_lib('05-pointer'); class Feature is repr('CStruct') {       has int32 $.index;       has num64 $.value; } my sub dot(Feature, Feature) returns num64 is native("./05-pointer") { * } my CArray[Feature] $lhs .= new; my CArray[Feature] $rhs .= new; $lhs[5] = Feature.new(index => -1, value => 0e0); $rhs[5] = Feature.new(index => -1, value => 0e0); for 1..5 -> $index {     $rhs[$index - 1] = Feature.new(index => $index, value => 2.5e0);     $lhs[$index - 1] = Feature.new(index => $index, value => 2.5e0); } for ^5 {     is $lhs[$_].value, 2.5e0, "\$lhs[$_].value = 2.5e0";     is $rhs[$_].value, 2.5e0, "\$rhs[$_].value = 2.5e0";     is $lhs[$_].index, $_ + 1, "\$lhs[$_].index = {$_ + 1}";     is $rhs[$_].index, $_ + 1, "\$rhs[$_].index = {$_ + 1}"; } is dot($lhs[0], $rhs[0]), [+] ((2.5 * 2.5) xx 5); done-testing; ---- *** results *** ---- $ mi6 test -v t/05-pointer.t ==> Set PERL6LIB=/home/itoyota/Programs/p6-Foo/lib ==> prove -e /home/itoyota/.rakudobrew/bin/../moar-nom/install/bin/perl6 -r -v t/05-pointer.t t/05-pointer.t ..  ok 1 - $lhs[0].value = 2.5e0 ok 2 - $rhs[0].value = 2.5e0 ok 3 - $lhs[0].index = 1 ok 4 - $rhs[0].index = 1 ok 5 - $lhs[1].value = 2.5e0 ok 6 - $rhs[1].value = 2.5e0 ok 7 - $lhs[1].index = 2 ok 8 - $rhs[1].index = 2 ok 9 - $lhs[2].value = 2.5e0 ok 10 - $rhs[2].value = 2.5e0 ok 11 - $lhs[2].index = 3 ok 12 - $rhs[2].index = 3 ok 13 - $lhs[3].value = 2.5e0 ok 14 - $rhs[3].value = 2.5e0 ok 15 - $lhs[3].index = 4 ok 16 - $rhs[3].index = 4 ok 17 - $lhs[4].value = 2.5e0 ok 18 - $rhs[4].value = 2.5e0 ok 19 - $lhs[4].index = 5 ok 20 - $rhs[4].index = 5 not ok 21 -  # Failed test at t/05-pointer.t line 33 # expected: '31.25' #      got: '6.25' 1..21 # Looks like you failed 1 test of 21 Dubious, test returned 1 (wstat 256, 0x100) Failed 1/21 subtests  Test Summary Report ------------------- t/05-pointer.t (Wstat: 256 Tests: 21 Failed: 1)   Failed test:  21    Non-zero exit status: 1 Files=1, Tests=21,  1 wallclock secs ( 0.02 usr  0.00 sys +  0.51 cusr  0.06 csys =  0.59 CPU) Result: FAIL ---- In the above example, dot method accepts entry address of given two vectors and computes the dot product of the values they have. Hence, in the test case 21, dot($lhs[0],$rhs[0]) should return 31.25e0, where $lhs[0] is the entry address of the CArray[Feature] (the values it has are 2.5e0 xx 5) and $rhs[0] is the entry address of the other CArray[Feature] (the values it has are 2.5e0 xx 5). However, in fact, it returns 6.25e0.  It seems that dot function in C side receive the entry address of the given vector correctly, but it fails in incrementing the pointer address and points a irrelevant address, because CArray cannot allocate contiguous memory. I think that NativeCall needs something for allocating contiguous memory. (I faced this type of error while creating a libsvm bindings for Perl 6: https://github.com/cjlin1/libsvm/blob/master/svm.cpp#L294-L314 ) $ perl6 --version This is Rakudo version 2016.10-309-g3dcc52b built on MoarVM version 2016.10-71-g9d5c874 implementing Perl 6.c.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org