gdb/testsuite/lib/sym-info-cmds.exp

   1 # Copyright 2019-2020 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 3 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, see <http://www.gnu.org/licenses/>.
  15
  16 # Make it easier to run the 'info modules' command (using
  17 # GDBInfoModules), and the 'info module ...' commands (using
  18 # GDBInfoModuleContents) and process the output.
  19 #
  20 # The difficulty we run into is that different versions of gFortran
  21 # include different helper modules which show up in the results.  The
  22 # procedures in this library help process those parts of the output we
  23 # actually want to check, while ignoring those parts that we don't
  24 # care about.
  25 #
  26 # For each namespace GDBInfoModules and GDBInfoModuleContents, there's
  27 # a run_command proc, use this to run a command and capture the
  28 # output.  Then make calls to check_header, check_entry, and
  29 # check_no_entry to ensure the output was as expected.
  30
  31 namespace eval GDBInfoSymbols {
  32
  33     # A string that is the header printed by GDB immediately after the
  34     # 'info [modules|types|functions|variables]' command has been issued.
  35     variable _header
  36
  37     # A list of entries extracted from the output of the command.
  38     # Each entry is a filename, a line number, and the rest of the
  39     # text describing the entry.  If an entry has no line number then
  40     # it is replaced with the text NONE.
  41     variable _entries
  42
  43     # The string that is the complete last command run.
  44     variable _last_command
  45
  46     # Add a new entry to the _entries list.
  47     proc _add_entry { filename lineno text } {
  48         variable _entries
  49
  50         set entry [list $filename $lineno $text]
  51         lappend _entries $entry
  52     }
  53
  54     # Run the 'info modules' command, passing ARGS as extra arguments
  55     # to the command.  Process the output storing the results within
  56     # the variables in this namespace.
  57     #
  58     # The results of any previous call to run_command are discarded
  59     # when this is called.
  60     proc run_command { cmd { testname "" } } {
  61         global gdb_prompt
  62
  63         variable _header
  64         variable _entries
  65         variable _last_command
  66
  67         if {![regexp -- "^info (modules|types|variables|functions)" $cmd]} {
  68             perror "invalid command"
  69         }
  70
  71         set _header ""
  72         set _entries [list]
  73         set _last_command $cmd
  74
  75         if { $testname == "" } {
  76             set testname $cmd
  77         }
  78
  79         send_gdb "$cmd\n"
  80         gdb_expect {
  81             -re "^$cmd\r\n" {
  82                 # Match the original command echoed back to us.
  83             }
  84             timeout {
  85                 fail "$testname (timeout)"
  86                 return 0
  87             }
  88         }
  89
  90         gdb_expect {
  91             -re "^\r\n" {
  92                 # Found the blank line after the header, we're done
  93                 # parsing the header now.
  94             }
  95             -re "^\[ \t]*(\[^\r\n\]+)\r\n" {
  96                 set str $expect_out(1,string)
  97                 if { $_header == "" } {
  98                     set _header $str
  99                 } else {
 100                     set _header "$_header $str"
 101                 }
 102                 exp_continue
 103             }
 104             timeout {
 105                 fail "$testname (timeout)"
 106                 return 0
 107             }
 108         }
 109
 110         set current_file ""
 111         gdb_expect {
 112             -re "^File (\[^\r\n\]+):\r\n" {
 113                 set current_file $expect_out(1,string)
 114                 exp_continue
 115             }
 116             -re "^(\[0-9\]+):\[ \t\]+(\[^\r\n\]+)\r\n" {
 117                 set lineno $expect_out(1,string)
 118                 set text $expect_out(2,string)
 119                 if { $current_file == "" } {
 120                     fail "$testname (missing filename)"
 121                     return 0
 122                 }
 123                 _add_entry $current_file $lineno $text
 124                 exp_continue
 125             }
 126             -re "^\[ \t\]+(\[^\r\n\]+)\r\n" {
 127                 set lineno "NONE"
 128                 set text $expect_out(1,string)
 129                 if { $current_file == "" } {
 130                     fail "$testname (missing filename)"
 131                     return 0
 132                 }
 133                 _add_entry $current_file $lineno $text
 134                 exp_continue
 135             }
 136             -re "^\r\n" {
 137                 exp_continue
 138             }
 139             -re "^$gdb_prompt $" {
 140                 # All done.
 141             }
 142             timeout {
 143                 fail "$testname (timeout)"
 144                 return 0
 145             }
 146         }
 147
 148         pass $testname
 149         return 1
 150     }
 151
 152     # Check that the header held in _header matches PATTERN.  Use
 153     # TESTNAME as the name of the test, or create a suitable default
 154     # test name based on the last command.
 155     proc check_header { pattern { testname "" } } {
 156         variable _header
 157         variable _last_command
 158
 159         if { $testname == "" } {
 160             set testname "$_last_command: check header"
 161         }
 162
 163         gdb_assert {[regexp -- $pattern $_header]} $testname
 164     }
 165
 166     # Check that we have an entry in _entries matching FILENAME,
 167     # LINENO, and TEXT.  If LINENO is the empty string it is replaced
 168     # with the string NONE in order to match a similarly missing line
 169     # number in the output of the command.
 170     #
 171     # TESTNAME is the name of the test, or a default will be created
 172     # based on the last command run and the arguments passed here.
 173     #
 174     # If a matching entry is found then it is removed from the
 175     # _entries list, this allows us to check for duplicates using the
 176     # check_no_entry call.
 177     proc check_entry { filename lineno text { testname "" } } {
 178         variable _entries
 179         variable _last_command
 180
 181         if { $testname == "" } {
 182             set testname \
 183                 "$_last_command: check for entry '$filename', '$lineno', '$text'"
 184         }
 185
 186         if { $lineno == "" } {
 187             set lineno "NONE"
 188         }
 189
 190         set new_entries [list]
 191
 192         set found_match 0
 193         foreach entry $_entries {
 194
 195             if {!$found_match} {
 196                 set f [lindex $entry 0]
 197                 set l [lindex $entry 1]
 198                 set t [lindex $entry 2]
 199                 if { [regexp -- $filename $f] \
 200                          && [regexp -- $lineno $l] \
 201                          && [regexp -- $text $t] } {
 202                     set found_match 1
 203                 } else {
 204                     lappend new_entries $entry
 205                 }
 206             } else {
 207                 lappend new_entries $entry
 208             }
 209         }
 210
 211         set _entries $new_entries
 212         gdb_assert { $found_match } $testname
 213     }
 214
 215     # Check that there is no entry in the _entries list matching
 216     # FILENAME, LINENO, and TEXT.  The LINENO and TEXT are optional,
 217     # and will be replaced with '.*' if missing.
 218     #
 219     # If LINENO is the empty string then it will be replaced with the
 220     # string NONE in order to match against missing line numbers in
 221     # the output of the command.
 222     #
 223     # TESTNAME is the name of the test, or a default will be built
 224     # from the last command run and the arguments passed here.
 225     #
 226     # This can be used after a call to check_entry to ensure that
 227     # there are no further matches for a particular file in the
 228     # output.
 229     proc check_no_entry { filename { lineno ".*" } { text ".*" } \
 230                               { testname "" } } {
 231         variable _entries
 232         variable _last_command
 233
 234         if { $testname == "" } {
 235             set testname \
 236                 "$_last_command: check no matches for '$filename', '$lineno', and '$text'"
 237         }
 238
 239         if { $lineno == "" } {
 240             set lineno "NONE"
 241         }
 242
 243         foreach entry $_entries {
 244             set f [lindex $entry 0]
 245             set l [lindex $entry 1]
 246             set t [lindex $entry 2]
 247             if { [regexp -- $filename $f] \
 248                      && [regexp -- $lineno $l] \
 249                      && [regexp -- $text $t] } {
 250                 fail $testname
 251             }
 252         }
 253
 254         pass $testname
 255     }
 256 }
 257
 258
 259 namespace eval GDBInfoModuleSymbols {
 260
 261     # A string that is the header printed by GDB immediately after the
 262     # 'info modules (variables|functions)' command has been issued.
 263     variable _header
 264
 265     # A list of entries extracted from the output of the command.
 266     # Each entry is a filename, a module name, a line number, and the
 267     # rest of the text describing the entry.  If an entry has no line
 268     # number then it is replaced with the text NONE.
 269     variable _entries
 270
 271     # The string that is the complete last command run.
 272     variable _last_command
 273
 274     # Add a new entry to the _entries list.
 275     proc _add_entry { filename module lineno text } {
 276         variable _entries
 277
 278         set entry [list $filename $module $lineno $text]
 279         lappend _entries $entry
 280     }
 281
 282     # Run the 'info module ....' command, passing ARGS as extra
 283     # arguments to the command.  Process the output storing the
 284     # results within the variables in this namespace.
 285     #
 286     # The results of any previous call to run_command are discarded
 287     # when this is called.
 288     proc run_command { cmd { testname "" } } {
 289         global gdb_prompt
 290
 291         variable _header
 292         variable _entries
 293         variable _last_command
 294
 295         if {![regexp -- "^info module (variables|functions)" $cmd]} {
 296             perror "invalid command: '$cmd'"
 297         }
 298
 299         set _header ""
 300         set _entries [list]
 301         set _last_command $cmd
 302
 303         if { $testname == "" } {
 304             set testname $cmd
 305         }
 306
 307         send_gdb "$cmd\n"
 308         gdb_expect {
 309             -re "^$cmd\r\n" {
 310                 # Match the original command echoed back to us.
 311             }
 312             timeout {
 313                 fail "$testname (timeout)"
 314                 return 0
 315             }
 316         }
 317
 318         gdb_expect {
 319             -re "^\r\n" {
 320                 # Found the blank line after the header, we're done
 321                 # parsing the header now.
 322             }
 323             -re "^\[ \t\]*(\[^\r\n\]+)\r\n" {
 324                 set str $expect_out(1,string)
 325                 if { $_header == "" } {
 326                     set _header $str
 327                 } else {
 328                     set _header "$_header $str"
 329                 }
 330                 exp_continue
 331             }
 332             timeout {
 333                 fail "$testname (timeout)"
 334                 return 0
 335             }
 336         }
 337
 338         set current_module ""
 339         set current_file ""
 340         gdb_expect {
 341             -re "^Module \"(\[^\"\]+)\":\r\n" {
 342                 set current_module $expect_out(1,string)
 343                 exp_continue
 344             }
 345             -re "^File (\[^\r\n\]+):\r\n" {
 346                 if { $current_module == "" } {
 347                     fail "$testname (missing module)"
 348                     return 0
 349                 }
 350                 set current_file $expect_out(1,string)
 351                 exp_continue
 352             }
 353             -re "^(\[0-9\]+):\[ \t\]+(\[^\r\n\]+)\r\n" {
 354                 set lineno $expect_out(1,string)
 355                 set text $expect_out(2,string)
 356                 if { $current_module == "" } {
 357                     fail "$testname (missing module)"
 358                     return 0
 359                 }
 360                 if { $current_file == "" } {
 361                     fail "$testname (missing filename)"
 362                     return 0
 363                 }
 364                 _add_entry $current_file $current_module \
 365                     $lineno $text
 366                 exp_continue
 367             }
 368             -re "^\[ \t\]+(\[^\r\n\]+)\r\n" {
 369                 set lineno "NONE"
 370                 set text $expect_out(1,string)
 371                 if { $current_module == "" } {
 372                     fail "$testname (missing module)"
 373                     return 0
 374                 }
 375                 if { $current_file == "" } {
 376                     fail "$testname (missing filename)"
 377                     return 0
 378                 }
 379                 _add_entry $current_file $current_module \
 380                     $lineno $text
 381                 exp_continue
 382             }
 383             -re "^\r\n" {
 384                 exp_continue
 385             }
 386             -re "^$gdb_prompt $" {
 387                 # All done.
 388             }
 389             timeout {
 390                 fail "$testname (timeout)"
 391                 return 0
 392             }
 393         }
 394
 395         pass $testname
 396         return 1
 397     }
 398
 399     # Check that the header held in _header matches PATTERN.  Use
 400     # TESTNAME as the name of the test, or create a suitable default
 401     # test name based on the last command.
 402     proc check_header { pattern { testname "" } } {
 403         variable _header
 404         variable _last_command
 405
 406         if { $testname == "" } {
 407             set testname "$_last_command: check header"
 408         }
 409
 410         gdb_assert {[regexp -- $pattern $_header]} $testname
 411     }
 412
 413     # Check that we have an entry in _entries matching FILENAME,
 414     # MODULE, LINENO, and TEXT.  If LINENO is the empty string it is
 415     # replaced with the string NONE in order to match a similarly
 416     # missing line number in the output of the command.
 417     #
 418     # TESTNAME is the name of the test, or a default will be created
 419     # based on the last command run and the arguments passed here.
 420     #
 421     # If a matching entry is found then it is removed from the
 422     # _entries list, this allows us to check for duplicates using the
 423     # check_no_entry call.
 424     proc check_entry { filename module lineno text { testname "" } } {
 425         variable _entries
 426         variable _last_command
 427
 428         if { $testname == "" } {
 429             set testname \
 430                 "$_last_command: check for entry '$filename', '$lineno', '$text'"
 431         }
 432
 433         if { $lineno == "" } {
 434             set lineno "NONE"
 435         }
 436
 437         set new_entries [list]
 438
 439         set found_match 0
 440         foreach entry $_entries {
 441
 442             if {!$found_match} {
 443                 set f [lindex $entry 0]
 444                 set m [lindex $entry 1]
 445                 set l [lindex $entry 2]
 446                 set t [lindex $entry 3]
 447                 if { [regexp -- $filename $f] \
 448                          && [regexp -- $module $m] \
 449                          && [regexp -- $lineno $l] \
 450                          && [regexp -- $text $t] } {
 451                     set found_match 1
 452                 } else {
 453                     lappend new_entries $entry
 454                 }
 455             } else {
 456                 lappend new_entries $entry
 457             }
 458         }
 459
 460         set _entries $new_entries
 461         gdb_assert { $found_match } $testname
 462     }
 463
 464     # Check that there is no entry in the _entries list matching
 465     # FILENAME, MODULE, LINENO, and TEXT.  The LINENO and TEXT are
 466     # optional, and will be replaced with '.*' if missing.
 467     #
 468     # If LINENO is the empty string then it will be replaced with the
 469     # string NONE in order to match against missing line numbers in
 470     # the output of the command.
 471     #
 472     # TESTNAME is the name of the test, or a default will be built
 473     # from the last command run and the arguments passed here.
 474     #
 475     # This can be used after a call to check_entry to ensure that
 476     # there are no further matches for a particular file in the
 477     # output.
 478     proc check_no_entry { filename module { lineno ".*" } \
 479                               { text ".*" } { testname "" } } {
 480         variable _entries
 481         variable _last_command
 482
 483         if { $testname == "" } {
 484             set testname \
 485                 "$_last_command: check no matches for '$filename', '$lineno', and '$text'"
 486         }
 487
 488         if { $lineno == "" } {
 489             set lineno "NONE"
 490         }
 491
 492         foreach entry $_entries {
 493             set f [lindex $entry 0]
 494             set m [lindex $entry 1]
 495             set l [lindex $entry 2]
 496             set t [lindex $entry 3]
 497             if { [regexp -- $filename $f] \
 498                      && [regexp -- $module $m] \
 499                      && [regexp -- $lineno $l] \
 500                      && [regexp -- $text $t] } {
 501                 fail $testname
 502             }
 503         }
 504
 505         pass $testname
 506     }
 507 }