OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [dejagnu/] [testsuite/] [runtest.all/] [default_procs.tcl] - Blame information for rev 1767

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
set sum_file [open .tmp w]
2 
set reboot 0
3 
set errno ""
4 
 
5 
# this tests a proc for a returned pattern
6 
proc lib_pat_test { cmd arg pattern } {
7 
    catch "$cmd \"$arg\"" result
8 
    puts "CMD(lib_pat_test) was: $cmd \"$arg\""
9 
    puts "RESULT(lib_pat_test) was: \"${result}\" for pattern \"$pattern\"."
10 
    if [ regexp -- "with too many" $result ] {
11 
        return -1
12 
    }
13 
    if [ string match "$pattern" $result ] {
14 
        return 1
15 
    } else {
16 
        return 0
17 
    }
18 
}
19 
 
20 
# this tests a proc for a returned value
21 
proc lib_ret_test { cmd arg val } {
22 
    catch "$cmd \"$arg\"" result
23 
#    catch "set result [$cmd $arg]" output
24 
#    set result "$cmd [eval $arg]
25 
    puts "CMD(lib_ret_test) was: $cmd $arg"
26 
    puts "RESULT(lib_ret_test) was: $result"
27 
#    puts "OUTPUT(lib_ret_test) was: $output"
28 
 
29 
    if { $result == $val } {
30 
        return 1
31 
    } else {
32 
        return 0
33 
    }
34 
}
35 
 
36 
#
37 
# This runs a standard test for a proc. The list is set up as:
38 
# |test proc|proc being tested|args|pattern|message|
39 
# test proc is something like lib_pat_test or lib_ret_test.
40 
#
41 
proc run_tests { tests } {
42 
    foreach i "$tests" {
43 
        set result [ [lindex $i 0] "[lindex $i 1]" "[lindex $i 2]" "[lindex $i 3]" ]
44 
        switch -- $result {
45 
            "-1" {
46 
                puts "ERRORED: [lindex $i 4]"
47 
            }
48 
            "1" {
49 
                puts "PASSED: [lindex $i 4]"
50 
            }
51 
            "0" {
52 
                puts "FAILED: [lindex $i 4]"
53 
            }
54 
            default {
55 
                puts "BAD VALUE: [lindex $i 4]"
56 
            }
57 
        }
58 
    }
59 
}
60 
 
61 
proc send_log { msg } {
62 
    # this is just a stub for testing
63 
}
64 
 
65 
proc pass { msg } {
66 
    puts "PASSED: $msg"
67 
}
68 
 
69 
proc fail { msg } {
70 
    puts "FAILED: $msg"
71 
}
72 
 
73 
proc perror { msg } {
74 
    global errno
75 
    puts "ERRORED: $msg"
76 
    set errno "$msg"
77 
}
78 
 
79 
proc warning { msg } {
80 
    global errno
81 
    puts "WARNED: $msg"
82 
    set errno "$msg"
83 
}
84 
 
85 
proc untested { msg } {
86 
    puts "NOTTESTED: $msg"
87 
}
88 
 
89 
proc unsupported { msg } {
90 
    puts "NOTSUPPORTED: $msg"
91 
}
92 
proc verbose { args } {
93 
    puts "[lindex $args 0]"
94 
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.