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

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [gdb/] [testsuite/] [gdb.chill/] [gch922.exp] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
# Copyright 1995, 1996, 1997 Free Software Foundation, Inc.
2
 
3
# This program is free software; you can redistribute it and/or modify
4
# it under the terms of the GNU General Public License as published by
5
# the Free Software Foundation; either version 2 of the License, or
6
# (at your option) any later version.
7
#
8
# This program is distributed in the hope that it will be useful,
9
# but WITHOUT ANY WARRANTY; without even the implied warranty of
10
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11
# GNU General Public License for more details.
12
#
13
# You should have received a copy of the GNU General Public License
14
# along with this program; if not, write to the Free Software
15
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
16
 
17
# Please email any bugs, comments, and/or additions to this file to:
18
# bug-gdb@prep.ai.mit.edu
19
 
20
# This file tests various Chill values, expressions, and types.
21
 
22
# This file was written by Wilfried Moser (moser@aut.alcatel.at)
23
#                          Kurt Fuchs (fuchs_k@aut.alcatel.at)
24
#
25
 
26
if $tracelevel then {
27
        strace $tracelevel
28
}
29
 
30
if [skip_chill_tests] then { continue }
31
 
32
set testfile "gch922"
33
set srcfile ${srcdir}/$subdir/${testfile}.ch
34
set binfile ${objdir}/${subdir}/${testfile}.exe
35
if  { [compile "${srcfile} -g -w -o ${binfile} ${CHILL_RT0} ${CHILL_LIB}"] != "" } {
36
    perror "Couldn't compile ${srcfile}"
37
    return -1
38
}
39
 
40
# Set the current language to chill.  This counts as a test.  If it
41
# fails, then we skip the other tests.
42
 
43
proc set_lang_chill {} {
44
    global gdb_prompt
45
    global binfile objdir subdir
46
 
47
    verbose "loading file '$binfile'"
48
    gdb_load $binfile
49
    send_gdb "set language chill\n"
50
    gdb_expect {
51
        -re ".*$gdb_prompt $" {}
52
        timeout { fail "set language chill (timeout)" ; return 0 }
53
    }
54
 
55
    send_gdb "show language\n"
56
    gdb_expect {
57
        -re ".* source language is \"chill\".*$gdb_prompt $" {
58
            pass "set language to \"chill\""
59
            send_gdb "break xx_\n"
60
            gdb_expect {
61
                -re ".*$gdb_prompt $" {
62
                    send_gdb "run\n"
63
                    gdb_expect -re ".*$gdb_prompt $" {}
64
                    return 1
65
                }
66
                timeout {
67
                    fail "can't set breakpoint (timeout)"
68
                    return 0
69
                }
70
            }
71
        }
72
        -re ".*$gdb_prompt $" {
73
            fail "setting language to \"chill\""
74
            return 0
75
        }
76
        timeout {
77
            fail "can't show language (timeout)"
78
            return 0
79
        }
80
    }
81
}
82
 
83
# Testing printing of a specific value.  Increment passcount for
84
# success or issue fail message for failure.  In both cases, return
85
# a 1 to indicate that more tests can proceed.  However a timeout
86
# is a serious error, generates a special fail message, and causes
87
# a 0 to be returned to indicate that more tests are likely to fail
88
# as well.
89
#
90
# Args are:
91
#
92
#       First one is string to send_gdb to gdb
93
#       Second one is string to match gdb result to
94
#       Third one is an optional message to be printed
95
 
96
proc test_print_accept { args } {
97
    global gdb_prompt
98
    global passcount
99
    global verbose
100
 
101
    if [llength $args]==3 then {
102
        set message [lindex $args 2]
103
    } else {
104
        set message [lindex $args 0]
105
    }
106
    set sendthis [lindex $args 0]
107
    set expectthis [lindex $args 1]
108
    set result [gdb_test $sendthis ".* = ${expectthis}" $message]
109
    if $result==0 {incr passcount}
110
    return $result
111
}
112
 
113
 
