gdb/testsuite/gdb.fortran/exprs.exp

   1 # Copyright (C) 1994 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 adapted from Chill tests by Stan Shebs (shebs@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 fortran.  This counts as a test.  If it
  30 # fails, then we skip the other tests.
  31
  32 proc set_lang_fortran {} {
  33     global prompt
  34
  35     send "set language fortran\n"
  36     expect {
  37         -re ".*$prompt $" {}
  38         timeout { fail "set language fortran (timeout)" ; return 0 }
  39     }
  40
  41     send "show language\n"
  42     expect {
  43         -re ".* source language is \"fortran\".*$prompt $" {
  44             pass "set language to \"fortran\""
  45             return 1
  46         }
  47         -re ".*$prompt $" {
  48             fail "setting language to \"fortran\""
  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
 120     if $passcount then {
 121         pass "$passcount correct integer literals printed"
 122     }
 123 }
 124
 125 proc test_character_literals_accepted {} {
 126     global prompt
 127     global passcount
 128
 129     set passcount 0
 130
 131     # Test various character values.
 132
 133     test_print_accept "p 'a'" "'a'"
 134
 135     if $passcount then {
 136         pass "$passcount correct character literals printed"
 137     }
 138 }
 139
 140 # Testing printing of a specific value.  Increment passcount for
 141 # success or issue fail message for failure.  In both cases, return
 142 # a 1 to indicate that more tests can proceed.  However a timeout
 143 # is a serious error, generates a special fail message, and causes
 144 # a 0 to be returned to indicate that more tests are likely to fail
 145 # as well.
 146
 147 proc test_print_reject { args } {
 148     global prompt
 149     global passcount
 150     global verbose
 151
 152     if [llength $args]==2 then {
 153         set expectthis [lindex $args 1]
 154     } else {
 155         set expectthis "should never match this bogus string"
 156     }
 157     set sendthis [lindex $args 0]
 158     if $verbose>2 then {
 159         send_user "Sending \"$sendthis\" to gdb\n"
 160         send_user "Looking to match \"$expectthis\"\n"
 161     }
 162     send "$sendthis\n"
 163     expect {
 164         -re ".*A .* in expression.*\\.*$prompt $" {
 165             incr passcount
 166             return 1
 167         }
 168         -re ".*Junk after end of expression.*$prompt $" {
 169             incr passcount
 170             return 1
 171         }
 172         -re ".*No symbol table is loaded.*$prompt $" {
 173             incr passcount
 174             return 1
 175         }
 176         -re ".*$expectthis.*$prompt $" {
 177             incr passcount
 178             return 1
 179         }
 180         -re ".*$prompt $" {
 181             fail "$sendthis not properly rejected"
 182             return 1
 183         }
 184         timeout {
 185             fail "$sendthis (timeout)"
 186             return 0
 187         }
 188     }
 189 }
 190
 191 proc test_integer_literals_rejected {} {
 192     global prompt
 193     global passcount
 194
 195     set passcount 0
 196
 197     test_print_reject "p _"
 198
 199     if $passcount then {
 200         pass "$passcount incorrect integer literals rejected"
 201     }
 202 }
 203
 204 proc test_logical_literals_accepted {} {
 205     global prompt
 206     global passcount
 207
 208     set passcount 0
 209
 210     # Test the only possible values for a logical, TRUE and FALSE.
 211
 212     test_print_accept "p .TRUE." ".TRUE."
 213     test_print_accept "p .FALSE." ".FALSE."
 214
 215     if $passcount then {
 216         pass "$passcount correct logical literals printed"
 217     }
 218 }
 219
 220 proc test_float_literals_accepted {} {
 221     global prompt
 222     global passcount
 223
 224     set passcount 0
 225
 226     # Test various floating point formats
 227
 228     test_print_accept "p .44 .LT. .45" "1"
 229     test_print_accept "p .44 .GT. .45" "0"
 230     test_print_accept "p 0.44 .LT. 0.45" "1"
 231     test_print_accept "p 0.44 .GT. 0.45" "0"
 232     test_print_accept "p 44. .LT. 45." "1"
 233     test_print_accept "p 44. .GT. 45." "0"
 234     test_print_accept "p 44.0 .LT. 45.0" "1"
 235     test_print_accept "p 44.0 .GT. 45.0" "0"
 236     test_print_accept "p 10D20 .LT. 10D21" "1"
 237     test_print_accept "p 10D20 .GT. 10D21" "0"
 238     test_print_accept "p 10d20 .LT. 10d21" "1"
 239     test_print_accept "p 10d20 .GT. 10d21" "0"
 240     test_print_accept "p 10E20 .LT. 10E21" "1"
 241     test_print_accept "p 10E20 .GT. 10E21" "0"
 242     test_print_accept "p 10e20 .LT. 10e21" "1"
 243     test_print_accept "p 10e20 .GT. 10e21" "0"
 244     test_print_accept "p 10.D20 .LT. 10.D21" "1"
 245     test_print_accept "p 10.D20 .GT. 10.D21" "0"
 246     test_print_accept "p 10.d20 .LT. 10.d21" "1"
 247     test_print_accept "p 10.d20 .GT. 10.d21" "0"
 248     test_print_accept "p 10.E20 .LT. 10.E21" "1"
 249     test_print_accept "p 10.E20 .GT. 10.E21" "0"
 250     test_print_accept "p 10.e20 .LT. 10.e21" "1"
 251     test_print_accept "p 10.e20 .GT. 10.e21" "0"
 252     test_print_accept "p 10.0D20 .LT. 10.0D21" "1"
 253     test_print_accept "p 10.0D20 .GT. 10.0D21" "0"
 254     test_print_accept "p 10.0d20 .LT. 10.0d21" "1"
 255     test_print_accept "p 10.0d20 .GT. 10.0d21" "0"
 256     test_print_accept "p 10.0E20 .LT. 10.0E21" "1"
 257     test_print_accept "p 10.0E20 .GT. 10.0E21" "0"
 258     test_print_accept "p 10.0e20 .LT. 10.0e21" "1"
 259     test_print_accept "p 10.0e20 .GT. 10.0e21" "0"
 260     test_print_accept "p 10.0D+20 .LT. 10.0D+21" "1"
 261     test_print_accept "p 10.0D+20 .GT. 10.0D+21" "0"
 262     test_print_accept "p 10.0d+20 .LT. 10.0d+21" "1"
 263     test_print_accept "p 10.0d+20 .GT. 10.0d+21" "0"
 264     test_print_accept "p 10.0E+20 .LT. 10.0E+21" "1"
 265     test_print_accept "p 10.0E+20 .GT. 10.0E+21" "0"
 266     test_print_accept "p 10.0e+20 .LT. 10.0e+21" "1"
 267     test_print_accept "p 10.0e+20 .GT. 10.0e+21" "0"
 268     test_print_accept "p 10.0D-11 .LT. 10.0D-10" "1"
 269     test_print_accept "p 10.0D-11 .GT. 10.0D-10" "0"
 270     test_print_accept "p 10.0d-11 .LT. 10.0d-10" "1"
 271     test_print_accept "p 10.0d-11 .GT. 10.0d-10" "0"
 272     test_print_accept "p 10.0E-11 .LT. 10.0E-10" "1"
 273     test_print_accept "p 10.0E-11 .GT. 10.0E-10" "0"
 274     test_print_accept "p 10.0e-11 .LT. 10.0e-10" "1"
 275     test_print_accept "p 10.0e-11 .GT. 10.0e-10" "0"
 276
 277     if $passcount then {
 278         pass "$passcount correct float literal comparisons"
 279     }
 280 }
 281
 282 proc test_convenience_variables {} {
 283     global prompt
 284
 285     gdb_test "set \\\$foo = 101"        " = 101" \
 286         "Set a new convenience variable"
 287
 288     gdb_test "print \\\$foo"            " = 101" \
 289         "Print contents of new convenience variable"
 290
 291     gdb_test "set \\\$foo = 301"        " = 301" \
 292         "Set convenience variable to a new value"
 293
 294     gdb_test "print \\\$foo"            " = 301" \
 295         "Print new contents of convenience variable"
 296
 297     gdb_test "set \\\$_ = 11"           " = 11" \
 298         "Set convenience variable \$_"
 299
 300     gdb_test "print \\\$_"              " = 11" \
 301         "Print contents of convenience variable \$_"
 302
 303     gdb_test "print \\\$foo + 10"       " = 311" \
 304         "Use convenience variable in arithmetic expression"
 305
 306     gdb_test "print (\\\$foo = 32) + 4" " = 36" \
 307         "Use convenience variable assignment in arithmetic expression"
 308
 309     gdb_test "print \\\$bar"            " = void" \
 310         "Print contents of uninitialized convenience variable"
 311 }
 312
 313 proc test_value_history {} {
 314     global prompt
 315
 316     gdb_test "print 101"        "\\\$1 = 101" \
 317         "Set value-history\[1\] using \$1"
 318
 319     gdb_test "print 102"        "\\\$2 = 102" \
 320         "Set value-history\[2\] using \$2"
 321
 322     gdb_test "print 103"        "\\\$3 = 103" \
 323         "Set value-history\[3\] using \$3"
 324
 325     gdb_test "print \\\$\\\$"   "\\\$4 = 102" \
 326         "Print value-history\[MAX-1\] using inplicit index \$\$"
 327
 328     gdb_test "print \\\$\\\$"   "\\\$5 = 103" \
 329         "Print value-history\[MAX-1\] again using implicit index \$\$"
 330
 331     gdb_test "print \\\$"       "\\\$6 = 103" \
 332         "Print value-history\[MAX\] using implicit index \$"
 333
 334     gdb_test "print \\\$\\\$2"  "\\\$7 = 102" \
 335         "Print value-history\[MAX-2\] using explicit index \$\$2"
 336
 337     gdb_test "print \\\$0"      "\\\$8 = 102" \
 338         "Print value-history\[MAX\] using explicit index \$0"
 339
 340     gdb_test "print 108"        "\\\$9 = 108" ""
 341
 342     gdb_test "print \\\$\\\$0"  "\\\$10 = 108" \
 343         "Print value-history\[MAX\] using explicit index \$\$0"
 344
 345     gdb_test "print \\\$1"      "\\\$11 = 101" \
 346         "Print value-history\[1\] using explicit index \$1"
 347
 348     gdb_test "print \\\$2"      "\\\$12 = 102" \
 349         "Print value-history\[2\] using explicit index \$2"
 350
 351     gdb_test "print \\\$3"      "\\\$13 = 103" \
 352         "Print value-history\[3\] using explicit index \$3"
 353
 354     gdb_test "print \\\$-3"     "\\\$14 = 100" \
 355         "Print (value-history\[MAX\] - 3) using implicit index \$"
 356
 357     gdb_test "print \\\$1 + 3"  "\\\$15 = 104" \
 358         "Use value-history element in arithmetic expression"
 359 }
 360
 361 proc test_arithmetic_expressions {} {
 362     global prompt
 363     global passcount
 364
 365     set passcount 0
 366
 367     # Test unary minus with various operands
 368
 369 #    test_print_accept "p -(TRUE)"      "-1"    "unary minus applied to bool"
 370 #    test_print_accept "p -('a')"       "xxx"   "unary minus applied to char"
 371     test_print_accept "p -(1)"          "-1"    "unary minus applied to int"
 372     test_print_accept "p -(1.0)"        "-1"    "unary minus applied to real"
 373
 374     # Test addition with various operands
 375
 376     test_print_accept "p .TRUE. + 1"    "2"     "bool plus int"
 377     test_print_accept "p 1 + 1"         "2"     "int plus int"
 378     test_print_accept "p 1.0 + 1"       "2"     "real plus int"
 379     test_print_accept "p 1.0 + 2.0"     "3"     "real plus real"
 380
 381     # Test subtraction with various operands
 382
 383     test_print_accept "p .TRUE. - 1"    "0"     "bool minus int"
 384     test_print_accept "p 3 - 1"         "2"     "int minus int"
 385     test_print_accept "p 3.0 - 1"       "2"     "real minus int"
 386     test_print_accept "p 5.0 - 2.0"     "3"     "real minus real"
 387
 388     # Test multiplication with various operands
 389
 390     test_print_accept "p .TRUE. * 1"    "1"     "bool times int"
 391     test_print_accept "p 2 * 3"         "6"     "int times int"
 392     test_print_accept "p 2.0 * 3"       "6"     "real times int"
 393     test_print_accept "p 2.0 * 3.0"     "6"     "real times real"
 394
 395     # Test division with various operands
 396
 397     test_print_accept "p .TRUE. / 1"    "1"     "bool divided by int"
 398     test_print_accept "p 6 / 3"         "2"     "int divided by int"
 399     test_print_accept "p 6.0 / 3"       "2"     "real divided by int"
 400     test_print_accept "p 6.0 / 3.0"     "2"     "real divided by real"
 401
 402     # Test modulo with various operands
 403
 404     if $passcount then {
 405         pass "$passcount correct arithmetic expressions"
 406     }
 407 }
 408
 409 # Start with a fresh gdb.
 410
 411 gdb_exit
 412 gdb_start
 413 gdb_reinitialize_dir $srcdir/$subdir
 414
 415 send "set print sevenbit-strings\n" ; expect -re ".*$prompt $"
 416
 417 if [set_lang_fortran] then {
 418     test_value_history
 419     test_convenience_variables
 420     test_integer_literals_accepted
 421     test_integer_literals_rejected
 422     test_logical_literals_accepted
 423     test_character_literals_accepted
 424     test_float_literals_accepted
 425     test_arithmetic_expressions
 426 } else {
 427     warning "$test_name tests suppressed."
 428 }