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

   1 # Copyright 2019-2023 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     # Call check_entry_1 with OPTIONAL == 0.
 167     proc check_entry { filename lineno text { testname "" } } {
 168         check_entry_1 $filename $lineno $text 0 $testname
 169     }
 170
 171     # Call check_entry_1 with OPTIONAL == 1.
 172     proc check_optional_entry { filename lineno text { testname "" } } {
 173         check_entry_1 $filename $lineno $text 1 $testname
 174     }
 175
 176     # Check that we have an entry in _entries matching FILENAME,
 177     # LINENO, and TEXT.  If LINENO is the empty string it is replaced
 178     # with the string NONE in order to match a similarly missing line
 179     # number in the output of the command.
 180     #
 181     # TESTNAME is the name of the test, or a default will be created
 182     # based on the last command run and the arguments passed here.
 183     #
 184     # If a matching entry is found then it is removed from the
 185     # _entries list, this allows us to check for duplicates using the
 186     # check_no_entry call.
 187     proc check_entry_1 { filename lineno text optional testname } {
 188         variable _entries
 189         variable _last_command
 190
 191         if { $testname == "" } {
 192             set testname \
 193                 "$_last_command: check for entry '$filename', '$lineno', '$text'"
 194         }
 195
 196         if { $lineno == "" } {
 197             set lineno "NONE"
 198         }
 199
 200         set new_entries [list]
 201
 202         set found_match 0
 203         foreach entry $_entries {
 204
 205             if {!$found_match} {
 206                 set f [lindex $entry 0]
 207                 set l [lindex $entry 1]
 208                 set t [lindex $entry 2]
 209                 if { [regexp -- $filename $f] \
 210                          && [regexp -- $lineno $l] \
 211                          && [regexp -- $text $t] } {
 212                     set found_match 1
 213                 } else {
 214                     lappend new_entries $entry
 215                 }
 216             } else {
 217                 lappend new_entries $entry
 218             }
 219         }
 220
 221         set _entries $new_entries
 222         if { $optional && ! $found_match } {
 223             unsupported $testname
 224         } else {
 225             gdb_assert { $found_match } $testname
 226         }
 227     }
 228
 229     # Check that there is no entry in the _entries list matching
 230     # FILENAME, LINENO, and TEXT.  The LINENO and TEXT are optional,
 231     # and will be replaced with '.*' if missing.
 232     #
 233     # If LINENO is the empty string then it will be replaced with the
 234     # string NONE in order to match against missing line numbers in
 235     # the output of the command.
 236     #
 237     # TESTNAME is the name of the test, or a default will be built
 238     # from the last command run and the arguments passed here.
 239     #
 240     # This can be used after a call to check_entry to ensure that
 241     # there are no further matches for a particular file in the
 242     # output.
 243     proc check_no_entry { filename { lineno ".*" } { text ".*" } \
 244                               { testname "" } } {
 245         variable _entries
 246         variable _last_command
 247
 248         if { $testname == "" } {
 249             set testname \
 250                 "$_last_command: check no matches for '$filename', '$lineno', and '$text'"
 251         }
 252
 253         if { $lineno == "" } {
 254             set lineno "NONE"
 255         }
 256
 257         foreach entry $_entries {
 258             set f [lindex $entry 0]
 259             set l [lindex $entry 1]
 260             set t [lindex $entry 2]
 261             if { [regexp -- $filename $f] \
 262                      && [regexp -- $lineno $l] \
 263                      && [regexp -- $text $t] } {
 264                 fail $testname
 265             }
 266         }
 267
 268         pass $testname
 269     }
 270 }
 271
 272
 273 namespace eval GDBInfoModuleSymbols {
 274
 275     # A string that is the header printed by GDB immediately after the
 276     # 'info modules (variables|functions)' command has been issued.
 277     variable _header
 278
 279     # A list of entries extracted from the output of the command.
 280     # Each entry is a filename, a module name, a line number, and the
 281     # rest of the text describing the entry.  If an entry has no line
 282     # number then it is replaced with the text NONE.
 283     variable _entries
 284
 285     # The string that is the complete last command run.
 286     variable _last_command
 287
 288     # Add a new entry to the _entries list.
 289     proc _add_entry { filename module lineno text } {
 290         variable _entries
 291
 292         set entry [list $filename $module $lineno $text]
 293         lappend _entries $entry
 294     }
 295
 296     # Run the 'info module ....' command, passing ARGS as extra
 297     # arguments to the command.  Process the output storing the
 298     # results within the variables in this namespace.
 299     #
 300     # The results of any previous call to run_command are discarded
 301     # when this is called.
 302     proc run_command { cmd { testname "" } } {
 303         global gdb_prompt
 304
 305         variable _header
 306         variable _entries
 307         variable _last_command
 308
 309         if {![regexp -- "^info module (variables|functions)" $cmd]} {
 310             perror "invalid command: '$cmd'"
 311         }
 312
 313         set _header ""
 314         set _entries [list]
 315         set _last_command $cmd
 316
 317         if { $testname == "" } {
 318             set testname $cmd
 319         }
 320
 321         send_gdb "$cmd\n"
 322         gdb_expect {
 323             -re "^$cmd\r\n" {
 324                 # Match the original command echoed back to us.
 325             }
 326             timeout {
 327                 fail "$testname (timeout)"
 328                 return 0
 329             }
 330         }
 331
 332         gdb_expect {
 333             -re "^\r\n" {
 334                 # Found the blank line after the header, we're done
 335                 # parsing the header now.
 336             }
 337             -re "^\[ \t\]*(\[^\r\n\]+)\r\n" {
 338                 set str $expect_out(1,string)
 339                 if { $_header == "" } {
 340                     set _header $str
 341                 } else {
 342                     set _header "$_header $str"
 343                 }
 344                 exp_continue
 345             }
 346             timeout {
 347                 fail "$testname (timeout)"
 348                 return 0
 349             }
 350         }
 351
 352         set current_module ""
 353         set current_file ""
 354         gdb_expect {
 355             -re "^Module \"(\[^\"\]+)\":\r\n" {
 356                 set current_module $expect_out(1,string)
 357                 exp_continue
 358             }
 359             -re "^File (\[^\r\n\]+):\r\n" {
 360                 if { $current_module == "" } {
 361                     fail "$testname (missing module)"
 362                     return 0
 363                 }
 364                 set current_file $expect_out(1,string)
 365                 exp_continue
 366             }
 367             -re "^(\[0-9\]+):\[ \t\]+(\[^\r\n\]+)\r\n" {
 368                 set lineno $expect_out(1,string)
 369                 set text $expect_out(2,string)
 370                 if { $current_module == "" } {
 371                     fail "$testname (missing module)"
 372                     return 0
 373                 }
 374                 if { $current_file == "" } {
 375                     fail "$testname (missing filename)"
 376                     return 0
 377                 }
 378                 _add_entry $current_file $current_module \
 379                     $lineno $text
 380                 exp_continue
 381             }
 382             -re "^\[ \t\]+(\[^\r\n\]+)\r\n" {
 383                 set lineno "NONE"
 384                 set text $expect_out(1,string)
 385                 if { $current_module == "" } {
 386                     fail "$testname (missing module)"
 387                     return 0
 388                 }
 389                 if { $current_file == "" } {
 390                     fail "$testname (missing filename)"
 391                     return 0
 392                 }
 393                 _add_entry $current_file $current_module \
 394                     $lineno $text
 395                 exp_continue
 396             }
 397             -re "^\r\n" {
 398                 exp_continue
 399             }
 400             -re "^$gdb_prompt $" {
 401                 # All done.
 402             }
 403             timeout {
 404                 fail "$testname (timeout)"
 405                 return 0
 406             }
 407         }
 408
 409         pass $testname
 410         return 1
 411     }
 412
 413     # Check that the header held in _header matches PATTERN.  Use
 414     # TESTNAME as the name of the test, or create a suitable default
 415     # test name based on the last command.
 416     proc check_header { pattern { testname "" } } {
 417         variable _header
 418         variable _last_command
 419
 420         if { $testname == "" } {
 421             set testname "$_last_command: check header"
 422         }
 423
 424         gdb_assert {[regexp -- $pattern $_header]} $testname
 425     }
 426
 427     # Check that we have an entry in _entries matching FILENAME,
 428     # MODULE, LINENO, and TEXT.  If LINENO is the empty string it is
 429     # replaced with the string NONE in order to match a similarly
 430     # missing line number in the output of the command.
 431     #
 432     # TESTNAME is the name of the test, or a default will be created
 433     # based on the last command run and the arguments passed here.
 434     #
 435     # If a matching entry is found then it is removed from the
 436     # _entries list, this allows us to check for duplicates using the
 437     # check_no_entry call.
 438     #
 439     # If OPTIONAL, don't generate a FAIL for a mismatch, but use UNSUPPORTED
 440     # instead.
 441     proc check_entry_1 { filename module lineno text optional testname } {
 442         variable _entries
 443         variable _last_command
 444
 445         if { $testname == "" } {
 446             set testname \
 447                 "$_last_command: check for entry '$filename', '$lineno', '$text'"
 448         }
 449
 450         if { $lineno == "" } {
 451             set lineno "NONE"
 452         }
 453
 454         set new_entries [list]
 455
 456         set found_match 0
 457         foreach entry $_entries {
 458
 459             if {!$found_match} {
 460                 set f [lindex $entry 0]
 461                 set m [lindex $entry 1]
 462                 set l [lindex $entry 2]
 463                 set t [lindex $entry 3]
 464                 if { [regexp -- $filename $f] \
 465                          && [regexp -- $module $m] \
 466                          && [regexp -- $lineno $l] \
 467                          && [regexp -- $text $t] } {
 468                     set found_match 1
 469                 } else {
 470                     lappend new_entries $entry
 471                 }
 472             } else {
 473                 lappend new_entries $entry
 474             }
 475         }
 476
 477         set _entries $new_entries
 478         if { $optional && ! $found_match } {
 479             unsupported $testname
 480         } else {
 481             gdb_assert { $found_match } $testname
 482         }
 483     }
 484
 485     # Call check_entry_1 with OPTIONAL == 0.
 486     proc check_entry { filename module lineno text { testname "" } } {
 487         check_entry_1 $filename $module $lineno $text 0 $testname
 488     }
 489
 490     # Call check_entry_1 with OPTIONAL == 1.
 491     proc check_optional_entry { filename module lineno text { testname "" } } {
 492         check_entry_1 $filename $module $lineno $text 1 $testname
 493     }
 494
 495     # Check that there is no entry in the _entries list matching
 496     # FILENAME, MODULE, LINENO, and TEXT.  The LINENO and TEXT are
 497     # optional, and will be replaced with '.*' if missing.
 498     #
 499     # If LINENO is the empty string then it will be replaced with the
 500     # string NONE in order to match against missing line numbers in
 501     # the output of the command.
 502     #
 503     # TESTNAME is the name of the test, or a default will be built
 504     # from the last command run and the arguments passed here.
 505     #
 506     # This can be used after a call to check_entry to ensure that
 507     # there are no further matches for a particular file in the
 508     # output.
 509     proc check_no_entry { filename module { lineno ".*" } \
 510                               { text ".*" } { testname "" } } {
 511         variable _entries
 512         variable _last_command
 513
 514         if { $testname == "" } {
 515             set testname \
 516                 "$_last_command: check no matches for '$filename', '$lineno', and '$text'"
 517         }
 518
 519         if { $lineno == "" } {
 520             set lineno "NONE"
 521         }
 522
 523         foreach entry $_entries {
 524             set f [lindex $entry 0]
 525             set m [lindex $entry 1]
 526             set l [lindex $entry 2]
 527             set t [lindex $entry 3]
 528             if { [regexp -- $filename $f] \
 529                      && [regexp -- $module $m] \
 530                      && [regexp -- $lineno $l] \
 531                      && [regexp -- $text $t] } {
 532                 fail $testname
 533             }
 534         }
 535
 536         pass $testname
 537     }
 538 }