114
proc test_chars {} {
115
    global passcount gdb_prompt
116
 
117
    verbose "Testing Chars"
118
    set passcount 0
119
 
120
    test_print_accept "print a" {'\^\(0\)'//"Jason""\^\(0,5\)""Hugo\^\(10\)"//'\^\(1\)'}
121
    test_print_accept "print b" {"Jason""\^\(0,5\)""Hugo\^\(10\)"}
122
    test_print_accept "print c" {'a'//"\^\(0,5\)Jason"//'b'}
123
    test_print_accept "print d" {'\^\(11\)'}
124
 
125
    gdb_test "set var a := (100)'\^(0,255)'" ""
126
    test_print_accept "print a" {"\^\(0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255,0,255\)"}
127
 
128
    send_gdb "set var a := (10)'\^(1)'//(26)\"\^(66,67)\"//\" \"//'I'//' '//'a'//'m'//\" Hugo\" \n" ; gdb_expect -re "$gdb_prompt $"
129
    test_print_accept "print a" {"\^\(1,1,1,1,1,1,1,1,1,1\)BCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBC I am Hugo"}
130
    send_gdb "set var b := \"Hugo \"\"\^(3,4)\"\"Otto\^(17)\" \n" ; gdb_expect -re "$gdb_prompt $"
131
    test_print_accept "print b" {"Hugo ""\^\(3,4\)""Otto\^\(17\)"}
132
    send_gdb "set var c := (70)'b' // \"\^(2,3)Hugo \" // (70)'c' \n" ; gdb_expect -re "$gdb_prompt $"
133
    test_print_accept "print c" {'b'//"\^\(2,3\)Hugo "//'c'}
134
    gdb_test "set var d := '\^(199)'" ""
135
    test_print_accept "print d" {'\^\(199\)'}
136
 
137
    test_print_accept "print (10)'\^(0)'//(26)\"\^(66,67)\"//\" \"//'I'//' '//'a'//'m'//\" Hugo\"" {"\^\(0,0,0,0,0,0,0,0,0,0\)BCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBCBC I am Hugo"}
138
    test_print_accept "print \"Jason\"\"\^(0,5)\"\"Hugo\^(10)\"" {"Jason""\^\(0,5\)""Hugo\^\(10\)"}
139
 
140
    send_gdb "set var a := \"\" \n" ; gdb_expect -re "$gdb_prompt $"
141
    test_print_accept "print a" {""}
142
    send_gdb "set var a := \"\"\"\" \n" ; gdb_expect -re "$gdb_prompt $"
143
    test_print_accept "print a" {""""}
144
    send_gdb "set var a := \" \"\"\" \n" ; gdb_expect -re "$gdb_prompt $"
145
    test_print_accept "print a" {" """}
146
    send_gdb "set var a := \"\^\^\" \n" ; gdb_expect -re "$gdb_prompt $"
147
    test_print_accept "print a" {"\^\^"}
148
    send_gdb "set var a := \"'\" \n" ; gdb_expect -re "$gdb_prompt $"
149
    test_print_accept "print a" {"'"}
150
}
151
 
152
 
153
proc test_code {} {
154
    global passcount gdb_prompt
155
 
156
    verbose "Testing Chars"
157
    set passcount 0
158
 
159
    runto bulk
160
    test_print_accept "print a" {"\^\(255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127,255,0,222,127\)"}
161
    test_print_accept "print b" {"\^\(200\)"}
162
#    test_print_accept "print c" {'a'//"\^\(0,5\)Jason"//'b'}
163
    test_print_accept "print d" {'a'}
164
}
165
 
166
 
167
# Start with a fresh gdb.
168
 
169
gdb_exit
170
gdb_start
171
gdb_reinitialize_dir $srcdir/$subdir
172
 
173
gdb_test "set print sevenbit-strings" ".*"
174
 
175
 
176
if [set_lang_chill] then {
177
    # test builtins as described in chapter 6.20.3 Z.200
178
 
179
    test_chars
180
#    test_code
181
} else {
182
    warning "$test_name tests suppressed."
183
}

powered by: WebSVN 2.1.0

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