[gdb/testsuite] Fix gdb.ada/big_packed_array.exp on s390x-linux
[binutils-gdb.git] / gdb / guile / scm-string.c
bloba249bccda1ebff0730e9506ccaf6758a70855f3b
1 /* GDB/Scheme charset interface.
3 Copyright (C) 2014-2024 Free Software Foundation, Inc.
5 This file is part of GDB.
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3 of the License, or
10 (at your option) any later version.
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program. If not, see <http://www.gnu.org/licenses/>. */
20 /* See README file in this directory for implementation notes, coding
21 conventions, et.al. */
23 #include "charset.h"
24 #include "guile-internal.h"
25 #include "gdbsupport/buildargv.h"
27 /* Convert STRING to an int.
28 STRING must be a valid integer. */
30 int
31 gdbscm_scm_string_to_int (SCM string)
33 char *s = scm_to_latin1_string (string);
34 int r = atoi (s);
36 free (s);
37 return r;
40 /* Convert a C (latin1) string to an SCM string.
41 "latin1" is chosen because Guile won't throw an exception. */
43 SCM
44 gdbscm_scm_from_c_string (const char *string)
46 return scm_from_latin1_string (string);
49 /* Convert an SCM string to a C (latin1) string.
50 "latin1" is chosen because Guile won't throw an exception.
51 It is an error to call this if STRING is not a string. */
53 gdb::unique_xmalloc_ptr<char>
54 gdbscm_scm_to_c_string (SCM string)
56 return gdb::unique_xmalloc_ptr<char> (scm_to_latin1_string (string));
59 /* Use printf to construct a Scheme string. */
61 SCM
62 gdbscm_scm_from_printf (const char *format, ...)
64 va_list args;
65 SCM result;
67 va_start (args, format);
68 std::string string = string_vprintf (format, args);
69 va_end (args);
70 result = scm_from_latin1_string (string.c_str ());
72 return result;
75 /* Struct to pass data from gdbscm_scm_to_string to
76 gdbscm_call_scm_to_stringn. */
78 struct scm_to_stringn_data
80 SCM string;
81 size_t *lenp;
82 const char *charset;
83 scm_t_string_failed_conversion_handler conversion_kind;
84 char *result;
87 /* Helper for gdbscm_scm_to_string to call scm_to_stringn
88 from within scm_c_catch. */
90 static SCM
91 gdbscm_call_scm_to_stringn (void *datap)
93 struct scm_to_stringn_data *data = (struct scm_to_stringn_data *) datap;
95 data->result = scm_to_stringn (data->string, data->lenp, data->charset,
96 data->conversion_kind);
97 return SCM_BOOL_F;
100 /* Convert an SCM string to a string in charset CHARSET.
101 This function is guaranteed to not throw an exception.
103 If LENP is NULL then the returned string is NUL-terminated,
104 and an exception is thrown if the string contains embedded NULs.
105 Otherwise the string is not guaranteed to be NUL-terminated, but worse
106 there's no space to put a NUL if we wanted to (scm_to_stringn limitation).
108 If STRICT is non-zero, and there's a conversion error, then a
109 <gdb:exception> object is stored in *EXCEPT_SCMP, and NULL is returned.
110 If STRICT is zero, then escape sequences are used for characters that
111 can't be converted, and EXCEPT_SCMP may be passed as NULL.
113 It is an error to call this if STRING is not a string. */
115 gdb::unique_xmalloc_ptr<char>
116 gdbscm_scm_to_string (SCM string, size_t *lenp,
117 const char *charset, int strict, SCM *except_scmp)
119 struct scm_to_stringn_data data;
120 SCM scm_result;
122 data.string = string;
123 data.lenp = lenp;
124 data.charset = charset;
125 data.conversion_kind = (strict
126 ? SCM_FAILED_CONVERSION_ERROR
127 : SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE);
128 data.result = NULL;
130 scm_result = gdbscm_call_guile (gdbscm_call_scm_to_stringn, &data, NULL);
132 if (gdbscm_is_false (scm_result))
134 gdb_assert (data.result != NULL);
135 return gdb::unique_xmalloc_ptr<char> (data.result);
137 gdb_assert (gdbscm_is_exception (scm_result));
138 *except_scmp = scm_result;
139 return NULL;
142 /* Struct to pass data from gdbscm_scm_from_string to
143 gdbscm_call_scm_from_stringn. */
145 struct scm_from_stringn_data
147 const char *string;
148 size_t len;
149 const char *charset;
150 scm_t_string_failed_conversion_handler conversion_kind;
151 SCM result;
154 /* Helper for gdbscm_scm_from_string to call scm_from_stringn
155 from within scm_c_catch. */
157 static SCM
158 gdbscm_call_scm_from_stringn (void *datap)
160 struct scm_from_stringn_data *data = (struct scm_from_stringn_data *) datap;
162 data->result = scm_from_stringn (data->string, data->len, data->charset,
163 data->conversion_kind);
164 return SCM_BOOL_F;
167 /* Convert STRING to a Scheme string in charset CHARSET.
168 This function is guaranteed to not throw an exception.
170 If STRICT is non-zero, and there's a conversion error, then a
171 <gdb:exception> object is returned.
172 If STRICT is zero, then question marks are used for characters that
173 can't be converted (limitation of underlying Guile conversion support). */
176 gdbscm_scm_from_string (const char *string, size_t len,
177 const char *charset, int strict)
179 struct scm_from_stringn_data data;
180 SCM scm_result;
182 data.string = string;
183 data.len = len;
184 data.charset = charset;
185 /* The use of SCM_FAILED_CONVERSION_QUESTION_MARK is specified by Guile. */
186 data.conversion_kind = (strict
187 ? SCM_FAILED_CONVERSION_ERROR
188 : SCM_FAILED_CONVERSION_QUESTION_MARK);
189 data.result = SCM_UNDEFINED;
191 scm_result = gdbscm_call_guile (gdbscm_call_scm_from_stringn, &data, NULL);
193 if (gdbscm_is_false (scm_result))
195 gdb_assert (!SCM_UNBNDP (data.result));
196 return data.result;
198 gdb_assert (gdbscm_is_exception (scm_result));
199 return scm_result;
202 /* Convert an SCM string to a host string.
203 This function is guaranteed to not throw an exception.
205 If LENP is NULL then the returned string is NUL-terminated,
206 and if the string contains embedded NULs then NULL is returned with
207 an exception object stored in *EXCEPT_SCMP.
208 Otherwise the string is not guaranteed to be NUL-terminated, but worse
209 there's no space to put a NUL if we wanted to (scm_to_stringn limitation).
211 Returns NULL if there is a conversion error, with the exception object
212 stored in *EXCEPT_SCMP.
213 It is an error to call this if STRING is not a string. */
215 gdb::unique_xmalloc_ptr<char>
216 gdbscm_scm_to_host_string (SCM string, size_t *lenp, SCM *except_scmp)
218 return gdbscm_scm_to_string (string, lenp, host_charset (), 1, except_scmp);
221 /* Convert a host string to an SCM string.
222 This function is guaranteed to not throw an exception.
223 Returns a <gdb:exception> object if there's a conversion error. */
226 gdbscm_scm_from_host_string (const char *string, size_t len)
228 return gdbscm_scm_from_string (string, len, host_charset (), 1);
231 /* (string->argv string) -> list
232 Return list of strings split up according to GDB's argv parsing rules.
233 This is useful when writing GDB commands in Scheme. */
235 static SCM
236 gdbscm_string_to_argv (SCM string_scm)
238 char *string;
239 SCM result = SCM_EOL;
241 gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "s",
242 string_scm, &string);
244 if (string == NULL || *string == '\0')
246 xfree (string);
247 return SCM_EOL;
250 gdb_argv c_argv (string);
251 for (char *arg : c_argv)
252 result = scm_cons (gdbscm_scm_from_c_string (arg), result);
254 xfree (string);
256 return scm_reverse_x (result, SCM_EOL);
259 /* Initialize the Scheme charset interface to GDB. */
261 static const scheme_function string_functions[] =
263 { "string->argv", 1, 0, 0, as_a_scm_t_subr (gdbscm_string_to_argv),
265 Convert a string to a list of strings split up according to\n\
266 gdb's argv parsing rules." },
268 END_FUNCTIONS
271 void
272 gdbscm_initialize_strings (void)
274 gdbscm_define_functions (string_functions, 1);