Help language development. Donate to The Perl Foundation

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

t/MainLoop.t
use v6;
use NativeCall;
use Test;

use Gnome::N::GlibToRakuTypes;

use Gnome::Glib::MainLoop;
use Gnome::Glib::MainContext;
use Gnome::Glib::Source;

#use Gnome::N::X;
#Gnome::N::debug(:on);

#-------------------------------------------------------------------------------
my Gnome::Glib::MainLoop $ml;
my Gnome::Glib::MainContext $mc;
#-------------------------------------------------------------------------------
subtest 'ISA test', {
  $ml .= new;
  isa-ok $ml, Gnome::Glib::MainLoop, '.new()';
  $ml.clear-object;

  $ml .= new(:context(Gnome::Glib::MainContext.new(:default)));
  isa-ok $ml, Gnome::Glib::MainLoop, '.new(:context)';
  isa-ok $ml.get-context, Gnome::Glib::MainContext, '.get-context()';
  $ml.clear-object;
}

#-------------------------------------------------------------------------------
# set environment variable 'raku-test-all' if rest must be tested too.
unless %*ENV<raku_test_all>:exists {
  done-testing;
  exit;
}

#-------------------------------------------------------------------------------
subtest "start thread with a new context", {
  class ContextHandlers {
    has $.handler-invoked = False;
    has $count = 0;

    method handler1 ( Str :$opt1, Bool :$invoke-full = False --> gboolean ) {
#CATCH { .note; }

      diag [~] $*THREAD.id, ' handler1 called: ', $count,
           ', invoke-full: ', $invoke-full;
      is $opt1, 'o1', 'Option :opt1 received';
      $!handler-invoked = True;

      # return G_SOURCE_CONTINUE 3x, the method will then be recalled 3 times
      if ++$count > 2 {
        $count = 0;
        diag $*THREAD.id ~ ' Return G_SOURCE_REMOVE';
        G_SOURCE_REMOVE
      }

      else {
        diag $*THREAD.id ~ ' Return G_SOURCE_CONTINUE';
        G_SOURCE_CONTINUE
      }
    }

    method notify ( Str :$opt2 ) {
#CATCH { .note; }
      diag "$*THREAD.id(), In notify handler";
      is $opt2, 'o2', 'option :opt2 received';
    }
  }

  my ContextHandlers $ch .= new;

  # there is an error when initialized both times with :default;
  #   (process:818039): GLib-CRITICAL **: 17:54:09.597:
  #   g_main_context_push_thread_default: assertion 'acquired_context' failed
  my Gnome::Glib::MainContext $main-context1 .= new;
  my Gnome::Glib::MainLoop $loop .= new(:context($main-context1));

  diag "$*THREAD.id(), Start thread";
  my Promise $p = start {
#CATCH { .note; }
    # wait for loop to start
    sleep(.3);

    #---------------------------------------------------------------------------
    subtest "manipulations ...", {
      $mc .= new(:default);
      ok $mc.acquire, '.acquire()';
      nok $mc.iteration(False), '.iteration()';
      nok $mc.pending, '.pending()';
      ok $mc.is-owner, '.is-owner()';
#      ok 1, $mc.dispatch // '.dispatch()';
      ok 1, $mc.wakeup // '.wakeup()';
      ok 1, $mc.release // '.release()';
    }

    ok $loop.is-running, '.is-running()';

    diag "$*THREAD.id(), " ~
         "Use .context-new\() and " ~
         ".push_thread_default\() to create and push " ~
         "a new context to invoke handler on thread";

    # This part is important that it happens in the thread where the
    # function is invoked in that context! The context must be
    # different than the one above that is used to create the loop
    my Gnome::Glib::MainContext $main-context2 .= new;
    $main-context2.push-thread-default;

#    diag "$*THREAD.id(), Use .invoke-full() to invoke sub on thread";

    $main-context2.invoke( $ch, 'handler1', :opt1<o1>);

    $main-context2.invoke-raw(
      -> Pointer $d { $ch.'handler1'(:opt1<o1>); },
    );

    if %*ENV<appveyor_tests>:exists {
      diag 'tests of invoke-full*() skipped; windows makes an infinite loop of it …';
    }

    else {
      $main-context2.invoke-full(
        G_PRIORITY_DEFAULT, $ch, 'handler1', $ch, 'notify',
        :opt1<o1>, :opt2<o2>, :invoke-full
      );

      $main-context2.invoke-full-raw(
        G_PRIORITY_DEFAULT,
        -> Pointer $d { $ch.'handler1'( :opt1<o1>, :invoke-full); },
        -> Pointer $d { $ch.'notify'( :opt2<o2>); },
      );
    }

    diag [~] $*THREAD.id(), ', ',
         'Use .pop-thread-default() to remove the context';
    $main-context2.pop-thread-default;

    $loop.quit;
    'test done'
  }

  diag "$*THREAD.id(), Start loop with .run\()";
  $loop.run;
  diag "$*THREAD.id(), Loop stopped";

  await $p;
  is $p.result, 'test done', 'Result promise ok';
}

