1#
2# help.test
3#
4# Tests for the help subsystem.  Help must be build first.  If help files
5# change, thest tests may have to be changed.
6#---------------------------------------------------------------------------
7# Copyright 1992-1999 Karl Lehenbauer and Mark Diekhans.
8#
9# Permission to use, copy, modify, and distribute this software and its
10# documentation for any purpose and without fee is hereby granted, provided
11# that the above copyright notice appear in all copies.  Karl Lehenbauer and
12# Mark Diekhans make no representations about the suitability of this
13# software for any purpose.  It is provided "as is" without express or
14# implied warranty.
15#------------------------------------------------------------------------------
16# $Id: help.test,v 1.4 2005/03/25 19:59:44 hobbs Exp $
17#------------------------------------------------------------------------------
18#
19
20if {[cequal [info procs Test] {}]} {
21    source [file join [file dirname [info script]] testlib.tcl]
22}
23
24if [cequal $tcl_platform(platform) windows] {
25    echo "    * The help tests have not been ported to Win32" 
26    return
27}
28
29TestRemove HELP.PRG
30
31#
32# Only run help test if help has been built.
33#
34if {[info exists ::env(TCLX_HELP_DIR)]
35    && [file exists $::env(TCLX_HELP_DIR)]} {
36    set HELPDIR $::env(TCLX_HELP_DIR)
37} else {
38    set HELPDIR [file join $tclx_library help]
39}
40if [cequal [glob -nocomplain [file join $HELPDIR *]] ""] {
41    puts "*************************************************************"
42    puts "No help pages in: "
43    puts "    $HELPDIR"
44    puts "Help tests will be skipped."
45    puts "*************************************************************"
46    return
47}
48
49#------------------------------------------------------------------------------
50# Read a line from the server, set an alarm to make sure it doesn't hang.
51# Handle pager `:' prompts specially.
52proc ReadServer {} {
53    global helpServerFH
54
55    alarm 45
56    if {[gets $helpServerFH line] < 0} {
57        alarm 0
58        error "EOF from help server"
59    }
60    alarm 0
61    return $line
62}
63
64#------------------------------------------------------------------------------
65# Eat a prompt line from the help server.
66
67proc EatServerPrompt {} {
68    set line [ReadServer]
69    if ![cequal $line "===HELPSERVER==="] {
70        error "unexpected output from help server: `$line'"
71    }
72}
73
74#------------------------------------------------------------------------------
75# Send a command to the help server and return the output.  The help server
76# output will be bracketed with commands to mark the beginning and ending.
77# An extra newline is always queued to continue the help pager.  The prompt of
78# the pager will be removed from the output.  This assumes that the output has
79# no lines starting with `:'.
80#
81proc HelpSend {cmd pagerCntVar} {
82    global helpServerFH
83    upvar $pagerCntVar pagerCnt
84
85    puts $helpServerFH $cmd
86    puts $helpServerFH ""  ;# Just a new line..
87
88    set pagerCnt 0
89    set results {}
90
91    # Read lines of the output.
92    while 1 {
93        set line [ReadServer]
94        if [cequal [cindex $line 0] ":"] {
95            set line [crange $line 1 end]
96            incr pagerCnt
97            puts $helpServerFH ""  ;# Just a new line
98        }
99        if [cequal "$line" "===HELPSERVER==="] {
100            break
101        }
102        append results $line "\n"
103    }
104    # Eat the extra prompt caused by the typed-ahead newline
105    EatServerPrompt
106
107    return $results
108}
109
110#
111# Create the help server process, which will execute the commands, 
112# with stdin and stdout redirected to pipes.
113#
114global helpServerFH
115
116set fh [open HELP.PRG w]
117puts $fh {
118    package require Tclx
119    namespace import -force tclx::help* tclx::apropos
120    fconfigure stdout -buffering none
121    fconfigure stderr -buffering none
122    commandloop -interactive on -prompt1 {subst "===HELPSERVER===\n"} \
123                -prompt2 {error "Help server incomplete cmd"}
124    error "Help server got eof"
125}
126close $fh
127
128set helpServerFH [open "|[list $::tcltest::tcltest HELP.PRG]" r+]
129fconfigure $helpServerFH -buffering none
130
131#
132# An alarm will be set when talking to the server uncase it doesn't talk back
133#
134signal error SIGALRM
135
136# Nuke the first prompt
137EatServerPrompt
138
139# Now run the tests.
140
141
142Test help-1.1 {help tests} {
143    HelpSend "help" promptCnt
144} 0 {
145Subjects available in /:
146   tcl/
147
148Help pages available in /:
149   help
150}
151
152Test help-1.1.1 {help tests} {
153    HelpSend "help tcl" promptCnt
154} 0 {
155Subjects available in /tcl:
156   control/         debug/           events/          files/
157   filescan/        intl/            intro/           keyedlists/
158   libraries/       lists/           math/            processes/
159   signals/         sockets/         status/          strings/
160   tclshell/        time/            variables/
161}
162
163Test help-1.2 {help tests} {
164    HelpSend "helppwd" promptCnt
165} 0 {Current help subject: /
166}
167
168Test help-1.3 {help tests} {
169    HelpSend "helpcd tcl/filescan" promptCnt
170} 0 {}
171
172Test help-1.4 {help tests} {
173    HelpSend "helppwd" promptCnt
174} 0 {Current help subject: /tcl/filescan
175}
176
177Test help-1.5 {help tests} {
178    set result [HelpSend "help /tcl/lists/lassign" promptCnt]
179    set fh [open "$HELPDIR/tcl/lists/lassign"]
180    set expect [read $fh]
181    close $fh
182    set summary {}
183    if {"$expect" == "$result"} {
184        append summary "CORRECT"
185    } else {
186        append summary "DATA DOES NOT MATCH : $result"
187    }
188    if {$promptCnt == 0} {
189       append summary " : PROMPT OK"
190    } else {
191       append summary " : TOO MANY PROMPTS: $promptCnt"
192    }
193    set summary
194} 0 {CORRECT : PROMPT OK}
195
196Test help-1.6 {help tests} {
197    set result [HelpSend "help /tcl/math/expr" promptCnt]
198    set fh [open "$HELPDIR/tcl/math/expr"]
199    set expect [read $fh]
200    close $fh
201    set summary {}
202    if {"$expect" == "$result"} {
203        append summary "CORRECT"
204    } else {
205        append summary "DATA DOES NOT MATCH: $result"
206    }
207    if {$promptCnt >= 2} {
208       append summary " : PROMPT OK"
209    } else {
210       append summary " : NOT ENOUGH PROMPTS: $promptCnt"
211    }
212    set summary
213} 0 {CORRECT : PROMPT OK}
214
215Test help-1.7 {help tests} {
216    HelpSend "apropos upvar" promptCnt
217} 0 {tcl/variables/upvar - Create link to variable in a different stack frame
218}
219
220Test help-1.8 {help tests} {
221    HelpSend "apropos clock" promptCnt
222} 0 {tcl/time/clock - Obtain and manipulate time
223tcl/time/alarm - Set a process alarm clock.
224}
225
226Test help-1.9 {help tests} {
227    HelpSend "helpcd" promptCnt
228} 0 {}
229
230Test help-1.10 {help tests} {
231    HelpSend "helppwd" promptCnt
232} 0 {Current help subject: /
233}
234
235
236# Terminate the help server.
237
238puts $helpServerFH "exit 0"
239close $helpServerFH
240
241TestRemove HELP.PRG
242
243# cleanup
244::tcltest::cleanupTests
245return
246