/* C support for testing XEmacs - see tests/automated/c-tests.el
   Copyright (C) 2000 Martin Buchholz
   Copyright (C) 2001, 2002, 2010 Ben Wing.
   Copyright (C) 2006 The Free Software Foundation, Inc.

This file is part of XEmacs.

XEmacs 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.

XEmacs 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 XEmacs.  If not, see <http://www.gnu.org/licenses/>. */

/* Author: Martin Buchholz

   This file provides support for running tests for XEmacs that cannot
   be written entirely in Lisp.  These tests are run automatically via
   tests/automated/c-tests.el, or can be run by hand using M-x */


#include <config.h>
#include "lisp.h"
#include "buffer.h"
#include "lstream.h"
#include "elhash.h"
#include "opaque.h"
#include "file-coding.h"	/* XCODING_SYSTEM_EOL_TYPE and its values */

static Lisp_Object Vtest_function_list;

DEFUN ("test-data-format-conversion", Ftest_data_format_conversion, 0, 0, "", /*
  Return list of results of test TO_EXTERNAL_FORMAT() and TO_INTERNAL_FORMAT().
For use by the automated test suite.  See tests/automated/c-tests.

Each element is a list (DESCRIPTION, STATUS, REASON).
DESCRIPTION is a string describing the test.
STATUS is a symbol, either t (pass) or nil (fail).
REASON is nil or a string describing the failure (not required).
*/
       ())
{
  void *ptr; Bytecount len;
  Lisp_Object string = Qnil, opaque = Qnil, conversion_result = Qnil;

  Ibyte int_foo[] = "\n\nfoo\nbar";
  Extbyte ext_unix[]= "\n\nfoo\nbar";

  Extbyte ext_dos[] = "\r\n\r\nfoo\r\nbar";
  Extbyte ext_mac[] = "\r\rfoo\rbar";
  Lisp_Object opaque_dos = make_opaque (ext_dos, sizeof (ext_dos) - 1);
  Lisp_Object string_foo = make_string (int_foo, sizeof (int_foo) - 1);

  Extbyte ext_latin[]  = "f\372b\343\340";
  Ibyte int_latin1[] = "f\200\372b\200\343\200\340";
  Ibyte int_latin2[] = "f\201\372b\201\343\201\340";
#ifdef MULE
  Extbyte ext_latin12[]= "f\033-A\372b\343\340\033-B";
  Extbyte ext_tilde[]  = "f~b~~";
  Lisp_Object string_latin2 = make_string (int_latin2, sizeof (int_latin2) - 1);
#endif
  Lisp_Object opaque_latin  = make_opaque (ext_latin,  sizeof (ext_latin) - 1);
  Lisp_Object opaque0_latin = make_opaque (ext_latin,  sizeof (ext_latin));
  Lisp_Object string_latin1 = make_string (int_latin1, sizeof (int_latin1) - 1);
  int autodetect_eol_p =
    !NILP (Fsymbol_value (intern ("eol-detection-enabled-p")));
  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
  struct gcpro ngcpro1, ngcpro2, ngcpro3;
#ifdef MULE
  struct gcpro ngcpro4;
#endif

  /* DFC conversion inhibits GC, but we have a call2() below which calls
     Lisp, which can trigger GC, so we need to GC-protect everything here. */
  GCPRO5 (string, opaque, conversion_result, opaque_dos, string_foo);
#ifdef MULE
  NGCPRO4 (string_latin2, opaque_latin, opaque0_latin, string_latin1);
#else
  NGCPRO3 (opaque_latin, opaque0_latin, string_latin1);
#endif

  /* Check for expected strings before and after conversion.
     Conversions depend on whether MULE is defined. */

  /* #### Any code below that uses iso-latin-2-with-esc is ill-conceived. */

#ifdef MULE
#define DFC_CHECK_DATA_COND_MULE(ptr,len,			\
				 constant_string_mule,		\
				 constant_string_non_mule,	\
				 description)			\
    DFC_CHECK_DATA (ptr, len, constant_string_mule, description)
#define DFC_CHECK_DATA_COND_MULE_NUL(ptr,len,			\
				     constant_string_mule,	\
				     constant_string_non_mule,	\
				     description)		\
    DFC_CHECK_DATA_NUL (ptr, len, constant_string_mule, description)
