1# This file contains tests for the tkMain.c file. 2# 3# This file contains a collection of tests for one or more of the Tcl 4# built-in commands. Sourcing this file into Tcl runs the tests and 5# generates output for errors. No output means no errors were found. 6# 7# Copyright (c) 1997 by Sun Microsystems, Inc. 8# Copyright (c) 1998-1999 by Scriptics Corporation. 9# All rights reserved. 10# 11# RCS: @(#) $Id$ 12 13package require tcltest 2.1 14eval tcltest::configure $argv 15tcltest::loadTestedCommands 16 17test main-1.1 {StdinProc} -constraints stdio -setup { 18 set script [makeFile { 19 close stdin; exit 20 } script] 21} -body { 22 list [catch {exec [interpreter] <$script} msg] $msg 23} -cleanup { 24 removeFile script 25} -result {0 {}} 26 27test main-2.1 {Tk_MainEx: -encoding option} -constraints { 28 stdio 29 } -setup { 30 set script [makeFile {} script] 31 file delete $script 32 set f [open $script w] 33 fconfigure $f -encoding utf-8 34 puts $f {puts [list $argv0 $argv $tcl_interactive]} 35 puts -nonewline $f {puts [string equal \u20ac } 36 puts $f "\u20ac]; exit" 37 close $f 38 catch {set f [open "|[list [interpreter] -encoding utf-8 script]" r]} 39 } -body { 40 read $f 41 } -cleanup { 42 close $f 43 removeFile script 44 } -result [list script {} 0]\n1\n 45 46test main-2.2 {Tk_MainEx: -encoding option} -constraints { 47 stdio 48 } -setup { 49 set script [makeFile {} script] 50 file delete $script 51 set f [open $script w] 52 fconfigure $f -encoding utf-8 53 puts $f {puts [list $argv0 $argv $tcl_interactive]} 54 puts -nonewline $f {puts [string equal \u20ac } 55 puts $f "\u20ac]; exit" 56 close $f 57 catch {set f [open "|[list [interpreter] -encoding ascii script]" r]} 58 } -body { 59 read $f 60 } -cleanup { 61 close $f 62 removeFile script 63 } -result [list script {} 0]\n0\n 64 65 # Procedure to simulate interactive typing of commands, line by line 66 proc type {chan script} { 67 foreach line [split $script \n] { 68 if {[catch { 69 puts $chan $line 70 flush $chan 71 }]} { 72 return 73 } 74 # Grrr... Behavior depends on this value. 75 after 1000 76 } 77 } 78 79test main-2.3 {Tk_MainEx: -encoding option} -constraints { 80 stdio 81 } -setup { 82 set script [makeFile {} script] 83 file delete $script 84 set f [open $script w] 85 fconfigure $f -encoding utf-8 86 puts $f {puts [list $argv0 $argv $tcl_interactive]} 87 puts -nonewline $f {puts [string equal \u20ac } 88 puts $f "\u20ac]" 89 close $f 90 catch {set f [open "|[list [interpreter] -enc utf-8 script]" r+]} 91 } -body { 92 type $f { 93 puts $argv 94 exit 95 } 96 list [catch {gets $f} line] $line 97 } -cleanup { 98 close $f 99 removeFile script 100 } -result {0 {-enc utf-8 script}} 101 102test main-3.1 {Tk_ParseArgv: -help option} -constraints unix -body { 103 # Run only on unix as Win32 pops up native dialog 104 list [catch {exec [interpreter] -help} msg] $msg 105} -match glob -result {1 {% Application initialization failed: Command-specific options:*}} 106 107test main-3.2 {Tk_ParseArgv: -help option} -setup { 108 set maininterp [interp create] 109} -body { 110 $maininterp eval { set argc 1 ; set argv -help } 111 list [catch {load {} Tk $maininterp} msg] $msg 112} -cleanup { 113 interp delete $maininterp 114} -match glob -result {1 {Command-specific options:*}} 115 116test main-3.3 {Tk_ParseArgv: -help option} -setup { 117 set maininterp [interp create] 118} -body { 119 # Repeat of 3.2 to catch cleanup, eg Bug 1927135 120 $maininterp eval { set argc 1 ; set argv -help } 121 list [catch {load {} Tk $maininterp} msg] $msg 122} -cleanup { 123 interp delete $maininterp 124} -match glob -result {1 {Command-specific options:*}} 125 126# cleanup 127cleanupTests 128return 129