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

p6rt · 2016-10-02T06:39:46Z

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

Searchable as RT129784$

p6rt · 2016-10-02T06:39:47Z

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

p6rt · 2016-10-02T06:42:57Z

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 <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.

p6rt added Bug NativeCall labels Jan 5, 2020

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

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

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

p6rt commented Oct 2, 2016

p6rt commented Oct 2, 2016

p6rt commented Oct 2, 2016

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

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

Comments

p6rt commented Oct 2, 2016

p6rt commented Oct 2, 2016

From @titsuki

p6rt commented Oct 2, 2016

From @titsuki