#else
#define DFC_CHECK_DATA_COND_MULE(ptr,len,			\
				 constant_string_mule,		\
				 constant_string_non_mule,	\
				 description)			\
    DFC_CHECK_DATA (ptr, len, constant_string_non_mule, description)
#define DFC_CHECK_DATA_COND_MULE_NUL(ptr,len,			\
				     constant_string_mule,	\
				     constant_string_non_mule,	\
				     description)		\
    DFC_CHECK_DATA_NUL (ptr, len, constant_string_non_mule, description)
#endif

  /* These now only apply to base coding systems, and
     need to test `eol-detection-enabled-p' at runtime. */
#define DFC_CHECK_DATA_COND_EOL(ptr,len,				\
				constant_string_eol,			\
				constant_string_non_eol,		\
				description) do {			\
    if (autodetect_eol_p)						\
      DFC_CHECK_DATA (ptr, len, constant_string_eol, description);	\
    else								\
      DFC_CHECK_DATA (ptr, len, constant_string_non_eol, description);	\
  } while (0)
#define DFC_CHECK_DATA_COND_EOL_NUL(ptr,len,				\
				    constant_string_eol,		\
				    constant_string_non_eol,		\
				    description) do {			\
    if (autodetect_eol_p)						\
      DFC_CHECK_DATA_NUL (ptr, len, constant_string_eol, description);	\
    else								\
      DFC_CHECK_DATA_NUL (ptr, len, constant_string_non_eol, description); \
  } while (0)

  /* Check for expected strings before and after conversion. */
#define DFC_CHECK_DATA(ptr,len,constant_string,test) do {		\
    DFC_INITIALIZE (test);						\
    DFC_CHECK_LENGTH (len, sizeof (constant_string) - 1, test);	\
    DFC_CHECK_CONTENT (ptr, constant_string, len, test);		\
    DFC_RESULT_PASS (test);						\
  } while (0)

  /* Macro version that includes the trailing NULL byte. */
#define DFC_CHECK_DATA_NUL(ptr,len,constant_string,test) do {	\
    DFC_INITIALIZE (test);					\
    DFC_CHECK_LENGTH (len, sizeof (constant_string), test);	\
    DFC_CHECK_CONTENT (ptr, constant_string, len, test);	\
    DFC_RESULT_PASS (test);					\
  } while (0)

/* WARNING WARNING WARNING!
   The following macros are NOT protected by "do { ... } while (0)"!!
*/

#define DFC_INITIALIZE(test_name) if (0)

#define DFC_CHECK_LENGTH(len1,len2,str1)	\
    else if ((len1) != (len2))			\
      conversion_result =			\
        Fcons (list3 (build_cistring(str1), Qnil, build_ascstring("wrong length")), \
	       conversion_result)

#define DFC_CHECK_CONTENT(str1,str2,len1,str3)	\
    else if (memcmp (str1, str2, len1))		\
      conversion_result =			\
	Fcons (list3 (build_cistring(str3), Qnil,			\
		      build_ascstring("octet comparison failed")),	\
	       conversion_result)

#define DFC_RESULT_PASS(str1)		\
    else				\
      conversion_result =		\
	Fcons (list3 (build_cistring(str1), Qt, Qnil),	\
	       conversion_result)

