# New Ticket Created by Itsuki Toyota # Please include the string: [perl #129944] # in the subject line of all future correspondence about this issue. # <URL: https://rt.perl.org/Ticket/Display.html?id=129944 >
See the following codes and results:
t/04-utf8.t
----
use v6;
use Test;
use NativeCall;
use lib <lib t>;
use CompileTestLib;
compile_cpp_test_lib('04-utf8');
compile_cpp_test_lib('04-utf8-wrap');
class Lattice is repr('CPointer') {
my sub lattice_create() returns Lattice is native("./04-utf8-wrap") { * }
my sub lattice_set_sentence(Lattice, Str $text) is native("./04-utf8-wrap")
{ * }
my sub lattice_get_sentence(Lattice) returns Str is
native("./04-utf8-wrap") { * }
method new {
lattice_create();
}
method set_sentence(Str $text) {
lattice_set_sentence(self, $text);
}
method get_sentence {
lattice_get_sentence(self);
}
}
my $lattice = Lattice.new;
$lattice.set_sentence("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa");
dd $lattice.get_sentence;
done-testing;
----
t/04-utf8-wrap.cpp
----
#include <cstdlib>
#include <cstdio>
#include "04-utf8.cpp"
#ifdef __cplusplus
extern "C" {
#endif
struct Lattice {
kombu::Lattice *lattice;
};
Lattice *lattice_create(void) {
Lattice *l = (Lattice*)malloc(sizeof(Lattice));
l->lattice = new(kombu::Lattice);
return l;
}
void lattice_set_sentence(Lattice* l, const char* text) {
l->lattice->set_sentence(text);
}
const char *lattice_get_sentence(Lattice* l) {
l->lattice->get_sentence();
}
#ifdef __cplusplus
} /* closing brace for extern "C" */
#endif
----
t/04-utf8.cpp
----
namespace kombu {
class Lattice {
public:
Lattice() : sentence_(0) {}
void set_sentence(const char* text) {
sentence_ = text;
}
const char *get_sentence() const {
return sentence_;
}
private:
const char* sentence_;
};
};
----
t/04-utf8.h
----
#if ! defined(HEADER_UTF8_H)
#define HEADER_UTF8_H
#ifdef __cplusplus
extern "C" {
#endif
typedef struct Lattice {
void *lattice;
} Lattice;
void set_sentence(struct Lattice*, const char* text);
void get_sentence(struct Lattice*);
Lattice *lattice_create(void);
#ifdef __cplusplus
} /* closing brace for extern "C" */
#endif
#endif /* HEADER_UTF8_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;
}
----
results
----
$ mi6 test -v t/04-utf8.t
==> Set PERL6LIB=/home/itoyota/Programs/p6-Foo/lib
==> prove -e /home/itoyota/.rakudobrew/bin/../moar-nom/install/bin/perl6 -r -v
t/04-utf8.t
t/04-utf8.t .. Malformed UTF-8 at line 1 col 2
in method CALL-ME at
/home/itoyota/.rakudobrew/moar-nom/install/share/perl6/sources/24DD121B5B4774C04A7084827BFAD92199756E03
(NativeCall) line 333
in method get_sentence at t/04-utf8.t line 21
in block <unit> at t/04-utf8.t line 29
Dubious, test returned 1 (wstat 256, 0x100)
No subtests run
Test Summary Report
-------------------
t/04-utf8.t (Wstat: 256 Tests: 0 Failed: 0)
Non-zero exit status: 1
Parse errors: No plan found in TAP output
Files=1, Tests=0, 1 wallclock secs ( 0.02 usr 0.00 sys + 0.67 cusr 0.04
csys = 0.73 CPU)
Result: FAIL
----
I think $lattice.get_sentence method should return
"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa".
