| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153 |
- MODULE test_gio ;
- (*
- m2-GTK4 test - GIO extras: GListStore (with GtkStringObject items),
- GFile, and GSettings (guarded by a schema lookup so it is safe and
- skips cleanly when the test schema is not installed).
- Needs no display.
- *)
- FROM GListStore IMPORT g_list_store_new, g_list_store_append,
- g_list_store_remove, g_list_store_find;
- 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 GFile IMPORT g_file_new_for_path, g_file_get_basename,
- g_file_get_path, g_file_query_exists;
- FROM GSettings IMPORT g_settings_new, g_settings_get_boolean,
- g_settings_set_boolean, g_settings_get_int, g_settings_set_int,
- g_settings_get_string, g_settings_set_string, g_settings_reset,
- g_settings_sync;
- FROM GSettingsSchema IMPORT g_settings_schema_source_get_default,
- g_settings_schema_source_lookup, g_settings_schema_unref,
- g_settings_schema_has_key;
- FROM GObject IMPORT g_object_unref;
- FROM GLib IMPORT g_free;
- FROM GtkUtils IMPORT CStrToM2;
- FROM SYSTEM IMPORT ADDRESS;
- FROM libc IMPORT printf;
- VAR
- failed: BOOLEAN;
- PROCEDURE Check (condition: BOOLEAN; VAR ok: BOOLEAN; what: ARRAY OF CHAR);
- BEGIN
- IF NOT condition THEN
- printf("FAIL: %s\n", what);
- ok := FALSE
- END
- END Check;
- PROCEDURE TestListStore (VAR ok: BOOLEAN);
- VAR
- store, o1, o2, o3, item: ADDRESS;
- pos: CARDINAL;
- buf: ARRAY [0..63] OF CHAR;
- BEGIN
- store := g_list_store_new(gtk_string_object_get_type());
- o1 := gtk_string_object_new("one");
- o2 := gtk_string_object_new("two");
- o3 := gtk_string_object_new("three");
- g_list_store_append(store, o1);
- g_list_store_append(store, o2);
- g_list_store_append(store, o3);
- Check(g_list_model_get_n_items(store) = 3, ok, "list store size");
- IF g_list_store_find(store, o3, pos) # 0 THEN
- Check(pos = 2, ok, "list store find position")
- ELSE
- Check(FALSE, ok, "list store find")
- END;
- (* remove the middle item; the rest shift down *)
- g_list_store_remove(store, 1);
- Check(g_list_model_get_n_items(store) = 2, ok, "list store after remove");
- item := g_list_model_get_item(store, 1);
- CStrToM2(gtk_string_object_get_string(item), buf);
- Check((buf[0] = 't') AND (buf[4] = 'e') AND (buf[5] = 0C),
- ok, "list store item text");
- g_object_unref(item);
- (* release our references; the store keeps the items alive *)
- g_object_unref(o1);
- g_object_unref(o2);
- g_object_unref(o3);
- g_object_unref(store)
- END TestListStore;
- PROCEDURE TestFile (VAR ok: BOOLEAN);
- VAR
- file, temp: ADDRESS;
- buf: ARRAY [0..255] OF CHAR;
- BEGIN
- file := g_file_new_for_path("/tmp");
- Check(g_file_query_exists(file, NIL) # 0, ok, "file query_exists /tmp");
- temp := g_file_get_basename(file);
- CStrToM2(temp, buf);
- g_free(temp);
- Check((buf[0] = 't') AND (buf[2] = 'p') AND (buf[3] = 0C),
- ok, "file basename");
- g_object_unref(file);
- file := g_file_new_for_path("/no/such/m2gtk4/path");
- Check(g_file_query_exists(file, NIL) = 0, ok, "file missing");
- g_object_unref(file)
- END TestFile;
- PROCEDURE TestSettings (VAR ok: BOOLEAN);
- VAR
- source, schema, settings: ADDRESS;
- text: ADDRESS;
- buf: ARRAY [0..63] OF CHAR;
- BEGIN
- source := g_settings_schema_source_get_default();
- schema := g_settings_schema_source_lookup(source, "org.example.m2gtk4", 1);
- IF schema = NIL THEN
- printf("(test schema not installed: GSettings part skipped)\n");
- RETURN
- END;
- Check(g_settings_schema_has_key(schema, "flag") # 0, ok, "schema has flag");
- g_settings_schema_unref(schema);
- settings := g_settings_new("org.example.m2gtk4");
- g_settings_set_boolean(settings, "flag", 1);
- Check(g_settings_get_boolean(settings, "flag") # 0, ok, "settings boolean");
- g_settings_reset(settings, "flag");
- g_settings_set_int(settings, "count", 7);
- Check(g_settings_get_int(settings, "count") = 7, ok, "settings int");
- g_settings_reset(settings, "count");
- g_settings_set_string(settings, "name", "modula");
- text := g_settings_get_string(settings, "name");
- CStrToM2(text, buf);
- g_free(text);
- Check((buf[0] = 'm') AND (buf[5] = 'a') AND (buf[6] = 0C),
- ok, "settings string");
- g_settings_reset(settings, "name");
- g_settings_sync();
- g_object_unref(settings)
- END TestSettings;
- VAR
- ok: BOOLEAN;
- BEGIN
- ok := TRUE;
- TestListStore(ok);
- TestFile(ok);
- TestSettings(ok);
- IF ok THEN
- printf("test_gio: PASS\n");
- HALT(0)
- ELSE
- printf("test_gio: FAIL\n");
- HALT(1)
- END
- END test_gio.
|