1# Copyright (C) 2003,2006,2007 Slaven Rezic. All rights reserved.
2# This program is free software; you can redistribute it and/or
3# modify it under the same terms as Perl itself.
4
5# Parts taken from TkTest.pm from Perl/Tk
6
7package TkTest;
8
9use strict;
10use vars qw(@EXPORT);
11
12use base qw(Exporter);
13@EXPORT    = qw(check_display_test_harness display_test);
14
15use ExtUtils::Command::MM qw(test_harness);
16
17sub check_display_test_harness {
18    my(@test_harness_args) = @_;
19
20    # In case of cygwin, use'ing Tk before forking (which is done by
21    # Test::Harness) may lead to "remap" errors, which are normally
22    # solved by the rebase or rebaseall utilities.
23    #
24    # Here, I just skip the DISPLAY check on cygwin to not force users
25    # to run rebase.
26    #
27    if (!($^O eq 'cygwin' || $^O eq 'MSWin32')) {
28
29	eval q{
30           use blib;
31           use Tk;
32        };
33	die "Strange: could not load Tk library: $@" if $@;
34
35	# empty the argument list for the following test_harness
36	@ARGV = () if !_can_MainWindow();
37    }
38
39    test_harness(@test_harness_args);
40}
41
42# Avoid this function. Tk 804.xxx may die if multiple MainWindows are
43# created within one process (seen e.g. on FreeBSD systems). By using
44# this function a test MainWindow will be created, so the next "real"
45# $mw creation may fail.
46#
47# display_test() is only safe if subsequent creation of MainWindows is
48# done in separate processes (i.e. if using system(...))
49sub display_test {
50    if (!_can_MainWindow()) {
51	print "1..0 # skip Cannot create MainWindow\n";
52	CORE::exit(0);
53    }
54}
55
56sub _can_MainWindow {
57    require Tk;
58    if (defined $Tk::platform && $Tk::platform eq 'unix') {
59	my $mw = eval { MainWindow->new() };
60	if (!Tk::Exists($mw)) {
61	    warn "Cannot create MainWindow (maybe no X11 server is running or DISPLAY is not set?)\n$@\n";
62	    return 0;
63	} else {
64	    $mw->destroy;
65	    return 1;
66	}
67    } else {
68	return 1;
69    }
70}
71
721;
73
74__END__
75