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

# Copyright 2021 Free Software Foundation, Inc.

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

# Test GDB's early init file mechanism.

standard_testfile

# Compile the test executable.
if {[build_executable "failed to build" $testfile $srcfile]} {
    return -1
}

# Start gdb and ensure that the initial version string is styled in
# STYLE, use MESSAGE as the name of the test.
proc check_gdb_startup_version_string { style { message "" } } {
    if { $message == "" } {
	set message "check startup version string has style $style"
    }

    gdb_exit
    gdb_spawn
    set vers [style "GNU gdb.*" $style]
    gdb_test "" "^${vers}.*" $message
}

# Return a list containing two directory paths for newly created home
# directories.
#
# The first directory is a HOME style home directory, it contains a
# .gdbearlyinit file containing CONTENT.
#
# The second directory is an XDG_CONFIG_HOME style home directory, it
# contains a sub-directory gdb/, inside which is a file gdbearlyinit
# that also contains CONTENT.
#
# The PREFIX is used in both directory names and should be unique for
# each call to this function.
proc setup_home_directories { prefix content } {
    set home_dir [standard_output_file "${prefix}-home"]
    set xdg_home_dir [standard_output_file "${prefix}-xdg"]

    file mkdir $home_dir
    file mkdir "$xdg_home_dir/gdb"

    # Write the content into the HOME directory.
    set fd [open "$home_dir/.gdbearlyinit" w]
    puts $fd $content
    close $fd

    # Copy this from the HOME directory into the XDG_CONFIG_HOME
    # directory.
    file copy -force "$home_dir/.gdbearlyinit" "$xdg_home_dir/gdb/gdbearlyinit"

    return [list $home_dir $xdg_home_dir]
}

# Restart GDB and ensure that there's no license text, we should just
# drop straight to the prompt.
proc check_gdb_startups_up_quietly { message } {
    global gdb_prompt

    gdb_exit
    gdb_spawn

    gdb_test_multiple "" $message {
	-re "^$gdb_prompt $" {
	    pass $gdb_test_name
	}
    }
}

save_vars { env(TERM) } {
    # We need an ANSI-capable terminal to get the output.
    setenv TERM ansi

    # Start GDB and confirm that the version string is styled.
    check_gdb_startup_version_string version

    # Create an empty directory we can use as HOME for some of the
    # tests below.  When we set XDG_CONFIG_HOME we still need to point
    # HOME at something otherwise GDB complains that it doesn't know
    # where to create the index cache.
    set empty_home_dir [standard_output_file fake-empty-home]

    # Create two directories to use for the style setting test.
    set dirs [setup_home_directories "style" \
		  [multi_line_input \
		       "set style version foreground none" \
		       "set style version background none" \
		       "set style version intensity normal"]]
    set home_dir [lindex $dirs 0]
    set xdg_home_dir [lindex $dirs 1]

    # Now arrange to use the fake home directory early init file.
    save_vars { INTERNAL_GDBFLAGS env(HOME) env(XDG_CONFIG_HOME) } {
	set INTERNAL_GDBFLAGS [string map {"-nx" ""} $INTERNAL_GDBFLAGS]

	# Now test GDB when using the HOME directory.
	set env(HOME) $home_dir
	unset -nocomplain env(XDG_CONFIG_HOME)
	check_gdb_startup_version_string none \
	    "check version string is unstyled using HOME"

	# Now test using the XDG_CONFIG_HOME folder.  We still need to
	# have a HOME directory set otherwise GDB will issue an error
	# about not knowing where to place the index cache.
	set env(XDG_CONFIG_HOME) $xdg_home_dir
	set env(HOME) $empty_home_dir
	check_gdb_startup_version_string none \
	    "check version string is unstyled using XDG_CONFIG_HOME"
    }

    # Create two directories to use for the quiet startup test.
    set dirs [setup_home_directories "quiet" "set startup-quietly on"]
    set home_dir [lindex $dirs 0]
    set xdg_home_dir [lindex $dirs 1]

    # Now arrange to use the fake home directory startup file.
    save_vars { INTERNAL_GDBFLAGS env(HOME) env(XDG_CONFIG_HOME) } {
	set INTERNAL_GDBFLAGS [string map {"-nx" ""} $INTERNAL_GDBFLAGS]

	# Now test GDB when using the HOME directory.
	set env(HOME) $home_dir
	unset -nocomplain env(XDG_CONFIG_HOME)
	check_gdb_startups_up_quietly \
	    "check GDB starts quietly using HOME"

	# Now test using the XDG_CONFIG_HOME folder.  We still need to
	# have a HOME directory set otherwise GDB will issue an error
	# about not knowing where to place the index cache.
	set env(XDG_CONFIG_HOME) $xdg_home_dir
	set env(HOME) $empty_home_dir
	check_gdb_startups_up_quietly \
	    "check GDB starts quietly using XDG_CONFIG_HOME"
    }
}