Mercurial > hg > xemacs-beta
annotate src/tests.c @ 4329:d9eb5ea14f65
Provide %b in #'format; use it for converting between ints and bit vectors.
lisp/ChangeLog addition:
2007-12-17 Aidan Kehoe <kehoea@parhasard.net>
* subr.el (integer-to-bit-vector): New.
* subr.el (bit-vector-to-integer): New.
Provide naive implementations using the Lisp reader for these.
src/ChangeLog addition:
2007-12-17 Aidan Kehoe <kehoea@parhasard.net>
* doprnt.c (emacs_doprnt_1):
Add support for formatted printing of both longs and bignums as
base 2.
* editfns.c (Fformat):
Document the new %b escape for #'format.
* lisp.h:
Make ulong_to_bit_string available beside long_to_string.
* lread.c:
Fix a bug where the integer base was being ignored in certain
contexts; thank you Sebastian Freundt. This is necessary for
correct behaviour of #'integer-to-bit-vector and
#'bit-vector-to-integer, just added to subr.el
* print.c (ulong_to_bit_string): New.
Analagous to long_to_string, but used all the time when %b is
encountered, since we can't pass that to sprintf.
man/ChangeLog addition:
2007-12-17 Aidan Kehoe <kehoea@parhasard.net>
* lispref/strings.texi (Formatting Strings):
Document %b for binary output.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 17 Dec 2007 08:44:14 +0100 |
| parents | 4d0f773d5e21 |
| children | 294a86d29f99 |
| rev | line source |
|---|---|
| 398 | 1 /* C support for testing XEmacs - see tests/automated/c-tests.el |
| 2 Copyright (C) 2000 Martin Buchholz | |
| 771 | 3 Copyright (C) 2001, 2002 Ben Wing. |
| 3417 | 4 Copyright (C) 2006 The Free Software Foundation, Inc. |
| 398 | 5 |
| 6 This file is part of XEmacs. | |
| 7 | |
| 8 XEmacs is free software; you can redistribute it and/or modify it | |
| 9 under the terms of the GNU General Public License as published by the | |
| 10 Free Software Foundation; either version 2, or (at your option) any | |
| 11 later version. | |
| 12 | |
| 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
| 19 along with XEmacs; see the file COPYING. If not, write to | |
| 20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 21 Boston, MA 02111-1307, USA. */ | |
| 22 | |
| 23 /* Author: Martin Buchholz | |
| 24 | |
| 25 This file provides support for running tests for XEmacs that cannot | |
| 26 be written entirely in Lisp. These tests are run automatically via | |
| 27 tests/automated/c-tests.el, or can be run by hand using M-x */ | |
| 28 | |
| 29 | |
| 30 #include <config.h> | |
| 31 #include "lisp.h" | |
| 32 #include "buffer.h" | |
| 33 #include "lstream.h" | |
| 489 | 34 #include "elhash.h" |
| 398 | 35 #include "opaque.h" |
| 3417 | 36 #include "file-coding.h" /* XCODING_SYSTEM_EOL_TYPE and its values */ |
| 398 | 37 |
| 38 static Lisp_Object Vtest_function_list; | |
| 39 | |
| 40 DEFUN ("test-data-format-conversion", Ftest_data_format_conversion, 0, 0, "", /* | |
| 41 Test TO_EXTERNAL_FORMAT() and TO_INTERNAL_FORMAT() | |
| 42 */ | |
| 43 ()) | |
| 44 { | |
| 665 | 45 void *ptr; Bytecount len; |
| 398 | 46 Lisp_Object string, opaque; |
| 47 | |
| 867 | 48 Ibyte int_foo[] = "\n\nfoo\nbar"; |
| 398 | 49 Extbyte ext_unix[]= "\n\nfoo\nbar"; |
| 50 | |
| 51 Extbyte ext_dos[] = "\r\n\r\nfoo\r\nbar"; | |
| 52 Extbyte ext_mac[] = "\r\rfoo\rbar"; | |
| 53 Lisp_Object opaque_dos = make_opaque (ext_dos, sizeof (ext_dos) - 1); | |
| 54 Lisp_Object string_foo = make_string (int_foo, sizeof (int_foo) - 1); | |
| 55 | |
| 56 Extbyte ext_latin[] = "f\372b\343\340"; | |
| 867 | 57 Ibyte int_latin1[] = "f\200\372b\200\343\200\340"; |
| 58 Ibyte int_latin2[] = "f\201\372b\201\343\201\340"; | |
| 398 | 59 #ifdef MULE |
| 60 Extbyte ext_latin12[]= "f\033-A\372b\343\340\033-B"; | |
| 61 Extbyte ext_tilde[] = "f~b~~"; | |
| 62 Lisp_Object string_latin2 = make_string (int_latin2, sizeof (int_latin2) - 1); | |
| 63 #endif | |
| 64 Lisp_Object opaque_latin = make_opaque (ext_latin, sizeof (ext_latin) - 1); | |
| 65 Lisp_Object opaque0_latin = make_opaque (ext_latin, sizeof (ext_latin)); | |
| 66 Lisp_Object string_latin1 = make_string (int_latin1, sizeof (int_latin1) - 1); | |
| 3417 | 67 int autodetect_eol_p = |
| 68 !NILP (Fsymbol_value (intern ("eol-detection-enabled-p"))); | |
| 398 | 69 |
| 70 /* Check for expected strings before and after conversion. | |
| 771 | 71 Conversions depend on whether MULE is defined. */ |
|
4318
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3417
diff
changeset
|
72 |
|
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3417
diff
changeset
|
73 /* #### Any code below that uses iso-latin-2-with-esc is ill-conceived. */ |
|
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3417
diff
changeset
|
74 |
| 398 | 75 #ifdef MULE |
| 76 #define DFC_CHECK_DATA_COND_MULE(ptr,len, \ | |
| 77 constant_string_mule, \ | |
| 78 constant_string_non_mule) \ | |
| 79 DFC_CHECK_DATA (ptr, len, constant_string_mule) | |
| 80 #define DFC_CHECK_DATA_COND_MULE_NUL(ptr,len, \ | |
| 81 constant_string_mule, \ | |
| 82 constant_string_non_mule) \ | |
| 83 DFC_CHECK_DATA_NUL (ptr, len, constant_string_mule) | |
| 84 #else | |
| 85 #define DFC_CHECK_DATA_COND_MULE(ptr,len, \ | |
| 86 constant_string_mule, \ | |
| 87 constant_string_non_mule) \ | |
| 88 DFC_CHECK_DATA (ptr, len, constant_string_non_mule) | |
| 89 #define DFC_CHECK_DATA_COND_MULE_NUL(ptr,len, \ | |
| 90 constant_string_mule, \ | |
| 91 constant_string_non_mule) \ | |
| 92 DFC_CHECK_DATA_NUL (ptr, len, constant_string_non_mule) | |
| 93 #endif | |
| 94 | |
| 3417 | 95 /* These now only apply to base coding systems, and |
| 96 need to test `eol-detection-enabled-p' at runtime. */ | |
| 398 | 97 #define DFC_CHECK_DATA_COND_EOL(ptr,len, \ |
| 3417 | 98 constant_string_eol, \ |
| 99 constant_string_non_eol) do { \ | |
| 100 if (autodetect_eol_p) \ | |
| 101 DFC_CHECK_DATA (ptr, len, constant_string_eol); \ | |
| 102 else \ | |
| 103 DFC_CHECK_DATA (ptr, len, constant_string_non_eol); \ | |
| 104 } while (0) | |
| 398 | 105 #define DFC_CHECK_DATA_COND_EOL_NUL(ptr,len, \ |
| 3417 | 106 constant_string_eol, \ |
| 107 constant_string_non_eol) do { \ | |
| 108 if (autodetect_eol_p) \ | |
| 109 DFC_CHECK_DATA_NUL (ptr, len, constant_string_eol); \ | |
| 110 else \ | |
| 111 DFC_CHECK_DATA_NUL (ptr, len, constant_string_non_eol); \ | |
| 112 } while (0) | |
| 398 | 113 |
| 114 /* Check for expected strings before and after conversion. */ | |
| 115 #define DFC_CHECK_DATA(ptr,len, constant_string) do { \ | |
| 116 assert ((len) == sizeof (constant_string) - 1); \ | |
| 117 assert (!memcmp (ptr, constant_string, len)); \ | |
| 118 } while (0) | |
| 119 | |
| 120 /* Macro version that includes the trailing NULL byte. */ | |
| 121 #define DFC_CHECK_DATA_NUL(ptr,len,constant_string) do {\ | |
| 122 assert ((len) == sizeof (constant_string)); \ | |
| 123 assert (!memcmp (ptr, constant_string, len)); \ | |
| 124 } while (0) | |
| 125 | |
| 126 #ifdef MULE | |
| 127 ptr = NULL, len = rand(); | |
| 128 TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2)), | |
| 129 ALLOCA, (ptr, len), | |
| 771 | 130 intern ("iso-8859-2")); |
| 398 | 131 DFC_CHECK_DATA_NUL (ptr, len, ext_latin); |
| 132 | |
| 133 ptr = NULL, len = rand(); | |
| 134 TO_EXTERNAL_FORMAT (LISP_STRING, string_latin2, | |
| 135 ALLOCA, (ptr, len), | |
| 771 | 136 intern ("iso-8859-2")); |
| 398 | 137 DFC_CHECK_DATA (ptr, len, ext_latin); |
| 138 | |
| 139 ptr = NULL, len = rand(); | |
| 140 TO_EXTERNAL_FORMAT (LISP_STRING, string_latin1, | |
| 141 ALLOCA, (ptr, len), | |
|
4318
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3417
diff
changeset
|
142 intern ("iso-latin-2-with-esc")); |
| 398 | 143 DFC_CHECK_DATA (ptr, len, ext_latin12); |
| 144 | |
| 145 ptr = NULL, len = rand(); | |
| 146 TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2) - 1), | |
| 147 MALLOC, (ptr, len), | |
| 771 | 148 intern ("iso-8859-2")); |
| 398 | 149 DFC_CHECK_DATA (ptr, len, ext_latin); |
| 1726 | 150 xfree (ptr, void *); |
| 398 | 151 |
| 152 TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2) - 1), | |
| 153 LISP_OPAQUE, opaque, | |
| 771 | 154 intern ("iso-8859-2")); |
| 398 | 155 DFC_CHECK_DATA (XOPAQUE_DATA (opaque), XOPAQUE_SIZE (opaque), ext_latin); |
| 156 | |
| 157 ptr = NULL, len = rand(); | |
| 158 TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin) - 1), | |
| 159 ALLOCA, (ptr, len), | |
|
4318
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3417
diff
changeset
|
160 intern ("iso-latin-2-with-esc")); |
| 398 | 161 DFC_CHECK_DATA (ptr, len, int_latin2); |
| 162 | |
| 163 ptr = NULL, len = rand(); | |
| 164 TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin) - 1), | |
| 165 MALLOC, (ptr, len), | |
|
4318
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3417
diff
changeset
|
166 intern ("iso-latin-2-with-esc")); |
| 398 | 167 DFC_CHECK_DATA (ptr, len, int_latin2); |
| 1726 | 168 xfree (ptr, void *); |
| 398 | 169 |
| 170 TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin) - 1), | |
| 171 LISP_STRING, string, | |
|
4318
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3417
diff
changeset
|
172 intern ("iso-latin-2-with-esc")); |
| 398 | 173 DFC_CHECK_DATA (XSTRING_DATA (string), XSTRING_LENGTH (string), int_latin2); |
| 174 | |
| 175 TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_latin, | |
| 176 LISP_STRING, string, | |
|
4318
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3417
diff
changeset
|
177 intern ("iso-latin-2-with-esc")); |
| 398 | 178 DFC_CHECK_DATA (XSTRING_DATA (string), XSTRING_LENGTH (string), int_latin2); |
| 179 | |
| 180 TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque0_latin, | |
| 181 LISP_STRING, string, | |
|
4318
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3417
diff
changeset
|
182 intern ("iso-latin-2-with-esc")); |
| 398 | 183 DFC_CHECK_DATA_NUL (XSTRING_DATA (string), XSTRING_LENGTH (string), int_latin2); |
| 184 | |
| 185 TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque0_latin, | |
| 186 LISP_BUFFER, Fcurrent_buffer(), | |
|
4318
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3417
diff
changeset
|
187 intern ("iso-latin-2-with-esc")); |
| 398 | 188 DFC_CHECK_DATA_NUL (BUF_BYTE_ADDRESS (current_buffer, BUF_PT (current_buffer)), |
| 189 sizeof (int_latin2), int_latin2); | |
| 190 | |
| 191 TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_latin, | |
| 192 LISP_BUFFER, Fcurrent_buffer(), | |
| 193 intern ("iso-8859-1")); | |
| 194 DFC_CHECK_DATA (BUF_BYTE_ADDRESS (current_buffer, BUF_PT (current_buffer)), | |
| 195 sizeof (int_latin1) - 1, int_latin1); | |
| 196 | |
| 197 TO_INTERNAL_FORMAT (DATA, (ext_latin12, sizeof (ext_latin12) - 1), | |
| 198 ALLOCA, (ptr, len), | |
|
4318
4d0f773d5e21
Fix the test failures introduced by the non-ISO-2022 coding systems.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3417
diff
changeset
|
199 intern ("iso-latin-2-with-esc")); |
| 398 | 200 DFC_CHECK_DATA (ptr, len, int_latin1); |
| 201 | |
| 202 #endif /* MULE */ | |
| 203 | |
| 204 ptr = NULL, len = rand(); | |
| 205 TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1), | |
| 206 ALLOCA, (ptr, len), | |
| 207 Qbinary); | |
| 208 DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1); | |
| 209 | |
| 210 ptr = NULL, len = rand(); | |
| 211 TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1)), | |
| 212 ALLOCA, (ptr, len), | |
| 213 Qbinary); | |
| 214 DFC_CHECK_DATA_COND_MULE_NUL (ptr, len, ext_latin, int_latin1); | |
| 215 | |
| 216 ptr = NULL, len = rand(); | |
| 217 TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2) - 1), | |
| 218 ALLOCA, (ptr, len), | |
| 771 | 219 Qbinary); |
| 398 | 220 DFC_CHECK_DATA_COND_MULE (ptr, len, ext_tilde, int_latin2); |
| 221 | |
| 222 ptr = NULL, len = rand(); | |
| 223 TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1), | |
| 224 ALLOCA, (ptr, len), | |
| 225 intern ("iso-8859-1")); | |
| 226 DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1); | |
| 227 | |
| 228 | |
| 229 ptr = NULL, len = rand(); | |
| 230 TO_EXTERNAL_FORMAT (LISP_STRING, string_latin1, | |
| 231 ALLOCA, (ptr, len), | |
| 232 Qbinary); | |
| 233 DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1); | |
| 234 | |
| 235 ptr = NULL, len = rand(); | |
| 236 TO_EXTERNAL_FORMAT (LISP_STRING, string_latin1, | |
| 237 ALLOCA, (ptr, len), | |
| 771 | 238 Qbinary); |
| 398 | 239 DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1); |
| 240 | |
| 241 ptr = NULL, len = rand(); | |
| 242 TO_EXTERNAL_FORMAT (LISP_STRING, string_latin1, | |
| 243 ALLOCA, (ptr, len), | |
| 244 intern ("iso-8859-1")); | |
| 245 DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1); | |
| 246 | |
| 247 ptr = NULL, len = rand(); | |
| 248 TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1), | |
| 249 MALLOC, (ptr, len), | |
| 250 Qbinary); | |
| 251 DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1); | |
| 1726 | 252 xfree (ptr, void *); |
| 398 | 253 |
| 254 ptr = NULL, len = rand(); | |
| 255 TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2)), | |
| 256 MALLOC, (ptr, len), | |
| 771 | 257 Qbinary); |
| 398 | 258 DFC_CHECK_DATA_COND_MULE_NUL (ptr, len, ext_tilde, int_latin2); |
| 1726 | 259 xfree (ptr, void *); |
| 398 | 260 |
| 261 ptr = NULL, len = rand(); | |
| 262 TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1), | |
| 263 MALLOC, (ptr, len), | |
| 264 intern ("iso-8859-1")); | |
| 265 DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1); | |
| 1726 | 266 xfree (ptr, void *); |
| 398 | 267 |
| 268 TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1), | |
| 269 LISP_OPAQUE, opaque, | |
| 270 Qbinary); | |
| 271 DFC_CHECK_DATA_COND_MULE (XOPAQUE_DATA (opaque), | |
| 272 XOPAQUE_SIZE (opaque), ext_latin, int_latin1); | |
| 273 | |
| 274 TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2)), | |
| 275 LISP_OPAQUE, opaque, | |
| 771 | 276 Qbinary); |
| 398 | 277 DFC_CHECK_DATA_COND_MULE_NUL (XOPAQUE_DATA (opaque), |
| 278 XOPAQUE_SIZE (opaque), ext_tilde, int_latin2); | |
| 279 | |
| 280 TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1), | |
| 281 LISP_OPAQUE, opaque, | |
| 282 intern ("iso-8859-1")); | |
| 283 DFC_CHECK_DATA_COND_MULE (XOPAQUE_DATA (opaque), | |
| 284 XOPAQUE_SIZE (opaque), ext_latin, int_latin1); | |
| 285 | |
| 286 ptr = NULL, len = rand(); | |
| 287 TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin) - 1), | |
| 288 ALLOCA, (ptr, len), | |
| 289 Qbinary); | |
| 290 DFC_CHECK_DATA_COND_MULE (ptr, len, int_latin1, ext_latin); | |
| 291 | |
| 292 ptr = NULL, len = rand(); | |
| 293 TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin)), | |
| 294 ALLOCA, (ptr, len), | |
| 295 intern ("iso-8859-1")); | |
| 296 DFC_CHECK_DATA_COND_MULE_NUL (ptr, len, int_latin1, ext_latin); | |
| 297 | |
| 298 ptr = NULL, len = rand(); | |
| 299 TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin)), | |
| 300 MALLOC, (ptr, len), | |
| 301 intern ("iso-8859-1")); | |
| 302 DFC_CHECK_DATA_COND_MULE_NUL (ptr, len, int_latin1, ext_latin); | |
| 1726 | 303 xfree (ptr, void *); |
| 398 | 304 |
| 305 ptr = NULL, len = rand(); | |
| 306 TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin)), | |
| 307 MALLOC, (ptr, len), | |
| 308 Qnil); | |
| 309 DFC_CHECK_DATA_COND_MULE_NUL (ptr, len, int_latin1, ext_latin); | |
| 1726 | 310 xfree (ptr, void *); |
| 398 | 311 |
| 312 TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin) - 1), | |
| 313 LISP_STRING, string, | |
| 314 intern ("iso-8859-1")); | |
| 315 DFC_CHECK_DATA_COND_MULE (XSTRING_DATA (string), | |
| 316 XSTRING_LENGTH (string), int_latin1, ext_latin); | |
| 317 | |
| 318 TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_latin, | |
| 319 LISP_STRING, string, | |
| 320 intern ("iso-8859-1")); | |
| 321 DFC_CHECK_DATA_COND_MULE (XSTRING_DATA (string), | |
| 322 XSTRING_LENGTH (string), int_latin1, ext_latin); | |
| 323 | |
| 324 TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque0_latin, | |
| 325 LISP_STRING, string, | |
| 326 intern ("iso-8859-1")); | |
| 327 DFC_CHECK_DATA_COND_MULE_NUL (XSTRING_DATA (string), | |
| 328 XSTRING_LENGTH (string), int_latin1, ext_latin); | |
| 329 | |
| 3417 | 330 /* This next group used to use the COND_EOL macros, but with the new Mule, |
| 331 they all specify an EOL convention, and all XEmacsen can grok them. */ | |
| 398 | 332 ptr = NULL, len = rand(); |
| 333 TO_EXTERNAL_FORMAT (DATA, (int_foo, sizeof (int_foo)), | |
| 334 MALLOC, (ptr, len), | |
| 771 | 335 Qbinary); |
| 3417 | 336 DFC_CHECK_DATA_NUL (ptr, len, ext_unix); |
| 1726 | 337 xfree (ptr, void *); |
| 398 | 338 |
| 339 ptr = NULL, len = rand(); | |
| 340 TO_EXTERNAL_FORMAT (DATA, (int_foo, sizeof (int_foo) - 1), | |
| 341 LISP_OPAQUE, opaque, | |
| 342 intern ("raw-text-mac")); | |
| 3417 | 343 DFC_CHECK_DATA (XOPAQUE_DATA (opaque), XOPAQUE_SIZE (opaque), ext_mac); |
| 398 | 344 |
| 345 ptr = NULL, len = rand(); | |
| 346 TO_EXTERNAL_FORMAT (LISP_STRING, string_foo, | |
| 347 ALLOCA, (ptr, len), | |
| 348 intern ("raw-text-dos")); | |
| 3417 | 349 DFC_CHECK_DATA (ptr, len, ext_dos); |
| 398 | 350 |
| 351 ptr = NULL, len = rand(); | |
| 352 TO_EXTERNAL_FORMAT (DATA, (int_foo, sizeof (int_foo) - 1), | |
| 353 ALLOCA, (ptr, len), | |
| 354 intern ("raw-text-unix")); | |
| 3417 | 355 DFC_CHECK_DATA (ptr, len, ext_unix); |
| 398 | 356 |
| 357 ptr = NULL, len = rand(); | |
| 358 TO_EXTERNAL_FORMAT (LISP_STRING, string_foo, | |
| 359 MALLOC, (ptr, len), | |
| 360 intern ("no-conversion-mac")); | |
| 3417 | 361 DFC_CHECK_DATA (ptr, len, ext_mac); |
| 1726 | 362 xfree (ptr, void *); |
| 398 | 363 |
| 364 ptr = NULL, len = rand(); | |
| 365 TO_EXTERNAL_FORMAT (DATA, (int_foo, sizeof (int_foo) - 1), | |
| 366 ALLOCA, (ptr, len), | |
| 771 | 367 intern ("no-conversion-dos")); |
| 3417 | 368 DFC_CHECK_DATA (ptr, len, ext_dos); |
| 398 | 369 |
| 370 ptr = NULL, len = rand(); | |
| 371 TO_EXTERNAL_FORMAT (DATA, (int_foo, sizeof (int_foo)), | |
| 372 ALLOCA, (ptr, len), | |
| 373 intern ("no-conversion-unix")); | |
| 3417 | 374 DFC_CHECK_DATA_NUL (ptr, len, ext_unix); |
| 375 | |
| 376 /* Oh, Lawdy, Lawdy, Lawdy, this done broke mah heart! | |
| 377 | |
| 378 I tried using the technique | |
| 379 | |
| 380 Fget_coding_system (call2 | |
| 381 (intern ("coding-system-change-eol-conversion"), | |
| 382 intern ("undecided"), $EOL_TYPE)); | |
| 383 XCODING_SYSTEM_EOL_TYPE (cs_to_use) = $EOL_DETECT_TYPE; | |
| 384 | |
| 385 with EOL_TYPE = Qlf (for no-detect) and Qnil (for auto-detect), | |
| 386 and with EOL_DETECT_TYPE = EOL_LF and EOL_AUTODETECT | |
| 387 respectively, but this doesn't seem to work on the `undecided' | |
| 388 coding system. The coding-system-eol-type attribute on the | |
| 389 coding system itself needs to be changed, too. I'm not sure at | |
| 390 the moment how `set-eol-detection' works its magic, but the code | |
| 391 below gives correct test results without default EOL detection, | |
| 392 with default EOL detection, and with Mule. Ship it! | |
| 393 | |
| 394 Mule. You'll envy the dead. | |
| 395 */ | |
| 398 | 396 |
| 3417 | 397 { |
| 398 /* Check eol autodetection doesn't happen when disabled -- cheat. */ | |
| 399 Lisp_Object cs_to_use = Fget_coding_system (intern ("undecided-unix")); | |
| 400 TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_dos, | |
| 401 LISP_BUFFER, Fcurrent_buffer(), | |
| 402 cs_to_use); | |
| 403 DFC_CHECK_DATA (BUF_BYTE_ADDRESS (current_buffer, BUF_PT (current_buffer)), | |
| 404 sizeof (ext_dos) - 1, ext_dos); | |
| 405 | |
| 406 /* Check eol autodetection works when enabled -- honest. */ | |
| 407 cs_to_use = | |
| 408 Fget_coding_system (call2 | |
| 409 (intern ("coding-system-change-eol-conversion"), | |
| 410 intern ("undecided"), Qnil)); | |
| 411 XCODING_SYSTEM_EOL_TYPE (cs_to_use) = EOL_AUTODETECT; | |
| 412 TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_dos, | |
| 413 LISP_BUFFER, Fcurrent_buffer(), | |
| 414 cs_to_use); | |
| 415 DFC_CHECK_DATA (BUF_BYTE_ADDRESS (current_buffer, BUF_PT (current_buffer)), | |
| 416 sizeof (int_foo) - 1, int_foo); | |
| 417 /* reset to default */ | |
| 418 XCODING_SYSTEM_EOL_TYPE (cs_to_use) = | |
| 419 autodetect_eol_p ? EOL_AUTODETECT : EOL_LF; | |
| 420 } | |
| 421 | |
| 422 /* Does eol-detection-enabled-p reflect the actual state of affairs? | |
| 423 This probably could be tested in Lisp somehow. Should it? */ | |
| 398 | 424 TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_dos, |
| 425 LISP_BUFFER, Fcurrent_buffer(), | |
| 426 intern ("undecided")); | |
| 3417 | 427 if (autodetect_eol_p) |
| 428 DFC_CHECK_DATA (BUF_BYTE_ADDRESS (current_buffer, | |
| 429 BUF_PT (current_buffer)), | |
| 430 sizeof (int_foo) - 1, int_foo); | |
| 431 else | |
| 432 DFC_CHECK_DATA (BUF_BYTE_ADDRESS (current_buffer, | |
| 433 BUF_PT (current_buffer)), | |
| 434 sizeof (ext_dos) - 1, ext_dos); | |
| 398 | 435 |
| 436 TO_INTERNAL_FORMAT (DATA, (ext_mac, sizeof (ext_mac) - 1), | |
| 437 LISP_STRING, string, | |
| 438 intern ("iso-8859-1")); | |
| 439 DFC_CHECK_DATA_COND_EOL (XSTRING_DATA (string), | |
| 440 XSTRING_LENGTH (string), int_foo, ext_mac); | |
| 441 | |
| 442 { | |
| 443 Lisp_Object stream = | |
| 444 make_fixed_buffer_input_stream (ext_dos, sizeof (ext_dos) - 1); | |
| 445 TO_INTERNAL_FORMAT (LISP_LSTREAM, stream, | |
| 446 LISP_STRING, string, | |
| 447 intern ("iso-8859-1")); | |
| 448 DFC_CHECK_DATA_COND_EOL (XSTRING_DATA (string), | |
| 449 XSTRING_LENGTH (string), int_foo, ext_dos); | |
| 450 } | |
| 451 | |
| 452 TO_INTERNAL_FORMAT (DATA, (ext_unix, sizeof (ext_unix) - 1), | |
| 453 LISP_STRING, string, | |
| 454 intern ("no-conversion")); | |
| 455 DFC_CHECK_DATA_COND_EOL (XSTRING_DATA (string), | |
| 456 XSTRING_LENGTH (string), int_foo, ext_unix); | |
| 457 | |
| 458 | |
| 459 ptr = NULL, len = rand(); | |
| 460 TO_EXTERNAL_FORMAT (LISP_OPAQUE, opaque_dos, | |
| 461 ALLOCA, (ptr, len), | |
| 462 Qbinary); | |
| 463 DFC_CHECK_DATA (ptr, len, ext_dos); | |
| 464 | |
| 465 return intern ("PASS"); | |
| 466 } | |
| 467 | |
| 468 | |
| 489 | 469 /* Hash Table testing */ |
| 470 | |
| 471 typedef struct | |
| 472 { | |
| 473 Lisp_Object hash_table; | |
| 474 EMACS_INT sum; | |
| 475 } test_hash_tables_data; | |
| 476 | |
| 477 | |
| 478 static int | |
| 2286 | 479 test_hash_tables_mapper (Lisp_Object UNUSED (key), Lisp_Object value, |
| 489 | 480 void *extra_arg) |
| 481 { | |
| 482 test_hash_tables_data *p = (test_hash_tables_data *) extra_arg; | |
| 483 p->sum += XINT (value); | |
| 484 return 0; | |
| 485 } | |
| 486 | |
| 487 static int | |
| 488 test_hash_tables_modifying_mapper (Lisp_Object key, Lisp_Object value, | |
| 489 void *extra_arg) | |
| 490 { | |
| 491 test_hash_tables_data *p = (test_hash_tables_data *) extra_arg; | |
| 492 Fputhash (make_int (- XINT (key)), | |
| 493 make_int (2 * XINT (value)), | |
| 494 p->hash_table); | |
| 495 p->sum += XINT (value); | |
| 496 return 0; | |
| 497 } | |
| 498 | |
| 499 static int | |
| 2286 | 500 test_hash_tables_predicate (Lisp_Object key, |
| 501 Lisp_Object UNUSED (value), | |
| 502 void *UNUSED (extra_arg)) | |
| 489 | 503 { |
| 504 return XINT (key) < 0; | |
| 505 } | |
| 506 | |
| 507 | |
| 508 DEFUN ("test-hash-tables", Ftest_hash_tables, 0, 0, "", /* | |
| 509 Test C interface to hash tables. | |
| 510 */ | |
| 511 ()) | |
| 512 { | |
| 513 test_hash_tables_data data; | |
| 514 data.hash_table = make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, | |
| 515 HASH_TABLE_EQUAL); | |
| 516 | |
| 517 Fputhash (make_int (1), make_int (2), data.hash_table); | |
| 518 Fputhash (make_int (3), make_int (4), data.hash_table); | |
| 519 | |
| 520 data.sum = 0; | |
| 521 elisp_maphash_unsafe (test_hash_tables_mapper, | |
| 522 data.hash_table, (void *) &data); | |
| 523 assert (data.sum == 2 + 4); | |
| 524 | |
| 525 data.sum = 0; | |
| 526 elisp_maphash (test_hash_tables_modifying_mapper, | |
| 527 data.hash_table, (void *) &data); | |
| 528 assert (data.sum == 2 + 4); | |
| 529 | |
| 530 /* hash table now contains: (1, 2) (3, 4) (-1, 2*2) (-3, 2*4) */ | |
| 531 | |
| 532 data.sum = 0; | |
| 533 elisp_maphash_unsafe (test_hash_tables_mapper, | |
| 534 data.hash_table, (void *) &data); | |
| 535 assert (data.sum == 3 * (2 + 4)); | |
| 536 | |
| 537 /* Remove entries with negative keys, added by modifying mapper */ | |
| 538 elisp_map_remhash (test_hash_tables_predicate, | |
| 539 data.hash_table, 0); | |
| 540 | |
| 541 data.sum = 0; | |
| 542 elisp_maphash_unsafe (test_hash_tables_mapper, | |
| 543 data.hash_table, (void *) &data); | |
| 544 assert (data.sum == 2 + 4); | |
| 545 | |
| 546 return intern ("PASS"); | |
| 547 } | |
| 548 | |
| 549 | |
| 398 | 550 |
| 3263 | 551 #ifdef NEW_GC |
| 2720 | 552 #define TESTS_DEFSUBR(Fname) do { \ |
| 553 DEFSUBR_MC_ALLOC (Fname); \ | |
| 554 defsubr (S##Fname); \ | |
| 555 Vtest_function_list = \ | |
| 556 Fcons (intern (subr_name (S##Fname)), \ | |
| 557 Vtest_function_list); \ | |
| 558 } while (0) | |
| 3263 | 559 #else /* not NEW_GC */ |
| 398 | 560 #define TESTS_DEFSUBR(Fname) do { \ |
| 561 DEFSUBR (Fname); \ | |
| 562 Vtest_function_list = \ | |
| 563 Fcons (intern (subr_name (&S##Fname)), \ | |
| 564 Vtest_function_list); \ | |
| 565 } while (0) | |
| 3263 | 566 #endif /* not NEW_GC */ |
| 398 | 567 |
| 568 void | |
| 569 syms_of_tests (void) | |
| 570 { | |
| 571 Vtest_function_list = Qnil; | |
| 572 | |
| 573 TESTS_DEFSUBR (Ftest_data_format_conversion); | |
| 489 | 574 TESTS_DEFSUBR (Ftest_hash_tables); |
| 398 | 575 /* Add other test functions here with TESTS_DEFSUBR */ |
| 576 } | |
| 577 | |
| 578 void | |
| 579 vars_of_tests (void) | |
| 580 { | |
| 581 DEFVAR_LISP ("test-function-list", &Vtest_function_list /* | |
| 582 List of all test functions defined in tests.c. | |
| 583 For use by the automated test suite. See tests/automated/c-tests. | |
| 584 */ ); | |
| 585 } |