#ifdef MULE
  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2)),
		      ALLOCA, (ptr, len),
		      intern ("iso-8859-2"));
  DFC_CHECK_DATA_NUL (ptr, len, ext_latin,
		      "Latin-2 DATA, ALLOCA, Latin 2/NUL");

  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (LISP_STRING, string_latin2,
		      ALLOCA, (ptr, len),
		      intern ("iso-8859-2"));
  DFC_CHECK_DATA (ptr, len, ext_latin,
		  "Latin-2 Lisp string, ALLOCA, Latin 2");

  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (LISP_STRING, string_latin1,
		      ALLOCA, (ptr, len),
		      intern ("iso-latin-2-with-esc"));
  DFC_CHECK_DATA (ptr, len, ext_latin12,
		  "Latin-1 Lisp string, ALLOCA, Latin 2/ESC");

  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2) - 1),
		      MALLOC, (ptr, len),
		      intern ("iso-8859-2"));
  DFC_CHECK_DATA (ptr, len, ext_latin, "Latin-2 DATA, MALLOC, Latin-2");
  xfree (ptr);

  TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2) - 1),
		      LISP_OPAQUE, opaque,
		      intern ("iso-8859-2"));
  DFC_CHECK_DATA (XOPAQUE_DATA (opaque), XOPAQUE_SIZE (opaque), ext_latin,
		  "Latin-2 DATA, Lisp opaque, Latin-2");

  ptr = NULL, len = rand();
  TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin) - 1),
		      ALLOCA, (ptr, len),
		      intern ("iso-latin-2-with-esc"));
  DFC_CHECK_DATA (ptr, len, int_latin2,
		  "Latin-2/ESC, ALLOCA, Latin-1 DATA");

  ptr = NULL, len = rand();
  TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin) - 1),
		      MALLOC, (ptr, len),
		      intern ("iso-latin-2-with-esc"));
  DFC_CHECK_DATA (ptr, len, int_latin2,
		  "Latin-2/ESC, MALLOC, Latin-1 DATA");
  xfree (ptr);

  TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin) - 1),
		      LISP_STRING, string,
		      intern ("iso-latin-2-with-esc"));
  DFC_CHECK_DATA (XSTRING_DATA (string), XSTRING_LENGTH (string), int_latin2,
		  "Latin-2/ESC, Lisp string, Latin-2");

  TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_latin,
		      LISP_STRING, string,
		      intern ("iso-latin-2-with-esc"));
  DFC_CHECK_DATA (XSTRING_DATA (string), XSTRING_LENGTH (string), int_latin2,
		  "Lisp opaque, Lisp string, Latin-2/ESC");

  TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque0_latin,
		      LISP_STRING, string,
		      intern ("iso-latin-2-with-esc"));
  DFC_CHECK_DATA_NUL (XSTRING_DATA (string), XSTRING_LENGTH (string), int_latin2,
		      "Lisp opaque, Lisp string, Latin-2/ESC/NUL");

  TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque0_latin,
		      LISP_BUFFER, Fcurrent_buffer(),
		      intern ("iso-latin-2-with-esc"));
  DFC_CHECK_DATA_NUL (BUF_BYTE_ADDRESS (current_buffer, BUF_PT (current_buffer)),
		    sizeof (int_latin2), int_latin2,
		      "Lisp opaque, Lisp buffer, Latin-2/ESC/NUL");

  TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_latin,
		      LISP_BUFFER, Fcurrent_buffer(),
		      intern ("iso-8859-1"));
  DFC_CHECK_DATA (BUF_BYTE_ADDRESS (current_buffer, BUF_PT (current_buffer)),
		  sizeof (int_latin1) - 1, int_latin1,
		  "Lisp opaque, Lisp buffer, Latin-1");

  TO_INTERNAL_FORMAT (DATA, (ext_latin12, sizeof (ext_latin12) - 1),
		      ALLOCA, (ptr, len),
		      intern ("iso-latin-2-with-esc"));
  DFC_CHECK_DATA (ptr, len, int_latin1, "DATA, ALLOCA, Latin-1");

