gdb/testsuite/gdb.base/reggroups.exp

   1 # This testcase is part of GDB, the GNU debugger.
   2
   3 # Copyright 2017-2023 Free Software Foundation, Inc.
   4
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  17
  18 # Test listing reggroups and the registers in each group.
  19
  20 standard_testfile
  21
  22 if {[prepare_for_testing "failed to prepare" $testfile $srcfile debug]} {
  23     return -1
  24 }
  25
  26 if {![runto_main]} {
  27     return 0
  28 }
  29
  30 set invalid_register_re "Invalid register .*"
  31
  32 # Fetch all reggroups from 'maint print reggroups'.
  33
  34 proc fetch_reggroups {test} {
  35     global gdb_prompt
  36
  37     set reggroups {}
  38     gdb_test_multiple "maint print reggroups" $test {
  39         -re "maint print reggroups\r\n" {
  40             exp_continue
  41         }
  42         -re "^ Group\[ \t\]+Type\[ \t\]+\r\n" {
  43             exp_continue
  44         }
  45         -re "^ (\[_0-9a-zA-Z-\]+)\[ \t\]+(user|internal)\[ \t\]+\r\n" {
  46             lappend reggroups $expect_out(1,string)
  47             exp_continue
  48         }
  49         -re "$gdb_prompt $" {
  50             gdb_assert "[llength $reggroups] != 0" $test
  51         }
  52     }
  53
  54     return $reggroups
  55 }
  56
  57 # Fetch all registers for a reggroup from 'info reg <reggroup>'.
  58
  59 proc fetch_reggroup_regs {reggroup test} {
  60     global gdb_prompt
  61     global invalid_register_re
  62
  63     # The command info reg <reggroup> will return something like the following:
  64     #
  65     # r0             0x0      0^M
  66     # r1             0x7fdffc 0x7fdffc^M
  67     # r2             0x7fe000 0x7fe000^M
  68     # npc            0x23a8   0x23a8 <main+12>^M
  69     # sr             0x8401   [ SM CY FO CID=0 ]^M
  70     #
  71     # We parse out and return the reg names, this is done by detecting
  72     # that for each line we have a register name followed by a $hex number.
  73     #
  74     # Note: we will not return vector registers, but I think this is ok because
  75     # for testing purposes we just want to ensure we get some registers and dont
  76     # fail.  Example vector register:
  77     #
  78     # xmm0           {v4_float = {0x0, 0x0, 0x0, 0x0}, v2_double = {0x0, ... }}
  79     #
  80     set regs {}
  81     gdb_test_multiple "info reg $reggroup" $test {
  82         -re "info reg $reggroup\r\n" {
  83             exp_continue
  84         }
  85         -re "^(\[0-9a-zA-Z-\]+)\[ \t\]+(0x\[0-9a-f\]+)\[ \t\]+(\[^\n\r\]+)\r\n" {
  86             lappend regs $expect_out(1,string)
  87             exp_continue
  88         }
  89         -re $invalid_register_re {
  90             fail "$test (unexpected invalid register response)"
  91         }
  92         -re "$gdb_prompt $" {
  93             pass $test
  94         }
  95     }
  96     return $regs
  97 }
  98
  99 set reggroups [fetch_reggroups "fetch reggroups"]
 100 set regcount 0
 101 foreach reggroup $reggroups {
 102     set regs [fetch_reggroup_regs $reggroup "fetch reggroup regs $reggroup"]
 103     set regcount [expr $regcount + [llength $regs]]
 104 }
 105
 106 gdb_assert "[llength $regcount] != 0" "system has reggroup registers"
 107
 108 # If this fails it means that probably someone changed the error text returned
 109 # for an invalid register argument.  If that happens we should fix the pattern
 110 # here and in the fetch_reggroup_regs procedure above.
 111 gdb_test "info reg invalid-reggroup" $invalid_register_re \
 112     "info reg invalid-reggroup should report 'Invalid register'"