m2-GTK4/tests/test_closure.mod

MODULE test_closure ;

(*
   m2-GTK4 test - per-connection closures (GtkClosures).

   Two buttons share one handler but carry independent counters; a
   payload is attached to a GSimpleAction through the 3-argument form;
   and disconnecting an "owned" connection runs its destroy procedure.
   Requires a display and the ISO dialect (-fiso).
*)

FROM Gio IMPORT g_application_run, g_application_quit;
FROM GtkApplication IMPORT gtk_application_new;
FROM GtkWindow IMPORT gtk_application_window_new, gtk_window_set_child;
FROM GtkBox IMPORT gtk_box_new, gtk_box_append;
FROM GtkEnums IMPORT GtkVertical;
FROM GtkButton IMPORT gtk_button_new_with_label;
FROM GObject IMPORT g_signal_emit_by_name, g_signal_handler_disconnect;
FROM GSimpleAction IMPORT g_simple_action_new;
FROM GAction IMPORT g_action_activate;
FROM GtkUtils IMPORT Connect;
FROM GtkClosures IMPORT Connect2, Connect3, Connect2Owned;
FROM SYSTEM IMPORT ADDRESS, CAST, ADR;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM libc IMPORT printf;

CONST
   AppId = "org.example.m2gtk4.TestClosure";

TYPE
   Counter = POINTER TO CounterRec;
   CounterRec = RECORD
      n: INTEGER;
   END;

VAR
   app: ADDRESS;
   passed: BOOLEAN;
   ownedDestroyed: BOOLEAN;

PROCEDURE OnClick (instance: ADDRESS; user: ADDRESS);
VAR
   c: Counter;
BEGIN
   c := CAST(Counter, user);
   INC(c^.n)
END OnClick;

PROCEDURE OnGo (instance, param: ADDRESS; user: ADDRESS);
VAR
   c: Counter;
BEGIN
   c := CAST(Counter, user);
   INC(c^.n)
END OnGo;

PROCEDURE DestroyCounter (user: ADDRESS);
VAR
   c: Counter;
BEGIN
   ownedDestroyed := TRUE;
   c := CAST(Counter, user);
   DISPOSE(c)
END DestroyCounter;

PROCEDURE OnActivate (application: ADDRESS; data: ADDRESS);
VAR
   window, box, buttonA, buttonB, buttonC, action: ADDRESS;
   ca, cb, cc, cgo: Counter;
   idC: LONGCARD;
   ok: BOOLEAN;
BEGIN
   ok := TRUE;

   NEW(ca); ca^.n := 0;
   NEW(cb); cb^.n := 0;
   NEW(cgo); cgo^.n := 0;

   (* two connections, one handler, independent state *)
   buttonA := gtk_button_new_with_label("A");
   buttonB := gtk_button_new_with_label("B");
   Connect2(buttonA, "clicked", OnClick, CAST(ADDRESS, ca));
   Connect2(buttonB, "clicked", OnClick, CAST(ADDRESS, cb));

   g_signal_emit_by_name(buttonA, "clicked");
   g_signal_emit_by_name(buttonA, "clicked");
   g_signal_emit_by_name(buttonB, "clicked");
   IF ca^.n # 2 THEN printf("button A count wrong\n"); ok := FALSE END;
   IF cb^.n # 1 THEN printf("button B count wrong\n"); ok := FALSE END;

   (* 3-argument form: action "activate" carries a parameter *)
   action := g_simple_action_new("go", NIL);
   Connect3(action, "activate", OnGo, CAST(ADDRESS, cgo));
   g_action_activate(action, NIL);
   IF cgo^.n # 1 THEN printf("action count wrong\n"); ok := FALSE END;

   (* owned connection: destroy runs on explicit disconnect *)
   NEW(cc); cc^.n := 0;
   ownedDestroyed := FALSE;
   buttonC := gtk_button_new_with_label("C");
   idC := Connect2Owned(buttonC, "clicked", OnClick,
                        CAST(ADDRESS, cc), DestroyCounter);
   g_signal_emit_by_name(buttonC, "clicked");
   IF cc^.n # 1 THEN printf("owned count wrong\n"); ok := FALSE END;
   g_signal_handler_disconnect(buttonC, idC);
   IF NOT ownedDestroyed THEN printf("destroy not called\n"); ok := FALSE END;

   box := gtk_box_new(GtkVertical, 4);
   gtk_box_append(box, buttonA);
   gtk_box_append(box, buttonB);
   gtk_box_append(box, buttonC);
   window := gtk_application_window_new(application);
   gtk_window_set_child(window, box);

   passed := ok;
   g_application_quit(application)
END OnActivate;

VAR
   rc: INTEGER;
BEGIN
   passed := FALSE;
   app := gtk_application_new(AppId, 0);
   IF app = NIL THEN
      printf("test_closure: FAIL (no app)\n");
      HALT(1)
   END;
   Connect(app, "activate", ADR(OnActivate), NIL);
   rc := g_application_run(app, 0, NIL);

   IF passed THEN
      printf("test_closure: PASS\n");
      HALT(0)
   ELSE
      printf("test_closure: FAIL\n");
      HALT(1)
   END
END test_closure.