Cannot assign the malloc allocated memory to the pointer in the argument.

p6rt commented 8 years ago

Migrated from rt.perl.org#129784 (status was 'new')

Searchable as RT129784$

p6rt commented 8 years ago

From @titsuki

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 \; 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\;

# MoarVM exposes exposes GNU make directives here, but we cannot pass this to gcc directly. my $ldshared = $cfg\.subst(/'--out-implib,lib$(notdir $@).a'/, "--out-implib,$libname.a");

$c_line = "$cfg\ -c $cfg\ $cfg\$name$o $cfg\ t/$name.c"; $l_line = "$cfg\ $ldshared $cfg\ $cfg\ $cfg\$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

p6rt commented 8 years ago

From @titsuki

On 2016-10月-01 土 23:39:47, cookbook_000@yahoo.co.jp wrote:

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 \; 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\;

# MoarVM exposes exposes GNU make directives here, but we cannot pass this to gcc directly. my $ldshared = $cfg\.subst(/'--out-implib,lib$(notdir $@).a'/, "--out-implib,$libname.a");

$c_line = "$cfg\ -c $cfg\ $cfg\$name$o $cfg\ t/$name.c"; $l_line = "$cfg\ $ldshared $cfg\ $cfg\ $cfg\$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.

Raku / old-issue-tracker

Cannot assign the malloc allocated memory to the pointer in the argument. #5716

From @titsuki

From @titsuki