Skip Menu |
Report information
Id: 129784
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, 2 Oct 2016 15:39:24 +0900 (JST)
To: "rakudobug [...] perl.org" <rakudobug [...] perl.org>
Subject: [BUG][NATIVECALL] Cannot assign the malloc allocated memory to the pointer in the argument.
From: cookbook_000 [...] yahoo.co.jp
Download (untitled) / with headers
text/plain 5.3k
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
Download (untitled) / with headers
text/plain 5.9k
On 2016-10月-01 土 23:39:47, cookbook_000@yahoo.co.jp wrote: Show quoted text
> 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
$ perl6 --version This is Rakudo version 2016.09-105-g4abc28c built on MoarVM version 2016.09-13-g34c375a 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