[Tclresource-commits] Extras/Tests/Forks BuildTestForks.tcl,NONE,1.1

[Bernard D. <bde...@us...>]

Update of /cvsroot/tclresource/Extras/Tests/Forks
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32063/Extras/Tests/Forks

Added Files:
	BuildTestForks.tcl 
Log Message:
First checkin

--- NEW FILE: BuildTestForks.tcl ---
# -------------------------------------------------------
# File: "BuildTestsFiles.tcl"
#                        Created: 2004-09-05 07:54:17
#              Last modification: 2004-09-06 08:39:42
# Author: Bernard Desgraupes
# e-mail: <bde...@ea...>
# www: <http://webperso.easyconnect.fr/bdesgraupes/>
# (c) Copyright: Bernard Desgraupes, 2004
# All rights reserved.
# 
# $Date: 2004/09/06 07:18:08 $
# $Revision: 1.1 $
# -------------------------------------------------------

package require resource 1.1

set date [ISOTime::ISODateAndTimeRelaxed]
set testdir [file dir [info script]]

# Build a datafork and a resourcefork resource file
foreach suffix [list DF RF] {
	if {$suffix eq "DF"} {
		set whichfork datafork
	} else {
		set whichfork resourcefork
	}
	
	set resfile [file join $testdir TestResources${suffix}.rsrc]
	if {[file exists $resfile]} {
		file delete $resfile
	} 
	set rid [resource open -$whichfork $resfile w+]
	# TEXT
	resource write -id 128 -name "Say hello" -file $rid TEXT "Hello Tclresource!"
	resource write -id 129 -name "Say goodbye" -file $rid TEXT "Goodbye Tclresource!"
	# STR#
	resource write -id 129 -name "Greetings" -file $rid "STR#" "\x00\x02\x05Hello\x05Salud"
	# ckid - "2f637673726f6f742f74636c" means "/cvsroot/tcl"
	set hexdata  "\x76\x52\x90\x1a\x3f\xe5\x32\x30\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\xbd\x28\x04\x36\xbd\x28\x04\x36\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2a\x2f\x63\x76\x73\x72\x6f\x6f\x74\x2f\x74\x63\x6c\x2f\x54\x63\x6c\x2f\x4d\x65\x6e\x75\x73\x2f\x63\x6f\x6c\x6f\x72\x73\x4d\x65\x6e\x75\x2e\x74\x63\x6c\x00\x09\x61\x6e\x6f\x6e\x79\x6d\x6f\x75\x73\x00\x04\x31\x2e\x32\x35\x00\x0e\x63\x6f\x6c\x6f\x72\x73\x4d\x65\x6e\x75\x2e\x74\x63\x6c\x00\x00\x00\x00\x00\x00"
	resource write -id 128 -name "CVS info" -file $rid ckid $hexdata
	# ALRT - this resource intentionally has no name
	set hexdata "\x00\x28\x00\x28\x00\x87\x01\x7c\x00\x80\x55\x55\x30\x0a"
	resource write -id 128 -file $rid ALRT $hexdata
	# MPSR - this resource intentionally has no name
	set hexdata "\x00\x09\x4d\x6f\x6e\x61\x63\x6f\x00\x4c\x25\xb0\x00\x05\x00\x00\xbf\x80\x00\x00\x00\x00\x00\x00\x43\xcc\x80\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x04\x00\x3b\x00\x1e\x01\xbe\x02\xff\x00\x3b\x00\x1e\x01\xbe\x02\xff\xbd\x5f\xe3\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00"
	resource write -id 1005 -file $rid MPSR $hexdata
	# Abou
	resource write -id 128 -name "About this file" -file $rid Abou "This is a $whichfork resource file for the Tclresource [package present resource] test suite. Built $date"

	resource close $rid	
} 

# Build a file with no forks
set resfile [file join $testdir TestResourcesNF.rsrc]
if {[file exists $resfile]} {
	file delete $resfile
} 
close [open $resfile w+]

unset -nocomplain date testdir suffix resfile rid whichfork