#
# help.test
#
# Tests for the help subsystem.  Help must be build first.  If help files
# change, thest tests may have to be changed.
#---------------------------------------------------------------------------
# Copyright 1992-1999 Karl Lehenbauer and Mark Diekhans.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  Karl Lehenbauer and
# Mark Diekhans make no representations about the suitability of this
# software for any purpose.  It is provided "as is" without express or
# implied warranty.
#------------------------------------------------------------------------------
# $Id: help.test,v 1.4 2005/03/25 19:59:44 hobbs Exp $
#------------------------------------------------------------------------------
#

if {[cequal [info procs Test] {}]} {
    source [file join [file dirname [info script]] testlib.tcl]
}

if [cequal $tcl_platform(platform) windows] {
    echo "    * The help tests have not been ported to Win32" 
    return
}

TestRemove HELP.PRG

#
# Only run help test if help has been built.
#
if {[info exists ::env(TCLX_HELP_DIR)]
    && [file exists $::env(TCLX_HELP_DIR)]} {
    set HELPDIR $::env(TCLX_HELP_DIR)
} else {
    set HELPDIR [file join $tclx_library help]
}
if [cequal [glob -nocomplain [file join $HELPDIR *]] ""] {
    puts "*************************************************************"
    puts "No help pages in: "
    puts "    $HELPDIR"
    puts "Help tests will be skipped."
    puts "*************************************************************"
    return
}

#------------------------------------------------------------------------------
# Read a line from the server, set an alarm to make sure it doesn't hang.
# Handle pager `:' prompts specially.
proc ReadServer {} {
    global helpServerFH

    alarm 45
    if {[gets $helpServerFH line] < 0} {
        alarm 0
        error "EOF from help server"
    }
    alarm 0
    return $line
}

#------------------------------------------------------------------------------
# Eat a prompt line from the help server.

proc EatServerPrompt {} {
    set line [ReadServer]
    if ![cequal $line "===HELPSERVER==="] {
        error "unexpected output from help server: `$line'"
    }
}

#------------------------------------------------------------------------------
# Send a command to the help server and return the output.  The help server
# output will be bracketed with commands to mark the beginning and ending.
# An extra newline is always queued to continue the help pager.  The prompt of
# the pager will be removed from the output.  This assumes that the output has
# no lines starting with `:'.
#
proc HelpSend {cmd pagerCntVar} {
    global helpServerFH
    upvar $pagerCntVar pagerCnt

    puts $helpServerFH $cmd
    puts $helpServerFH ""  ;# Just a new line..

    set pagerCnt 0
    set results {}

    # Read lines of the output.
    while 1 {
        set line [ReadServer]
        if [cequal [cindex $line 0] ":"] {
            set line [crange $line 1 end]
            incr pagerCnt
            puts $helpServerFH ""  ;# Just a new line
        }
        if [cequal "$line" "===HELPSERVER==="] {
            break
        }
        append results $line "\n"
    }
    # Eat the extra prompt caused by the typed-ahead newline
    EatServerPrompt

    return $results
}

#
# Create the help server process, which will execute the commands, 
# with stdin and stdout redirected to pipes.
#
global helpServerFH

set fh [open HELP.PRG w]
puts $fh {
    package require Tclx
    namespace import -force tclx::help* tclx::apropos
    fconfigure stdout -buffering none
    fconfigure stderr -buffering none
    commandloop -interactive on -prompt1 {subst "===HELPSERVER===\n"} \
                -prompt2 {error "Help server incomplete cmd"}
    error "Help server got eof"
}
close $fh

set helpServerFH [open "|[list $::tcltest::tcltest HELP.PRG]" r+]
fconfigure $helpServerFH -buffering none

#
# An alarm will be set when talking to the server uncase it doesn't talk back
#
signal error SIGALRM

# Nuke the first prompt
EatServerPrompt

# Now run the tests.


Test help-1.1 {help tests} {
    HelpSend "help" promptCnt
} 0 {
Subjects available in /:
   tcl/

Help pages available in /:
   help
}

Test help-1.1.1 {help tests} {
    HelpSend "help tcl" promptCnt
} 0 {
Subjects available in /tcl:
   control/         debug/           events/          files/
   filescan/        intl/            intro/           keyedlists/
   libraries/       lists/           math/            processes/
   signals/         sockets/         status/          strings/
   tclshell/        time/            variables/
}

Test help-1.2 {help tests} {
    HelpSend "helppwd" promptCnt
} 0 {Current help subject: /
}

Test help-1.3 {help tests} {
    HelpSend "helpcd tcl/filescan" promptCnt
} 0 {}

Test help-1.4 {help tests} {
    HelpSend "helppwd" promptCnt
} 0 {Current help subject: /tcl/filescan
}

Test help-1.5 {help tests} {
    set result [HelpSend "help /tcl/lists/lassign" promptCnt]
    set fh [open "$HELPDIR/tcl/lists/lassign"]
    set expect [read $fh]
    close $fh
    set summary {}
    if {"$expect" == "$result"} {
        append summary "CORRECT"
    } else {
        append summary "DATA DOES NOT MATCH : $result"
    }
    if {$promptCnt == 0} {
       append summary " : PROMPT OK"
    } else {
       append summary " : TOO MANY PROMPTS: $promptCnt"
    }
    set summary
} 0 {CORRECT : PROMPT OK}

Test help-1.6 {help tests} {
    set result [HelpSend "help /tcl/math/expr" promptCnt]
    set fh [open "$HELPDIR/tcl/math/expr"]
    set expect [read $fh]
    close $fh
    set summary {}
    if {"$expect" == "$result"} {
        append summary "CORRECT"
    } else {
        append summary "DATA DOES NOT MATCH: $result"
    }
    if {$promptCnt >= 2} {
       append summary " : PROMPT OK"
    } else {
       append summary " : NOT ENOUGH PROMPTS: $promptCnt"
    }
    set summary
} 0 {CORRECT : PROMPT OK}

Test help-1.7 {help tests} {
    HelpSend "apropos upvar" promptCnt
} 0 {tcl/variables/upvar - Create link to variable in a different stack frame
}

Test help-1.8 {help tests} {
    HelpSend "apropos clock" promptCnt
} 0 {tcl/time/clock - Obtain and manipulate time
tcl/time/alarm - Set a process alarm clock.
}

Test help-1.9 {help tests} {
    HelpSend "helpcd" promptCnt
} 0 {}

Test help-1.10 {help tests} {
    HelpSend "helppwd" promptCnt
} 0 {Current help subject: /
}


# Terminate the help server.

puts $helpServerFH "exit 0"
close $helpServerFH

TestRemove HELP.PRG

# cleanup
::tcltest::cleanupTests
return