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.