## xclient-unit-test-old.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 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 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 xok = xsocket_old; # xsocket_old is from src/lib/x-kit/xclient/src/wire/xsocket-old.pkg package dy = display_old; # display_old is from src/lib/x-kit/xclient/src/wire/display-old.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_old; # window_old is from src/lib/x-kit/xclient/src/window/window-old.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 xet = xevent_types; # xevent_types is from src/lib/x-kit/xclient/src/wire/xevent-types.pkg #
tracefile = "xclient-unit-test.trace.log";
herein
package xclient_unit_test_old {
#
name = "src/lib/x-kit/xclient/src/stuff/xclient-unit-test-old.pkg";
trace = xtr::log_if xtr::io_logging 0; # Conditionally write strings to tracing.log or whatever.
default_time_quantum # Copied from src/lib/x-kit/widget/old/lib/run-in-x-window-old.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 -> { default_screen, screens, next_xid, xsocket, ... };
screen = list::nth (screens, default_screen);
screen -> { root_window_id => parent_window_id, root_visual, black_rgb8, white_rgb8, ... }: dy::Xscreen;
green_pixel = rgb8::rgb8_green;
background_pixel = green_pixel;
border_pixel = black_rgb8;
window_id = next_xid ();
take_xevent' = xok::take_xevent' xsocket;
fun do_xevent (e: xevent_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 (;;) {
#
do_one_mailop [
#
take_xevent' ==> 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: g2d::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 => { upperleft => { col=>100, row=>100 },
size => { wide=>400, high=>400 },
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
]
};
xok::send_xrequest xsocket (v2w::encode_map_window { window_id });
xok::flush_xsocket xsocket;
sleep_for 0.1;
trace {. sprintf "xclient_unit_test_old: Now writing create_window_request to socket."; };
# sox::send_vector (socket, create_window_request);
trace {. sprintf "xclient_unit_test_old: Done writing create_window_request to socket."; };
trace {. sprintf "xclient_unit_test_old: Now reading back header of reply for create_window request."; };
# header = sox::receive_vector (socket, 8);
trace {. sprintf "xclient_unit_test_old: 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-old.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: 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.
};
# tsc::start_up_thread_scheduler'
# default_time_quantum
# {.
assert (tsr::thread_scheduler_is_running ());
(au::get_xdisplay_string_and_xauthentication NULL)
->
( display_name: String, # Typically from $DISPLAY environment variable.
xauthentication: Null_Or(xt::Xauthentication) # Typically from ~/.Xauthority
);
trace {. sprintf "xclient_unit_test_old: DISPLAY variable is set to '%s'" display_name; };
trace {. sprintf "xclient_unit_test_old: Now calling dy::open_xdisplay"; };
{ xdisplay = dy::open_xdisplay { display_name, xauthentication }; # Raises dy::XSERVER_CONNECT_ERROR on failure.
trace {. sprintf "xclient_unit_test_old: Done calling dy::open_xdisplay"; };
exercise_window_stuff xdisplay;
# do_it (make_root_window NULL);
dy::close_xdisplay xdisplay;
} except
dy::XSERVER_CONNECT_ERROR string
=
{ fprintf fil::stderr "xclient_unit_test_old: Could not connect to X server: %s\n" string;
fprintf fil::stderr "xclient_unit_test_old: *** OMITTING XCLIENT UNIT TESTS. ***\n";
trace {. sprintf "xclient_unit_test_old: Could not connect to X server: %s" string; };
trace {. "xclient_unit_test_old: *** OMITTING XCLIENT UNIT TESTS. ***"; };
assert FALSE;
};
trace {. sprintf "xclient-unit-test-old.pkg: Now calling tsc::shut_down_thread_scheduler"; };
# Commented out for always-on multithreading:
# tsc::shut_down_thread_scheduler winix__premicrothread::process::success;
# };
# Commented out for always-on multithreading:
# # Close tracelog file:
# #
# { include package logger; # logger is from src/lib/src/lib/thread-kit/src/lib/logger.pkg#
# tracing_to = fil::logger_is_set_to ();
#
# set_logger_to fil::LOG_TO_STDERR;
#
# case tracing_to
# #
# fil::LOG_TO_STREAM stream => fil::close_output stream;
# #
# _ => ();
# esac;
# };
assert TRUE;
summarize_unit_tests name;
};
};
end;