Skip to content

Instantly share code, notes, and snippets.

@Xliff
Last active March 18, 2022 10:46
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save Xliff/74ffdc15f4c20943185f9449240c5e78 to your computer and use it in GitHub Desktop.
Save Xliff/74ffdc15f4c20943185f9449240c5e78 to your computer and use it in GitHub Desktop.
Weird NativeCall Error, or Am I Just Missing Something.... (most likely the later)

The below code gives me the following error message:

This type cannot unbox to a native integer: P6opaque, Whatever
  in block <unit> at t/10-raw-hashtable.t line 15

And for the life of me, I can 't figure out why. Can someone help?

Note: The definition for the glib constant is for Ubuntu-based systems and may need tuning if you are running something else.

===== t/10-raw-hashtable.t =====
use v6;

use NativeCall;

constant gpointer = Pointer;

constant glib      = 'glib-2.0',v0;
constant guint    := uint32;
constant gboolean := uint32;

class GHashTable  is repr<CPointer> { }

my $h = g_hash_table_new(&g_str_hash, &g_str_equal);

my $r = g_hash_table_insert(
  $h,
  toPointer('Jazzy',  typed => Str),
  toPointer('Cheese', typed => Str)
);

say g_hash_table_contains(
  $h,
  toPointer('Jazzy', typed => Str)
);

sub g_hash_table_insert (
  GHashTable $hash_table,
  gpointer   $key,
  gpointer   $value
)
  returns uint32
  is native(glib)
  is export
{ * }

sub g_hash_table_new (
  &hash_func  (Pointer --> guint),
  &equal_func (Pointer $a, Pointer $b --> gboolean)
)
  returns GHashTable
  is native(glib)
  is export
{ * }

sub g_str_equal (gpointer $v1, gpointer $v2)
  returns uint32
  is native(glib)
  is export
{ * }

sub g_str_hash (gpointer $v)
  returns guint
  is native(glib)
  is export
{ * }

sub g_hash_table_contains (GHashTable $hash_table, gpointer $key)
  returns uint32
  is native(glib)
  is export
{ * }

sub toPointer (
  $value,
  :$signed   = False,
  :$double   = False,
  :$direct   = False,
  :$encoding = 'utf8',
  :$all      = False,
  :$typed    = Str
)
  is export
{
  # Properly handle non-Str Cool data.
  return $value if $value ~~ Pointer;
  return ($typed !=== Nil ?? $typed !! Nil) unless $value.defined;
  my ($ov, $use-arr, \t, $v) = ( checkForType($typed, $value), False );
  if $ov ~~ Int && $direct {
    $v = Pointer.new($ov);
  } else {
    given $ov {
      # For all implementor-based classes
      when .^lookup('p').so { $ov .= p }

      when Rat { $ov .= Num; proceed }
      when Int {
        $use-arr = True;
        when $signed.so { t := $double ?? CArray[int64] !!  CArray[int32]  }
        default         { t := $double ?? CArray[uint64] !! CArray[uint32] }
      }
      when Rat | Num {
        $use-arr = True;
        t := $double ?? CArray[num64] !!  CArray[num32]
      }

      # Str
      default {
        $ov = ~$ov unless $ov ~~ Str;
        t := Str;
        # Better to use CArray[uint8] as it is less volatile than Str;
        my $ca = CArray[uint8].new( $ov.encode($encoding) );
        $ov = nativecast(Pointer, $ca);
      }
    }
    if $use-arr {
      $v    = t.new;
      $v[0] = $ov;
    } else {
      $v = $ov;
    }
    $v = nativecast(Pointer, $v) unless $v ~~ Pointer;
  }
  $all.not ?? $v !! ($v, \t);
}

sub resolveNativeType (\T) is export {
  say "Resolving { T.^name } to its Raku equivalent...";
  do given T {
    when num32 | num64     { Num }

    when int8  | uint8  |
         int16 | uint16 |
         int32 | uint32 |
         int64 | uint64
                           { Int }

    when str               { Str }

    default                {
      do if T.REPR eq <CPointer CStruct>.any {
        T
      } else {
        # cw: I don't know if this is the best way to handle this.
        die "Do not know how to handle a type of { .^name }!";
      }
    }
  }
}

sub checkForType(\T, $v is copy) is export {
  if T !=== Nil {
    unless $v ~~ T {
      say "Attempting to convert a { $v.^name } to { T.^name }...";
      my $resolved-name = resolveNativeType(T).^name;
      $resolved-name ~= "[{ T.of.^name }]" if $resolved-name eq 'CArray';
      say "RN: { $resolved-name }";
      if $v.^lookup($resolved-name) -> $m {
        say "Using coercer at { $v.^name }.$resolved-name...";
        $v = $m($v);
      }
      # Note reversal of usual comparison. This is due to the fact that
      # nativecall types must be compatible with the value, not the
      # other way around. In a;; other cases, T and $v should have
      # the same type value.
      die "Value does not support { $v.^name } variables. Will only accept {
        T.^name }!" unless T ~~ $v.WHAT;
    }
  }
  $v;
}
@Xliff
Copy link
Author

Xliff commented Mar 18, 2022

Full stacktrace via --ll-exception

This type cannot unbox to a native integer: P6opaque, Whatever
   at t/10-raw-hashtable.t:15  (<ephemeral file>:<unit>)
 from t/10-raw-hashtable.t:1  (<ephemeral file>:<unit-outer>)
 from gen/moar/stage2/NQPHLL.nqp:1949  (/home/cbwood/.rakubrew/versions/moar-blead/install/share/nqp/lib/NQPHLL.moarvm:eval)
 from gen/moar/stage2/NQPHLL.nqp:2154  (/home/cbwood/.rakubrew/versions/moar-blead/install/share/nqp/lib/NQPHLL.moarvm:evalfiles)
 from gen/moar/stage2/NQPHLL.nqp:2114  (/home/cbwood/.rakubrew/versions/moar-blead/install/share/nqp/lib/NQPHLL.moarvm:command_eval)
 from gen/moar/Compiler.nqp:111  (/home/cbwood/.rakubrew/versions/moar-blead/install/share/perl6/lib/Perl6/Compiler.moarvm:command_eval)
 from gen/moar/stage2/NQPHLL.nqp:2039  (/home/cbwood/.rakubrew/versions/moar-blead/install/share/nqp/lib/NQPHLL.moarvm:command_line)
 from gen/moar/rakudo.nqp:140  (/home/cbwood/.rakubrew/versions/moar-blead/install/share/perl6/runtime/perl6.moarvm:MAIN)
 from gen/moar/rakudo.nqp:1  (/home/cbwood/.rakubrew/versions/moar-blead/install/share/perl6/runtime/perl6.moarvm:<mainline>)
 from <unknown>:1  (/home/cbwood/.rakubrew/versions/moar-blead/install/share/perl6/runtime/perl6.moarvm:<main>)
 from <unknown>:1  (/home/cbwood/.rakubrew/versions/moar-blead/install/share/perl6/runtime/perl6.moarvm:<entry>)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment