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 proc test_integer_literals_accepted {} {
  59     global prompt
  60
  61     # Test various decimal values.
  62
  63     test_print_accept "p 123" "123"
  64     test_print_accept "p -123" "-123"
  65 }
  66
  67 proc test_character_literals_accepted {} {
  68     global prompt
  69
  70     # Test various character values.
  71
  72     test_print_accept "p 'a'" "'a'"
  73 }
  74
  75 proc test_integer_literals_rejected {} {
  76     global prompt
  77
  78     test_print_reject "p _"
  79 }
  80
  81 proc test_logical_literals_accepted {} {
  82     global prompt
  83
  84     # Test the only possible values for a logical, TRUE and FALSE.
  85
  86     test_print_accept "p .TRUE." ".TRUE."
  87     test_print_accept "p .FALSE." ".FALSE."
  88 }
  89
  90 proc test_float_literals_accepted {} {
  91     global prompt
  92
  93     # Test various floating point formats
  94
  95     test_print_accept "p .44 .LT. .45" "1"
  96     test_print_accept "p .44 .GT. .45" "0"
  97     test_print_accept "p 0.44 .LT. 0.45" "1"
  98     test_print_accept "p 0.44 .GT. 0.45" "0"
  99     test_print_accept "p 44. .LT. 45." "1"
 100     test_print_accept "p 44. .GT. 45." "0"
 101     test_print_accept "p 44.0 .LT. 45.0" "1"
 102     test_print_accept "p 44.0 .GT. 45.0" "0"
 103     test_print_accept "p 10D20 .LT. 10D21" "1"
 104     test_print_accept "p 10D20 .GT. 10D21" "0"
 105     test_print_accept "p 10d20 .LT. 10d21" "1"
 106     test_print_accept "p 10d20 .GT. 10d21" "0"
 107     test_print_accept "p 10E20 .LT. 10E21" "1"
 108     test_print_accept "p 10E20 .GT. 10E21" "0"
 109     test_print_accept "p 10e20 .LT. 10e21" "1"
 110     test_print_accept "p 10e20 .GT. 10e21" "0"
 111     test_print_accept "p 10.D20 .LT. 10.D21" "1"
 112     test_print_accept "p 10.D20 .GT. 10.D21" "0"
 113     test_print_accept "p 10.d20 .LT. 10.d21" "1"
 114     test_print_accept "p 10.d20 .GT. 10.d21" "0"
 115     test_print_accept "p 10.E20 .LT. 10.E21" "1"
 116     test_print_accept "p 10.E20 .GT. 10.E21" "0"
 117     test_print_accept "p 10.e20 .LT. 10.e21" "1"
 118     test_print_accept "p 10.e20 .GT. 10.e21" "0"
 119     test_print_accept "p 10.0D20 .LT. 10.0D21" "1"
 120     test_print_accept "p 10.0D20 .GT. 10.0D21" "0"
 121     test_print_accept "p 10.0d20 .LT. 10.0d21" "1"
 122     test_print_accept "p 10.0d20 .GT. 10.0d21" "0"
 123     test_print_accept "p 10.0E20 .LT. 10.0E21" "1"
 124     test_print_accept "p 10.0E20 .GT. 10.0E21" "0"
 125     test_print_accept "p 10.0e20 .LT. 10.0e21" "1"
 126     test_print_accept "p 10.0e20 .GT. 10.0e21" "0"
 127     test_print_accept "p 10.0D+20 .LT. 10.0D+21" "1"
 128     test_print_accept "p 10.0D+20 .GT. 10.0D+21" "0"
 129     test_print_accept "p 10.0d+20 .LT. 10.0d+21" "1"
 130     test_print_accept "p 10.0d+20 .GT. 10.0d+21" "0"
 131     test_print_accept "p 10.0E+20 .LT. 10.0E+21" "1"
 132     test_print_accept "p 10.0E+20 .GT. 10.0E+21" "0"
 133     test_print_accept "p 10.0e+20 .LT. 10.0e+21" "1"
 134     test_print_accept "p 10.0e+20 .GT. 10.0e+21" "0"
 135     test_print_accept "p 10.0D-11 .LT. 10.0D-10" "1"
 136     test_print_accept "p 10.0D-11 .GT. 10.0D-10" "0"
 137     test_print_accept "p 10.0d-11 .LT. 10.0d-10" "1"
 138     test_print_accept "p 10.0d-11 .GT. 10.0d-10" "0"
 139     test_print_accept "p 10.0E-11 .LT. 10.0E-10" "1"
 140     test_print_accept "p 10.0E-11 .GT. 10.0E-10" "0"
 141     test_print_accept "p 10.0e-11 .LT. 10.0e-10" "1"
 142     test_print_accept "p 10.0e-11 .GT. 10.0e-10" "0"
 143 }
 144
 145 proc test_convenience_variables {} {
 146     global prompt
 147
 148     gdb_test "set \\\$foo = 101"        " = 101" \
 149         "Set a new convenience variable"
 150
 151     gdb_test "print \\\$foo"            " = 101" \
 152         "Print contents of new convenience variable"
 153
 154     gdb_test "set \\\$foo = 301"        " = 301" \
 155         "Set convenience variable to a new value"
 156
 157     gdb_test "print \\\$foo"            " = 301" \
 158         "Print new contents of convenience variable"
 159
 160     gdb_test "set \\\$_ = 11"           " = 11" \
 161         "Set convenience variable \$_"
 162
 163     gdb_test "print \\\$_"              " = 11" \
 164         "Print contents of convenience variable \$_"
 165
 166     gdb_test "print \\\$foo + 10"       " = 311" \
 167         "Use convenience variable in arithmetic expression"
 168
 169     gdb_test "print (\\\$foo = 32) + 4" " = 36" \
 170         "Use convenience variable assignment in arithmetic expression"
 171
 172     gdb_test "print \\\$bar"            " = VOID" \
 173         "Print contents of uninitialized convenience variable"
 174 }
 175
 176 proc test_value_history {} {
 177     global prompt
 178
 179     gdb_test "print 101"        "\\\$1 = 101" \
 180         "Set value-history\[1\] using \$1"
 181
 182     gdb_test "print 102"        "\\\$2 = 102" \
 183         "Set value-history\[2\] using \$2"
 184
 185     gdb_test "print 103"        "\\\$3 = 103" \
 186         "Set value-history\[3\] using \$3"
 187
 188     gdb_test "print \\\$\\\$"   "\\\$4 = 102" \
 189         "Print value-history\[MAX-1\] using inplicit index \$\$"
 190
 191     gdb_test "print \\\$\\\$"   "\\\$5 = 103" \
 192         "Print value-history\[MAX-1\] again using implicit index \$\$"
 193
 194     gdb_test "print \\\$"       "\\\$6 = 103" \
 195         "Print value-history\[MAX\] using implicit index \$"
 196
 197     gdb_test "print \\\$\\\$2"  "\\\$7 = 102" \
 198         "Print value-history\[MAX-2\] using explicit index \$\$2"
 199
 200     gdb_test "print \\\$0"      "\\\$8 = 102" \
 201         "Print value-history\[MAX\] using explicit index \$0"
 202
 203     gdb_test "print 108"        "\\\$9 = 108" ""
 204
 205     gdb_test "print \\\$\\\$0"  "\\\$10 = 108" \
 206         "Print value-history\[MAX\] using explicit index \$\$0"
 207
 208     gdb_test "print \\\$1"      "\\\$11 = 101" \
 209         "Print value-history\[1\] using explicit index \$1"
 210
 211     gdb_test "print \\\$2"      "\\\$12 = 102" \
 212         "Print value-history\[2\] using explicit index \$2"
 213
 214     gdb_test "print \\\$3"      "\\\$13 = 103" \
 215         "Print value-history\[3\] using explicit index \$3"
 216
 217     gdb_test "print \\\$-3"     "\\\$14 = 100" \
 218         "Print (value-history\[MAX\] - 3) using implicit index \$"
 219
 220     gdb_test "print \\\$1 + 3"  "\\\$15 = 104" \
 221         "Use value-history element in arithmetic expression"
 222 }
 223
 224 proc test_arithmetic_expressions {} {
 225     global prompt
 226
 227     # Test unary minus with various operands
 228
 229 #    test_print_accept "p -(TRUE)"      "-1"    "unary minus applied to bool"
 230 #    test_print_accept "p -('a')"       "xxx"   "unary minus applied to char"
 231     test_print_accept "p -(1)"          "-1"    "unary minus applied to int"
 232     test_print_accept "p -(1.0)"        "-1"    "unary minus applied to real"
 233
 234     # Test addition with various operands
 235
 236     test_print_accept "p .TRUE. + 1"    "2"     "bool plus int"
 237     test_print_accept "p 1 + 1"         "2"     "int plus int"
 238     test_print_accept "p 1.0 + 1"       "2"     "real plus int"
 239     test_print_accept "p 1.0 + 2.0"     "3"     "real plus real"
 240
 241     # Test subtraction with various operands
 242
 243     test_print_accept "p .TRUE. - 1"    "0"     "bool minus int"
 244     test_print_accept "p 3 - 1"         "2"     "int minus int"
 245     test_print_accept "p 3.0 - 1"       "2"     "real minus int"
 246     test_print_accept "p 5.0 - 2.0"     "3"     "real minus real"
 247
 248     # Test multiplication with various operands
 249
 250     test_print_accept "p .TRUE. * 1"    "1"     "bool times int"
 251     test_print_accept "p 2 * 3"         "6"     "int times int"
 252     test_print_accept "p 2.0 * 3"       "6"     "real times int"
 253     test_print_accept "p 2.0 * 3.0"     "6"     "real times real"
 254
 255     # Test division with various operands
 256
 257     test_print_accept "p .TRUE. / 1"    "1"     "bool divided by int"
 258     test_print_accept "p 6 / 3"         "2"     "int divided by int"
 259     test_print_accept "p 6.0 / 3"       "2"     "real divided by int"
 260     test_print_accept "p 6.0 / 3.0"     "2"     "real divided by real"
 261
 262     # Test modulo with various operands
 263
 264 }
 265
 266 # Start with a fresh gdb.
 267
 268 gdb_exit
 269 gdb_start
 270 gdb_reinitialize_dir $srcdir/$subdir
 271
 272 send "set print sevenbit-strings\n" ; expect -re ".*$prompt $"
 273
 274 if [set_lang_fortran] then {
 275     test_value_history
 276     test_convenience_variables
 277     test_integer_literals_accepted
 278     test_integer_literals_rejected
 279     test_logical_literals_accepted
 280     test_character_literals_accepted
 281     test_float_literals_accepted
 282     test_arithmetic_expressions
 283 } else {
 284     warning "$test_name tests suppressed."
 285 }