m2-GTK4/tests/test_models.mod

MODULE test_models ;

(*
   m2-GTK4 test - filter and sort models.

   Wraps a GListStore of strings with a GtkCustomFilter (via
   GtkFilterListModel) and a GtkCustomSorter (via GtkSortListModel).
   The match/compare callbacks are plain Modula-2 procedures.  Needs no
   display.
*)

FROM GListStore IMPORT g_list_store_new, g_list_store_append;
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 GtkCustomFilter IMPORT gtk_custom_filter_new;
FROM GtkFilterListModel IMPORT gtk_filter_list_model_new,
   gtk_filter_list_model_set_incremental, gtk_filter_list_model_get_filter;
FROM GtkCustomSorter IMPORT gtk_custom_sorter_new;
FROM GtkSortListModel IMPORT gtk_sort_list_model_new,
   gtk_sort_list_model_get_sorter;
FROM GObject IMPORT g_object_ref, g_object_unref;
FROM GtkUtils IMPORT CStrToM2;
FROM Gtk IMPORT gtk_init;
FROM GLib IMPORT g_strcmp0;
FROM SYSTEM IMPORT ADDRESS, ADR;
FROM libc IMPORT strncpy, 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;

(* gboolean match(gpointer item, gpointer user_data): keep names with 'l'. *)
PROCEDURE Match (item: ADDRESS; user: ADDRESS) : INTEGER;
VAR
   src: ADDRESS;
   buf: ARRAY [0..63] OF CHAR;
   i: CARDINAL;
   found: BOOLEAN;
BEGIN
   src := gtk_string_object_get_string(item);
   strncpy(ADR(buf), src, HIGH(buf) + 1);
   buf[HIGH(buf)] := 0C;
   found := FALSE;
   i := 0;
   WHILE (i < HIGH(buf)) AND (buf[i] # 0C) DO
      IF (buf[i] = 'l') OR (buf[i] = 'L') THEN found := TRUE END;
      INC(i)
   END;
   IF found THEN RETURN 1 ELSE RETURN 0 END
END Match;

(* int compare(gconstpointer a, gconstpointer b, gpointer user_data) *)
PROCEDURE Compare (a, b, user: ADDRESS) : INTEGER;
BEGIN
   RETURN g_strcmp0(gtk_string_object_get_string(a),
                    gtk_string_object_get_string(b))
END Compare;

VAR
   store, filter, filterModel, sorter, sortModel, item: ADDRESS;
   buf: ARRAY [0..63] OF CHAR;
BEGIN
   failed := FALSE;

   gtk_init();   (* GTK model types need the GTK type system initialised *)

   store := g_list_store_new(gtk_string_object_get_type());
   g_list_store_append(store, gtk_string_object_new("Alpha"));
   g_list_store_append(store, gtk_string_object_new("Beta"));
   g_list_store_append(store, gtk_string_object_new("Gamma"));
   g_list_store_append(store, gtk_string_object_new("Delta"));

   (* filter: only "Alpha" and "Delta" contain 'l'.
      gtk_filter_list_model_new takes ownership of model and filter. *)
   filter := gtk_custom_filter_new(ADR(Match), NIL, NIL);
   filterModel := gtk_filter_list_model_new(g_object_ref(store), filter);
   gtk_filter_list_model_set_incremental(filterModel, 0);
   Check(gtk_filter_list_model_get_filter(filterModel) = filter,
         "filter list model filter");
   Check(g_list_model_get_n_items(filterModel) = 2, "filtered count");

   (* sort: ascending by string; first item must be "Alpha".
      gtk_sort_list_model_new takes ownership of model and sorter. *)
   sorter := gtk_custom_sorter_new(ADR(Compare), NIL, NIL);
   sortModel := gtk_sort_list_model_new(g_object_ref(store), sorter);
   Check(gtk_sort_list_model_get_sorter(sortModel) = sorter,
         "sort list model sorter");
   Check(g_list_model_get_n_items(sortModel) = 4, "sorted count");
   item := g_list_model_get_item(sortModel, 0);
   CStrToM2(gtk_string_object_get_string(item), buf);
   Check(buf[0] = 'A', "sorted first item is Alpha");
   g_object_unref(item);

   (* filter and sorter were consumed by the models above *)
   g_object_unref(filterModel);
   g_object_unref(sortModel);
   g_object_unref(store);

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