gdb/testsuite/gdb.xml/maint-xml-dump.exp

   1 # Copyright 2020-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 # Test the 'maint print xml-tdesc' command.  This file picks up every
  17 # XML file matching the pattern maint-xml-dump-*.xml (in the same
  18 # directory as this script) and passes each in turn to the command
  19 # 'maint print xml-tdesc'.
  20 #
  21 # The expected output is generated by parsing the input XML file.  The
  22 # rules for changing an XML file into the expected output are:
  23 #
  24 # 1. Blank lines, and lines starting with a comment are stripped from
  25 #    the expected output.
  26 #
  27 # 2. The <?xml ... ?> and <!DOCTYPE ...> entities are optional,
  28 #    suitable defaults will be added if these lines are missing from
  29 #    the input file.
  30 #
  31 # 3. A trailing comment on a line will replace the expected output for
  32 #    that line but with the indentation of the line preserved.  So
  33 #    this (The '|' marks the start of the line):
  34 #    |    <reg name="r1" bitsize="32"/>  <!-- <reg name="r1" bitsize="32" type="int" regnum="0"/> -->
  35 #    Will actually look for the following output:
  36 #    |    <reg name="r1" bitsize="32" type="int" regnum="0"/>
  37 #
  38 # 4. Indentation of lines will be preserved so your input file needs
  39 #    to follow the expected indentation.
  40 if {[gdb_skip_xml_test]} {
  41     unsupported "xml tests not being run"
  42     return -1
  43 }
  44
  45 gdb_start
  46
  47 # Read the XML file FILENAME and produce an output pattern that should
  48 # match what GDB produces with the 'maint print xml-desc' command.
  49 proc build_pattern { filename } {
  50     set pattern {}
  51
  52     set xml_version_line {<?xml version="1.0"?>}
  53     set doc_type_line {<!DOCTYPE target SYSTEM "gdb-target.dtd">}
  54
  55     set linenum 0
  56     set ifd [open "$filename" r]
  57     while {[gets $ifd line] >= 0} {
  58         incr linenum
  59
  60         # The <?xml .... ?> tag can only appear as the first line in
  61         # the file.  If it is not present then add one to the expected
  62         # output now.
  63         if {$linenum == 1} {
  64             if {![regexp {^<\?xml} $line]} {
  65                 set pattern [string_to_regexp $xml_version_line]
  66                 set xml_version_line ""
  67             }
  68         }
  69
  70         # If we have not yet seen a DOCTYPE line, then maybe we should
  71         # be adding one?  If we find <target> then add a default
  72         # DOCTYPE line, otherwise, if the XML file includes a DOCTYPE
  73         # line, use that.
  74         if {$doc_type_line != "" } {
  75             if {[regexp {^[ \t]*<target>} $line]} {
  76                 set pattern [multi_line $pattern \
  77                                  [string_to_regexp $doc_type_line]]
  78                 set doc_type_line ""
  79             } elseif {[regexp {^[ \t]*<!DOCTYPE } $line]} {
  80                 set doc_type_line ""
  81             }
  82         }
  83
  84         if {[regexp {^[ \t]*<!--} $line]} {
  85             # Comment line, ignore it.
  86         } elseif {[regexp {^[ \t]+$} $line]} {
  87             # Blank line, ignore it.
  88         } elseif {[regexp {^([ \t]*).*<!-- (.*) -->$} $line \
  89                        matches grp1 grp2]} {
  90             set pattern [multi_line \
  91                              $pattern \
  92                              [string_to_regexp "$grp1$grp2"]]
  93         } else {
  94             set pattern [multi_line \
  95                              $pattern \
  96                              [string_to_regexp $line]]
  97         }
  98     }
  99     close $ifd
 100
 101     # Due to handling the <?xml ...?> tags we can end up with a stray
 102     # '\r\n' at the start of the output pattern.  Remove it here.
 103     if {[string range $pattern 0 1] == "\r\n"} {
 104         set pattern [string range $pattern 2 end]
 105     }
 106
 107     return $pattern
 108 }
 109
 110 # Run over every test XML file and check the output.
 111 foreach filename [lsort [glob $srcdir/$subdir/maint-xml-dump-*.xml]] {
 112     set pattern [build_pattern $filename]
 113
 114     if {[is_remote host]} {
 115         set test_path [remote_download host $filename]
 116     } else {
 117         set test_path $filename
 118     }
 119
 120     verbose -log "Looking for:\n$pattern"
 121
 122     gdb_test "maint print xml-tdesc $test_path" \
 123         "$pattern" "check [file tail $filename]"
 124 }