1BEGIN
2  {
3    $| = 1;
4    $^W = 1;
5
6    eval { require Test; };
7    if ($@)
8      {
9        $^W=0;
10	print "1..0 # skip no Test module\n";
11	CORE::exit(0);
12      }
13    Test->import;
14  }
15
16use strict;
17use Tk;
18##
19## Test all widget classes:  load module, create, pack, and
20## destory an instance. Check in configure does not return
21## an error so (some) ConfigSpecs errors are uncovered
22##
23
24use vars '@class';
25use vars '@tk_pod_modules';
26
27my $tests;
28BEGIN
29  {
30    @class =
31      qw(
32	More
33	PodText
34	PodSearch
35	PodTree
36	Pod
37      );
38    @tk_pod_modules = qw(Cache FindPods Search_db Search SimpleBridge Styles
39			 Util WWWBrowser);
40
41    $tests = 10*@class+@tk_pod_modules;
42    plan test => $tests;
43
44  };
45
46$ENV{TKPODDEBUG} = 0;
47
48if (!defined $ENV{BATCH}) {
49    $ENV{BATCH} = 1;
50}
51
52my $mw;
53eval {$mw = Tk::MainWindow->new();};
54if (!Tk::Exists($mw))
55  {
56    for (1..$tests)
57      {
58	skip("Cannot create MainWindow", 1, 1);
59      }
60    CORE::exit(0);
61  }
62$mw->geometry("+1+1"); # for twm
63
64my $w;
65foreach my $class (@class)
66  {
67    print "# Testing $class\n";
68    undef($w);
69
70    if ($class =~ m{^Pod(Text|Search|Tree)$})
71      {
72	my $module = "Tk::Pod::$1";
73	# Tks autoload does not find it.
74	eval qq{ require $module; };
75	ok($@, "", "loading $module module");
76      }
77    else
78      {
79	eval "require Tk::$class;";
80	ok($@, "", "Error loading Tk::$class");
81      }
82
83    eval { $w = $mw->$class(); };
84    ok($@, "", "can't create $class widget");
85    skip($@, Tk::Exists($w), 1, "$class instance does not exist");
86
87    if (Tk::Exists($w))
88      {
89        if ($w->isa('Tk::Wm'))
90          {
91	    # KDE-beta4 wm with policies:
92	    #     'interactive placement'
93	    #		 okay with geometry and positionfrom
94	    #     'manual placement'
95	    #		geometry and positionfrom do not help
96	    eval { $w->positionfrom('user'); };
97            #eval { $w->geometry('+10+10'); };
98	    ok ($@, "", 'Problem set postitionform to user');
99
100            eval { $w->Popup; };
101	    ok ($@, "", "Can't Popup a $class widget")
102          }
103        else
104          {
105	    ok(1); # dummy for above positionfrom test
106            eval { $w->pack; };
107	    ok ($@, "", "Can't pack a $class widget")
108          }
109        eval { $mw->update; };
110        ok ($@, "", "Error during 'update' for $class widget");
111
112	if (!$ENV{BATCH}) {
113	    $mw->messageBox(-icon => "info", -message => "Showing '$class'", -type => "Continue");
114	}
115
116        eval { my @dummy = $w->configure; };
117        ok ($@, "", "Error: configure list for $class");
118        eval { $mw->update; };
119        ok ($@, "", "Error: 'update' after configure for $class widget");
120        eval { $w->destroy; };
121        ok($@, "", "can't destroy $class widget");
122        ok(!Tk::Exists($w), 1, "$class: widget not really destroyed");
123      }
124    else
125      {
126        # Widget $class couldn't be created:
127	#	Popup/pack, update, destroy skipped
128	for (1..5) { skip (1,1,1, "skipped because widget could not be created"); }
129      }
130  }
131
132print "# Require all modules\n";
133for my $base (@tk_pod_modules) {
134    eval "require Tk::Pod::$base";
135    if ($@ && $base eq 'Search_db') {
136	ok($@ =~ m{locate Text.*English}, 1, "Could not require Tk::Pod::$base: $@");
137    } else {
138	ok($@, "", "Could not require Tk::Pod::$base: $@");
139    }
140}
141
1421;
143__END__
144