gdb/testsuite/gdb.base/early-init-file.exp

   1 # Copyright 2021-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 GDB's early init file mechanism.
  17
  18 # Test assumes host == build.
  19 require {!is_remote host}
  20
  21 standard_testfile
  22
  23 # Compile the test executable.
  24 if {[build_executable "failed to build" $testfile $srcfile]} {
  25     return -1
  26 }
  27
  28 set custom_signal_handle_re \
  29     "warning: Found custom handler for signal $decimal \(\[^\r\n\]+\) preinstalled\."
  30 set signal_dispositions_re \
  31     [multi_line \
  32          "Some signal dispositions inherited from the environment \(\[^\r\n\]+\)" \
  33          "won't be propagated to spawned programs\." ]
  34 set gdb_sanitizer_msg_re \
  35     [multi_line \
  36          "($custom_signal_handle_re" \
  37          ")+$signal_dispositions_re" \
  38          ""]
  39
  40 # Start gdb and ensure that the initial version string is styled in
  41 # STYLE, use MESSAGE as the name of the test.
  42 proc check_gdb_startup_version_string { style { message "" } } {
  43     global gdb_sanitizer_msg_re
  44
  45     if { $message == "" } {
  46         set message "check startup version string has style $style"
  47     }
  48
  49     gdb_exit
  50     gdb_spawn
  51     set vers [style "GNU gdb.*" $style]
  52     gdb_test "" "^(${gdb_sanitizer_msg_re})?${vers}.*" $message
  53 }
  54
  55 # Return a list containing two directory paths for newly created home
  56 # directories.
  57 #
  58 # The first directory is a HOME style home directory, it contains a
  59 # .gdbearlyinit file containing CONTENT.
  60 #
  61 # The second directory is an XDG_CONFIG_HOME style home directory, it
  62 # contains a sub-directory gdb/, inside which is a file gdbearlyinit
  63 # that also contains CONTENT.
  64 #
  65 # The PREFIX is used in both directory names and should be unique for
  66 # each call to this function.
  67 proc setup_home_directories { prefix content } {
  68     set home_dir [standard_output_file "${prefix}-home"]
  69     set xdg_home_dir [standard_output_file "${prefix}-xdg"]
  70
  71     file mkdir $home_dir
  72     file mkdir "$xdg_home_dir/gdb"
  73
  74     # Write the content into the HOME directory.
  75     set fd [open "$home_dir/.gdbearlyinit" w]
  76     puts $fd $content
  77     close $fd
  78
  79     # Copy this from the HOME directory into the XDG_CONFIG_HOME
  80     # directory.
  81     file copy -force "$home_dir/.gdbearlyinit" "$xdg_home_dir/gdb/gdbearlyinit"
  82
  83     return [list $home_dir $xdg_home_dir]
  84 }
  85
  86 # Restart GDB and ensure that there's no license text, we should just
  87 # drop straight to the prompt.
  88 proc check_gdb_startups_up_quietly { message } {
  89     global gdb_prompt
  90     global gdb_sanitizer_msg_re
  91
  92     gdb_exit
  93     gdb_spawn
  94
  95     gdb_test_multiple "" $message {
  96         -re "^(${gdb_sanitizer_msg_re})?$gdb_prompt $" {
  97             pass $gdb_test_name
  98         }
  99     }
 100 }
 101
 102 with_ansi_styling_terminal {
 103
 104     # Start GDB and confirm that the version string is styled.
 105     save_vars { INTERNAL_GDBFLAGS env(HOME) env(XDG_CONFIG_HOME) } {
 106         set INTERNAL_GDBFLAGS [string map {"-q" ""} $INTERNAL_GDBFLAGS]
 107         check_gdb_startup_version_string version
 108     }
 109
 110     # Create an empty directory we can use as HOME for some of the
 111     # tests below.  When we set XDG_CONFIG_HOME we still need to point
 112     # HOME at something otherwise GDB complains that it doesn't know
 113     # where to create the index cache.
 114     set empty_home_dir [standard_output_file fake-empty-home]
 115
 116     # Create two directories to use for the style setting test.
 117     set dirs [setup_home_directories "style" \
 118                   [multi_line_input \
 119                        "set style version foreground none" \
 120                        "set style version background none" \
 121                        "set style version intensity normal"]]
 122     set home_dir [lindex $dirs 0]
 123     set xdg_home_dir [lindex $dirs 1]
 124
 125     # Now arrange to use the fake home directory early init file.
 126     save_vars { INTERNAL_GDBFLAGS env(HOME) env(XDG_CONFIG_HOME) } {
 127         set INTERNAL_GDBFLAGS [string map {"-nx" "" "-q" ""} $INTERNAL_GDBFLAGS]
 128
 129         # Now test GDB when using the HOME directory.
 130         set env(HOME) $home_dir
 131         unset -nocomplain env(XDG_CONFIG_HOME)
 132         check_gdb_startup_version_string none \
 133             "check version string is unstyled using HOME"
 134
 135         # Now test using the XDG_CONFIG_HOME folder.  We still need to
 136         # have a HOME directory set otherwise GDB will issue an error
 137         # about not knowing where to place the index cache.
 138         set env(XDG_CONFIG_HOME) $xdg_home_dir
 139         set env(HOME) $empty_home_dir
 140         check_gdb_startup_version_string none \
 141             "check version string is unstyled using XDG_CONFIG_HOME"
 142     }
 143
 144     # Create two directories to use for the quiet startup test.
 145     set dirs [setup_home_directories "quiet" "set startup-quietly on"]
 146     set home_dir [lindex $dirs 0]
 147     set xdg_home_dir [lindex $dirs 1]
 148
 149     # Now arrange to use the fake home directory startup file.
 150     save_vars { INTERNAL_GDBFLAGS env(HOME) env(XDG_CONFIG_HOME) } {
 151         set INTERNAL_GDBFLAGS [string map {"-nx" "" "-q" ""} $INTERNAL_GDBFLAGS]
 152
 153         # Now test GDB when using the HOME directory.
 154         set env(HOME) $home_dir
 155         unset -nocomplain env(XDG_CONFIG_HOME)
 156         check_gdb_startups_up_quietly \
 157             "check GDB starts quietly using HOME"
 158
 159         # Now test using the XDG_CONFIG_HOME folder.  We still need to
 160         # have a HOME directory set otherwise GDB will issue an error
 161         # about not knowing where to place the index cache.
 162         set env(XDG_CONFIG_HOME) $xdg_home_dir
 163         set env(HOME) $empty_home_dir
 164         check_gdb_startups_up_quietly \
 165             "check GDB starts quietly using XDG_CONFIG_HOME"
 166     }
 167 }