annotate tests/automated/md5-tests.el @ 934:c925bacdda60

[xemacs-hg @ 2002-07-29 09:21:12 by michaels] 2002-07-17 Marcus Crestani <crestani@informatik.uni-tuebingen.de> Markus Kaltenbach <makalten@informatik.uni-tuebingen.de> Mike Sperber <mike@xemacs.org> configure flag to turn these changes on: --use-kkcc First we added a dumpable flag to lrecord_implementation. It shows, if the object is dumpable and should be processed by the dumper. * lrecord.h (struct lrecord_implementation): added dumpable flag (MAKE_LRECORD_IMPLEMENTATION): fitted the different makro definitions to the new lrecord_implementation and their calls. Then we changed mark_object, that it no longer needs a mark method for those types that have pdump descritions. * alloc.c: (mark_object): If the object has a description, the new mark algorithm is called, and the object is marked according to its description. Otherwise it uses the mark method like before. These procedures mark objects according to their descriptions. They are modeled on the corresponding pdumper procedures. (mark_with_description): (get_indirect_count): (structure_size): (mark_struct_contents): These procedures still call mark_object, this is needed while there are Lisp_Objects without descriptions left. We added pdump descriptions for many Lisp_Objects: * extents.c: extent_auxiliary_description * database.c: database_description * gui.c: gui_item_description * scrollbar.c: scrollbar_instance_description * toolbar.c: toolbar_button_description * event-stream.c: command_builder_description * mule-charset.c: charset_description * device-msw.c: devmode_description * dialog-msw.c: mswindows_dialog_id_description * eldap.c: ldap_description * postgresql.c: pgconn_description pgresult_description * tooltalk.c: tooltalk_message_description tooltalk_pattern_description * ui-gtk.c: emacs_ffi_description emacs_gtk_object_description * events.c: * events.h: * event-stream.c: * event-Xt.c: * event-gtk.c: * event-tty.c: To write a pdump description for Lisp_Event, we converted every struct in the union event to a Lisp_Object. So we created nine new Lisp_Objects: Lisp_Key_Data, Lisp_Button_Data, Lisp_Motion_Data, Lisp_Process_Data, Lisp_Timeout_Data, Lisp_Eval_Data, Lisp_Misc_User_Data, Lisp_Magic_Data, Lisp_Magic_Eval_Data. We also wrote makro selectors and mutators for the fields of the new designed Lisp_Event and added everywhere these new abstractions. We implemented XD_UNION support in (mark_with_description), so we can describe exspecially console/device specific data with XD_UNION. To describe with XD_UNION, we added a field to these objects, which holds the variant type of the object. This field is initialized in the appendant constructor. The variant is an integer, it has also to be described in an description, if XD_UNION is used. XD_UNION is used in following descriptions: * console.c: console_description (get_console_variant): returns the variant (create_console): added variant initialization * console.h (console_variant): the different console types * console-impl.h (struct console): added enum console_variant contype * device.c: device_description (Fmake_device): added variant initialization * device-impl.h (struct device): added enum console_variant devtype * objects.c: image_instance_description font_instance_description (Fmake_color_instance): added variant initialization (Fmake_font_instance): added variant initialization * objects-impl.h (struct Lisp_Color_Instance): added color_instance_type * objects-impl.h (struct Lisp_Font_Instance): added font_instance_type * process.c: process_description (make_process_internal): added variant initialization * process.h (process_variant): the different process types
author michaels
date Mon, 29 Jul 2002 09:21:25 +0000
parents 3ecd8885ac67
children 189fb67ca31a
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;; Copyright (C) 1998 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Author: Hrvoje Niksic <hniksic@xemacs.org>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 ;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Created: 1998
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Keywords: tests
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;;; Synched up with: Not in FSF.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;; Test basic md5 functionality.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 ;; See test-harness.el for instructions on how to run these tests.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 (eval-when-compile
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 (require 'test-harness)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 (file-error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 (push "." load-path)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 (when (and (boundp 'load-file-name) (stringp load-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 (push (file-name-directory load-file-name) load-path))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 (require 'test-harness))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 (defconst md5-tests
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 '(
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 ;; Test samples from rfc1321:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 ("" . "d41d8cd98f00b204e9800998ecf8427e")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 ("a" . "0cc175b9c0f1b6a831c399e269772661")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 ("abc" . "900150983cd24fb0d6963f7d28e17f72")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 ("message digest" . "f96b697d7cb7938d525a2f31aaf161d0")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 ("abcdefghijklmnopqrstuvwxyz" . "c3fcd3d76192e4007dfb496cca67e13b")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 . "d174ab98d277d9f5a5611c2c9f419d9f")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 ("12345678901234567890123456789012345678901234567890123456789012345678901234567890"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 . "57edf4a22be3c955ac49da2e2107b67a")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 ;; Test `md5' on strings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 (mapcar (lambda (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 (Assert (equal (md5 (car x)) (cdr x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 md5-tests)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 ;; Test `md5' on portions of strings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 (let ((large-string (mapconcat #'car md5-tests "")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 (let ((count 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 (mapcar (lambda (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 (Assert (equal (md5 large-string count (+ count (length (car x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 (cdr x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 (incf count (length (car x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 md5-tests)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 ;; Test `md5' on buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 (with-temp-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 (mapcar (lambda (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 (erase-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 (insert (car x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 (Assert (equal (md5 (current-buffer)) (cdr x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 md5-tests))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 ;; Test `md5' on portions of buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 (with-temp-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 (insert (mapconcat #'car md5-tests ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 (let ((point 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 (mapcar (lambda (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 (Assert (equal (md5 (current-buffer) point (+ point (length (car x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 (cdr x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 (incf point (length (car x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 md5-tests)))