#endif /* MULE */

  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1),
		      ALLOCA, (ptr, len),
		      Qbinary);
  DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1,
			    "Latin-1 DATA, ALLOCA, binary");

  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1)),
		      ALLOCA, (ptr, len),
		      Qbinary);
  DFC_CHECK_DATA_COND_MULE_NUL (ptr, len, ext_latin, int_latin1,
				"Latin-1 DATA, ALLOCA, binary/NUL");

  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2) - 1),
		      ALLOCA, (ptr, len),
		      Qbinary);
  DFC_CHECK_DATA_COND_MULE (ptr, len, ext_tilde, int_latin2,
			    "Latin-2 DATA, ALLOCA, binary");

  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1),
		      ALLOCA, (ptr, len),
		      intern ("iso-8859-1"));
  DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1,
			    "Latin-1 DATA, ALLOCA, Latin-1");


  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (LISP_STRING, string_latin1,
		      ALLOCA, (ptr, len),
		      Qbinary);
  DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1,
			    "Latin-1 Lisp string, ALLOCA, binary");

  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (LISP_STRING, string_latin1,
		      ALLOCA, (ptr, len),
		      Qbinary);
  DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1,
			    "Latin-1 Lisp string, ALLOCA, binary");

  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (LISP_STRING, string_latin1,
		      ALLOCA, (ptr, len),
		      intern ("iso-8859-1"));
  DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1,
			    "Latin-1 Lisp string, ALLOCA, Latin-1");

  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1),
		      MALLOC, (ptr, len),
		      Qbinary);
  DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1,
			    "Latin-1 DATA, MALLOC, binary");
  xfree (ptr);

  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2)),
		      MALLOC, (ptr, len),
		      Qbinary);
  DFC_CHECK_DATA_COND_MULE_NUL (ptr, len, ext_tilde, int_latin2,
				"Latin-2 DATA, MALLOC, binary/NUL");
  xfree (ptr);

  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1),
		      MALLOC, (ptr, len),
		      intern ("iso-8859-1"));
  DFC_CHECK_DATA_COND_MULE (ptr, len, ext_latin, int_latin1,
			    "Latin-1 DATA, MALLOC, Latin-1");
  xfree (ptr);

  TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1),
		      LISP_OPAQUE, opaque,
		      Qbinary);
  DFC_CHECK_DATA_COND_MULE (XOPAQUE_DATA (opaque),
			    XOPAQUE_SIZE (opaque), ext_latin, int_latin1,
			    "Latin-1 DATA, Lisp opaque, binary");

  TO_EXTERNAL_FORMAT (DATA, (int_latin2, sizeof (int_latin2)),
		      LISP_OPAQUE, opaque,
		      Qbinary);
  DFC_CHECK_DATA_COND_MULE_NUL (XOPAQUE_DATA (opaque),
				XOPAQUE_SIZE (opaque), ext_tilde, int_latin2,
				"Latin-2 DATA, Lisp opaque, binary");

  TO_EXTERNAL_FORMAT (DATA, (int_latin1, sizeof (int_latin1) - 1),
		      LISP_OPAQUE, opaque,
		      intern ("iso-8859-1"));
  DFC_CHECK_DATA_COND_MULE (XOPAQUE_DATA (opaque),
			    XOPAQUE_SIZE (opaque), ext_latin, int_latin1,
			    "Latin-1 DATA, Lisp opaque, Latin-1");

  ptr = NULL, len = rand();
  TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin) - 1),
		      ALLOCA, (ptr, len),
		      Qbinary);
  DFC_CHECK_DATA_COND_MULE (ptr, len, int_latin1, ext_latin,
			    "Latin-1 DATA, ALLOCA, binary");

  ptr = NULL, len = rand();
  TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin)),
		      ALLOCA, (ptr, len),
		      intern ("iso-8859-1"));
  DFC_CHECK_DATA_COND_MULE_NUL (ptr, len, int_latin1, ext_latin,
				"Latin-1 DATA, ALLOCA, Latin-1");

  ptr = NULL, len = rand();
  TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin)),
		      MALLOC, (ptr, len),
		      intern ("iso-8859-1"));
  DFC_CHECK_DATA_COND_MULE_NUL (ptr, len, int_latin1, ext_latin,
				"Latin-1 DATA, MALLOC, Latin-1");
  xfree (ptr);

  ptr = NULL, len = rand();
  TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin)),
		      MALLOC, (ptr, len),
		      Qnil);
  DFC_CHECK_DATA_COND_MULE_NUL (ptr, len, int_latin1, ext_latin,
				"Latin-1 DATA, MALLOC, nil");
  xfree (ptr);

  TO_INTERNAL_FORMAT (DATA, (ext_latin, sizeof (ext_latin) - 1),
		      LISP_STRING, string,
		      intern ("iso-8859-1"));
  DFC_CHECK_DATA_COND_MULE (XSTRING_DATA (string),
			    XSTRING_LENGTH (string), int_latin1, ext_latin,
			    "Latin-1 DATA, Lisp stirng, Latin-1");

  TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_latin,
		      LISP_STRING, string,
		      intern ("iso-8859-1"));
  DFC_CHECK_DATA_COND_MULE (XSTRING_DATA (string),
			    XSTRING_LENGTH (string), int_latin1, ext_latin,
			    "Latin-1 Lisp opaque, Lisp string, Latin-1");

  TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque0_latin,
		      LISP_STRING, string,
		      intern ("iso-8859-1"));
  DFC_CHECK_DATA_COND_MULE_NUL (XSTRING_DATA (string),
				XSTRING_LENGTH (string), int_latin1, ext_latin,
				"Latin-1 Lisp opaque, Lisp string, Latin-1/NUL");

  /* This next group used to use the COND_EOL macros, but with the new Mule,
     they all specify an EOL convention, and all XEmacsen can grok them. */
  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (DATA, (int_foo, sizeof (int_foo)),
		      MALLOC, (ptr, len),
		      Qbinary);
  DFC_CHECK_DATA_NUL (ptr, len, ext_unix,
		      "ASCII DATA, MALLOC, binary/LF/NUL");
  xfree (ptr);

  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (DATA, (int_foo, sizeof (int_foo) - 1),
		      LISP_OPAQUE, opaque,
		      intern ("raw-text-mac"));
  DFC_CHECK_DATA (XOPAQUE_DATA (opaque), XOPAQUE_SIZE (opaque), ext_mac,
		      "ASCII DATA, Lisp opaque, binary/CR");

  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (LISP_STRING, string_foo,
		      ALLOCA, (ptr, len),
		      intern ("raw-text-dos"));
  DFC_CHECK_DATA (ptr, len, ext_dos, "ASCII Lisp string, ALLOCA, binary/CRLF");

  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (DATA, (int_foo, sizeof (int_foo) - 1),
		      ALLOCA, (ptr, len),
		      intern ("raw-text-unix"));
  DFC_CHECK_DATA (ptr, len, ext_unix, "ASCII DATA, ALLOCA, binary/LF");

  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (LISP_STRING, string_foo,
		      MALLOC, (ptr, len),
		      intern ("no-conversion-mac"));
  DFC_CHECK_DATA (ptr, len, ext_mac, "ASCII Lisp string, MALLOC, binary/CR");
  xfree (ptr);

  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (DATA, (int_foo, sizeof (int_foo) - 1),
		      ALLOCA, (ptr, len),
		      intern ("no-conversion-dos"));
  DFC_CHECK_DATA (ptr, len, ext_dos, "ASCII DATA, ALLOCA, binary/CRLF");

  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (DATA, (int_foo, sizeof (int_foo)),
		      ALLOCA, (ptr, len),
		      intern ("no-conversion-unix"));
  DFC_CHECK_DATA_NUL (ptr, len, ext_unix, "ASCII DATA, ALLOCA, binary/LF/NUL");

  /* Oh, Lawdy, Lawdy, Lawdy, this done broke mah heart!

     I tried using the technique

     Fget_coding_system (call2
			 (intern ("coding-system-change-eol-conversion"),
			  intern ("undecided"), $EOL_TYPE));
     XCODING_SYSTEM_EOL_TYPE (cs_to_use) = $EOL_DETECT_TYPE;

     with EOL_TYPE = Qlf (for no-detect) and Qnil (for auto-detect),
     and with EOL_DETECT_TYPE = EOL_LF and EOL_AUTODETECT
     respectively, but this doesn't seem to work on the `undecided'
     coding system.  The coding-system-eol-type attribute on the
     coding system itself needs to be changed, too.  I'm not sure at
     the moment how `set-eol-detection' works its magic, but the code
     below gives correct test results without default EOL detection,
     with default EOL detection, and with Mule.  Ship it!

     Mule.  You'll envy the dead.
  */

  {
    /* Check eol autodetection doesn't happen when disabled -- cheat. */
    Lisp_Object cs_to_use = Fget_coding_system (intern ("undecided-unix"));
    TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_dos,
			LISP_BUFFER, Fcurrent_buffer(),
			cs_to_use);
    DFC_CHECK_DATA (BUF_BYTE_ADDRESS (current_buffer, BUF_PT (current_buffer)),
		    sizeof (ext_dos) - 1, ext_dos,
		    "DOS Lisp opaque, Lisp buffer, undecided-unix");

    /* Check eol autodetection works when enabled -- honest. */
    cs_to_use =
      Fget_coding_system (call2
			  (intern ("coding-system-change-eol-conversion"),
			  intern ("undecided"), Qnil));
    XCODING_SYSTEM_EOL_TYPE (cs_to_use) = EOL_AUTODETECT;
    TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_dos,
			LISP_BUFFER, Fcurrent_buffer(),
			cs_to_use);
    DFC_CHECK_DATA (BUF_BYTE_ADDRESS (current_buffer, BUF_PT (current_buffer)),
		    sizeof (int_foo) - 1, int_foo,
		    "DOS Lisp opaque, Lisp buffer, undecided");
    /* reset to default */
    XCODING_SYSTEM_EOL_TYPE (cs_to_use) =
      autodetect_eol_p ? EOL_AUTODETECT : EOL_LF;
  }

  /* Does eol-detection-enabled-p reflect the actual state of affairs?
     This probably could be tested in Lisp somehow.  Should it? */
  TO_INTERNAL_FORMAT (LISP_OPAQUE, opaque_dos,
		      LISP_BUFFER, Fcurrent_buffer(),
		      intern ("undecided"));
  if (autodetect_eol_p)
    DFC_CHECK_DATA (BUF_BYTE_ADDRESS (current_buffer,
				      BUF_PT (current_buffer)),
		    sizeof (int_foo) - 1, int_foo,
		    "DOS Lisp opaque, Lisp buffer, autodetect eol");
  else
    DFC_CHECK_DATA (BUF_BYTE_ADDRESS (current_buffer,
				      BUF_PT (current_buffer)),
		    sizeof (ext_dos) - 1, ext_dos,
		    "DOS Lisp opaque, Lisp buffer, no autodetect eol");

  TO_INTERNAL_FORMAT (DATA, (ext_mac, sizeof (ext_mac) - 1),
		      LISP_STRING, string,
		      intern ("iso-8859-1"));
  DFC_CHECK_DATA_COND_EOL (XSTRING_DATA (string),
			   XSTRING_LENGTH (string), int_foo, ext_mac,
			   "Mac DATA, Lisp string, Latin-1/EOL");
  {
    Lisp_Object stream =
      make_fixed_buffer_input_stream (ext_dos, sizeof (ext_dos) - 1);
    TO_INTERNAL_FORMAT (LISP_LSTREAM, stream,
			LISP_STRING, string,
			intern ("iso-8859-1"));
    DFC_CHECK_DATA_COND_EOL (XSTRING_DATA (string),
			     XSTRING_LENGTH (string), int_foo, ext_dos,
			   "DOS lstream, Lisp string, Latin-1/EOL");
  }

  TO_INTERNAL_FORMAT (DATA, (ext_unix, sizeof (ext_unix) - 1),
		      LISP_STRING, string,
		      intern ("no-conversion"));
  DFC_CHECK_DATA_COND_EOL (XSTRING_DATA (string),
			   XSTRING_LENGTH (string), int_foo, ext_unix,
			   "Unix DATA, Lisp string, no-conversion");

  ptr = NULL, len = rand();
  TO_EXTERNAL_FORMAT (LISP_OPAQUE, opaque_dos,
		      ALLOCA, (ptr, len),
		      Qbinary);
  DFC_CHECK_DATA (ptr, len, ext_dos, "DOS Lisp opaque, ALLOCA, binary");

  NUNGCPRO;
  UNGCPRO;
  return conversion_result;
}


