gdb/testsuite/gdb.chill/gch922.exp

   1 # Copyright (C) 1995, 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\)'<repeats 70 times>//"Jason""\^\(0,5\)""Hugo\^\(10\)"//'\^\(1\)'<repeats 70 times>}
 121     test_print_accept "print b" {"Jason""\^\(0,5\)""Hugo\^\(10\)"}
 122     test_print_accept "print c" {'a'<repeats 70 times>//"\^\(0,5\)Jason"//'b'<repeats 70 times>}
 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'<repeats 70 times>//"\^\(2,3\)Hugo "//'c'<repeats 70 times>}
 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'<repeats 70 times>//"\^\(0,5\)Jason"//'b'<repeats 70 times>}
 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 }