Commit | Line | Data |
---|---|---|
b811d2c2 | 1 | # Copyright 2011-2020 Free Software Foundation, Inc. |
7fea6923 PM |
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 | # This file was written by Pierre Muller <muller@ics.u-strasbg.fr> | |
17 | # | |
18 | # Check if environment variables are correctly passed to inferiors | |
19 | # | |
20 | ||
50500caf PA |
21 | # Can't pass environment variables to the inferior if when we connect, |
22 | # the inferior is already running. | |
079670b9 | 23 | if [use_gdb_stub] { |
50500caf | 24 | return |
514f6425 | 25 | } |
7fea6923 | 26 | |
62cef515 | 27 | standard_testfile .c |
7fea6923 PM |
28 | |
29 | # Compile binary | |
30 | # and start with a fresh gdb | |
31 | ||
5b362f04 | 32 | if { [prepare_for_testing "failed to prepare" ${binfile} ${srcfile}] } { |
7fea6923 PM |
33 | return -1 |
34 | } | |
35 | ||
50500caf PA |
36 | # Test that the the inferior sees EXPECTED env vars starting with |
37 | # "TEST_GDB". | |
38 | proc test_num_test_vars {expected message} { | |
39 | set num [get_integer_valueof "j" -1 "$message, get num vars"] | |
40 | gdb_assert {$num == $expected} "$message, confirmed" | |
7fea6923 PM |
41 | } |
42 | ||
43 | set bp_line [gdb_get_line_number "set breakpoint here"] | |
44 | gdb_breakpoint $bp_line | |
45 | ||
50500caf PA |
46 | # Restart test program, and prepare for another test sequence. |
47 | # Returns true on success. | |
48 | proc run_and_count_vars {} { | |
49 | global srcfile bp_line | |
50 | ||
51 | return [runto "$srcfile:$bp_line"] | |
52 | } | |
53 | ||
54 | # Find environment variable named VARNAME (peeking inferior variables | |
55 | # directly), and return its value. Returns "<not found>" if not | |
56 | # found. | |
57 | ||
58 | proc find_env {varname} { | |
59 | global gdb_prompt | |
60 | ||
61 | for {set i 0} {1} {incr i} { | |
62 | set test "printf \"var: %s\\n\", envp\[$i\] ? envp\[$i\] : \"\"" | |
63 | set var "" | |
64 | gdb_test_multiple $test $test { | |
65 | -re "var: \r\n$gdb_prompt $" { | |
66 | return "<not found>" | |
67 | } | |
68 | -re "var: \(\[^\r\n\]*\)\r\n$gdb_prompt $" { | |
69 | set var $expect_out(1,string) | |
70 | } | |
71 | } | |
72 | ||
73 | if {[string match "$varname=*" $var]} { | |
74 | set from [expr [string first "=" $var] + 1] | |
75 | set to [string length $var] | |
76 | return [string range $var $from $to] | |
77 | } | |
78 | } | |
79 | } | |
80 | ||
7fea6923 PM |
81 | # |
82 | # Test gdb set/unset environment commands. | |
50500caf | 83 | # The executable lists and counts all environment variables |
7fea6923 PM |
84 | # starting with TEST_GDB. |
85 | ||
50500caf PA |
86 | proc_with_prefix test_set_unset_env {} { |
87 | global binfile | |
88 | ||
89 | clean_restart $binfile | |
90 | ||
91 | # First test with no TEST_GDB_VAR. | |
92 | with_test_prefix "test1" { | |
93 | if ![run_and_count_vars] { | |
94 | return | |
95 | } | |
96 | test_num_test_vars 0 "no TEST_GDB vars" | |
97 | } | |
98 | ||
99 | # Second test with one TEST_GDB_VAR. | |
100 | with_test_prefix "test2" { | |
101 | gdb_test_no_output "set env TEST_GDB_VAR1 test1" \ | |
102 | "set TEST_GDB_VAR1" | |
103 | ||
104 | if ![run_and_count_vars] { | |
105 | return | |
106 | } | |
107 | test_num_test_vars 1 "one TEST_GDB var" | |
108 | } | |
109 | ||
110 | # Third test with two TEST_GDB_VAR. | |
111 | with_test_prefix "test3" { | |
112 | gdb_test_no_output "set env TEST_GDB_VAR2 test2" \ | |
113 | "set TEST_GDB_VAR2" | |
114 | ||
115 | if ![run_and_count_vars] { | |
116 | return | |
117 | } | |
118 | ||
119 | test_num_test_vars 2 "two TEST_GDB var" | |
120 | } | |
121 | ||
122 | # Fourth test with one TEST_GDB_VAR left, after one was removed | |
123 | # with unset command. | |
124 | with_test_prefix "test4" { | |
125 | gdb_test_no_output "unset env TEST_GDB_VAR1" \ | |
126 | "unset TEST_GDB_VAR1" | |
127 | ||
128 | if ![run_and_count_vars] { | |
129 | return | |
130 | } | |
131 | ||
132 | test_num_test_vars 1 "one TEST_GDB var, after unset" | |
133 | } | |
134 | } | |
7fea6923 | 135 | |
50500caf PA |
136 | proc_with_prefix test_inherit_env_var {} { |
137 | global binfile | |
138 | global bp_line | |
139 | global env | |
7fea6923 | 140 | |
50500caf PA |
141 | # This test assumes that the build's environ (where dejagnu runs) |
142 | # is the same as the host's (where gdb runs) environ. | |
143 | if [is_remote host] { | |
144 | return | |
145 | } | |
7fea6923 | 146 | |
50500caf PA |
147 | save_vars {env(TEST_GDB_GLOBAL)} { |
148 | set env(TEST_GDB_GLOBAL) "Global environment value" | |
7fea6923 | 149 | |
50500caf | 150 | clean_restart $binfile |
7fea6923 | 151 | |
50500caf | 152 | gdb_breakpoint $bp_line |
7fea6923 | 153 | |
50500caf PA |
154 | # First test with only inherited TEST_GDB_GLOBAL. |
155 | with_test_prefix "test1" { | |
156 | if ![run_and_count_vars] { | |
157 | return | |
158 | } | |
7fea6923 | 159 | |
50500caf PA |
160 | gdb_test "show env" ".*TEST_GDB_GLOBAL=.*" \ |
161 | "test passing TEST_GDB_GLOBAL to GDB" | |
7fea6923 | 162 | |
50500caf | 163 | test_num_test_vars 1 "TEST_GDB_GLOBAL" |
7fea6923 | 164 | |
50500caf | 165 | set var [find_env "TEST_GDB_GLOBAL"] |
7fea6923 | 166 | |
50500caf PA |
167 | gdb_assert {[string equal $var "Global environment value"]} \ |
168 | "TEST_GDB_GLOBAL found with right value" | |
169 | } | |
7fea6923 | 170 | |
50500caf PA |
171 | # Second test with one TEST_GDB_VAR. |
172 | with_test_prefix "test2" { | |
173 | gdb_test_no_output "unset env TEST_GDB_GLOBAL" \ | |
174 | "unset TEST_GDB_GLOBAL" | |
7fea6923 | 175 | |
50500caf PA |
176 | if ![run_and_count_vars] { |
177 | return | |
178 | } | |
7fea6923 | 179 | |
50500caf PA |
180 | test_num_test_vars 0 "TEST_GDB_GLOBAL is unset" |
181 | } | |
182 | } | |
7fea6923 PM |
183 | } |
184 | ||
50500caf PA |
185 | test_set_unset_env |
186 | test_inherit_env_var |