gdb/testsuite/gdb.chill/powerset.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 # [email protected]
  19
  20 # This file tests various Chill values, expressions, and types.
  21
  22 if $tracelevel then {
  23         strace $tracelevel
  24 }
  25
  26 if [skip_chill_tests] then { continue }
  27
  28 set testfile "powerset"
  29 set srcfile ${srcdir}/$subdir/${testfile}.ch
  30 set binfile ${objdir}/${subdir}/${testfile}.exe
  31 if  { [compile "${srcfile} -g -w -o ${binfile} ${CHILL_RT0} ${CHILL_LIB}"] != "" } {
  32     perror "Couldn't compile ${srcfile}"
  33     return -1
  34 }
  35
  36 # Set the current language to chill.  This counts as a test.  If it
  37 # fails, then we skip the other tests.
  38
  39 proc set_lang_chill {} {
  40     global gdb_prompt
  41     global binfile objdir subdir
  42
  43     verbose "loading file '$binfile'"
  44     gdb_load $binfile
  45     send_gdb "set language chill\n"
  46     gdb_expect {
  47         -re ".*$gdb_prompt $" {}
  48         timeout { fail "set language chill (timeout)" ; return 0 }
  49     }
  50
  51     send_gdb "show language\n"
  52     gdb_expect {
  53         -re ".* source language is \"chill\".*$gdb_prompt $" {
  54             pass "set language to \"chill\""
  55             send_gdb "break xx_\n"
  56             gdb_expect {
  57                 -re ".*$gdb_prompt $" {
  58                     send_gdb "run\n"
  59                     gdb_expect -re ".*$gdb_prompt $" {}
  60                     return 1
  61                 }
  62                 timeout {
  63                     fail "can't set breakpoint (timeout)"
  64                     return 0
  65                 }
  66             }
  67         }
  68         -re ".*$gdb_prompt $" {
  69             fail "setting language to \"chill\""
  70             return 0
  71         }
  72         timeout {
  73             fail "can't show language (timeout)"
  74             return 0
  75         }
  76     }
  77 }
  78
  79 # Testing printing of a specific value.  Increment passcount for
  80 # success or issue fail message for failure.  In both cases, return
  81 # a 1 to indicate that more tests can proceed.  However a timeout
  82 # is a serious error, generates a special fail message, and causes
  83 # a 0 to be returned to indicate that more tests are likely to fail
  84 # as well.
  85 #
  86 # Args are:
  87 #
  88 #       First one is string to send_gdb to gdb
  89 #       Second one is string to match gdb result to
  90 #       Third one is an optional message to be printed
  91
  92 proc test_print_accept { args } {
  93     global gdb_prompt
  94     global passcount
  95     global verbose
  96
  97     if [llength $args]==3 then {
  98         set message [lindex $args 2]
  99     } else {
 100         set message [lindex $args 0]
 101     }
 102     set sendthis [lindex $args 0]
 103     set expectthis [lindex $args 1]
 104     set result [gdb_test $sendthis ".* = ${expectthis}" $message]
 105     if $result==0 {incr passcount}
 106     return $result
 107 }
 108
 109 proc test_card {} {
 110     global passcount
 111
 112     verbose "testing builtin CARD"
 113     set passcount 0
 114
 115     # discrete mode names
 116     test_print_accept "print card(v_ps1)" "4"
 117     test_print_accept "print card(v_ps2)" "15"
 118     test_print_accept "print card(v_ps3)" "4"
 119     test_print_accept "print card(v_ps4)" "11"
 120     test_print_accept "print card(v_ps5)" "1"
 121     test_print_accept "print card(v_ps51)" "0"
 122     test_print_accept "print card(v_ps6)" "101"
 123
 124     # a failure
 125     setup_xfail "*-*-*"
 126     test_print_accept "print card(m_ps1)" "typename in invalid context"
 127 }
 128
 129 proc test_min {} {
 130     global passcount
 131
 132     verbose "testing builtin MIN"
 133     set passcount 0
 134
 135     # discrete mode names
 136     test_print_accept "print min(v_ps1)" "1"
 137     test_print_accept "print min(v_ps2)" "-100"
 138     test_print_accept "print min(v_ps3)" "bb"
 139     test_print_accept "print min(v_ps4)" "','"
 140     test_print_accept "print min(v_ps5)" "FALSE"
 141     test_print_accept "print min(v_ps6)" "-50"
 142
 143     # a failure
 144     setup_xfail "*-*-*"
 145     test_print_accept "print min(v_ps51)" "MIN for empty powerset"
 146     setup_xfail "*-*-*"
 147     test_print_accept "print min(m_ps1)" "typename in invalid context"
 148 }
 149
 150 proc test_max {} {
 151     global passcount
 152
 153     verbose "testing builtin MIN"
 154     set passcount 0
 155
 156     # discrete mode names
 157     test_print_accept "print max(v_ps1)" "7"
 158     test_print_accept "print max(v_ps2)" "100"
 159     test_print_accept "print max(v_ps3)" "ii"
 160     test_print_accept "print max(v_ps4)" "'z'"
 161     test_print_accept "print max(v_ps5)" "FALSE"
 162     test_print_accept "print max(v_ps6)" "50"
 163
 164     # test an IN
 165     test_print_accept "print 0 in v_ps6" "TRUE"
 166
 167     # a failure
 168     setup_xfail "*-*-*"
 169     test_print_accept "print max(v_ps51)" "MAX for empty powerset"
 170 }
 171
 172 # Start with a fresh gdb.
 173
 174 gdb_exit
 175 gdb_start
 176 gdb_reinitialize_dir $srcdir/$subdir
 177
 178 gdb_test "set print sevenbit-strings ".*"
 179
 180 if [set_lang_chill] then {
 181     # test builtins as described in chapter 6.20.3 Z.200
 182     test_card
 183     test_min
 184     test_max
 185 } else {
 186     warning "$test_name tests suppressed."
 187 }