#-------------------------------------------------------------------------------
subtest 'timeout-add', {
  class Timeout {
    method tom-poes-do-something ( Str :$task, :$loop --> Int ) {
      state Int $count = 2;
      diag "Tom Poes, please $task $count times";
      if $count++ >= 5 {
        $loop.quit;       # quit loop
        $count = 2;       # prepare for next test
        G_SOURCE_REMOVE   # destroy timeout struct
      }

      else {
        G_SOURCE_CONTINUE
      }
    }
  }

  my Gnome::Glib::MainLoop $loop .= new;

  my Timeout $to .= new;
  my Int $esid = $loop.timeout-add(
    100, $to, 'tom-poes-do-something', :task<jump>, :$loop
  );
  ok $esid > 0, '.timeout-add(): ' ~ $esid;
  $loop.run;



#`{{TODO
  my Gnome::Glib::MainContext $main-context .= new(:thread-default);
  $loop .= new(:context($main-context));

  my Gnome::Glib::Source $source .= new(:timeout(200));
  $source.set-callback( $to, 'tom-poes-do-something', :task<jump>, :$loop);
  note 'acq: ', $main-context.acquire;
  $main-context.attach($source);
  $main-context.dispatch;
  $loop.run;
}}
}

#`{{

#-------------------------------------------------------------------------------
subtest 'Manipulations', {
}

#-------------------------------------------------------------------------------
subtest 'Inherit Gnome::Glib::Main', {
  class MyClass is Gnome::Glib::Main {
    method new ( |c ) {
      self.bless( :GMain, |c);
    }

    submethod BUILD ( *%options ) {

    }
  }

  my MyClass $mgc .= new;
  isa-ok $mgc, Gnome::Glib::Main, '.new()';
}

#-------------------------------------------------------------------------------
subtest 'Interface ...', {
}

#-------------------------------------------------------------------------------
subtest 'Properties ...', {
  use Gnome::GObject::Value;
  use Gnome::GObject::Type;

  #my Gnome::Glib::Main $m .= new;

  sub test-property ( $type, Str $prop, Str $routine, $value ) {
    my Gnome::GObject::Value $gv .= new(:init($type));
    $m.get-property( $prop, $gv);
    my $gv-value = $gv."$routine"();
    is $gv-value, $value, "property $prop";
    $gv.clear-object;
  }

  # example call
  #test-property( G_TYPE_BOOLEAN, 'homogeneous', 'get-boolean', 0);
}

#-------------------------------------------------------------------------------
subtest 'Themes ...', {
}

#-------------------------------------------------------------------------------
subtest 'Signals ...', {
  use Gnome::Gtk3::Main;
  use Gnome::N::GlibToRakuTypes;

  my Gnome::Gtk3::Main $main .= new;

  class SignalHandlers {
    has Bool $!signal-processed = False;

    method ... (
      'any-args',
      Gnome::Glib::Main() :$_native-object, gulong :$_handler-id
      # --> ...
    ) {

      isa-ok $_widget, Gnome::Glib::Main;
      $!signal-processed = True;
    }

    method signal-emitter ( Gnome::Glib::Main :$widget --> Str ) {

      while $main.gtk-events-pending() { $main.iteration-do(False); }

      $widget.emit-by-name(
        'signal',
      #  'any-args',
      #  :return-type(int32),
      #  :parameters([int32,])
      );
      is $!signal-processed, True, '\'...\' signal processed';

      while $main.gtk-events-pending() { $main.iteration-do(False); }

      #$!signal-processed = False;
      #$widget.emit-by-name(
      #  'signal',
      #  'any-args',
      #  :return-type(int32),
      #  :parameters([int32,])
      #);
      #is $!signal-processed, True, '\'...\' signal processed';

      while $main.gtk-events-pending() { $main.iteration-do(False); }
      sleep(0.4);
      $main.gtk-main-quit;

      'done'
    }
  }

  my Gnome::Glib::Main $m .= new;

  #my Gnome::Gtk3::Window $w .= new;
  #$w.add($m);

  my SignalHandlers $sh .= new;
  $m.register-signal( $sh, 'method', 'signal');

  my Promise $p = $m.start-thread(
    $sh, 'signal-emitter',
    # G_PRIORITY_DEFAULT,       # enable 'use Gnome::Glib::Main'
    # :!new-context,
    # :start-time(now + 1)
  );

  is $main.gtk-main-level, 0, "loop level 0";
  $main.gtk-main;
  #is $main.gtk-main-level, 0, "loop level is 0 again";

  is $p.result, 'done', 'emitter finished';
}
}}

#-------------------------------------------------------------------------------
done-testing;