m2-GTK4/tests/test_builder.mod

MODULE test_builder ;

(*
   m2-GTK4 test - GtkBuilder.

   Loads a widget tree from an inline UI string, fetches an object by id,
   looks up a type name, and checks that malformed XML reports a
   GTK_BUILDER_ERROR via the GError out-parameter.  Requires a display.
*)

FROM Gio IMPORT g_application_run, g_application_quit;
FROM GtkApplication IMPORT gtk_application_new;
FROM GtkBuilder IMPORT GtkBuilder, gtk_builder_new,
   gtk_builder_add_from_string, gtk_builder_get_object,
   gtk_builder_get_objects, gtk_builder_get_type_from_name,
   gtk_builder_error_quark;
FROM GError IMPORT GError;
FROM GtkUtils IMPORT Connect, ErrorMessage, ClearError, Unref;
FROM SYSTEM IMPORT ADDRESS, ADR;
FROM libc IMPORT printf;

CONST
   AppId = "org.example.m2gtk4.TestBuilder";
   GoodUi = "<interface><object class='GtkWindow' id='win'><property name='title'>T</property><child><object class='GtkLabel' id='label1'><property name='label'>Hi</property></object></child></object></interface>";

VAR
   app: ADDRESS;
   passed: BOOLEAN;

PROCEDURE OnActivate (application: ADDRESS; data: ADDRESS);
VAR
   builder: GtkBuilder;
   err: GError;
   buf: ARRAY [0..255] OF CHAR;
   ok: BOOLEAN;
BEGIN
   ok := TRUE;

   (* --- success path --- *)
   builder := gtk_builder_new();
   err := NIL;
   IF gtk_builder_add_from_string(builder, GoodUi, -1, err) = 0 THEN
      ErrorMessage(err, buf);
      printf("good UI failed: %s\n", buf);
      ClearError(err);
      ok := FALSE
   END;
   IF err # NIL THEN
      ErrorMessage(err, buf);
      printf("unexpected error: %s\n", buf);
      ClearError(err);
      ok := FALSE
   END;
   IF gtk_builder_get_object(builder, "label1") = NIL THEN
      printf("label1 not found\n");
      ok := FALSE
   END;
   IF gtk_builder_get_type_from_name(builder, "GtkLabel") = 0 THEN
      printf("type lookup failed\n");
      ok := FALSE
   END;
   IF gtk_builder_get_objects(builder) = NIL THEN
      printf("objects list is NIL\n");
      ok := FALSE
   END;
   Unref(builder);

   (* --- failure path: malformed XML must set a GError --- *)
   builder := gtk_builder_new();
   err := NIL;
   IF gtk_builder_add_from_string(builder, "<interface><bad/></interface>",
                                  -1, err) # 0 THEN
      printf("bad UI unexpectedly parsed\n");
      ok := FALSE
   END;
   IF err = NIL THEN
      printf("bad UI did not set an error\n");
      ok := FALSE
   ELSE
      IF err^.domain # gtk_builder_error_quark() THEN
         printf("wrong error domain\n");
         ok := FALSE
      END;
      ClearError(err)
   END;
   Unref(builder);

   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_builder: 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_builder: PASS\n");
      HALT(0)
   ELSE
      printf("test_builder: FAIL\n");
      HALT(1)
   END
END test_builder.