Nativecall ability to set wheter given symbol is to be mangled or not

[Vladimir Marek]

Hi,

In order to play with perl I wanted to do a gui. I decided to try to
bind qt libraries via nativecall[1]. Nativecall contains logic for g++
or msvc which tries to guess mangled name. I found that it does not work
that well for qt libraries. Especially on windows the actual symbols are
far from nativecall guess. So I decided I'll compile the shim library
exporting qt functionality into 'extern "C"' to make the symbols
predictable. Sadly I can't force nativecall to not mangle symbols at
all. I'm using the attached patch and in the perl itself

class QString is repr<CPPStruct> is QObject {
    has Pointer $.vtable;

        my sub qt_QString(Str) returns QString is native('./p6', v1) is
        mangled(False) { * };
...

Important is the 'is mangled(False)'.

Could something like this be included into nativecall?

[1] https://bitbucket.org/vlmarek/perl6-qt (beware, only proof of
concept)

Thank you
-- 
        Vlad

diff --git a/lib/NativeCall.pm6 b/lib/NativeCall.pm6
index 3fabbbb..ff378c1 100644
--- a/lib/NativeCall.pm6
+++ b/lib/NativeCall.pm6
@@ -180,15 +180,16 @@ sub type_code_for(Mu ::T) {
 }
 
 sub gen_native_symbol(Routine $r, :$cpp-name-mangler) {
-    if $r.package.REPR eq 'CPPStruct' {
-        $cpp-name-mangler($r, $r.?native_symbol // ($r.package.^name ~ '::' ~ 
$r.name))
-    }
-    elsif $r.?native_call_mangled {
+    if ! $r.?native_call_mangled {
+        # Native symbol or name is said to be already mangled
+        $r.?native_symbol // $r.name;
+    } elsif $r.package.REPR eq 'CPPStruct' {
+        # Mangle C++ classes
+        $cpp-name-mangler($r, $r.?native_symbol // ($r.package.^name ~ '::' ~ 
$r.name));
+    } else {
+        # Mangle C
         $cpp-name-mangler($r, $r.?native_symbol // $r.name)
     }
-    else {
-        $r.?native_symbol // $r.name
-    }
 }
 
 multi sub map_return_type(Mu $type) { Mu }
@@ -289,9 +290,17 @@ my role Native[Routine $r, $libname where 
Str|Callable|List] {
     has Pointer $!entry-point;
 
     method !setup() {
+        # Make sure that C++ methotds are treated as mangled (unless set 
otherwise)
+        if self.package.REPR eq 'CPPStruct' and not 
self.does(NativeCallMangled) {
+          self does NativeCallMangled[True];
+        }
+
         my $guessed_libname = guess_library_name($libname);
-        $!cpp-name-mangler  = %lib{$guessed_libname} //
-            (%lib{$guessed_libname} = guess-name-mangler($r, 
$guessed_libname));
+        if self.does(NativeCallMangled) and $r.?native_call_mangled {
+          # if needed, try to guess mangler
+          $!cpp-name-mangler  = %lib{$guessed_libname} //
+              (%lib{$guessed_libname} = guess-name-mangler($r, 
$guessed_libname));
+        }
         my Mu $arg_info := param_list_for($r.signature, $r);
         my $conv = self.?native_call_convention || '';
         nqp::buildnativecall(self,

commit 0f118259330184b4e06bdb025e8b416967efe8eb
Author: neuron <vlma...@volny.cz>
Date:   Wed Jul 6 07:37:58 2016 +0200

    Move role definitions before the setup method

diff --git a/lib/NativeCall.pm6 b/lib/NativeCall.pm6
index db7a2cf..3fabbbb 100644
--- a/lib/NativeCall.pm6
+++ b/lib/NativeCall.pm6
@@ -18,6 +18,22 @@ my constant CArray        is export(:types, :DEFAULT) = 
NativeCall::Types::CArra
 my constant Pointer       is export(:types, :DEFAULT) = 
NativeCall::Types::Pointer;
 my constant OpaquePointer is export(:types, :DEFAULT) = 
NativeCall::Types::Pointer;
 
+
+# Role for carrying extra calling convention information.
+my role NativeCallingConvention[$name] {
+    method native_call_convention() { $name };
+}
+
+# Role for carrying extra string encoding information.
+my role NativeCallEncoded[$name] {
+    method native_call_encoded() { $name };
+}
+
+my role NativeCallMangled[$name] {
+    method native_call_mangled() { $name }
+}
+
+
 # Throwaway type just to get us some way to get at the NativeCall
 # representation.
 my class native_callsite is repr('NativeCall') { }
@@ -304,20 +320,6 @@ my role Native[Routine $r, $libname where 
Str|Callable|List] {
     }
 }
 
-# Role for carrying extra calling convention information.
-my role NativeCallingConvention[$name] {
-    method native_call_convention() { $name };
-}
-
-# Role for carrying extra string encoding information.
-my role NativeCallEncoded[$name] {
-    method native_call_encoded() { $name };
-}
-
-my role NativeCallMangled[$name] {
-    method native_call_mangled() { $name }
-}
-
 multi sub postcircumfix:<[ ]>(CArray:D \array, $pos) is export(:DEFAULT, 
:types) {
     $pos ~~ Iterable ?? $pos.map: { array.AT-POS($_) } !! array.AT-POS($pos);
 }