m2-GTK4/tests/test_shim2.mod

MODULE test_shim2 ;

(*
   m2-GTK4 test - the shim's generic GListModel (m2_list_model_new).

   A Modula-2 model with get_n_items/get_item callbacks is queried
   through the GListModel API.  Requires GTK initialised (and so a
   display).
*)

FROM Gtk IMPORT gtk_init;
FROM M2GtkShim IMPORT m2_list_model_new;
FROM GtkStringObject IMPORT gtk_string_object_new,
   gtk_string_object_get_string, gtk_string_object_get_type;
FROM GListModel IMPORT g_list_model_get_n_items, g_list_model_get_item;
FROM GObject IMPORT g_object_unref;
FROM GtkUtils IMPORT CStrToM2;
FROM SYSTEM IMPORT ADDRESS, ADR;
FROM libc IMPORT printf;

VAR
   failed: BOOLEAN;

PROCEDURE Check (condition: BOOLEAN; what: ARRAY OF CHAR);
BEGIN
   IF NOT condition THEN
      printf("FAIL: %s\n", what);
      failed := TRUE
   END
END Check;

PROCEDURE GetNItems (user: ADDRESS) : CARDINAL;
BEGIN
   RETURN 3
END GetNItems;

(* Return a new reference (transfer full). *)
PROCEDURE GetItem (position: CARDINAL; user: ADDRESS) : ADDRESS;
BEGIN
   IF position = 0 THEN RETURN gtk_string_object_new("A") END;
   IF position = 1 THEN RETURN gtk_string_object_new("B") END;
   RETURN gtk_string_object_new("C")
END GetItem;

VAR
   model, item: ADDRESS;
   buf: ARRAY [0..31] OF CHAR;
BEGIN
   failed := FALSE;
   gtk_init();

   model := m2_list_model_new(ADR(GetNItems), ADR(GetItem),
                              gtk_string_object_get_type(), NIL, NIL);
   Check(model # NIL, "model created");
   Check(g_list_model_get_n_items(model) = 3, "n items");

   item := g_list_model_get_item(model, 1);
   CStrToM2(gtk_string_object_get_string(item), buf);
   Check((buf[0] = 'B') AND (buf[1] = 0C), "item 1 is B");
   g_object_unref(item);

   g_object_unref(model);

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