gdb/testsuite/gdb.chill/chexp.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., 675 Mass Ave, Cambridge, MA 02139, 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 was written by Fred Fish. (fnf@cygnus.com)
  21
  22 if $tracelevel then {
  23         strace $tracelevel
  24 }
  25
  26 set prms_id 0
  27 set bug_id 0
  28
  29 # Set the current language to chill.  This counts as a test.  If it
  30 # fails, then we skip the other tests.
  31
  32 proc set_lang_chill {} {
  33     global prompt
  34
  35     send "set language chill\n"
  36     expect {
  37         -re ".*$prompt $" {}
  38         timeout { fail "set language chill (timeout)" ; return 0 }
  39     }
  40
  41     send "show language\n"
  42     expect {
  43         -re ".* source language is \"chill\".*$prompt $" {
  44             pass "set language to \"chill\""
  45             return 1
  46         }
  47         -re ".*$prompt $" {
  48             fail "setting language to \"chill\""
  49             return 0
  50         }
  51         timeout {
  52             fail "can't show language (timeout)"
  53             return 0
  54         }
  55     }
  56 }
  57
  58 # Testing printing of a specific value.  Increment passcount for
  59 # success or issue fail message for failure.  In both cases, return
  60 # a 1 to indicate that more tests can proceed.  However a timeout
  61 # is a serious error, generates a special fail message, and causes
  62 # a 0 to be returned to indicate that more tests are likely to fail
  63 # as well.
  64 #
  65 # Args are:
  66 #
  67 #       First one is string to send to gdb
  68 #       Second one is string to match gdb result to
  69 #       Third one is an optional message to be printed
  70
  71 proc test_print_accept { args } {
  72     global prompt
  73     global passcount
  74     global verbose
  75
  76     if [llength $args]==3 then {
  77         set message [lindex $args 2]
  78     } else {
  79         set message [lindex $args 0]
  80     }
  81     set sendthis [lindex $args 0]
  82     set expectthis [lindex $args 1]
  83     if $verbose>2 then {
  84         send_user "Sending \"$sendthis\" to gdb\n"
  85         send_user "Looking to match \"$expectthis\"\n"
  86         send_user "Message is \"$message\"\n"
  87     }
  88     send "$sendthis\n"
  89     expect {
  90         -re ".* = $expectthis\r\n$prompt $" {
  91             incr passcount
  92             return 1
  93         }
  94         -re ".*$prompt $" {
  95             if ![string match "" $message] then {
  96                 fail "$sendthis ($message)"
  97             } else {
  98                 fail "$sendthis"
  99             }
 100             return 1
 101         }
 102         timeout {
 103             fail "$sendthis (timeout)"
 104             return 0
 105         }
 106     }
 107 }
 108
 109 proc test_integer_literals_accepted {} {
 110     global prompt
 111     global passcount
 112
 113     set passcount 0
 114
 115     # Test various decimal values.
 116
 117     test_print_accept "p 123" "123"
 118     test_print_accept "p -123" "-123"
 119     test_print_accept "p D'123" "123"
 120     test_print_accept "p d'123" "123"
 121     test_print_accept "p -D'123" "-123"
 122     test_print_accept "p -d'123" "-123"
 123     test_print_accept "p 123_456" "123456"
 124     test_print_accept "p __1_2_3__" "123"
 125     test_print_accept "p/d 123" "D'123"
 126
 127     # Test various binary values.
 128
 129     test_print_accept "p B'111" "7"
 130     test_print_accept "p b'111" "7"
 131     test_print_accept "p -B'111" "-7"
 132     test_print_accept "p B'0111" "7"
 133     test_print_accept "p b'0111" "7"
 134     test_print_accept "p -b'0111" "-7"
 135     test_print_accept "p B'_0_1_1_1_" "7"
 136     test_print_accept "p b'_0_1_1_1_" "7"
 137     test_print_accept "p -b'_0_1_1_1_" "-7"
 138     test_print_accept "p/t B'111" "B'111"
 139
 140     # Test various octal values.
 141
 142     test_print_accept "p O'123" "83"
 143     test_print_accept "p o'123" "83"
 144     test_print_accept "p -o'0123" "-83"
 145     test_print_accept "p O'0123" "83"
 146     test_print_accept "p o'0123" "83"
 147     test_print_accept "p -o'123" "-83"
 148     test_print_accept "p O'_1_2_3_" "83"
 149     test_print_accept "p o'_1_2_3_" "83"
 150     test_print_accept "p -o'_1_2_3_" "-83"
 151     test_print_accept "p/o O'123" "O'123"
 152
 153     # Test various hexadecimal values.
 154
 155     test_print_accept "p H'123" "291"
 156     test_print_accept "p h'123" "291"
 157     test_print_accept "p -h'123" "-291"
 158     test_print_accept "p H'0123" "291"
 159     test_print_accept "p h'0123" "291"
 160     test_print_accept "p -h'0123" "-291"
 161     test_print_accept "p H'_1_2_3_" "291"
 162     test_print_accept "p h'_1_2_3_" "291"
 163     test_print_accept "p -h'_1_2_3_" "-291"
 164     test_print_accept "p H'ABCDEF" "11259375"
 165     test_print_accept "p H'abcdef" "11259375"
 166     test_print_accept "p H'AbCdEf" "11259375"
 167     test_print_accept "p H'_A_b_C_d_E_f_" "11259375"
 168     test_print_accept "p/x H'123" "H'123"
 169
 170     if $passcount then {
 171         pass "$passcount correct integer literals printed"
 172     }
 173 }
 174
 175 proc test_character_literals_accepted {} {
 176     global prompt
 177     global passcount
 178
 179     set passcount 0
 180
 181     # Test various decimal values.
 182
 183     test_print_accept "p 'a'" "'a'"
 184     test_print_accept "p/x 'a'" "H'61"
 185     test_print_accept "p/d 'a'" "D'97"
 186     test_print_accept "p/t 'a'" "B'1100001"
 187     # test_print_accept "p '^(97)'" "'a'"       (not in GNU Chill)
 188     test_print_accept "p C'61'" "'a'"
 189     test_print_accept "p c'61'" "'a'"
 190     test_print_accept "p/x C'FF'" "H'ff"
 191     # test_print_accept "p/x '^(H'FF)'" "H'ff"  (not in GNU Chill)
 192     # test_print_accept "p/x '^(D'255)'" "H'ff" (not in GNU Chill)
 193
 194     if $passcount then {
 195         pass "$passcount correct character literals printed"
 196     }
 197 }
 198
 199 # Testing printing of a specific value.  Increment passcount for
 200 # success or issue fail message for failure.  In both cases, return
 201 # a 1 to indicate that more tests can proceed.  However a timeout
 202 # is a serious error, generates a special fail message, and causes
 203 # a 0 to be returned to indicate that more tests are likely to fail
 204 # as well.
 205
 206 proc test_print_reject { args } {
 207     global prompt
 208     global passcount
 209     global verbose
 210
 211     if [llength $args]==2 then {
 212         set expectthis [lindex $args 1]
 213     } else {
 214         set expectthis "should never match this bogus string"
 215     }
 216     set sendthis [lindex $args 0]
 217     if $verbose>2 then {
 218         send_user "Sending \"$sendthis\" to gdb\n"
 219         send_user "Looking to match \"$expectthis\"\n"
 220     }
 221     send "$sendthis\n"
 222     expect {
 223         -re ".*A .* in expression.*\\.*$prompt $" {
 224             incr passcount
 225             return 1
 226         }
 227         -re ".*Junk after end of expression.*$prompt $" {
 228             incr passcount
 229             return 1
 230         }
 231         -re ".*No symbol table is loaded.*$prompt $" {
 232             incr passcount
 233             return 1
 234         }
 235         -re ".*$expectthis.*$prompt $" {
 236             incr passcount
 237             return 1
 238         }
 239         -re ".*$prompt $" {
 240             fail "$sendthis not properly rejected"
 241             return 1
 242         }
 243         timeout {
 244             fail "$sendthis (timeout)"
 245             return 0
 246         }
 247     }
 248 }
 249
 250 proc test_integer_literals_rejected {} {
 251     global prompt
 252     global passcount
 253
 254     set passcount 0
 255
 256     # These are valid integer literals in Z.200, but not GNU-Chill.
 257
 258     test_print_reject "p _"
 259     test_print_reject "p __"
 260
 261     test_print_reject "p D'"
 262     test_print_reject "p D'_"
 263     test_print_reject "p D'__"
 264
 265     test_print_reject "p B'"
 266     test_print_reject "p B'_"
 267     test_print_reject "p B'__"
 268
 269     test_print_reject "p O'"
 270     test_print_reject "p O'_"
 271     test_print_reject "p O'__"
 272
 273     test_print_reject "p H'"
 274     test_print_reject "p H'_"
 275     test_print_reject "p H'__"
 276
 277     # Test various decimal values.
 278
 279     test_print_reject "p D'DEADBEEF"
 280     test_print_reject "p D'123DEADBEEF"
 281
 282     # Test various binary values.
 283
 284     test_print_reject "p B'2"
 285     test_print_reject "p B'12"
 286
 287     # Test various octal values.
 288
 289     test_print_reject "p O'9"
 290     test_print_reject "p O'79"
 291
 292     # Test various hexadecimal values.
 293
 294     test_print_reject "p H'G"
 295     test_print_reject "p H'AG"
 296
 297     if $passcount then {
 298         pass "$passcount incorrect integer literals rejected"
 299     }
 300 }
 301
 302 proc test_boolean_literals_accepted {} {
 303     global prompt
 304     global passcount
 305
 306     set passcount 0
 307
 308     # Test the only possible values for a boolean, TRUE and FALSE.
 309
 310     test_print_accept "p TRUE" "TRUE"
 311     test_print_accept "p FALSE" "FALSE"
 312
 313     if $passcount then {
 314         pass "$passcount correct boolean literals printed"
 315     }
 316 }
 317
 318 proc test_float_literals_accepted {} {
 319     global prompt
 320     global passcount
 321
 322     set passcount 0
 323
 324     # Test various floating point formats
 325
 326     test_print_accept "p .44 < .45" "1"
 327     test_print_accept "p .44 > .45" "0"
 328     test_print_accept "p 0.44 < 0.45" "1"
 329     test_print_accept "p 0.44 > 0.45" "0"
 330     test_print_accept "p 44. < 45." "1"
 331     test_print_accept "p 44. > 45." "0"
 332     test_print_accept "p 44.0 < 45.0" "1"
 333     test_print_accept "p 44.0 > 45.0" "0"
 334     test_print_accept "p 10D20 < 10D21" "1"
 335     test_print_accept "p 10D20 > 10D21" "0"
 336     test_print_accept "p 10d20 < 10d21" "1"
 337     test_print_accept "p 10d20 > 10d21" "0"
 338     test_print_accept "p 10E20 < 10E21" "1"
 339     test_print_accept "p 10E20 > 10E21" "0"
 340     test_print_accept "p 10e20 < 10e21" "1"
 341     test_print_accept "p 10e20 > 10e21" "0"
 342     test_print_accept "p 10.D20 < 10.D21" "1"
 343     test_print_accept "p 10.D20 > 10.D21" "0"
 344     test_print_accept "p 10.d20 < 10.d21" "1"
 345     test_print_accept "p 10.d20 > 10.d21" "0"
 346     test_print_accept "p 10.E20 < 10.E21" "1"
 347     test_print_accept "p 10.E20 > 10.E21" "0"
 348     test_print_accept "p 10.e20 < 10.e21" "1"
 349     test_print_accept "p 10.e20 > 10.e21" "0"
 350     test_print_accept "p 10.0D20 < 10.0D21" "1"
 351     test_print_accept "p 10.0D20 > 10.0D21" "0"
 352     test_print_accept "p 10.0d20 < 10.0d21" "1"
 353     test_print_accept "p 10.0d20 > 10.0d21" "0"
 354     test_print_accept "p 10.0E20 < 10.0E21" "1"
 355     test_print_accept "p 10.0E20 > 10.0E21" "0"
 356     test_print_accept "p 10.0e20 < 10.0e21" "1"
 357     test_print_accept "p 10.0e20 > 10.0e21" "0"
 358     test_print_accept "p 10.0D+20 < 10.0D+21" "1"
 359     test_print_accept "p 10.0D+20 > 10.0D+21" "0"
 360     test_print_accept "p 10.0d+20 < 10.0d+21" "1"
 361     test_print_accept "p 10.0d+20 > 10.0d+21" "0"
 362     test_print_accept "p 10.0E+20 < 10.0E+21" "1"
 363     test_print_accept "p 10.0E+20 > 10.0E+21" "0"
 364     test_print_accept "p 10.0e+20 < 10.0e+21" "1"
 365     test_print_accept "p 10.0e+20 > 10.0e+21" "0"
 366     test_print_accept "p 10.0D-11 < 10.0D-10" "1"
 367     test_print_accept "p 10.0D-11 > 10.0D-10" "0"
 368     test_print_accept "p 10.0d-11 < 10.0d-10" "1"
 369     test_print_accept "p 10.0d-11 > 10.0d-10" "0"
 370     test_print_accept "p 10.0E-11 < 10.0E-10" "1"
 371     test_print_accept "p 10.0E-11 > 10.0E-10" "0"
 372     test_print_accept "p 10.0e-11 < 10.0e-10" "1"
 373     test_print_accept "p 10.0e-11 > 10.0e-10" "0"
 374     # looks funny, but apparently legal
 375     test_print_accept "p _.1e+10 < _.1e+11" "1"
 376     test_print_accept "p _.1e+10 > _.1e+11" "0"
 377     test_print_accept "p __.1e-12 < __.1e-11" "1"
 378     test_print_accept "p __.1e-12 > __.1e-11" "0"
 379
 380     if $passcount then {
 381         pass "$passcount correct float literal comparisons"
 382     }
 383 }
 384
 385 proc test_convenience_variables {} {
 386     global prompt
 387
 388     gdb_test "set \\\$foo := 101"       " := 101" \
 389         "Set a new convenience variable"
 390
 391     gdb_test "print \\\$foo"            " = 101" \
 392         "Print contents of new convenience variable"
 393
 394     gdb_test "set \\\$foo := 301"       " := 301" \
 395         "Set convenience variable to a new value"
 396
 397     gdb_test "print \\\$foo"            " = 301" \
 398         "Print new contents of convenience variable"
 399
 400     gdb_test "set \\\$_ := 11"          " := 11" \
 401         "Set convenience variable \$_"
 402
 403     gdb_test "print \\\$_"              " = 11" \
 404         "Print contents of convenience variable \$_"
 405
 406     gdb_test "print \\\$foo + 10"       " = 311" \
 407         "Use convenience variable in arithmetic expression"
 408
 409     gdb_test "print (\\\$foo := 32) + 4"        " = 36" \
 410         "Use convenience variable assignment in arithmetic expression"
 411
 412     gdb_test "print \\\$bar"            " = void" \
 413         "Print contents of uninitialized convenience variable"
 414 }
 415
 416 proc test_value_history {} {
 417     global prompt
 418
 419     gdb_test "print 101"        "\\\$1 = 101" \
 420         "Set value-history\[1\] using \$1"
 421
 422     gdb_test "print 102"        "\\\$2 = 102" \
 423         "Set value-history\[2\] using \$2"
 424
 425     gdb_test "print 103"        "\\\$3 = 103" \
 426         "Set value-history\[3\] using \$3"
 427
 428     gdb_test "print \\\$\\\$"   "\\\$4 = 102" \
 429         "Print value-history\[MAX-1\] using inplicit index \$\$"
 430
 431     gdb_test "print \\\$\\\$"   "\\\$5 = 103" \
 432         "Print value-history\[MAX-1\] again using implicit index \$\$"
 433
 434     gdb_test "print \\\$"       "\\\$6 = 103" \
 435         "Print value-history\[MAX\] using implicit index \$"
 436
 437     gdb_test "print \\\$\\\$2"  "\\\$7 = 102" \
 438         "Print value-history\[MAX-2\] using explicit index \$\$2"
 439
 440     gdb_test "print \\\$0"      "\\\$8 = 102" \
 441         "Print value-history\[MAX\] using explicit index \$0"
 442
 443     gdb_test "print 108"        "\\\$9 = 108" ""
 444
 445     gdb_test "print \\\$\\\$0"  "\\\$10 = 108" \
 446         "Print value-history\[MAX\] using explicit index \$\$0"
 447
 448     gdb_test "print \\\$1"      "\\\$11 = 101" \
 449         "Print value-history\[1\] using explicit index \$1"
 450
 451     gdb_test "print \\\$2"      "\\\$12 = 102" \
 452         "Print value-history\[2\] using explicit index \$2"
 453
 454     gdb_test "print \\\$3"      "\\\$13 = 103" \
 455         "Print value-history\[3\] using explicit index \$3"
 456
 457     gdb_test "print \\\$-3"     "\\\$14 = 100" \
 458         "Print (value-history\[MAX\] - 3) using implicit index \$"
 459
 460     gdb_test "print \\\$1 + 3"  "\\\$15 = 104" \
 461         "Use value-history element in arithmetic expression"
 462 }
 463
 464 proc test_arithmetic_expressions {} {
 465     global prompt
 466     global passcount
 467
 468     set passcount 0
 469
 470     # Test unary minus with various operands
 471
 472 #    test_print_accept "p -(TRUE)"      "-1"    "unary minus applied to bool"
 473 #    test_print_accept "p -('a')"       "xxx"   "unary minus applied to char"
 474     test_print_accept "p -(1)"          "-1"    "unary minus applied to int"
 475     test_print_accept "p -(1.0)"        "-1"    "unary minus applied to real"
 476
 477     # Test addition with various operands
 478
 479     test_print_accept "p TRUE + 1"      "2"     "bool plus int"
 480     test_print_accept "p 'a' + 1"       "98"    "char plus int"
 481     test_print_accept "p 1 + 1"         "2"     "int plus int"
 482     test_print_accept "p 1.0 + 1"       "2"     "real plus int"
 483     test_print_accept "p 1.0 + 2.0"     "3"     "real plus real"
 484
 485     # Test subtraction with various operands
 486
 487     test_print_accept "p TRUE - 1"      "0"     "bool minus int"
 488     test_print_accept "p 'b' - 1"       "97"    "char minus int"
 489     test_print_accept "p 3 - 1"         "2"     "int minus int"
 490     test_print_accept "p 3.0 - 1"       "2"     "real minus int"
 491     test_print_accept "p 5.0 - 2.0"     "3"     "real minus real"
 492
 493     # Test multiplication with various operands
 494
 495     test_print_accept "p TRUE * 1"      "1"     "bool times int"
 496     test_print_accept "p 'a' * 2"       "194"   "char times int"
 497     test_print_accept "p 2 * 3"         "6"     "int times int"
 498     test_print_accept "p 2.0 * 3"       "6"     "real times int"
 499     test_print_accept "p 2.0 * 3.0"     "6"     "real times real"
 500
 501     # Test division with various operands
 502
 503     test_print_accept "p TRUE / 1"      "1"     "bool divided by int"
 504     test_print_accept "p 'a' / 2"       "48"    "char divided by int"
 505     test_print_accept "p 6 / 3"         "2"     "int divided by int"
 506     test_print_accept "p 6.0 / 3"       "2"     "real divided by int"
 507     test_print_accept "p 6.0 / 3.0"     "2"     "real divided by real"
 508
 509     # Test modulo with various operands
 510
 511     test_print_accept "p TRUE MOD 1"    "0"     "bool modulo int"
 512     test_print_accept "p 'a' MOD 2"     "1"     "char modulo int"
 513     test_print_accept "p -5 MOD 3"      "1"     "negative int modulo int"
 514     test_print_accept "p 5 MOD 1"       "0"     "int modulo int"
 515     test_print_accept "p 5 MOD 2"       "1"     "int modulo int"
 516     test_print_accept "p 5 MOD 3"       "2"     "int modulo int"
 517     test_print_accept "p 5 MOD 4"       "1"     "int modulo int"
 518     test_print_accept "p 5 MOD 5"       "0"     "int modulo int"
 519     test_print_accept "p 0 MOD 1"       "0"     "int modulo int"
 520     test_print_accept "p 0 MOD 2"       "0"     "int modulo int"
 521     test_print_accept "p 0 MOD 3"       "0"     "int modulo int"
 522     test_print_accept "p 0 MOD 4"       "0"     "int modulo int"
 523     test_print_accept "p -5 MOD 1"      "0"     "int modulo int"
 524     test_print_accept "p -5 MOD 2"      "1"     "int modulo int"
 525     test_print_accept "p -5 MOD 3"      "1"     "int modulo int"
 526     test_print_accept "p -5 MOD 4"      "3"     "int modulo int"
 527     test_print_accept "p -5 MOD 5"      "0"     "int modulo int"
 528     test_print_accept "p -5 MOD 5"      "0"     "int modulo int"
 529     test_print_reject "p 6.0 MOD 3" \
 530         "Integer-only operation on floating point number.*"
 531     test_print_reject "p 6.0 MOD 3.0" \
 532         "Integer-only operation on floating point number.*"
 533     test_print_reject "p -5 MOD -1" \
 534         "Second operand of MOD must be greater than zero.*"
 535     test_print_reject "p -5 MOD 0" \
 536         "Second operand of MOD must be greater than zero.*"
 537
 538     # Test remainder with various operands
 539
 540     test_print_accept "p TRUE REM 1"    "0"     "bool remainder int"
 541     test_print_accept "p 'a' REM 2"     "1"     "char remainder int"
 542     test_print_accept "p 5 REM 5"       "0"     "int remainder int"
 543     test_print_accept "p 5 REM 4"       "1"     "int remainder int"
 544     test_print_accept "p 5 REM 3"       "2"     "int remainder int"
 545     test_print_accept "p 5 REM 2"       "1"     "int remainder int"
 546     test_print_accept "p 5 REM 1"       "0"     "int remainder int"
 547     test_print_accept "p 5 REM -1"      "0"     "int remainder int"
 548     test_print_accept "p 5 REM -2"      "1"     "int remainder int"
 549     test_print_accept "p 5 REM -3"      "2"     "int remainder int"
 550     test_print_accept "p 5 REM -4"      "1"     "int remainder int"
 551     test_print_accept "p 5 REM -5"      "0"     "int remainder int"
 552     test_print_accept "p -5 REM 5"      "0"     "int remainder int"
 553     test_print_accept "p -5 REM 4"      "-1"    "int remainder int"
 554     test_print_accept "p -5 REM 3"      "-2"    "int remainder int"
 555     test_print_accept "p -5 REM 2"      "-1"    "int remainder int"
 556     test_print_accept "p -5 REM 1"      "0"     "int remainder int"
 557     test_print_accept "p -5 REM -1"     "0"     "int remainder int"
 558     test_print_accept "p -5 REM -2"     "-1"    "int remainder int"
 559     test_print_accept "p -5 REM -3"     "-2"    "int remainder int"
 560     test_print_accept "p -5 REM -4"     "-1"    "int remainder int"
 561     test_print_accept "p -5 REM -5"     "0"     "int remainder int"
 562     test_print_accept "p 6 REM 3"       "0"     "int remainder int"
 563     test_print_reject "p 6.0 REM 3" \
 564         "Integer-only operation on floating point number.*"
 565     test_print_reject "p 6.0 REM 3.0" \
 566         "Integer-only operation on floating point number.*"
 567
 568     if $passcount then {
 569         pass "$passcount correct arithmetic expressions"
 570     }
 571 }
 572
 573 # Start with a fresh gdb.
 574
 575 gdb_exit
 576 gdb_start
 577 gdb_reinitialize_dir $srcdir/$subdir
 578
 579 send "set print sevenbit-strings\n" ; expect -re ".*$prompt $"
 580
 581 if [set_lang_chill] then {
 582     test_value_history
 583     test_convenience_variables
 584     test_integer_literals_accepted
 585     test_integer_literals_rejected
 586     test_boolean_literals_accepted
 587     test_character_literals_accepted
 588     test_float_literals_accepted
 589     test_arithmetic_expressions
 590 } else {
 591     warning "$test_name tests suppressed."
 592 }