Help language development. Donate to The Perl Foundation

Gnome::Glib cpan:MARTIMM last updated on 2022-08-03

use v6;
#use lib '../gnome-native/lib';
use NativeCall;
use Test;

use Gnome::N::NativeLib;
use Gnome::N::GlibToRakuTypes;

use Gnome::Glib::Quark;
use Gnome::Glib::Error;

#use Gnome::N::X;

my Gnome::Glib::Quark $quark .= new;
my Gnome::Glib::Error() $e;
subtest 'ISA test', {
  # The error domain is called <NAMESPACE>_<MODULE>_ERROR
  my GQuark $domain = $quark.from-string('gnome_gtk3_button_test_error');
  $e .= new( :$domain, :code(1), :error-message('Error in test'));
  isa-ok $e, Gnome::Glib::Error, '.new( :domain, :code, :error-message)';

  ok !$, '.clear-object()';
  $e = Nil;

subtest 'Manipulations', {
  my GQuark $domain = $quark.from-string('gnome_gtk3_button_test_error');
  $e .= new( :$domain, :code(2), :error-message('Error in test'));
#  ok $, 'error $e is valid';

  my Gnome::Glib::Error() $e2 = $e.copy;
  ok $, '.copy()';
  ok $e2.matches( $domain, 2), '.matches()';

  is $e2.domain, $domain, '.domain()';
  is $e2.code, 2, '.code()';
  is $e2.message, 'Error in test', '.message()';
  nok $, '.clear-object()';

  $domain = $quark.from-string('gnome_gtk3_button_2nd_test_error');
  $e2 .= new( :$domain, :code(3), :error-message('2nd error in test'));
  ok $e2.matches( $domain, 3), '2nd error matches with domain and code';

  is $e2.domain, $domain, 'domain in structure ok';
  is $e2.code, 3, 'code in structure ok';
  is $e2.message, '2nd error in test', 'message in structure ok';

#  nok $, '.clear-object()';
#  is $e.domain, GQuark, 'domain undefined';
#  is $e.code, Int, 'code undefined';
#  is $e.message, Str, 'message undefined';
#  nok $e.matches( $domain, 3), 'error does not match anymore';

    my GQuark $q = $quark.from-string('some_other_error'),
    222, 'Very weird error!'
#  ok $, 'error $e is valid';
  is $e.domain, $q, '.set-error-literal()';

  $e.prefix-error-literal('a multi % followed by a ');
  is $e.message, 'a multi % followed by a Very weird error!',

# create a local sub to call a gtk function
# Definition is:
#   gboolean g_file_get_contents (
#      const gchar  *filename,
#      gchar       **contents,  // Address to return content
#      gsize        *length,
#      GError      **error);    // Address to return error
# So for api spec for contents and error;
#   CArray[Str] $contents
#   CArray[N-GError] $error
# The variables must be initialized with undefined fields;
#   my CArray[Str] $s .= new(Str);
#   my CArray[N-GError] $ga .= new(N-GError);
sub g_file_get_contents (
  Str $filename, CArray[Str] $contents, int32 $length is rw,
  CArray[N-GError] $error
) returns gboolean
  is native(&glib-lib)
  { * }

subtest 'A real error', {
  my Str $f = 't/abc.txt';
  $f.IO.spurt('test text');

  my CArray[N-GError] $ga .= new(N-GError);
  my CArray[Str] $s .= new(Str);
  my int32 $l;
  my Bool $r = g_file_get_contents( $f, $s, $l, $ga).Bool;
  ok $r, 'no error';
  is $l, 9, 'length of string is ok';
  is $s[0], 'test text', 'returned text is ok';

  $r = g_file_get_contents( 'unknown-file.txt', $s, $l, $ga).Bool;
  nok $r, 'returned an error';

  $e = $ga[0];
#removed test because there is an issue about this domain being 4 instead of 3.
#this means that perhaps there is an extra registration done somehow
#is $e.domain, 3, 'domain is 3; 3rd domain registration in this test';
  is $$e.domain), 'g-file-error-quark',
     'domain text is g-file-error-quark';

  # 4 is value of G_FILE_ERROR_NOENT in enum GFileError (not defined yet)
  # See also
  is $e.code, 4, 'error code for this error is 4';
# problem in other languages:  like $e.message, /:s Failed to open file/, $e.message;

  unlink $f;