| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103 |
- MODULE test_expr ;
- (*
- m2-GTK4 test - expressions and the expression-based sorters/filters.
- Builds a property expression over GtkStringObjects, uses it in a
- GtkStringSorter and a GtkStringFilter, and checks sorting/filtering
- through the list models. Requires GTK initialised (and so a display).
- *)
- FROM Gtk IMPORT gtk_init;
- FROM GtkExpression IMPORT gtk_property_expression_new;
- FROM GtkStringSorter IMPORT gtk_string_sorter_new,
- gtk_string_sorter_set_ignore_case, gtk_string_sorter_get_ignore_case,
- gtk_string_sorter_set_collation, gtk_string_sorter_get_collation;
- FROM GtkNumericSorter IMPORT gtk_numeric_sorter_new,
- gtk_numeric_sorter_set_sort_order, gtk_numeric_sorter_get_sort_order,
- GtkSortDescending;
- FROM GtkStringFilter IMPORT gtk_string_filter_new,
- gtk_string_filter_set_match_mode, gtk_string_filter_get_match_mode,
- gtk_string_filter_set_search, GtkStringFilterSubstring;
- FROM GtkBoolFilter IMPORT gtk_bool_filter_new, gtk_bool_filter_set_invert,
- gtk_bool_filter_get_invert;
- FROM GtkStringList IMPORT gtk_string_list_new, gtk_string_list_append;
- FROM GtkStringObject IMPORT gtk_string_object_get_type,
- gtk_string_object_get_string;
- FROM GtkSortListModel IMPORT gtk_sort_list_model_new;
- FROM GtkFilterListModel IMPORT gtk_filter_list_model_new;
- FROM GListModel IMPORT g_list_model_get_n_items, g_list_model_get_item;
- FROM GObject IMPORT g_object_ref, 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;
- VAR
- expr, sorter, nsorter, filter, boolf, list, sortModel, filterModel,
- item: ADDRESS;
- buf: ARRAY [0..31] OF CHAR;
- BEGIN
- failed := FALSE;
- gtk_init();
- expr := gtk_property_expression_new(gtk_string_object_get_type(), NIL,
- "string", NIL);
- Check(expr # NIL, "property expression");
- sorter := gtk_string_sorter_new(expr);
- gtk_string_sorter_set_ignore_case(sorter, 1);
- Check(gtk_string_sorter_get_ignore_case(sorter) # 0, "sorter ignore case");
- gtk_string_sorter_set_collation(sorter, 0);
- Check(gtk_string_sorter_get_collation(sorter) = 0, "sorter collation");
- nsorter := gtk_numeric_sorter_new(NIL);
- gtk_numeric_sorter_set_sort_order(nsorter, GtkSortDescending);
- Check(gtk_numeric_sorter_get_sort_order(nsorter) = GtkSortDescending,
- "numeric sort order");
- filter := gtk_string_filter_new(expr);
- gtk_string_filter_set_match_mode(filter, GtkStringFilterSubstring);
- Check(gtk_string_filter_get_match_mode(filter) = GtkStringFilterSubstring,
- "filter match mode");
- boolf := gtk_bool_filter_new(NIL);
- gtk_bool_filter_set_invert(boolf, 1);
- Check(gtk_bool_filter_get_invert(boolf) # 0, "bool filter invert");
- list := gtk_string_list_new(NIL);
- gtk_string_list_append(list, "banana");
- gtk_string_list_append(list, "apple");
- gtk_string_list_append(list, "cherry");
- (* sorting: apple < banana < cherry *)
- sortModel := gtk_sort_list_model_new(g_object_ref(list), sorter);
- Check(g_list_model_get_n_items(sortModel) = 3, "sorted count");
- item := g_list_model_get_item(sortModel, 0);
- CStrToM2(gtk_string_object_get_string(item), buf);
- Check(buf[0] = 'a', "sorted first is apple");
- g_object_unref(item);
- (* filtering: only "banana" contains "an" *)
- gtk_string_filter_set_search(filter, "an");
- filterModel := gtk_filter_list_model_new(g_object_ref(list), filter);
- Check(g_list_model_get_n_items(filterModel) = 1, "filtered count");
- IF failed THEN
- printf("test_expr: FAIL\n");
- HALT(1)
- ELSE
- printf("test_expr: PASS\n");
- HALT(0)
- END
- END test_expr.
|