aboutsummaryrefslogtreecommitdiff
path: root/contrib/bluegnu2.0.3/lib/dejagnu.itcl
blob: 35957cca62ec022281f9cef0aab40f6c0a77a130 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
#! iexpect
#
# This program is a full compatible Object Oriented version of
# DejaGnu's runtest program
#
#   Copyright (C) 1998 jotOmega dsc, Inc.

#This file is part of BlueGnu.

################################################################
# Preemble
################################################################
# Check Environment variables:
#
#       BLUEGNULIBS
#       TESTSUITEROOT
#

if [info exists env(BLUEGNULIBS)] {
    set szToolsLib $env(BLUEGNULIBS)
} else {
    set szToolsLib [file dirname $argv0]
    set PWD [pwd]
    cd $szToolsLib
    set szToolsLib [pwd]
    cd $PWD
    regsub {/bin$} $szToolsLib {/lib/bluegnu} szToolsLib
    set env(BLUEGNULIBS) $szToolsLib
}

if [info exists env(TESTSUITEROOT)] {
    set szRootDir $env(TESTSUITEROOT)
} else {
    set szRootDir [pwd]
    set env(TESTSUITEROOT) $szRootDir
}
if [info exists env(DEBUG)] {
    set bDebug 1
} else {
    set bDebug 0
}

# Make sure that the testsuite root directory is our working directory
# all tests name are relative to this directory
cd $szRootDir

# set the default tool. All test are relative to this directory.
#
set szTool $szRootDir
catch {unset lTool}
lappend lTool $szTool

#
# source basic utilities
#
source $szToolsLib/testSessionClasses.itcl
source $szToolsLib/testSessionFramework.itcl
#source $szToolsLib/testSessionUtils.itcl
#
verbose "Library  : >$szToolsLib<"
verbose "TestSuite: >$szRootDir<"
verbose "$argv0 $argv" 5
#
# from here we should use only defined utilities
################################################################
################################################################

set szRootName [file rootname $argv0]
puts "RootName : >$szRootName<"

::TestSession::Queue Q0
::TestSession::DejaGnu E0; # will load dejagnu.tcl

while {! [catch {Q0 pop} T]} {
    clone_output "Q0 element: $T"
    runtest E0 $T
}

delete object Q0
delete object E0