gdb/testsuite/gdb.chill/chillvars.exp

   1 # Copyright (C) 1992 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 was written by Fred Fish. ([email protected])
  21
  22 if $tracelevel then {
  23         strace $tracelevel
  24 }
  25
  26 proc do_tests {} {
  27     global prms_id bug_id subdir objdir srcdir binfile prompt
  28
  29     set prms_id 0
  30     set bug_id 0
  31
  32     # Start with a fresh gdb.
  33
  34     gdb_exit
  35     gdb_start
  36     gdb_reinitialize_dir $srcdir/$subdir
  37     gdb_load $objdir/$subdir/$binfile
  38
  39     send "set language chill\n" ; expect -re "$prompt $"
  40
  41     # This is needed (at least on SunOS4) to make sure the
  42     # the symbol table is read.
  43     send "break chillvars.ch:3\n" ; expect -re "$prompt $"
  44     send "delete 1\n" ; expect -re "$prompt $"
  45
  46     send "set width 0\n" ; expect -re "$prompt $"
  47     send "set print sevenbit-strings\n" ; expect -re "$prompt $"
  48     send "set print address off\n" ; expect -re "$prompt $"
  49
  50     test_BOOL
  51     test_CHAR
  52     test_BYTE
  53     test_UBYTE
  54     test_INT
  55     test_UINT
  56     test_LONG
  57     test_ULONG
  58     test_REAL
  59     test_LONG_REAL
  60     test_POWERSET
  61     test_arrays
  62     test_strings
  63     test_structs
  64
  65     test_ptr
  66 }
  67
  68 proc test_BOOL {} {
  69
  70     gdb_test "ptype bool_true"          "type = (BOOL|bool)"
  71     gdb_test "ptype bool_false"         "type = (BOOL|bool)"
  72     gdb_test "whatis bool_true"         "type = (BOOL|bool)"
  73     gdb_test "whatis bool_false"        "type = (BOOL|bool)"
  74     gdb_test "print bool_false"         " = FALSE"
  75     gdb_test "print bool_true"          " = TRUE"
  76
  77 }
  78
  79 proc test_CHAR {} {
  80     gdb_test "ptype control_char"       "type = (CHAR|char)"
  81     gdb_test "whatis control_char"      "type = (CHAR|char)"
  82     gdb_test "print control_char"       " = C'07'"
  83     gdb_test "ptype printable_char"     "type = (CHAR|char)"
  84     gdb_test "whatis printable_char"    "type = (CHAR|char)"
  85     gdb_test "print printable_char"     " = 'a'"
  86
  87     gdb_test "print lower(char)"        " = C'00'"
  88     gdb_test "print upper(char)"        " = C'ff'"
  89 }
  90
  91 proc test_BYTE {} {
  92     gdb_test "ptype byte_low"           "type = (BYTE|byte)"
  93     gdb_test "whatis byte_low"          "type = (BYTE|byte)"
  94     gdb_test "print byte_low"           " = -128"
  95     gdb_test "ptype byte_high"          "type = (BYTE|byte)"
  96     gdb_test "whatis byte_high"         "type = (BYTE|byte)"
  97     gdb_test "print byte_high"          " = 127"
  98
  99     gdb_test "print lower(byte)"        " = -128"
 100     gdb_test "print upper(byte)"        " = 127"
 101     gdb_test "print lower(byte_high)"   " = -128"
 102     gdb_test "print upper(byte_high)"   " = 127"
 103 }
 104
 105 proc test_UBYTE {} {
 106     gdb_test "ptype ubyte_low"          "type = (UBYTE|ubyte)"
 107     gdb_test "whatis ubyte_low"         "type = (UBYTE|ubyte)"
 108     gdb_test "print ubyte_low"          " = 0"
 109     gdb_test "ptype ubyte_high"         "type = (UBYTE|ubyte)"
 110     gdb_test "whatis ubyte_high"        "type = (UBYTE|ubyte)"
 111     gdb_test "print ubyte_high"         " = 255"
 112 }
 113
 114 proc test_INT {} {
 115     gdb_test "ptype int_low"            "type = (INT|int)"
 116     gdb_test "whatis int_low"           "type = (INT|int)"
 117     gdb_test "print int_low"            " = -32768"
 118     gdb_test "ptype int_high"           "type = (INT|int)"
 119     gdb_test "whatis int_high"          "type = (INT|int)"
 120     gdb_test "print int_high"           " = 32767"
 121 }
 122
 123 proc test_UINT {} {
 124     gdb_test "ptype uint_low"           "type = (UINT|uint)"
 125     gdb_test "whatis uint_low"          "type = (UINT|uint)"
 126     gdb_test "print uint_low"           " = 0"
 127     gdb_test "ptype uint_high"          "type = (UINT|uint)"
 128     gdb_test "whatis uint_high"         "type = (UINT|uint)"
 129     gdb_test "print uint_high"          " = 65535"
 130 }
 131
 132 proc test_LONG {} {
 133     gdb_test "ptype long_low"           "type = (LONG|long)"
 134     gdb_test "whatis long_low"          "type = (LONG|long)"
 135     gdb_test "print long_low"           " = -2147483648"
 136     gdb_test "ptype long_high"          "type = (LONG|long)"
 137     gdb_test "whatis long_high"         "type = (LONG|long)"
 138     gdb_test "print long_high"          " = 2147483647"
 139 }
 140
 141 proc test_ULONG {} {
 142     gdb_test "ptype ulong_low"          "type = (ULONG|ulong)"
 143     gdb_test "whatis ulong_low"         "type = (ULONG|ulong)"
 144     gdb_test "print ulong_low"          " = 0"
 145     gdb_test "ptype ulong_high"         "type = (ULONG|ulong)"
 146     gdb_test "whatis ulong_high"        "type = (ULONG|ulong)"
 147     gdb_test "print ulong_high"         " = 4294967295"
 148 }
 149
 150 proc test_REAL {} {
 151     gdb_test "ptype real1"              "type = (FLOAT|float)"
 152     gdb_test "whatis real1"             "type = (FLOAT|float)"
 153     gdb_test "print real1"              " = 3.14159274"
 154 }
 155
 156 proc test_LONG_REAL {} {
 157     gdb_test "ptype long_real1"         "type = (DOUBLE|double)"
 158     gdb_test "whatis long_real1"        "type = (DOUBLE|double)"
 159     gdb_test "print long_real1"         " = 3\\.1400000000000001e\\+300"
 160 }
 161
 162 proc test_POWERSET {} {
 163 }
 164
 165 proc test_arrays {} {
 166     gdb_test "ptype booltable1"         "type = ARRAY \\(+0:3\\)+ (BOOL|bool)"
 167     gdb_test_exact "print booltable1"   \
 168         { = [(0): TRUE, (1:2): FALSE, (3): TRUE]}
 169
 170     gdb_test "ptype booltable2"         "type = ARRAY \\(+4:7\\)+ (BOOL|bool)"
 171     gdb_test_exact "print booltable2" { = [(4): TRUE, (5:6): FALSE, (7): TRUE]}
 172
 173     gdb_test "ptype chartable1"         "type = ARRAY \\(+0:2\\)+ (CHAR|char)"
 174     gdb_test_exact "print chartable1"  {= [(0): C'00', (1): C'01', (2): C'02']}
 175
 176     gdb_test "ptype chartable2"         "type = ARRAY \\(+3:5\\)+ (CHAR|char)"
 177     gdb_test_exact "print chartable2"   \
 178         {= [(3): C'00', (4): C'01', (5): C'02']}
 179
 180     gdb_test "ptype bytetable1"         "type = ARRAY \\(+0:4\\)+ (BYTE|byte)"
 181     gdb_test_exact "print bytetable1"           \
 182        {= [(0): -2, (1): -1, (2): 0, (3): 1, (4): 2]}
 183
 184     gdb_test "ptype bytetable2"         "type = ARRAY \\(+5:9\\)+ (BYTE|byte)"
 185     gdb_test_exact "print bytetable2"   \
 186         {= [(5): -2, (6): -1, (7): 0, (8): 1, (9): 2]}
 187
 188     gdb_test "ptype bytetable3" \
 189         "type = ARRAY \\(1:2\\) ARRAY \\('c':'d'\\) ARRAY \\(FALSE:TRUE\\) (BYTE|byte)"
 190     gdb_test_exact "print bytetable3" \
 191     {= [(1): [('c'): [(FALSE): 0, (TRUE): 1], ('d'): [(FALSE): 2, (TRUE): 3]], (2): [('c'): [(FALSE): 4, (TRUE): 5], ('d'): [(FALSE): 6, (TRUE): 7]]]}
 192     gdb_test "ptype bytetable4" \
 193         "type = ARRAY \\(1:2\\) ARRAY \\('c':'d'\\) ARRAY \\(FALSE:TRUE\\) (BYTE|byte)"
 194     gdb_test_exact "print bytetable4" \
 195     {= [(1): [('c'): [(FALSE): 0, (TRUE): 1], ('d'): [(FALSE): 2, (TRUE): 3]], (2): [('c'): [(FALSE): 4, (TRUE): 5], ('d'): [(FALSE): 6, (TRUE): 7]]]}
 196
 197     gdb_test "ptype ubytetable1"        "type = ARRAY \\(+0:4\\)+ (UBYTE|ubyte)"
 198     gdb_test_exact "print ubytetable1"  \
 199         {= [(0): 0, (1): 1, (2): 2, (3): 3, (4): 4]}
 200
 201     gdb_test "ptype ubytetable2"        "type = ARRAY \\(+5:9\\)+ (UBYTE|ubyte)"
 202     gdb_test_exact "print ubytetable2"  \
 203         {= [(5): 0, (6): 1, (7): 2, (8): 3, (9): 4]}
 204
 205     gdb_test "ptype inttable1"          "type = ARRAY \\(+0:4\\)+ (INT|int)"
 206     gdb_test_exact "print inttable1"    \
 207         {= [(0): -2, (1): -1, (2): 0, (3): 1, (4): 2]}
 208
 209     gdb_test "ptype inttable2"          "type = ARRAY \\(+5:9\\)+ (INT|int)"
 210     gdb_test_exact "print inttable2"            \
 211         {= [(5): -2, (6): -1, (7): 0, (8): 1, (9): 2]}
 212
 213     gdb_test "ptype uinttable1"         "type = ARRAY \\(+0:4\\)+ (UINT|uint)"
 214     gdb_test_exact "print uinttable1"   \
 215         {= [(0): 0, (1): 1, (2): 2, (3): 3, (4): 4]}
 216
 217     gdb_test "ptype uinttable2"         "type = ARRAY \\(+5:9\\)+ (UINT|uint)"
 218     gdb_test_exact "print uinttable2"   \
 219         {= [(5): 0, (6): 1, (7): 2, (8): 3, (9): 4]}
 220
 221     gdb_test "ptype longtable1"         "type = ARRAY \\(+0:4\\)+ (LONG|long)"
 222     gdb_test_exact "print longtable1"   \
 223         {= [(0): -2, (1): -1, (2): 0, (3): 1, (4): 2]}
 224
 225     gdb_test "ptype longtable2"         "type = ARRAY \\(+5:9\\)+ (LONG|long)"
 226     gdb_test_exact "print longtable2"   \
 227         {= [(5): -2, (6): -1, (7): 0, (8): 1, (9): 2]}
 228
 229     gdb_test "ptype ulongtable1"        "type = ARRAY \\(+0:4\\)+ (ULONG|ulong)"
 230     gdb_test_exact "print ulongtable1"  \
 231         {= [(0): 0, (1): 1, (2): 2, (3): 3, (4): 4]}
 232
 233     gdb_test "ptype ulongtable2"        "type = ARRAY \\(+5:9\\)+ (ULONG|ulong)"
 234     gdb_test_exact "print ulongtable2"  \
 235         {= [(5): 0, (6): 1, (7): 2, (8): 3, (9): 4]}
 236
 237     gdb_test "ptype realtable1"         "type = ARRAY \\(+0:4\\)+ (FLOAT|float)"
 238     gdb_test_exact "print realtable1"   \
 239         {= [(0): -2, (1): -1, (2): 0, (3): 1, (4): 2]}
 240
 241     gdb_test "ptype realtable2"         "type = ARRAY \\(+5:9\\)+ (FLOAT|float)"
 242     gdb_test_exact "print realtable2"   \
 243         {= [(5): -2, (6): -1, (7): 0, (8): 1, (9): 2]}
 244
 245     gdb_test "ptype longrealtable1"     "type = ARRAY \\(+0:4\\)+ (DOUBLE|double)"
 246     gdb_test_exact "print longrealtable1" \
 247         {= [(0): -2, (1): -1, (2): 0, (3): 1, (4): 2]}
 248
 249     gdb_test "ptype longrealtable2"     "type = ARRAY \\(+5:9\\)+ (DOUBLE|double)"
 250     gdb_test_exact "print longrealtable2"       \
 251         {= [(5): -2, (6): -1, (7): 0, (8): 1, (9): 2]}
 252
 253     gdb_test "print length(longrealtable2)" {= 5}
 254     gdb_test "print lower(longrealtable2)" {= 5}
 255     gdb_test "print upper(longrealtable2)" {= 9}
 256 }
 257
 258 proc test_strings {} {
 259
 260     gdb_test "ptype string1"            "type = CHARS \[(\]4\[)\]+"
 261     gdb_test "print string1"            " = \"abcd\""
 262
 263     gdb_test "ptype string2"            "type = CHARS \[(\]+5\[)\]+"
 264     gdb_test "print string2"            " = \"ef\"//c\"00\"//\"gh\""
 265
 266     gdb_test "ptype string3"            "type = CHARS \[(\]+6\[)\]+"
 267     gdb_test "print string3"            " = \"efghij\""
 268
 269     gdb_test "ptype string4"            "type = CHARS \[(\]+7\[)\]+"
 270     gdb_test "print string4"            " = \"zzzzzz\"//c\"00\""
 271
 272     # These tests require a running process, so run to one of the procs
 273     # and then do the tests.
 274
 275     if [runto scalar_arithmetic] then {
 276         gdb_test "ptype string1//string2"       "type = CHARS \\(9\\)"
 277         gdb_test "print string1//string2"    " = \"abcdef\"//c\"00\"//\"gh\""
 278         gdb_test_exact {ptype "a chill string"} {type = CHARS (14)}
 279         gdb_test "print 'a chill string'"       " = \"a chill string\""
 280         gdb_test "print \"ef\"//c'00'//\"gh\""  " = \"ef\"//c\"00\"//\"gh\""
 281         gdb_test "print string1 // \"efgh\""    " = \"abcdefgh\""
 282         gdb_test "print (6) 'z'"                " = \"zzzzzz\""
 283         gdb_test "ptype (6) 'z'"                "type = CHARS \[(\]+6\[)\]+"
 284         gdb_test "print (1+2*3) 'x'"            " = \"xxxxxxx\""
 285         gdb_test "ptype (1+2*3) 'x'"            "type = CHARS \[(\]+7\[)\]+"
 286     }
 287
 288 }
 289
 290 proc test_structs {} {
 291     gdb_test "ptype struct1" \
 292         "type = STRUCT \\(+.*abool (BOOL|bool),.*aint (INT|int),.*astring CHARS \\(+8\\)+.*\\)+"
 293     gdb_test "print struct1" \
 294         ".* = \\\[\.abool: TRUE, \.aint: 123, \.astring: \"a string\"\\\]"
 295     gdb_test "ptype struct2" \
 296         "type = STRUCT \\(+.*abool (BOOL|bool),.*nstruct simple_struct,.*aint (INT|int).*\\)+"
 297     gdb_test "print struct2" \
 298         ".* = \\\[.abool: TRUE, \.nstruct: \\\[\.abool: FALSE, \.aint: 456, \.astring: \"deadbeef\"\\\], \.aint: 789\\\]"
 299 }
 300
 301 proc test_ptr {} {
 302     # This is to test Cygnus PR 6932
 303     gdb_test "print xptr->int" ".* = 32767"
 304 }
 305
 306 # Check to see if we have an executable to test.  If not, then either we
 307 # haven't tried to compile one, or the compilation failed for some reason.
 308 # In either case, just notify the user and skip the tests in this file.
 309
 310 set binfile "chillvars.exe"
 311 set srcfile $binfile.ch
 312
 313 if [skip_chill_tests] then { continue }
 314
 315 if ![file exists $objdir/$subdir/$binfile] then {
 316     warning "$binfile does not exist; tests suppressed." 0
 317 } else {
 318     do_tests
 319 }