/* Hash Table testing */

typedef struct
{
  Lisp_Object hash_table;
  EMACS_INT sum;
} test_hash_tables_data;


static int
test_hash_tables_mapper (Lisp_Object UNUSED (key), Lisp_Object value,
			 void *extra_arg)
{
  test_hash_tables_data *p = (test_hash_tables_data *) extra_arg;
  p->sum += XFIXNUM (value);
  return 0;
}

static int
test_hash_tables_modifying_mapper (Lisp_Object key, Lisp_Object value,
				   void *extra_arg)
{
  test_hash_tables_data *p = (test_hash_tables_data *) extra_arg;
  Fputhash (make_fixnum (- XFIXNUM (key)),
	    make_fixnum (2 * XFIXNUM (value)),
	    p->hash_table);
  p->sum += XFIXNUM (value);
  return 0;
}

static int
test_hash_tables_predicate (Lisp_Object key,
			    Lisp_Object UNUSED (value),
			    void *UNUSED (extra_arg))
{
  return XFIXNUM (key) < 0;
}


DEFUN ("test-hash-tables", Ftest_hash_tables, 0, 0, "", /*
  Return list of results of testing C interface to hash tables.
For use by the automated test suite.  See tests/automated/c-tests.

Each element is a list (DESCRIPTION, STATUS, REASON).
DESCRIPTION is a string describing the test.
STATUS is a symbol, either t (pass) or nil (fail).
REASON is nil or a string describing the failure (not required).
*/
       ())
{
  Lisp_Object hash_result = Qnil;

  test_hash_tables_data data;
  data.hash_table = make_lisp_hash_table (50, HASH_TABLE_NON_WEAK,
					  Qequal);

  Fputhash (make_fixnum (1), make_fixnum (2), data.hash_table);
  Fputhash (make_fixnum (3), make_fixnum (4), data.hash_table);

  data.sum = 0;
  elisp_maphash_unsafe (test_hash_tables_mapper,
			data.hash_table, (void *) &data);
  hash_result = Fcons (list3 (build_ascstring ("simple mapper"),
				   (data.sum == 2 + 4) ? Qt : Qnil,
				   build_ascstring ("sum != 2 + 4")),
			    hash_result);

  data.sum = 0;
  elisp_maphash (test_hash_tables_modifying_mapper,
		 data.hash_table, (void *) &data);
  hash_result = Fcons (list3 (build_ascstring ("modifying mapper"),
				   (data.sum == 2 + 4) ? Qt : Qnil,
				   build_ascstring ("sum != 2 + 4")),
			    hash_result);

  /* hash table now contains:  (1, 2) (3, 4) (-1, 2*2) (-3, 2*4) */

  data.sum = 0;
  elisp_maphash_unsafe (test_hash_tables_mapper,
			data.hash_table, (void *) &data);
  hash_result = Fcons (list3 (build_ascstring ("simple mapper"),
				   (data.sum == 3 * (2 + 4)) ? Qt : Qnil,
				   build_ascstring ("sum != 3 * (2 + 4)")),
			    hash_result);

  /* Remove entries with negative keys, added by modifying mapper */
  elisp_map_remhash (test_hash_tables_predicate,
		     data.hash_table, 0);

  data.sum = 0;
  elisp_maphash_unsafe (test_hash_tables_mapper,
			data.hash_table, (void *) &data);
  hash_result = Fcons (list3 (build_ascstring ("remove negatives mapper"),
				   (data.sum == 2 + 4) ? Qt : Qnil,
				   build_ascstring ("sum != 2 + 4")),
			    hash_result);

  return hash_result;
}

