## xclient-unit-test.pkg
#
# NB: We must compile this locally via
# xclient-internals.sublib
# instead of globally via
# src/lib/test/unit-tests.lib# like most unit tests, in order to have
# access to required library internals.
# Compiled by:
# src/lib/x-kit/xclient/xclient.sublib# Run by:
# src/lib/test/all-unit-tests.pkgstipulate
include package unit_test; # unit_test is from src/lib/src/unit-test.pkg include package makelib::scripting_globals;
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
# package byt = byte; # byte is from src/lib/std/src/byte.pkg package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg# package mps = microthread_preemptive_scheduler; # microthread_preemptive_scheduler is from src/lib/src/lib/thread-kit/src/core-thread-kit/microthread-preemptive-scheduler.pkg package mtx = rw_matrix; # rw_matrix is from src/lib/std/src/rw-matrix.pkg package r8 = rgb8; # rgb8 is from src/lib/x-kit/xclient/src/color/rgb8.pkg# package tsc = thread_scheduler_control; # thread_scheduler_control is from src/lib/src/lib/thread-kit/src/posix/thread-scheduler-control.pkg package tsr = thread_scheduler_is_running; # thread_scheduler_is_running is from src/lib/src/lib/thread-kit/src/core-thread-kit/thread-scheduler-is-running.pkg# package tr = logger; # logger is from src/lib/src/lib/thread-kit/src/lib/logger.pkg package xtr = xlogger; # xlogger is from src/lib/x-kit/xclient/src/stuff/xlogger.pkg# package sox = socket_junk; # socket_junk is from src/lib/internet/socket-junk.pkg package xet = xevent_types; # xevent_types is from src/lib/x-kit/xclient/src/wire/xevent-types.pkg package xj = xsession_junk; # xsession_junk is from src/lib/x-kit/xclient/src/window/xsession-junk.pkg package dy = display; # display is from src/lib/x-kit/xclient/src/wire/display.pkg package rgb = rgb; # rgb is from src/lib/x-kit/xclient/src/color/rgb.pkg package wy = widget_style; # widget_style is from src/lib/x-kit/widget/lib/widget-style.pkg package rop = ro_pixmap; # ro_pixmap is from src/lib/x-kit/xclient/src/window/ro-pixmap.pkg package shp = shade; # shade is from src/lib/x-kit/widget/lib/shade.pkg package r2k = xevent_router_to_keymap; # xevent_router_to_keymap is from src/lib/x-kit/xclient/src/window/xevent-router-to-keymap.pkg package x2s = xclient_to_sequencer; # xclient_to_sequencer is from src/lib/x-kit/xclient/src/wire/xclient-to-sequencer.pkg package sep = client_to_selection; # client_to_selection is from src/lib/x-kit/xclient/src/window/client-to-selection.pkg package wpp = client_to_window_watcher; # client_to_window_watcher is from src/lib/x-kit/xclient/src/window/client-to-window-watcher.pkg package ap = client_to_atom; # client_to_atom is from src/lib/x-kit/xclient/src/iccc/client-to-atom.pkg# package p2g = pen_cache; # pen_cache is from src/lib/x-kit/xclient/src/window/pen-cache.pkg package w2x = windowsystem_to_xserver; # windowsystem_to_xserver is from src/lib/x-kit/xclient/src/window/windowsystem-to-xserver.pkg package sj = socket_junk; # socket_junk is from src/lib/internet/socket-junk.pkg package fti = font_index; # font_index is from src/lib/x-kit/xclient/src/window/font-index.pkg package a2r = windowsystem_to_xevent_router; # windowsystem_to_xevent_router is from src/lib/x-kit/xclient/src/window/windowsystem-to-xevent-router.pkg package xt = xtypes; # xtypes is from src/lib/x-kit/xclient/src/wire/xtypes.pkg package au = authentication; # authentication is from src/lib/x-kit/xclient/src/stuff/authentication.pkg package v2w = value_to_wire; # value_to_wire is from src/lib/x-kit/xclient/src/wire/value-to-wire.pkg package wi = window; # window is from src/lib/x-kit/xclient/src/window/window.pkg# package qk = quark; # quark is from src/lib/x-kit/style/quark.pkg package g2d = geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg# package hsv = hue_saturation_value; # hue_saturation_value is from src/lib/x-kit/xclient/src/color/hue-saturation-value.pkg# package rpx = ro_pixmap_ximp; # ro_pixmap_ximp is from src/lib/x-kit/widget/lib/ro-pixmap-ximp.pkg# package imx = image_ximp; # image_ximp is from src/lib/x-kit/widget/lib/image-ximp.pkg# package shx = shade_ximp; # shade _ximp is from src/lib/x-kit/widget/lib/shade-ximp.pkg package rw = root_window; # root_window is from src/lib/x-kit/widget/lib/root-window.pkg package wme = window_map_event_sink; # window_map_event_sink is from src/lib/x-kit/xclient/src/window/window-map-event-sink.pkg package cpm = cs_pixmap; # cs_pixmap is from src/lib/x-kit/xclient/src/window/cs-pixmap.pkg package cpt = cs_pixmat; # cs_pixmat is from src/lib/x-kit/xclient/src/window/cs-pixmat.pkg package v1u = vector_of_one_byte_unts; # vector_of_one_byte_unts is from src/lib/std/src/vector-of-one-byte-unts.pkg package u1 = one_byte_unt; # one_byte_unt is from src/lib/std/one-byte-unt.pkg package rwv = rw_vector; # rw_vector is from src/lib/std/src/rw-vector.pkg package e2s = xevent_to_string; # xevent_to_string is from src/lib/x-kit/xclient/src/to-string/xevent-to-string.pkg #
tracefile = "xclient-unit-test.trace.log";
nb = log::note_on_stderr; # log is from src/lib/std/src/log.pkgherein
package xclient_unit_test {
#
name = "src/lib/x-kit/xclient/src/stuff/xclient-unit-test.pkg";
trace = xtr::log_if xtr::io_logging 0; # Conditionally write strings to tracing.log or whatever.
fun print_xauthentication (xauthentication: Null_Or(xt::Xauthentication))
=
case xauthentication
#
NULL => printf "make_root_window()/CCC xauthentication NULL -- run-in-x-window.pkg\n";
#
THE (xt::XAUTHENTICATION
{
family: Int,
address: String,
display: String,
name: String,
data: vector_of_one_byte_unts::Vector
})
=> printf "make_root_window()/CCC xauthentication THE XAUTHENTICATION { family %d, address %s, display %s, name %s, data (...) } -- run-in-x-window.pkg\n" family address display name;
esac;
fun create_window (windowsystem_to_xserver: w2x::Windowsystem_To_Xserver) # Create a new X-window with the given xid
{
window_id: xt::Window_Id,
parent_window_id: xt::Window_Id,
visual_id: xt::Visual_Id_Choice,
#
io_class: xt::Io_Class,
depth: Int,
site: g2d::Window_Site,
attributes: List( xt::a::Window_Attribute )
}
=
windowsystem_to_xserver.xclient_to_sequencer.send_xrequest msg
where
msg = v2w::encode_create_window
{
window_id,
parent_window_id,
visual_id,
io_class,
depth,
site,
attributes
};
end;
fun red_pixels rgb_vector
=
{ len = rwv::length rgb_vector;
#
for (count = 0, i = 0; i < len; ++i; count) {
#
(rwv::get (rgb_vector,i)) -> { red, green, blue };
#
count = (red > green and red > blue) ?? count + 1
:: count;
};
};
fun green_pixels rgb_vector
=
{ len = rwv::length rgb_vector;
#
for (count = 0, i = 0; i < len; ++i; count) {
#
(rwv::get (rgb_vector,i)) -> { red, green, blue };
#
count = (green > red and green > blue) ?? count + 1
:: count;
};
};
fun blue_pixels rgb_vector
=
{ len = rwv::length rgb_vector;
#
for (count = 0, i = 0; i < len; ++i; count) {
#
(rwv::get (rgb_vector,i)) -> { red, green, blue };
#
count = (blue > green and blue > red) ?? count + 1
:: count;
};
};
fun cs_pixmap_to_rgb_vector (cpm::CS_PIXMAP { size, data })
=
{ size -> { wide, high };
#
case data
#
[ red7, red6, red5, red4, red3, red2, red1, red0,
grn7, grn6, grn5, grn4, grn3, grn2, grn1, grn0,
blu7, blu6, blu5, blu4, blu3, blu2, blu1, blu0
]
=> { v = rwv::make_rw_vector (high * wide, { red => 0, green => 0, blue => 0 });
#
for (row = 0; row < high; ++row) {
r7 = list::nth (red7, row);
r6 = list::nth (red6, row);
r5 = list::nth (red5, row);
r4 = list::nth (red4, row);
r3 = list::nth (red3, row);
r2 = list::nth (red2, row);
r1 = list::nth (red1, row);
r0 = list::nth (red0, row);
g7 = list::nth (grn7, row);
g6 = list::nth (grn6, row);
g5 = list::nth (grn5, row);
g4 = list::nth (grn4, row);
g3 = list::nth (grn3, row);
g2 = list::nth (grn2, row);
g1 = list::nth (grn1, row);
g0 = list::nth (grn0, row);
b7 = list::nth (blu7, row);
b6 = list::nth (blu6, row);
b5 = list::nth (blu5, row);
b4 = list::nth (blu4, row);
b3 = list::nth (blu3, row);
b2 = list::nth (blu2, row);
b1 = list::nth (blu1, row);
b0 = list::nth (blu0, row);
for (col = 0; col < wide; ++col) {
#
index = row * wide + col;
byte = col >> 3;
bit = col & 7;
red = (((u1::to_int (v1u::get (r0, byte))) >> bit) & 1) << 0;
red += (((u1::to_int (v1u::get (r1, byte))) >> bit) & 1) << 1;
red += (((u1::to_int (v1u::get (r2, byte))) >> bit) & 1) << 2;
red += (((u1::to_int (v1u::get (r3, byte))) >> bit) & 1) << 3;
red += (((u1::to_int (v1u::get (r4, byte))) >> bit) & 1) << 4;
red += (((u1::to_int (v1u::get (r5, byte))) >> bit) & 1) << 5;
red += (((u1::to_int (v1u::get (r6, byte))) >> bit) & 1) << 6;
red += (((u1::to_int (v1u::get (r7, byte))) >> bit) & 1) << 7;
green = (((u1::to_int (v1u::get (g0, byte))) >> bit) & 1) << 0;
green += (((u1::to_int (v1u::get (g1, byte))) >> bit) & 1) << 1;
green += (((u1::to_int (v1u::get (g2, byte))) >> bit) & 1) << 2;
green += (((u1::to_int (v1u::get (g3, byte))) >> bit) & 1) << 3;
green += (((u1::to_int (v1u::get (g4, byte))) >> bit) & 1) << 4;
green += (((u1::to_int (v1u::get (g5, byte))) >> bit) & 1) << 5;
green += (((u1::to_int (v1u::get (g6, byte))) >> bit) & 1) << 6;
green += (((u1::to_int (v1u::get (g7, byte))) >> bit) & 1) << 7;
blue = (((u1::to_int (v1u::get (b0, byte))) >> bit) & 1) << 0;
blue += (((u1::to_int (v1u::get (b1, byte))) >> bit) & 1) << 1;
blue += (((u1::to_int (v1u::get (b2, byte))) >> bit) & 1) << 2;
blue += (((u1::to_int (v1u::get (b3, byte))) >> bit) & 1) << 3;
blue += (((u1::to_int (v1u::get (b4, byte))) >> bit) & 1) << 4;
blue += (((u1::to_int (v1u::get (b5, byte))) >> bit) & 1) << 5;
blue += (((u1::to_int (v1u::get (b6, byte))) >> bit) & 1) << 6;
blue += (((u1::to_int (v1u::get (b7, byte))) >> bit) & 1) << 7;
rwv::set (v, index, { red, green, blue });
};
};
#
v;
};
_ => { msg = "cs_pixmap_to_rgb_vector only supports 24-bit rgb pixmaps";
log::fatal msg;
raise exception DIE msg;
};
esac;
};
fun print_cs_pixmap_as_rgb (cs_pixmap as cpm::CS_PIXMAP { size, data })
=
{ size -> { wide, high };
#
rgb_vector = cs_pixmap_to_rgb_vector cs_pixmap;
for (row = 0; row < high; ++row) {
#
result =
for (result = sprintf "row %2d:" row, col = 0; col < wide; ++col; result) {
#
index = row * wide + col;
(rwv::get (rgb_vector,index)) -> { red, green, blue };
rgb = (red << 16) | (green << 8) | (blue << 0);
result = result + (sprintf " %06x" rgb);
};
result = result + "\n";
print result;
};
};
fun print_cs_pixmap (cpm::CS_PIXMAP { size, data })
=
{ size -> { wide, high };
printf "print_cs_pixmap: size: wide d=%d high d=%d\n" wide high;
apply print_plane data;
}
where
fun print_plane plane
=
{ printf "plane:\n";
apply print_scanline plane;
}
where
fun print_scanline vec
=
{ printf " scanline:";
v1u::apply print_byte vec;
printf "\n";
}
where
fun print_byte b
=
printf " %02x" (u1::to_int b);
end;
end;
end;
fun print_rw_matrix_rgb8 ((m as { rw_vector, rows, cols }): mtx::Rw_Matrix( r8::Rgb8 ))
=
{ result = REF ([]: List(String));
#
fun note string
=
result := string ! *result;
note (sprintf "\nprint_rw_matrix_rgb8: rows d=%d cols d=%d\n" rows cols);
for (row = 0; row < rows; ++row) { note " ";
for (col = 0; col < cols; ++col) {
#
(r8::rgb8_to_ints m[row,col]) -> (red, green, blue);
note (sprintf " %02x.%02x.%02x" red green blue);
};
note "\n";
};
print (string::cat (reverse *result));
};
fun all_pixels_are ((m as { rw_vector, rows, cols }): mtx::Rw_Matrix( r8::Rgb8 ), color: r8::Rgb8)
=
{
# for (row = 0; row < rows; ++row) {
# for (r = row, col = 0; col < cols; r, ++col) {
# #
# printf "all_pixels_are row %d col %d rows %d cols %d\n" r col rows cols;
# if (not (r8::same_rgb8 (m[r,col], color))) raise exception DIE ""; fi;
# };
# };
# TRUE;
#
# Above doesn't work -- something is broken in nested loop code generation. XXX BUGGO FIXME
mismatches = REF 0;
fun col_lup (row, col)
=
if (col != cols)
#
if (not (r8::same_rgb8 (m[row,col], color)))
(r8::rgb8_to_ints m[row,col]) -> (r1, g1, b1);
(r8::rgb8_to_ints color) -> (r2, g2, b2);
printf "all_pixels found mismatch on row=%d col=%d m[row,col] =(%d,%d,%d), color=(%d,%d,%d)\n" row col r1 g1 b1 r2 g2 b2;
# raise exception DIE "";
mismatches := *mismatches + 1;
fi;
col_lup (row, col+1);
fi;
fun row_lup row
=
if (row != rows)
#
col_lup (row, 0);
row_lup (row+1);
fi;
row_lup 0;
if (*mismatches > 0) printf "all_pixels found %d mismatches\n" *mismatches; fi;
*mismatches;
};
fun exercise_window_stuff ()
=
{
(au::get_xdisplay_string_and_xauthentication NULL)
->
( display_name: String, # Typically from $DISPLAY environment variable.
xauthentication: Null_Or(xt::Xauthentication) # Typically from ~/.Xauthority
);
print_xauthentication xauthentication;
# trace {. sprintf "xclient_unit_test: DISPLAY variable is set to '%s'" display_name; };
(make_run_gun ()) -> { run_gun', fire_run_gun };
(make_end_gun ()) -> { end_gun', fire_end_gun };
root_window = rw::make_root_window { display_name,
xauthentication,
run_gun',
end_gun'
};
root_window -> { id: Id, # This is for internal client use only -- never gets passed to X.
#
screen: xj::Screen,
#
make_shade: rgb::Rgb -> shp::Shades,
make_tile: String -> rop::Ro_Pixmap,
#
style: wy::Widget_Style,
next_widget_id: Void -> Int
}
: rw::Root_Window
;
screen -> { xsession: xj::Xsession,
screen_info: xj::Screen_Info
}: xj::Screen
;
screen_info -> { xscreen: dy::Xscreen,
per_depth_imps: List (xj::Per_Depth_Imps),
rootwindow_per_depth_imps: xj::Per_Depth_Imps
};
xsession -> { xdisplay: dy::Xdisplay, #
screens: List( xj::Screen_Info ), # Screens attached to this display. Always a length-1 list in practice.
default_screen_info: xj::Screen_Info,
windowsystem_to_xevent_router: a2r::Windowsystem_To_Xevent_Router, # Feeds X events to appropriate toplevel window.
font_index: fti::Font_Index,
client_to_atom: ap::Client_To_Atom,
client_to_window_watcher: wpp::Client_To_Window_Watcher,
client_to_selection: sep::Client_To_Selection,
windowsystem_to_xserver: w2x::Windowsystem_To_Xserver,
# xclient_to_sequencer: x2s::Xclient_To_Sequencer,
xevent_router_to_keymap: r2k::Xevent_Router_To_Keymap
};
xdisplay -> { socket: sj::Stream_Socket(Int), # Actual unix socket fd, wrapped up a bit. The 'Int' part is bogus -- I don't get what Reppy was trying to do with that phantom type.
#
name: String, # "host: display::screen", e.g. "foo.com:0.0".
vendor: String, # Name of the server's vendor, e.g. 'The X.Org Foundation'.
default_screen
=>
default_screen_number: Int, # Number of the default screen. Always 0 in practice.
screens
=>
display_screens: List( dy::Xscreen ), # Screens attached to this display. Always a length-1 list in practice.
pixmap_formats: List( xt::Pixmap_Format ),
max_request_length: Int,
image_byte_order: xt::Order,
bitmap_bit_order: xt::Order,
bitmap_scanline_unit: xt::Raw_Format,
bitmap_scanline_pad: xt::Raw_Format,
min_keycode: xt::Keycode,
max_keycode: xt::Keycode,
next_xid: Void -> xt::Xid # resource id allocator. Implemented below by spawn_xid_factory_thread() from src/lib/x-kit/xclient/src/wire/display-old.pkg }: dy::Xdisplay
;
default_screen = xj::default_screen_of xsession;
assert (list::length screens > 0); # Always 1 in practice.
assert (list::length display_screens == list::length screens);
printf "exercise_window_stuff doing make_image_ximp stuff -- xclient-unit-test\n";
printf "exercise_window_stuff list::length screens d=%d -- xclient-unit-test\n" (list::length screens);
printf "exercise_window_stuff list::length display_screens d=%d -- xclient-unit-test\n" (list::length display_screens);
printf "exercise_window_stuff default_screen_number d=%d -- xclient-unit-test\n" default_screen_number ;
screen = list::nth (display_screens, default_screen_number);
screen -> { root_window_id, root_visual, black_rgb8, white_rgb8, ... }: dy::Xscreen;
green_pixel = rgb8::rgb8_green;
# background_pixel = green_pixel;
# background_pixel = rgb8::rgb8_from_ints (10, 100, 60);
# background_pixel = rgb8::rgb8_from_ints (255, 0, 0);
# background_pixel = rgb8::rgb8_from_ints (0, 255, 0);
# background_pixel = rgb8::rgb8_from_ints (0, 0, 255);
background_pixel = rgb8::rgb8_from_ints (128+64, 1, 255);
border_pixel = black_rgb8;
window_id = next_xid ();
make_thread "foobar" {.
#
block_until_mailop_fires run_gun'; # Wait for the starting gun.
};
fire_run_gun ();
window_has_received_first_expose_xevent_oneshot
=
make_oneshot_maildrop(): Oneshot_Maildrop(Void);
fun wait_until_window_has_received_first_expose_xevent ()
=
get_from_oneshot window_has_received_first_expose_xevent_oneshot;
fun xevent_sink ( route: a2r::Envelope_Route,
event: xet::x::Event
)
=
{
#
case event
#
xet::x::EXPOSE { exposed_window_id: xt::Window_Id, # The exposed window.
boxes: List( g2d::Box ), # The exposed rectangle. The list is
# so that multiple events can be packed.
count: Int # Number of subsequent expose events.
}
=> {
printf "xevent_sink(): EXPOSE { exposed_window_id d=%d (window_id d=%d) count d=%d list::length boxes d=%d -- xclient-unit-test.pkg\n"
(xt::xid_to_int exposed_window_id)
(xt::xid_to_int window_id)
count
(list::length boxes)
;
if (xt::same_xid (exposed_window_id, window_id))
#
put_in_oneshot (window_has_received_first_expose_xevent_oneshot, ());
fi;
};
_ => {
# printf "xevent_sink(): ignoring '%s' x event -- xclient-unit-test.pkg\n" (e2s::xevent_name event);
};
esac;
};
windowsystem_to_xevent_router.note_new_hostwindow
(
window_id,
#
{ upperleft => { col => 0, row => 0 },
size => { wide => 100, high => 100 },
border_thickness => 1
}: g2d::Window_Site,
#
xevent_sink
);
case root_visual
#
xt::VISUAL { visual_id, depth as 24, red_mask => 0uxFF0000, green_mask => 0ux00FF00, blue_mask => 0ux0000FF, ... } # Code currently assumes that we always get this case.
=>
{
create_window windowsystem_to_xserver # Create a window on the X server to draw stuff in etc.
{
window_id,
parent_window_id => root_window_id,
visual_id => xt::SAME_VISUAL_AS_PARENT,
#
depth,
io_class => xt::INPUT_OUTPUT,
#
site => { upperleft => { col=>0, row=>0 },
size => { wide=>100, high=>100 },
border_thickness => 1
}: g2d::Window_Site,
attributes => [ xt::a::BORDER_PIXEL border_pixel,
xt::a::BACKGROUND_PIXEL background_pixel,
xt::a::EVENT_MASK wi::standard_xevent_mask
]
};
windowsystem_to_xserver.xclient_to_sequencer.send_xrequest (v2w::encode_map_window { window_id }); # "map" (make visible) our new window.
wait_until_window_has_received_first_expose_xevent ();
per_depth_imps = xj::per_depth_imps_for_depth (default_screen, depth);
per_depth_imps -> { depth: Int,
windowsystem_to_xserver: w2x::Windowsystem_To_Xserver, # The xpacket encoder for this depth on this screen.
window_map_event_sink: wme::Window_Map_Event_Sink
}; #
window = { window_id, # Create a client-side window to represent our new X server window.
screen => default_screen,
per_depth_imps,
windowsystem_to_xserver,
subwindow_or_view => NULL
}
: xj::Window;
window_area_to_sample # Select the part of our X window to read back from X server.
=
{ col => 0, wide => 16,
row => 0, high => 8
};
cs_pixmap = cpm::make_clientside_pixmap_from_window (window_area_to_sample, window); # Read selected part of our window from X server.
# print_cs_pixmap cs_pixmap;
# log::note_on_stderr {. "exercise_window_stuff(): printing screen sample: -- xclient-unit-test.pkg\n"; };
# print_cs_pixmap_as_rgb cs_pixmap;
# rgb_vector = cs_pixmap_to_rgb_vector cs_pixmap;
# log::note_on_stderr {. sprintf "exercise_window_stuff(): red pixels d=%d -- xclient-unit-test.pkg" ( red_pixels rgb_vector); };
# log::note_on_stderr {. sprintf "exercise_window_stuff(): green pixels d=%d -- xclient-unit-test.pkg" (green_pixels rgb_vector); };
# log::note_on_stderr {. sprintf "exercise_window_stuff(): blue pixels d=%d -- xclient-unit-test.pkg" ( blue_pixels rgb_vector); };
rw_matrix_rgb8 = cpt::make_clientside_pixmat_from_window (window_area_to_sample, window); # Read selected part of our window from X server.
# log::note_on_stderr {. "exercise_window_stuff(): printing same screen sample obtained via ZPIXMAP instead of XYPIXMAP: -- xclient-unit-test.pkg\n"; };
# print_rw_matrix_rgb8 rw_matrix_rgb8;
assert (all_pixels_are (rw_matrix_rgb8, background_pixel) == 0);
mblack = mtx::make_rw_matrix ((100,100), r8::rgb8_black);
fun to_x pixmat
=
cpt::copy_from_clientside_pixmat_to_pixmap
#
window
#
{ from => pixmat,
from_box => { col => 0, wide => 30,
row => 0, high => 30
},
to_point => { col => 0, row => 0 }
};
fun from_x ()
=
cpt::make_clientside_pixmat_from_window (window_area_to_sample, window);
to_x mblack;
rw_matrix_rgb8 = from_x(); # Read selected part of our window from X server.
# log::note_on_stderr {. "exercise_window_stuff(): reprinting same screen sample obtained via ZPIXMAP instead of XYPIXMAP: -- xclient-unit-test.pkg\n"; };
# print_rw_matrix_rgb8 rw_matrix_rgb8;
to_x (mtx::make_rw_matrix ((100,100), r8::rgb8_red));
mismatches= all_pixels_are (from_x(), r8::rgb8_red);
# printf "(black to red) assert (all_pixels_are (from_x(), r8::rgb8_red)) = %d;...\n" mismatches;
assert (mismatches == 0);
to_x (mtx::make_rw_matrix ((100,100), r8::rgb8_green));
mismatches = all_pixels_are (from_x(), r8::rgb8_green);
# printf "(red to green) assert (all_pixels_are (from_x(), r8::rgb8_green)) = %d;...\n" mismatches;
assert (mismatches == 0);
to_x (mtx::make_rw_matrix ((100,100), r8::rgb8_blue));
mismatches = all_pixels_are (from_x(), r8::rgb8_blue);
# printf "(green to blue) assert (all_pixels_are (from_x(), r8::rgb8_blue)) = %d;...\n" mismatches;
assert (mismatches == 0);
to_x (mtx::make_rw_matrix ((100,100), r8::rgb8_cyan));
mismatches = all_pixels_are (from_x(), r8::rgb8_cyan);
# printf "(blue to cyan) assert (all_pixels_are (from_x(), r8::rgb8_cyan)) = %d;...\n" mismatches;
assert (mismatches == 0);
to_x (mtx::make_rw_matrix ((100,100), r8::rgb8_magenta));
mismatches = all_pixels_are (from_x(), r8::rgb8_magenta);
# printf "(cyan to magenta) assert (all_pixels_are (from_x(), r8::rgb8_magenta)) = %d;...\n" mismatches;
assert (mismatches == 0);
to_x (mtx::make_rw_matrix ((100,100), r8::rgb8_yellow));
mismatches = all_pixels_are (from_x(), r8::rgb8_yellow);
# printf "(magenta to yellow) assert (all_pixels_are (from_x(), r8::rgb8_yellow)) = %d;...\n" mismatches;
assert (mismatches == 0);
# At this point we should have lots of call-by-call checks
# of drawing triangles, drawing text etc etc etc to validate
# the low-level X support.
# But the X server code is ridiculously well-tested, and
# the xclient code is 20 years old and stable and known to
# work reasonably well, so I'm going to wimp out on this for
# now in favor of working on the new-generation X widgets.
# XXX SUCKO FIXME -- 2014-02-06 CrT
sleep_for 1.0;
};
xt::VISUAL { visual_id, depth, red_mask, green_mask, blue_mask, ... }
=>
{ printf "\nxclient-unit-test.pkg: exercise_window_stuff:\n";
printf "This code assumes root visual has depth=24 red_mask=0xff0000 green_mask=0x00ff00 blue_mask=0x0000ff\n";
printf "but actually the root visual has depth=%d red_mask=0x%06x green_mask=0x%06x blue_mask=0x%06x\n" depth (unt::to_int red_mask) (unt::to_int green_mask) (unt::to_int blue_mask);
printf "Skipping these unit tests.\n";
assert FALSE;
};
xt::NO_VISUAL_FOR_THIS_DEPTH int
=>
{ # This case should never happen.
assert FALSE;
print "root_visual is NO_VISUAL_FOR_THIS_DEPTH?!\n";
};
esac;
log::note_on_stderr {. "Calling fire_end_gun(). -- xclient-unit-test.pkg <===================\n"; };
fire_end_gun ();
# window
# =
# create_window
# :
# xok::Xsocket
# ->
# { id: xt::Window_Id,
# parent: xt::Window_Id,
# #
# in_only: Null_Or( Bool ),
# depth: Int,
# visual: Null_Or( xt::Visual_Id ),
# #
# geometry: g2d::Window_Site,
# attributes: List( Xwin_Val )
# }
# ->
# Void;
();
};
fun run ()
=
{ # Remove any old version of the tracefile:
#
if (isfile tracefile)
unlink tracefile;
fi;
printf "\nDoing %s:\n" name;
# Open tracelog file and
# select tracing level:
#
{ include package logger; # logger is from src/lib/src/lib/thread-kit/src/lib/logger.pkg #
set_logger_to (fil::LOG_TO_FILE tracefile);
#
# enable fil::all_logging; # Gross overkill.
# enable xtr::xkit_logging; # Lesser overkill.
# enable xtr::io_logging; # Saner yet.
};
assert (tsr::thread_scheduler_is_running ());
exercise_window_stuff ();
{
# xdisplay = dy::open_xdisplay { display_name, xauthentication }; # Raises dy::XSERVER_CONNECT_ERROR on failure.
# trace {. sprintf "xclient_unit_test: Done calling dy::open_xdisplay"; };
# do_it (make_root_window NULL);
# dy::close_xdisplay xdisplay;
} except
dy::XSERVER_CONNECT_ERROR string
=
{ fprintf fil::stderr "xclient_unit_test: Could not connect to X server: %s\n" string;
fprintf fil::stderr "xclient_unit_test: *** OMITTING XCLIENT UNIT TESTS. ***\n";
trace {. sprintf "xclient_unit_test: Could not connect to X server: %s" string; };
trace {. "xclient_unit_test: *** OMITTING XCLIENT UNIT TESTS. ***"; };
assert FALSE;
};
# trace {. sprintf "xclient-unit-test.pkg: Now calling tsc::shut_down_thread_scheduler"; };
assert TRUE;
summarize_unit_tests name;
};
};
end;