gdb/testsuite/gdb.base/info-types.exp.tcl

   1 # Copyright 2019-2021 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 # Check that 'info types' produces the expected output for an inferior
  17 # containing a number of different types.
  18
  19 # Match LINE against regexp OUTPUT_LINES[IDX].
  20 proc match_line { line output_lines idx_name } {
  21     upvar $idx_name idx
  22
  23     while { 1 } {
  24         if { $idx == [llength $output_lines] } {
  25             # Ran out of regexps, bail out.
  26             return -1
  27         }
  28
  29         set re [lindex $output_lines $idx]
  30         if { $re == "--optional" } {
  31             # Optional, get actual regexp.
  32             set opt 1
  33             incr idx
  34             set re [lindex $output_lines $idx]
  35         } else {
  36             # Not optional.
  37             set opt 0
  38         }
  39
  40         if { [regexp $re $line] } {
  41             # Match.
  42             incr idx
  43             if { $idx == [llength $output_lines] } {
  44                 # Last match, we're done.
  45                 return 1
  46             }
  47             # Match found, keep looking for next match.
  48             return 0
  49         } else {
  50             # No match.
  51             if { $idx == 0 } {
  52                 # First match not found, just keep looking for first match.
  53                 return 0
  54             } elseif { $opt } {
  55                 # Try next regexp on same line.
  56                 incr idx
  57                 continue
  58             } else {
  59                 # Mismatch, bail out.
  60                 return -1
  61             }
  62         }
  63         break
  64     }
  65
  66     # Keep going.
  67     return 0
  68 }
  69
  70 # Run 'info types' test, compiling the test file for language LANG,
  71 # which should be either 'c' or 'c++'.
  72 proc run_test { lang } {
  73     global testfile
  74     global srcfile
  75     global binfile
  76     global subdir
  77     global srcdir
  78     global compile_flags
  79
  80     standard_testfile info-types.c
  81
  82     if {[prepare_for_testing "failed to prepare" \
  83              "${testfile}" $srcfile "debug $lang"]} {
  84         return -1
  85     }
  86
  87     if ![runto_main] then {
  88         fail "can't run to main"
  89         return 0
  90     }
  91
  92     set file_re "File .*[string_to_regexp $srcfile]:"
  93
  94     if { $lang == "c++" } {
  95         set output_lines \
  96             [list \
  97                  $file_re \
  98                  "98:\[\t \]+CL;" \
  99                  "42:\[\t \]+anon_struct_t;" \
 100                  "65:\[\t \]+anon_union_t;" \
 101                  "21:\[\t \]+baz_t;" \
 102                  "33:\[\t \]+enum_t;" \
 103                  "56:\[\t \]+union_t;" \
 104                  "52:\[\t \]+typedef enum {\\.\\.\\.} anon_enum_t;" \
 105                  "45:\[\t \]+typedef anon_struct_t anon_struct_t;" \
 106                  "68:\[\t \]+typedef anon_union_t anon_union_t;" \
 107                  "28:\[\t \]+typedef baz_t baz;" \
 108                  "31:\[\t \]+typedef baz_t \\* baz_ptr;" \
 109                  "27:\[\t \]+typedef baz_t baz_t;" \
 110                  "\[\t \]+double" \
 111                  "\[\t \]+float" \
 112                  "\[\t \]+int" \
 113                  "103:\[\t \]+typedef CL my_cl;" \
 114                  "38:\[\t \]+typedef enum_t my_enum_t;" \
 115                  "17:\[\t \]+typedef float my_float_t;" \
 116                  "16:\[\t \]+typedef int my_int_t;" \
 117                  "104:\[\t \]+typedef CL \\* my_ptr;" \
 118                  "54:\[\t \]+typedef enum {\\.\\.\\.} nested_anon_enum_t;" \
 119                  "47:\[\t \]+typedef anon_struct_t nested_anon_struct_t;" \
 120                  "70:\[\t \]+typedef anon_union_t nested_anon_union_t;" \
 121                  "30:\[\t \]+typedef baz_t nested_baz;" \
 122                  "29:\[\t \]+typedef baz_t nested_baz_t;" \
 123                  "39:\[\t \]+typedef enum_t nested_enum_t;" \
 124                  "19:\[\t \]+typedef float nested_float_t;" \
 125                  "18:\[\t \]+typedef int nested_int_t;" \
 126                  "62:\[\t \]+typedef union_t nested_union_t;" \
 127                  "--optional" "\[\t \]+unsigned int" \
 128                  ""]
 129     } else {
 130         set output_lines \
 131             [list \
 132                  $file_re \
 133                  "52:\[\t \]+typedef enum {\\.\\.\\.} anon_enum_t;" \
 134                  "45:\[\t \]+typedef struct {\\.\\.\\.} anon_struct_t;" \
 135                  "68:\[\t \]+typedef union {\\.\\.\\.} anon_union_t;" \
 136                  "28:\[\t \]+typedef struct baz_t baz;" \
 137                  "31:\[\t \]+typedef struct baz_t \\* baz_ptr;" \
 138                  "21:\[\t \]+struct baz_t;" \
 139                  "\[\t \]+double" \
 140                  "33:\[\t \]+enum enum_t;" \
 141                  "\[\t \]+float" \
 142                  "\[\t \]+int" \
 143                  "38:\[\t \]+typedef enum enum_t my_enum_t;" \
 144                  "17:\[\t \]+typedef float my_float_t;" \
 145                  "16:\[\t \]+typedef int my_int_t;" \
 146                  "54:\[\t \]+typedef enum {\\.\\.\\.} nested_anon_enum_t;" \
 147                  "47:\[\t \]+typedef struct {\\.\\.\\.} nested_anon_struct_t;" \
 148                  "70:\[\t \]+typedef union {\\.\\.\\.} nested_anon_union_t;" \
 149                  "30:\[\t \]+typedef struct baz_t nested_baz;" \
 150                  "29:\[\t \]+typedef struct baz_t nested_baz_t;" \
 151                  "39:\[\t \]+typedef enum enum_t nested_enum_t;" \
 152                  "19:\[\t \]+typedef float nested_float_t;" \
 153                  "18:\[\t \]+typedef int nested_int_t;" \
 154                  "62:\[\t \]+typedef union union_t nested_union_t;" \
 155                  "56:\[\t \]+union union_t;" \
 156                  "--optional" "\[\t \]+unsigned int" \
 157                  ""]
 158     }
 159
 160     set state 0
 161     set idx 0
 162     gdb_test_multiple "info types" "" {
 163         -re "\r\nAll defined types:" {
 164             if { $state == 0 } { set state 1 } else { set state -1 }
 165             exp_continue
 166         }
 167         -re "^\r\n(\[^\r\n\]*)(?=\r\n)" {
 168             if { $state == 1 } {
 169                 set line $expect_out(1,string)
 170                 set res [match_line $line $output_lines idx]
 171                 if { $res == 1 } {
 172                     set state 2
 173                 } elseif { $res == -1 } {
 174                     set state -2
 175                 }
 176             }
 177             exp_continue
 178         }
 179         -re -wrap "" {
 180             if { $state == 2} {
 181                 pass $gdb_test_name
 182             } else {
 183                 fail "$gdb_test_name (state == $state)"
 184             }
 185         }
 186     }
 187 }
 188
 189 run_test $lang