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