DEFUN ("test-store-void-in-lisp", Ftest_store_void_in_lisp, 0, 0, "", /*
  Test STORE_VOID_IN_LISP and its inverse GET_VOID_FROM_LISP.
Tests by internal assert(); only returns if it succeeds.
*/
       ())
{
  struct foobar { int x; int y; short z; void *q; } baz;

#define FROB(val)							\
do									\
{									\
  void *pval = (void *) (val);						\
  assert (GET_VOID_FROM_LISP (STORE_VOID_IN_LISP (pval)) == pval);	\
}									\
while (0)
  assert (FIXNUM_VALBITS >= 31);
  FROB (&baz);
  FROB (&baz.x);
  FROB (&baz.y);
  FROB (&baz.z);
  FROB (&baz.q);
  FROB (0);
  FROB (2);
  FROB (&Vtest_function_list);
  FROB (0x00000080);
  FROB (0x00008080);
  FROB (0x00808080);
  FROB (0x80808080);
  FROB (0xCAFEBABE);
  FROB (0xFFFFFFFE);
#if FIXNUM_VALBITS >= 63
  FROB (0x0000808080808080);
  FROB (0x8080808080808080);
  FROB (0XDEADBEEFCAFEBABE);
  FROB (0XFFFFFFFFFFFFFFFE);
#endif /* FIXNUM_VALBITS >= 63 */

  return list1 (list3 (build_ascstring ("STORE_VOID_IN_LISP"), Qt, Qnil));
}



#ifdef NEW_GC
#define TESTS_DEFSUBR(Fname) do {		\
  DEFSUBR_MC_ALLOC (Fname);			\
  defsubr (S##Fname);				\
  Vtest_function_list =				\
    Fcons (intern (subr_name (S##Fname)),	\
	   Vtest_function_list);		\
} while (0)
#else /* not NEW_GC */
#define TESTS_DEFSUBR(Fname) do {		\
  DEFSUBR (Fname);				\
  Vtest_function_list =				\
    Fcons (intern (subr_name (&S##Fname)),	\
	   Vtest_function_list);		\
} while (0)
#endif /* not NEW_GC */

void
syms_of_tests (void)
{
  Vtest_function_list = Qnil;

  TESTS_DEFSUBR (Ftest_data_format_conversion);
  TESTS_DEFSUBR (Ftest_hash_tables);
  TESTS_DEFSUBR (Ftest_store_void_in_lisp);
  /* Add other test functions here with TESTS_DEFSUBR */
}

void
vars_of_tests (void)
{
  DEFVAR_LISP ("test-function-list", &Vtest_function_list /*
List of all test functions defined in tests.c.
For use by the automated test suite.  See tests/automated/c-tests.
*/ );
}