gdb/testsuite/gdb.chill/tests1.exp

   1 # Copyright (C) 1995 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 if $tracelevel then {
  23         strace $tracelevel
  24 }
  25
  26 if [skip_chill_tests] then { continue }
  27
  28 set testfile "tests1"
  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 prompt
  41     global binfile objdir subdir
  42
  43     verbose "loading file '$binfile'"
  44     gdb_load $binfile
  45     send "set language chill\n"
  46     expect {
  47         -re ".*$prompt $" {}
  48         timeout { fail "set language chill (timeout)" ; return 0 }
  49     }
  50
  51     send "show language\n"
  52     expect {
  53         -re ".* source language is \"chill\".*$prompt $" {
  54             pass "set language to \"chill\""
  55             send "break dummyfunc\n"
  56             expect {
  57                 -re ".*$prompt $" {
  58                     send "run\n"
  59                     expect -re ".*$prompt $" {}
  60                     return 1
  61                 }
  62                 timeout {
  63                     fail "can't set breakpoint (timeout)"
  64                     return 0
  65                 }
  66             }
  67         }
  68         -re ".*$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 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 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
 110 #
 111 # same function as above but $expectthis has to match exactly (no '=' is
 112 # appended in regexp
 113 #
 114 proc test_print_accept_exact { args } {
 115     global prompt
 116     global passcount
 117     global verbose
 118
 119     if [llength $args]==3 then {
 120         set message [lindex $args 2]
 121     } else {
 122         set message [lindex $args 0]
 123     }
 124     set sendthis [lindex $args 0]
 125     set expectthis [lindex $args 1]
 126     if $verbose>2 then {
 127         send_user "Sending \"$sendthis\" to gdb\n"
 128         send_user "Looking to match \"$expectthis\"\n"
 129         send_user "Message is \"$message\"\n"
 130     }
 131     send "$sendthis\n"
 132     expect {
 133         -re "$expectthis\r\n$prompt $" {
 134             incr passcount
 135             return 1
 136         }
 137         -re ".*$prompt $" {
 138             if ![string match "" $message] then {
 139                 fail "$sendthis ($message)"
 140             } else {
 141                 fail "$sendthis"
 142             }
 143             return 1
 144         }
 145         timeout {
 146             fail "$sendthis (timeout)"
 147             return 0
 148         }
 149     }
 150 }
 151
 152 # Testing printing of a specific value.  Increment passcount for
 153 # success or issue fail message for failure.  In both cases, return
 154 # a 1 to indicate that more tests can proceed.  However a timeout
 155 # is a serious error, generates a special fail message, and causes
 156 # a 0 to be returned to indicate that more tests are likely to fail
 157 # as well.
 158
 159 proc test_print_reject { args } {
 160     global prompt
 161     global passcount
 162     global verbose
 163
 164     if [llength $args]==2 then {
 165         set expectthis [lindex $args 1]
 166     } else {
 167         set expectthis "should never match this bogus string"
 168     }
 169     set sendthis [lindex $args 0]
 170     if $verbose>2 then {
 171         send_user "Sending \"$sendthis\" to gdb\n"
 172         send_user "Looking to match \"$expectthis\"\n"
 173     }
 174     send "$sendthis\n"
 175     expect {
 176         -re ".*A .* in expression.*\\.*$prompt $" {
 177             incr passcount
 178             return 1
 179         }
 180         -re ".*Junk after end of expression.*$prompt $" {
 181             incr passcount
 182             return 1
 183         }
 184         -re ".*No symbol table is loaded.*$prompt $" {
 185             incr passcount
 186             return 1
 187         }
 188         -re ".*$expectthis.*$prompt $" {
 189             incr passcount
 190             return 1
 191         }
 192         -re ".*$prompt $" {
 193             fail "$sendthis not properly rejected"
 194             return 1
 195         }
 196         timeout {
 197             fail "$sendthis (timeout)"
 198             return 0
 199         }
 200     }
 201 }
 202
 203 # various tests if modes are treated correctly
 204 # using ptype
 205 proc test_modes {} {
 206     global passcount
 207
 208     verbose "testing chill modes"
 209     set passcount 0
 210
 211     # discrete modes
 212     test_print_accept "ptype BYTE" "byte"
 213     test_print_accept "ptype UBYTE" "ubyte"
 214     test_print_accept "ptype INT" "int"
 215     test_print_accept "ptype UINT" "uint"
 216     test_print_accept "ptype LONG" "long"
 217     test_print_accept "ptype ULONG" "ulong"
 218     test_print_accept "ptype BOOL" "bool"
 219     test_print_accept "ptype CHAR" "char"
 220
 221     test_print_accept "ptype set1" "SET \[(\]a, b, c\[)\]" \
 222         "print unnumbered set mode"
 223     test_print_accept "ptype nset1" "SET \[(\]na = 1, nb = 34, nc = 20\[)\]" \
 224         "print numbered set mode"
 225
 226     # mp:
 227     # display maybe in hex values ?
 228     #
 229     test_print_accept "ptype r11" "ubyte \\(0:255\\)" \
 230         "print ubyte range mode"
 231     test_print_accept "ptype r12" "uint \\(0:65535\\)" \
 232         "print uint range mode"
 233 #    test_print_accept "ptype r13" "ulong \\(0:4294967295\\)" \
 234 #       "print ulong range mode"
 235     test_print_accept "ptype r14" "byte \\(-128:127\\)" \
 236         "print byte range mode"
 237     test_print_accept "ptype r15" "int \\(-32768:32767\\)" \
 238         "print int range mode"
 239     test_print_accept "ptype r16" "long \\(-2147483648:2147483647\\)" \
 240         "print long range mode"
 241
 242     test_print_accept "ptype r2" "set1 \\(b:c\\)" \
 243         "print unnumbered set range mode"
 244     test_print_accept "ptype r3" "nset1 \\(na:na\\)" \
 245         "print numbered set range mode"
 246     # really this order ?
 247     # I'm not sure what should happen for the next two tests.
 248     setup_xfail "*-*-*"
 249     test_print_accept "ptype r4" "nset1 \\(nb = 34:nc = 20\\)" \
 250         "print numbered set range mode"
 251     setup_xfail "*-*-*"
 252     test_print_accept "ptype r5" "nset1 \\(na = 1, nb = 34, nc = 20\\)" \
 253         "print numbered set range mode"
 254
 255     # powerset modes
 256     test_print_accept "ptype pm1" \
 257         "POWERSET SET \[(\]p1, p2, p3, p4, p5, p6, p7, p8, p9, p10\[)\]" \
 258         "print powerset mode 1"
 259     test_print_accept "ptype pm2" "POWERSET byte \\(1:8\\)" \
 260         "print powerset mode 2"
 261     test_print_accept "ptype pm3" "POWERSET int \\(-32768:32767\\)" \
 262         "print powerset mode 3"
 263     test_print_accept "ptype pm4" "POWERSET long \\(-32768:32768\\)" \
 264         "print powerset mode 4"
 265     test_print_accept "ptype pm5" \
 266         "POWERSET long \\(-2147483648:2147483647\\)" \
 267         "print powerset mode 5"
 268
 269     # reference modes
 270     test_print_accept "ptype ref1" "REF pm1" \
 271         "print reference to powerset mode"
 272     test_print_accept "ptype ref2" "REF byte" \
 273         "print reference to byte"
 274     test_print_accept "ptype ref3" "PTR" \
 275         "print free reference type"
 276
 277     # procedure modes
 278     # FIXME: we have to talk about this ...
 279     test_print_accept "ptype prm1" \
 280         "REF PROC \[(\]\[)\]" \
 281         "print procedure mode 1"
 282     setup_xfail "*-*-*"
 283     test_print_accept "ptype prm2" \
 284         "REF PROC \[(\]bool in, int out long inout\[)\] RETURNS \[(\]char\[)\]" \
 285         "print procedure mode 2"
 286     setup_xfail "*-*-*"
 287     test_print_accept "ptype prm3" \
 288         "REF PROC \[(\]pm1, ref loc\[)\] RETURNS \[(\]ref3\[)\]" \
 289         "print procedure mode 3"
 290     setup_xfail "*-*-*"
 291     test_print_accept "ptype prm4" \
 292         "\[(\] \[)\] EXCEPTIONS \[(\]ex1, ex2, ex3\[)\]" \
 293         "print procedure mode 4"
 294     setup_xfail "*-*-*"
 295     test_print_accept "ptype prm5" \
 296         "REF PROC \[(\]r11, r16 inout, r5 out\[)\] RETURNS \[(\]r2\[)\] EXCEPTIONS \[(\]ex1\[)\]" \
 297         "print procedure mode 5"
 298
 299     # synchronization modes
 300     # FIXME: since gdb doesn't process events & buffers so far, this has be
 301     #        filled later...
 302     xfail "synchronization mode handling"
 303
 304     # timing modes
 305     test_print_accept "ptype DURATION" "duration"
 306     test_print_accept "ptype TIME" "time"
 307
 308     # string modes
 309     # some tests are done in chillvars.exp
 310     test_print_accept "ptype strm1" "CHARS \\(5\\)" "print char string mode"
 311     test_print_accept "ptype strm2" "CHARS \[(\]7\[)\] VARYING" \
 312         "print varying char string mode"
 313     test_print_accept "ptype bstr1" "BOOLS \\(20\\)" "print bit string mode"
 314
 315     test_print_accept "ptype B'000'" "BOOLS \\(3\\)" "bit string literal"
 316     test_print_accept "ptype B'11110000'" "BOOLS \\(8\\)" "bit string literal"
 317     # FIXME: adjust error message
 318     gdb_test "ptype B'00110211'" {.*Too-large digit.*[.]} \
 319         "reject invalid bitstring"
 320
 321     # array modes
 322     # some tests are done in chillvars.exp
 323     test_print_accept "ptype arr1m" "ARRAY \\(1:100\\) set1" \
 324         "print array mode 1"
 325     test_print_accept "ptype arr2m" "ARRAY \\(1:100\\) ARRAY \\(1:100\\) set1"\
 326         "print array mode 2"
 327     test_print_accept "ptype arr3m" "ARRAY \\(0:255\\) ARRAY \\(0:65535\\) ARRAY \\(-128:127\\) set1" \
 328         "print array mode 3"
 329     setup_xfail "*-*-*"
 330     test_print_accept "ptype arr4m" "ARRAY \\(b:c\\) ARRAY \\(na = 1:na = 1\\) ARRAY \\(nc:nb\\) ARRAY \\(na = 1:nc = 20\\) POWERSET SET \[(\]p1, p2, p3, p4, p5, p6, p7, p8, p9, p10\[)\]" \
 331         "print array mode 4"
 332
 333     # structure modes
 334     # some checks are in chillvars.exp
 335     setup_xfail "*-*-*"
 336     test_print_accept "ptype stru1m" "STRUCT \\(.*a long,.*b long,.*CASE b OF.*\\(42\\):.*ch1 CHARS\\(20\\),.*\\(52\\):.*ch2 CHARS\\(10\\).*ELSE.*ch3 CHARS\\(1\\).*ESAC.*\\)" \
 337         "print structure mode 1"
 338     setup_xfail "*-*-*"
 339     test_print_accept "ptype stru2m" "STRUCT \\(.*f set1\\(a, b, c\\),.*CASE f OF.*\\(a\\):.*ch1 CHARS\\(20\\),.*\\(b\\):.*ch2 CHARS\\(10\\) VARYING.*ELSE.*ch3 CHARS\\(0\\) VARYING.*ESAC.*\\)" \
 340         "print structure mode 2"
 341     setup_xfail "*-*-*"
 342     test_print_accept "ptype stru3m" "STRUCT \\(.*f nset1\\(na = 1, na = 1\\),.*CASE f OF.*\\(na\\):.*ch1 CHARS\\(20\\).*ESAC.*\\)" \
 343         "print structure mode 3"
 344
 345
 346     if $passcount then {
 347         pass "$passcount correct modes printed"
 348     }
 349 }
 350
 351 # various tests if locations are treated correctly
 352 # read access using ptype, print, whatis
 353 proc test_locations {} {
 354     global passcount
 355
 356     set passcount 0
 357     verbose "testing read access to locations"
 358     # various location tests can be found in chillvars.exp
 359
 360     # set locations
 361     test_print_accept "ptype s1l" "SET \\(a, b, c\\)" \
 362         "print mode of set location"
 363     test_print_accept "whatis s1l" "set1" \
 364         "print modename of set location"
 365     test_print_accept "print s1l" "c" "print set location"
 366     test_print_accept "ptype s2l" "SET \\(na = 1, nb = 34, nc = 20\\)" \
 367         "print mode of numbered set location"
 368     test_print_accept "whatis s2l" "nset1" \
 369         "print mode name of numbered set location"
 370     test_print_accept "print s2l" "nb" "print numberes set location"
 371
 372     # range modes
 373     test_print_accept "ptype rl1" "ubyte \\(0:255\\)" \
 374         "print mode of range location"
 375     test_print_accept "whatis rl1" "r11" \
 376         "print mode name of range location"
 377     test_print_accept "print rl1" "3" \
 378         "print range location"
 379
 380     test_print_accept "ptype rl2" "ubyte \\(0:255\\)" \
 381         "print mode of range location"
 382     test_print_accept "whatis rl2" "r11" \
 383         "print mode name of range location"
 384     test_print_accept "print rl2" "0" \
 385         "print range location"
 386
 387     test_print_accept "ptype rl3" "ubyte \\(0:255\\)" \
 388         "print mode of range location"
 389     test_print_accept "whatis rl3" "r11" \
 390         "print mode name of range location"
 391     test_print_accept "print rl3" "255" \
 392         "print range location"
 393
 394     test_print_accept "ptype rl5" "uint \\(0:65535\\)" \
 395         "print mode of range location"
 396     test_print_accept "whatis rl5" "r12" \
 397         "print mode name of range location"
 398     test_print_accept "print rl5" "65530" \
 399         "print range location"
 400
 401     test_print_accept "ptype rl6" "uint \\(0:65535\\)" \
 402         "print mode of range location"
 403     test_print_accept "whatis rl6" "r12" \
 404         "print mode name of range location"
 405     test_print_accept "print rl6" "0" \
 406         "print range location"
 407
 408     test_print_accept "ptype rl7" "uint \\(0:65535\\)" \
 409         "print mode of range location"
 410     test_print_accept "whatis rl7" "r12" \
 411         "print mode name of range location"
 412     test_print_accept "print rl7" "65535" \
 413         "print range location"
 414
 415 #     test_print_accept "ptype rl9" "ulong \\(0:4294967295\\)" \
 416 #       "print mode of range location"
 417 #     test_print_accept "whatis rl9" "r13" \
 418 #       "print mode name of range location"
 419 #     test_print_accept "print rl9" "128" \
 420 #       "print range location"
 421
 422 #     test_print_accept "ptype rl10" "ulong \\(0:4294967295\\)" \
 423 #       "print mode of range location"
 424 #     test_print_accept "whatis rl10" "r13" \
 425 #       "print mode name of range location"
 426 #     test_print_accept "print rl10" "0" \
 427 #       "print range location"
 428
 429 #     test_print_accept "ptype rl11" "ulong \\(0:4294967295\\)" \
 430 #       "print mode of range location"
 431 #     test_print_accept "whatis rl11" "r13" \
 432 #       "print mode name of range location"
 433 #     test_print_accept "print rl11" "4294967295" \
 434 #       "print range location"
 435
 436     test_print_accept "ptype rl13" "byte \\(-128:127\\)" \
 437         "print mode of range location"
 438     test_print_accept "whatis rl13" "r14" \
 439         "print mode name of range location"
 440     test_print_accept "print rl13" "-121" \
 441         "print range location"
 442
 443     test_print_accept "ptype rl14" "byte \\(-128:127\\)" \
 444         "print mode of range location"
 445     test_print_accept "whatis rl14" "r14" \
 446         "print mode name of range location"
 447     test_print_accept "print rl14" "-128" \
 448         "print range location"
 449
 450     test_print_accept "ptype rl15" "byte \\(-128:127\\)" \
 451         "print mode of range location"
 452     test_print_accept "whatis rl15" "r14" \
 453         "print mode name of range location"
 454     test_print_accept "print rl15" "127" \
 455         "print range location"
 456
 457     test_print_accept "ptype rl17" "int \\(-32768:32767\\)" \
 458         "print mode of range location"
 459     test_print_accept "whatis rl17" "r15" \
 460         "print mode name of range location"
 461     test_print_accept "print rl17" "-32720" \
 462         "print range location"
 463
 464     test_print_accept "ptype rl18" "int \\(-32768:32767\\)" \
 465         "print mode of range location"
 466     test_print_accept "whatis rl18" "r15" \
 467         "print mode name of range location"
 468     test_print_accept "print rl18" "-32768" \
 469         "print range location"
 470
 471     test_print_accept "ptype rl19" "int \\(-32768:32767\\)" \
 472         "print mode of range location"
 473     test_print_accept "whatis rl19" "r15" \
 474         "print mode name of range location"
 475     test_print_accept "print rl19" "32767" \
 476         "print range location"
 477
 478     test_print_accept "ptype rl21" "long \\(-2147483648:2147483647\\)" \
 479         "print mode of range location"
 480     test_print_accept "whatis rl21" "r16" \
 481         "print mode name of range location"
 482     test_print_accept "print rl21" "2147483643" \
 483         "print range location"
 484
 485     test_print_accept "ptype rl22" "long \\(-2147483648:2147483647\\)" \
 486         "print mode of range location"
 487     test_print_accept "whatis rl22" "r16" \
 488         "print mode name of range location"
 489     test_print_accept "print rl22" "-2147483648" \
 490         "print range location"
 491
 492     test_print_accept "ptype rl23" "long \\(-2147483648:2147483647\\)" \
 493         "print mode of range location"
 494     test_print_accept "whatis rl23" "r16" \
 495         "print mode name of range location"
 496     test_print_accept "print rl23" "2147483647" \
 497         "print range location"
 498
 499     # powerset locations
 500     test_print_accept "ptype pl1" \
 501         "POWERSET SET \\(p1, p2, p3, p4, p5, p6, p7, p8, p9, p10\\)" \
 502         "print mode of powerset location 1"
 503     test_print_accept "whatis pl1" "pm1" \
 504         "print mode mode name of powerset location"
 505     test_print_accept "print pl1" \
 506         "\[\[\]p1:p10\[\]\]" \
 507         "print powerset location 1"
 508     test_print_accept "print pl2" {\[\]} \
 509         "print powerset location 2"
 510     test_print_accept "print pl3" "\[\[\]p1, p10\[\]\]" \
 511         "print powerset location 3"
 512     test_print_accept "print pl4" {\[p1:p2, p4:p6, p8:p10\]} \
 513         "print powerset location 4"
 514     test_print_accept "print pl5" {\[p1:p4, p6, p8:p10\]} \
 515         "print powerset location 5"
 516     test_print_accept "print pl6" {\[p1, p3:p8, p10\]} \
 517         "print powerset location 6"
 518
 519     test_print_accept "ptype pl7" \
 520         "POWERSET byte \\(1:8\\)" \
 521         "print mode of byte powerset location"
 522     test_print_accept "whatis pl7" "pm2" \
 523         "print modename of byte powerset location"
 524     test_print_accept "print pl7" {\[1:8\]} \
 525         "print powerset location 7"
 526
 527     test_print_accept "ptype pl8" \
 528         "POWERSET int \\(-32768:32767\\)" \
 529         "print mode of int powerset location"
 530     test_print_accept "whatis pl8" "pm3" \
 531         "print modename of int powerset location"
 532     test_print_accept "print pl8" {\[-32768:32767\]} \
 533         "print powerset location 8"
 534
 535 #    test_print_accept "ptype pl9" \
 536 #       "POWERSET long \\(-2147483648:2147483647\\)" \
 537 #       "print mode of long powerset location"
 538 #    test_print_accept "whatis pl9" "pm5" \
 539 #       "print modename of long powerset location"
 540 #    test_print_accept "print pl9" {\[-2147483648:2147483647\]} \
 541 #       "print powerset location 9"
 542
 543     # reference modes
 544     test_print_accept "ptype ref3l" "PTR" "print mode of reference location"
 545     test_print_accept "whatis ref3l" "ref3" \
 546         "print modename of reference location"
 547     test_print_accept "print ref3l" "ref3\\(H'.*\\)" \
 548         "print reference location"
 549     test_print_accept "ptype ref4l" "PTR" "print mode of reference location"
 550     test_print_accept "whatis ref4l" "ref4" \
 551         "print modename of reference location"
 552     test_print_accept "print ref4l" "ref4\\(H'.*\\)" \
 553         "print reference location"
 554     test_print_accept "ptype ref5l" "PTR" "print mode of reference location"
 555     test_print_accept "whatis ref5l" "PTR" \
 556         "print modename of reference location"
 557     test_print_accept "print ref5l" "PTR\\(H'.*\\)" \
 558         "print reference location"
 559
 560     # dereference a little bit..
 561     test_print_accept "print ref6l->syn_int" "42" \
 562         "dereference reference to synmode location"
 563     test_print_accept "print ref7l->int" "-42" \
 564         "dereference reference to predefined mode location"
 565     test_print_accept "print ref8l->pm1" \
 566         "\[\[\]p1:p10\[\]\]" \
 567         "dereference reference to newmode location"
 568
 569     # synchronization mode locations
 570     # FIXME: synchronization modes are not supported so far...
 571     xfail "no synchronization mode location support, not implemented yet"
 572
 573     # timing mode locations
 574     # FIXME: callbacks to abstime, inttime not implemented
 575     xfail "timing modes not implemented properly yet"
 576
 577     # char string locations
 578     # some tests are don in chillvars.exp
 579     test_print_accept "ptype strl1" \
 580         "CHARS \\(7\\) VARYING" \
 581         "print varying string location"
 582     test_print_accept "whatis strl1" "strm2" \
 583         "print string locationa mode name"
 584     test_print_accept "print strl1" \
 585         "\"hansi\"//c\"00\"" \
 586         "print string location"
 587     # string elements
 588     test_print_accept "print strl1(0)" "\'h\'" \
 589         "print string element 1"
 590     test_print_accept "print strl1(5)" "C\'00\'" \
 591         "print string element 2"
 592     test_print_accept "print strl1(3)" "\'s\'" \
 593         "print string element 3"
 594     test_print_accept "ptype strl1(0)" "char" \
 595         "print mode of string element"
 596     # slices
 597     test_print_accept "print strl1(3:4)" "\"si\"" \
 598         "print string slice 1"
 599     test_print_accept "print strl1(0:5)" \
 600         "\"hansi\"//c\"00\"" \
 601         "print string slice 2"
 602     test_print_accept "print strl1(0:0)" "\"h\"" \
 603         "print string slice 3"
 604     test_print_accept "print strl1(0 up 6)" \
 605         "\"hansi\"//c\"00\"" \
 606         "print string slice 4"
 607     # FIXME: adjust error message, when implented
 608     gdb_test "print strl1(6 up 1)" \
 609         ".*slice.*out of range.*" \
 610         "print invalid string slice length"
 611     gdb_test "print strl1(-1 up 5)" \
 612         ".*slice.*out of range.*" \
 613         "print invalid string slice length"
 614     gdb_test "print strl1(-1:5)" \
 615         ".*slice.*out of range.*" \
 616         "print invalid string slice"
 617     test_print_accept_exact "print strl1(-1:7)" \
 618         ".*slice.*out of range.*" \
 619         "print invalid string slice"
 620     gdb_test "print strl1(0 up -1)" \
 621         ".*slice.*out of range.*" \
 622         "print invalid string slice length"
 623     gdb_test "print strl1(0 up 0)" {""}
 624
 625     # bitstring locations
 626     test_print_accept "ptype bstr1" \
 627         "BOOLS \\(20\\)" \
 628         "print mode of bitstring location"
 629     test_print_accept "whatis bstrl1" "bstr1" \
 630         "print mode name of bitstring location"
 631     test_print_accept "print bstrl1" \
 632         "B'10101010101010101010'" \
 633         "print bitstring location"
 634
 635     test_print_accept "ptype bstrl1(0)" "bool|BOOL" \
 636         "print mode of bitstring element"
 637     test_print_accept "print bstrl1(0)" "TRUE" \
 638         "print bitstring element 1"
 639     test_print_accept "print bstrl1(19)" "FALSE" \
 640         "print bitstring element 2"
 641     test_print_accept "print bstrl1(10)" "TRUE" \
 642         "print bitstring element 3"
 643
 644     test_print_accept "print bstrl1(0:19)" \
 645         "B'10101010101010101010'" \
 646         "print bitstring location slice 1"
 647     test_print_accept "print bstrl1(0:0)" \
 648         "B'1'" \
 649         "print bitstring location slice 2"
 650     test_print_accept "print bstrl1(3:9)" \
 651         "B'0101010'" \
 652         "print bitstring location slice 3"
 653     test_print_accept "print bstrl1(0 up 20)" \
 654         "B'10101010101010101010'" \
 655         "print bitstring location slice 4"
 656     test_print_accept "print bstrl1(19 up 1)" \
 657         "B'0'" \
 658         "print bitstring location slice 5"
 659     gdb_test "print bstrl1(20 up 1)" \
 660         ".*slice out of range.*" \
 661         "print invalid bitstring slice (20 up 1)"
 662     gdb_test "print bstrl1(-4:5)" \
 663         ".*slice out of range.*" \
 664         "print invalid bitstring slice (-4:5)"
 665     gdb_test "print bstrl1(-1:up 1)" \
 666         ".*invalid expression syntax.*" \
 667         "print invalid bitstring slice (-1:ip 1)"
 668     gdb_test "print bstrl1(-1:20)" \
 669         ".*slice out of range.*" \
 670         "print invalid bitstring slice (-1:20)"
 671     gdb_test "print bstrl1(0 up -1)" \
 672         ".*slice out of range.*" \
 673         "print invalid bitstring slice (0 up -1)"
 674     test_print_accept "print bstrl1(4 up 0)" "B''"
 675
 676     # array mode locations
 677     gdb_test_exact "ptype arrl1" \
 678         "ARRAY (1:100) set1" \
 679         "print mode of array location"
 680     gdb_test "whatis arrl1" "arr1m" \
 681         "print mode name of array location"
 682     gdb_test_exact "print arrl1" {[(1:100): a]} \
 683         "print array location"
 684     test_print_accept "ptype arrl1(1)" \
 685         "SET \\(a, b, c\\)" \
 686         "print mode of array element"
 687     gdb_test_exact "print arrl3" \
 688         {[(1:5): [(1:3): [(1:2): -2147483648]]]} \
 689         "print array location 2"
 690     gdb_test_exact "print arrl3(1)" \
 691         {[(1:3): [(1:2): -2147483648]]} \
 692         "print array location 3"
 693     gdb_test_exact "ptype arrl3(1)" \
 694         {ARRAY (1:3) ARRAY (1:2) long} \
 695         "print mode of array element"
 696     test_print_accept "print arrl3(5)" \
 697         {\[\(1:3\): \[\(1:2\): -2147483648\]\]} \
 698         "print array location 4"
 699     test_print_accept "print arrl3(1,1)" \
 700         {\[\(1:2\): -2147483648\]} \
 701         "print array location 5"
 702     test_print_accept "ptype arrl3(1,1)" \
 703         {ARRAY \(1:2\) long} \
 704         "print mode of array element"
 705     test_print_accept "print arrl3(5,3)" \
 706         {\[\(1:2\): -2147483648\]} \
 707         "print array location 6"
 708     test_print_accept "print arrl3(1,1,1)" \
 709         "-2147483648" \
 710         "print array location 7"
 711     test_print_accept "print arrl3(5,3,2)" \
 712         "-2147483648" \
 713         "print array location 8"
 714     test_print_accept "print arrl3(1)(3)(2)" \
 715         "-2147483648" \
 716         "print array location 9"
 717
 718     # reject the following range fails
 719     # FIXME: adjust error messages
 720     test_print_accept_exact "print arrl3(-1)" \
 721         ".* array or string index out of range.*" \
 722         "check invalid array indices 1"
 723     test_print_accept_exact "print arrl3(6)" \
 724         ".* array or string index out of range.*" \
 725         "check invalid array indices 2"
 726     test_print_accept_exact "print arrl3(0,0)" \
 727         ".* array or string index out of range.*" \
 728         "check invalid array indices 3"
 729     test_print_accept_exact "print arrl3(1,0)" \
 730         ".* array or string index out of range.*" \
 731         "check invalid array indices 4"
 732     test_print_accept_exact "print arrl3(1,4)" \
 733         ".* array or string index out of range.*" \
 734         "check invalid array indices 5"
 735     test_print_accept_exact "print arrl3(6,4)" \
 736         ".* array or string index out of range.*" \
 737         "check invalid array indices 6"
 738     test_print_accept_exact "print arrl3(1,1,0)" \
 739         ".* array or string index out of range.*" \
 740         "check invalid array indices 7"
 741     test_print_accept_exact "print arrl3(6,4,0)" \
 742         ".* array or string index out of range.*" \
 743         "check invalid array indices 8"
 744     test_print_accept_exact "print arrl3(1,1,3)" \
 745         ".* array or string index out of range.*" \
 746         "check invalid array indices 9"
 747
 748     test_print_accept_exact "print arrl3(0)(0)" \
 749         ".* array or string index out of range.*" \
 750         "check invalid array indices 10"
 751     test_print_accept_exact "print arrl3(1)(0)" \
 752         ".* array or string index out of range.*" \
 753         "check invalid array indices 11"
 754     test_print_accept_exact "print arrl3(1)(4)" \
 755         ".* array or string index out of range.*" \
 756         "check invalid array indices 12"
 757     test_print_accept_exact "print arrl3(6)(4)" \
 758         ".* array or string index out of range.*" \
 759         "check invalid array indices 13"
 760     test_print_accept_exact "print arrl3(1)(1)(0)" \
 761         ".* array or string index out of range.*" \
 762         "check invalid array indices 14"
 763     test_print_accept_exact "print arrl3(6)(4)(0)" \
 764         ".* array or string index out of range.*" \
 765         "check invalid array indices 15"
 766     test_print_accept_exact "print arrl3(1)(1)(3)" \
 767         ".* array or string index out of range.*" \
 768         "check invalid array indices 16"
 769
 770     # slices
 771     test_print_accept "print arrl4(1:3)" \
 772         {\[\(1:2\): \[\(1:3\): \[\(1:2\): -2147483648\]\], \(3\): \[\(1:3\): \[\(1:2\): 100\]\]\]} \
 773         "print array slice 1"
 774     test_print_accept "ptype arrl4(1:3)" \
 775         {ARRAY \(1:3\) ARRAY \(1:3\) ARRAY \(1:2\) long} \
 776         "print mode of array slice"
 777 # The next one is bogus:
 778 #    test_print_accept "print arrl4(5, 2:3, 1)" \
 779 #       # FIXME: maybe the '(1): ' in the inner tupel should be omitted ? \
 780 #       {\[(2): \[\(1\): 100\], \(3\):\[\(1\): 100\]\]} \
 781 #       "print array slice 2"
 782     test_print_accept "print arrl4(1 up 4)" \
 783         {\[\(1:2\): \[\(1:3\): \[\(1:2\): -2147483648\]\], \(3\): \[\(1:3\): \[\(1:2\): 100\]\], \(4\): \[\(1:3\): \[\(1:2\): -2147483648\]\]\]} \
 784         "print array slice 3"
 785 # The next two are bogus:
 786 #    test_print_accept "print arrl4(3, 2 up 1)" \
 787 #       {\[\(2:3\): \[\(1:2\): 100\]\]} \
 788 #       "print array slice 4"
 789 #    test_print_accept "print arrl4(1:2, 1 up 1, 2)" \
 790 #       {\[\(1\): \[\(1\): \[\(2\): -2147483648\], \(2\): \[\(2\): -2147483648\]\], \(2\): \[\(1\): \[\(2\): -2147483648\], \(2\): \[\(2\): -2147483648\]\]\]} \
 791 #       "print array slice 4"
 792     # reject invalid slices
 793     # FIXME: adjust error messages
 794     test_print_accept_exact "print arrl4(5:6)" \
 795         ".*slice out of range.*" \
 796         "check invalid range 1"
 797     test_print_accept_exact "print arrl4(0:1)" \
 798         ".*slice out of range.*" \
 799         "check invalid range 2"
 800     test_print_accept_exact "print arrl4(0:6)" \
 801         ".*slice out of range.*" \
 802         "check invalid range 3"
 803     gdb_test "print arrl4(3:2)" \
 804         ".*slice out of range.*" \
 805         "check invalid range 4"
 806     gdb_test "print arrl4(1,3:4)" \
 807         ".*syntax error.*" \
 808         "check invalid range 5"
 809     gdb_test "print arrl4(1,0:1)" \
 810         ".*syntax error.*" \
 811         "check invalid range 6"
 812     gdb_test "print arrl4(1,0:4)" \
 813         ".*syntax error.*" \
 814         "check invalid range 7"
 815     gdb_test "print arrl4(1,3:2)" \
 816         ".*syntax error.*" \
 817         "check invalid range 8"
 818     gdb_test "print arrl4(5 up 2)" \
 819         ".*slice out of range.*" \
 820         "check invalid range 9"
 821     gdb_test "print arrl4(-1 up 1)" \
 822         ".*slice out of range.*" \
 823         "check invalid range 10"
 824     gdb_test "print arrl4(-1 up 7)" \
 825         ".*slice out of range.*" \
 826         "check invalid range 11"
 827     gdb_test "print arrl4(1 up 0)" \
 828         ".*slice out of range.*" \
 829         "check invalid range 12"
 830     gdb_test "print arrl4(1,3 up 1)" \
 831         ".*syntax error.*" \
 832         "check invalid range 13"
 833     gdb_test "print arrl4(1,-1 up 1)" \
 834         ".*syntax error.*" \
 835         "check invalid range 14"
 836     gdb_test "print arrl4(1,-1 up 5)" \
 837         ".*syntax error.*" \
 838         "check invalid range 15"
 839     gdb_test "print arrl4(1,2 up 0)" \
 840         ".*syntax error.*" \
 841         "check invalid range 16"
 842
 843     # structure modes
 844     # some tests are in chillvars.exp
 845     # FIXME: no tag processing implemented do maybe adjust these tests
 846     setup_xfail "*-*-*"
 847     test_print_accept "ptype stru1m" \
 848         "STRUCT \\(.*a long,.*b long,.*CASE b OF.*\\(42\\):.*ch1 CHARS\\(20\\),.*\\(52\\):.*ch2 CHARS\\(10\\).*ELSE.*ch3 CHARS\\(1\\).*ESAC.*\\)" \
 849         "print mode of structure location 1"
 850     test_print_accept "whatis strul1" "stru1m" \
 851         "print mode name of structure location 1"
 852     setup_xfail "*-*-*"
 853     test_print_accept "print strul1" \
 854         {\[\.a: -2147483648, \.b: 42, \.\(b\): \{\(42\) = \[\.ch1: \"12345678900987654321\"\], \(52\) = \[\.ch2: \"1234567890\"\], (else) = \[\.ch3: \"1\"\]\}\]} \
 855         "print structure location 1"
 856     test_print_accept "print strul1.a" \
 857         "-2147483648" \
 858         "print field of structure location 1"
 859     test_print_accept "print strul1.b" "42" \
 860         "print field of structure location 1"
 861     test_print_accept "print strul1.ch1" \
 862         "\"12345678900987654321\"" \
 863         "print field of structure location 1"
 864     setup_xfail "*-*-*"
 865     test_print_accept "print strul1.ch2" \
 866         "\"1234567890\".*warning: tag field value does'nt match" \
 867         "print field of structure location 1"
 868     setup_xfail "*-*-*"
 869     test_print_accept "print strul1.ch3" \
 870         "\"1\".*warning: tag field value does'nt match" \
 871         "print field of structure location 1"
 872
 873     if $passcount then {
 874         pass "$passcount correct locations printed"
 875     }
 876 }
 877
 878 # Start with a fresh gdb.
 879
 880 gdb_exit
 881 gdb_start
 882 gdb_reinitialize_dir $srcdir/$subdir
 883
 884 send "set print sevenbit-strings\n" ; expect -re ".*$prompt $"
 885
 886 if [set_lang_chill] then {
 887     test_modes
 888     test_locations
 889 } else {
 890     warning "$test_name tests suppressed."
 891 }