## xclient-unit-test.pkg
# Compiled by:
# src/lib/x-kit/xclient/xclient.sublib# 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.
# Run by:
# src/lib/test/all-unit-tests.pkgstipulate
include unit_test; # unit_test is from src/lib/src/unit-test.pkg include makelib::scripting_globals;
include threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package ctl = thread_scheduler_control; # thread_scheduler_control is from src/lib/src/lib/thread-kit/src/posix/thread-scheduler-control.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/pkg/stuff/xlogger.pkg package sox = socket_junk; # socket_junk is from src/lib/internet/socket-junk.pkg package xok = xsocket; # xsocket is from src/lib/x-kit/xclient/pkg/wire/xsocket.pkg package dy = display; # display is from src/lib/x-kit/xclient/pkg/wire/display.pkg package xt = xtypes; # xtypes is from src/lib/x-kit/xclient/pkg/wire/xtypes.pkg package au = authentication; # authentication is from src/lib/x-kit/xclient/pkg/stuff/authentication.pkg package v2w = value_to_wire; # value_to_wire is from src/lib/x-kit/xclient/pkg/wire/value-to-wire.pkg package wi = window; # window is from src/lib/x-kit/xclient/pkg/window/window.pkg package xg = xgeometry; # xgeometry is from src/lib/std/2d/xgeometry.pkg package hsv = hue_saturation_value; # hue_saturation_value is from src/lib/x-kit/xclient/pkg/color/hue-saturation-value.pkg #
tracefile = "xclient-unit-test.trace.log";
herein
package xclient_unit_test {
#
name = "src/lib/x-kit/xclient/pkg/stuff/xclient-unit-test.pkg";
trace = xtr::log_if xtr::io_logging; # Conditionally write strings to tracing.log or whatever.
default_time_quantum # Copied from src/lib/x-kit/widget/lib/run-xkit.pkg =
time::from_milliseconds 20;
junk = hsv::from_floats { hue => 0.0, saturation => 0.0, value => 0.0 };
junk = yiq::from_rgb (rgb::rgb_from_floats (0.0, 0.0, 0.0));
#
# This is a temporary hack just to force hsv:: and yiq:: to compile.
fun exercise_window_stuff (xdisplay: dy::Xdisplay)
=
{ xdisplay -> dy::XDISPLAY { default_screen, screens, next_xid, xsocket, ... };
screen = list::nth (screens, default_screen);
screen -> dy::XSCREEN { root_window_id => parent_window_id, root_visual, black_rgb8, white_rgb8, ... };
green_pixel = rgb8::rgb8_green;
background_pixel = green_pixel;
border_pixel = black_rgb8;
window_id = next_xid ();
xevent_in'
=
xok::wait_for_xevent xsocket;
fun do_xevent (e: event_types::x::Event)
=
();
case root_visual
#
xt::VISUAL { visual_id, depth => 24, red_mask => 0uxFF0000, green_mask => 0ux00FF00, blue_mask => 0ux0000FF, ... }
=>
{ # Set up a null thread to read and discard
# incoming X events, since the xsocket logic
# will deadlock if we do not:
#
make_thread "Discard all X events" .{
#
for (;;) {
#
select [
#
xevent_in' ==> do_xevent
];
};
};
# Create a new X-window with the given xid
#
fun create_window (xsocket: xok::Xsocket)
{
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: xg::Window_Site,
attributes: List( xt::a::Window_Attribute )
}
=
xok::send_xrequest xsocket msg
where
msg = v2w::encode_create_window
{
window_id,
parent_window_id,
visual_id,
io_class,
depth,
site,
attributes
};
end;
create_window xsocket
{
window_id,
parent_window_id,
visual_id => xt::SAME_VISUAL_AS_PARENT,
#
depth => 24,
io_class => xt::INPUT_OUTPUT,
#
site =>
xg::WINDOW_SITE
{ upperleft => xg::POINT { col=>100, row=>100 },
size => xg::SIZE { wide=>400, high=>400 },
border_thickness => 1
},
attributes
=>
[ xt::a::BORDER_PIXEL border_pixel,
xt::a::BACKGROUND_PIXEL background_pixel,
xt::a::EVENT_MASK wi::standard_xevent_mask
]
};
xok::send_xrequest xsocket (v2w::encode_map_window { window_id });
xok::flush xsocket;
do_mailop (timeout_in' (time::from_milliseconds 100));
trace .{ sprintf "xclient_unit_test: Now writing create_window_request to socket."; };
# sox::send_vector (socket, create_window_request);
trace .{ sprintf "xclient_unit_test: Done writing create_window_request to socket."; };
trace .{ sprintf "xclient_unit_test: Now reading back header of reply for create_window request."; };
# header = rse::do_syscall_retry_on_eintr # We need this retry mechanism because our 50Hz SIGALRM
# # # timer may hit before the X server reply gets back to us.
# sox::receive_vector (socket, 8);
trace .{ sprintf "xclient_unit_test: Done reading back header of reply for create_window request."; };
};
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;
# 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: xg::Window_Site,
# attributes: List( Xwin_Val )
# }
# ->
# Void;
();
};
fun run ()
=
{ printf "\nDoing %s:\n" name;
# Remove any old version of the tracefile:
#
if (isfile tracefile)
#
unlink tracefile;
fi;
# Open tracelog file and
# select tracing level:
#
{ include logger; # logger is from src/lib/src/lib/thread-kit/src/lib/logger.pkg #
set_logger_to (file::LOG_TO_FILE tracefile);
#
# enable file::all_logging; # Gross overkill.
# enable xtr::xkit_logging; # Lesser overkill.
# enable xtr::io_logging; # Saner yet.
};
ctl::start_up_thread_scheduler'
default_time_quantum
.{
assert (ctl::thread_scheduler_is_running ());
my ( display_name: String, # Typically from $DISPLAY environment variable.
xauthentication: Null_Or(xt::Xauthentication) # Typically from ~/.Xauthority
)
=
au::get_xdisplay_string_and_xauthentication NULL;
trace .{ sprintf "xclient_unit_test: DISPLAY variable is set to '%s'" display_name; };
trace .{ sprintf "xclient_unit_test: Now calling dy::open_xdisplay"; };
{ xdisplay = dy::open_xdisplay { display_name, xauthentication }; # Raises dy::XSERVER_CONNECT_ERROR on failure.
trace .{ sprintf "xclient_unit_test: Done calling dy::open_xdisplay"; };
exercise_window_stuff xdisplay;
# do_it (make_root_window NULL);
} except
dy::XSERVER_CONNECT_ERROR string
=
{ fprintf file::stderr "xclient_unit_test: Could not connect to X server: %s\n" string;
fprintf file::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 ctl::shut_down_thread_scheduler"; };
ctl::shut_down_thread_scheduler winix::process::success;
};
# Close tracelog file:
#
{ include logger; # logger is from src/lib/src/lib/thread-kit/src/lib/logger.pkg tracing_to = file::logger_is_set_to ();
set_logger_to file::LOG_TO_STDERR;
case tracing_to
#
file::LOG_TO_STREAM stream => file::close_output stream;
#
_ => ();
esac;
};
assert TRUE;
summarize_unit_tests name;
};
};
end;