From 682100cbf63ec3e1426fde2d38adb4c175b9269a Mon Sep 17 00:00:00 2001 From: tomo Date: Fri, 25 Jun 1999 07:31:46 +0000 Subject: [PATCH] Sync up with r21-2-17-1999-06-24-19. --- tests/ChangeLog | 4 + tests/automated/base64-tests.el | 248 --------------------------------------- tests/glyph-test.el | 24 ++++ 3 files changed, 28 insertions(+), 248 deletions(-) delete mode 100644 tests/automated/base64-tests.el diff --git a/tests/ChangeLog b/tests/ChangeLog index 080e89a..14c70cd 100644 --- a/tests/ChangeLog +++ b/tests/ChangeLog @@ -1,3 +1,7 @@ +1999-06-22 XEmacs Build Bot + + * XEmacs 21.2.17 is released + 1999-06-11 XEmacs Build Bot * XEmacs 21.2.16 is released diff --git a/tests/automated/base64-tests.el b/tests/automated/base64-tests.el deleted file mode 100644 index 3c11ec2..0000000 --- a/tests/automated/base64-tests.el +++ /dev/null @@ -1,248 +0,0 @@ -;; Copyright (C) 1999 Free Software Foundation, Inc. - -;; Author: Hrvoje Niksic -;; Maintainer: Hrvoje Niksic -;; Created: 1999 -;; Keywords: tests - -;; 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 2, 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; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. - -;;; Synched up with: Not in FSF. - -;;; Commentary: - -;; Test base64 functions. -;; See test-harness.el for instructions on how to run these tests. - -(eval-when-compile - (condition-case nil - (require 'test-harness) - (file-error - (push "." load-path) - (when (and (boundp 'load-file-name) (stringp load-file-name)) - (push (file-name-directory load-file-name) load-path)) - (require 'test-harness)))) - -;; We need to test the buffer and string functions. We do it by -;; testing them in various circumstances, asserting the same result, -;; and returning that result. - -(defvar bt-test-buffer (get-buffer-create " *base64-workhorse*")) - -(defun bt-base64-encode-string (string &optional no-line-break) - (let ((string-result (base64-encode-string string no-line-break)) - length) - (with-current-buffer bt-test-buffer - ;; the whole buffer - (erase-buffer) - (insert string) - (setq length (base64-encode-region (point-min) (point-max) no-line-break)) - (Assert (eq length (- (point-max) (point-min)))) - (Assert (equal (buffer-string) string-result)) - ;; partial - (erase-buffer) - (insert "random junk........\0\0';'eqwrkw[erpqf") - (let ((p1 (point)) p2) - (insert string) - (setq p2 (point-marker)) - (insert "...more random junk.q,f3/.qrm314.r,m2typ' 2436T@W$^@$#^T@") - (setq length (base64-encode-region p1 p2 no-line-break)) - (Assert (eq length (- p2 p1))) - (Assert (equal (buffer-substring p1 p2) string-result)))) - string-result)) - -(defun bt-base64-decode-string (string) - (let ((string-result (base64-decode-string string)) - length) - (with-current-buffer bt-test-buffer - ;; the whole buffer - (erase-buffer) - (insert string) - (setq length (base64-decode-region (point-min) (point-max))) - (cond (string-result - (Assert (eq length (- (point-max) (point-min)))) - (Assert (equal (buffer-string) string-result))) - (t - (Assert (null length)) - ;; The buffer should not have been modified. - (Assert (equal (buffer-string) string)))) - ;; partial - (erase-buffer) - (insert "random junk........\0\0';'eqwrkw[erpqf") - (let ((p1 (point)) p2) - (insert string) - (setq p2 (point-marker)) - (insert "...more random junk.q,f3/.qrm314.\0\0r,m2typ' 2436T@W$^@$#T@") - (setq length (base64-decode-region p1 p2)) - (cond (string-result - (Assert (eq length (- p2 p1))) - (Assert (equal (buffer-substring p1 p2) string-result))) - (t - (Assert (null length)) - ;; The buffer should not have been modified. - (Assert (equal (buffer-substring p1 p2) string)))))) - string-result)) - -(defun bt-remove-newlines (str) - (apply #'string (delete ?\n (mapcar #'identity str)))) - -(defconst bt-allchars - (let ((str (make-string 256 ?\0))) - (dotimes (i 256) - (aset str i (int-char i))) - str)) - -(defconst bt-test-strings - `(("" "") - ("foo" "Zm9v") - ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" - "QUJDREVGR0hJSktMTU5PUFFSU1RVVldYWVphYmNkZWZnaGlqa2xtbm9wcXJzdHV2d3h5ejAx -MjM0NTY3ODk=") - (,bt-allchars - "AAECAwQFBgcICQoLDA0ODxAREhMUFRYXGBkaGxwdHh8gISIjJCUmJygpKissLS4vMDEyMzQ1 -Njc4OTo7PD0+P0BBQkNERUZHSElKS0xNTk9QUVJTVFVWV1hZWltcXV5fYGFiY2RlZmdoaWpr -bG1ub3BxcnN0dXZ3eHl6e3x9fn+AgYKDhIWGh4iJiouMjY6PkJGSk5SVlpeYmZqbnJ2en6Ch -oqOkpaanqKmqq6ytrq+wsbKztLW2t7i5uru8vb6/wMHCw8TFxsfIycrLzM3Oz9DR0tPU1dbX -2Nna29zd3t/g4eLj5OXm5+jp6uvs7e7v8PHy8/T19vf4+fr7/P3+/w==") - )) - -;;----------------------------------------------------- -;; Encoding base64 -;;----------------------------------------------------- - -(loop for (raw encoded) in bt-test-strings do - (Assert (equal (bt-base64-encode-string raw) encoded)) - ;; test the NO-LINE-BREAK flag - (Assert (equal (bt-base64-encode-string raw t) (bt-remove-newlines encoded)))) - -;; When Mule is around, Lisp programmers should make sure that the -;; buffer contains only characters whose `char-int' is in the [0, 256) -;; range. If this condition is not satisfied for any character, an -;; error is signaled. -(when (featurep 'mule) - ;; #### remove subtraction of 128 -- no longer needed with make-char - ;; patch! - (let* ((mule-string (format "Hrvoje Nik%ci%c" - ;; scaron == 185 in Latin 2 - (make-char 'latin-iso8859-2 (- 185 128)) - ;; cacute == 230 in Latin 2 - (make-char 'latin-iso8859-2 (- 230 128))))) - (Check-Error-Message error "Non-ascii character in base64 input" - (bt-base64-encode-string mule-string)))) - -;;----------------------------------------------------- -;; Decoding base64 -;;----------------------------------------------------- - -(loop for (raw encoded) in bt-test-strings do - (Assert (equal (bt-base64-decode-string encoded) raw)) - (Assert (equal (bt-base64-decode-string (bt-remove-newlines encoded)) raw))) - -;; Test errors -(dolist (str `("foo" "AAC" "foo\0bar" "====" "Zm=9v" ,bt-allchars)) - (Check-Error error (base64-decode-string str))) - -;; base64-decode-string should ignore non-base64 characters anywhere -;; in the string. We test this in the cheesiest manner possible, by -;; inserting non-base64 chars at the beginning, at the end, and in the -;; middle of the string. - -(defconst bt-base64-chars '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J - ;; sometimes I hate Emacs indentation. - ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T - ?U ?V ?W ?X ?Y ?Z ?a ?b ?c ?d - ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n - ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x - ?y ?z ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 - ?8 ?9 ?+ ?/ ?=)) - -(defconst bt-nonbase64-chars (set-difference (mapcar #'identity bt-allchars) - bt-base64-chars)) - -(when nil - ;; This code crashes XEmacs! This requires further investigation. - ;; I'm running Linux, and for me, XEmacs crashes in - ;; Fmapconcat()->mapcar1(), after a GC that thrashes the stack. - ;; Raymond Toy reports a similar crash under Solaris. - (loop for (raw encoded) in bt-test-strings do - (unless (equal raw "") - (let* ((middlepos (/ (1+ (length encoded)) 2)) - (left (substring encoded 0 middlepos)) - (right (substring encoded middlepos))) - ;; Whitespace at the beginning, end, and middle. - (let ((mangled (concat bt-nonbase64-chars left bt-nonbase64-chars right - bt-nonbase64-chars))) - (Assert (equal (bt-base64-decode-string mangled) raw))) - - ;; Whitespace between every char. - (let ((mangled (concat bt-nonbase64-chars - ;; ENCODED with bt-nonbase64-chars - ;; between every character. - (mapconcat #'char-to-string encoded - (apply #'string bt-nonbase64-chars)) - bt-nonbase64-chars))) - (Assert (equal (bt-base64-decode-string mangled) raw)))))) - ) - -;;----------------------------------------------------- -;; Mixed... -;;----------------------------------------------------- - -;; The whole point of base64 is to ensure that an arbitrary sequence -;; of bytes passes through gateway hellfire unscathed, protected by -;; the asbestos suit of base64. Here we test that -;; (base64-decode-string (base64-decode-string FOO)) equals FOO for -;; any FOO we can think of. The following stunts stress-test -;; practically all aspects of the encoding and decoding process. - -(loop for (raw ignored) in bt-test-strings do - (Assert (equal (bt-base64-decode-string - (bt-base64-encode-string raw)) - raw)) - (Assert (equal (bt-base64-decode-string - (bt-base64-decode-string - (bt-base64-encode-string - (bt-base64-encode-string raw)))) - raw)) - (Assert (equal (bt-base64-decode-string - (bt-base64-decode-string - (bt-base64-decode-string - (bt-base64-encode-string - (bt-base64-encode-string - (bt-base64-encode-string raw)))))) - raw)) - (Assert (equal (bt-base64-decode-string - (bt-base64-decode-string - (bt-base64-decode-string - (bt-base64-decode-string - (bt-base64-encode-string - (bt-base64-encode-string - (bt-base64-encode-string - (bt-base64-encode-string raw)))))))) - raw)) - (Assert (equal (bt-base64-decode-string - (bt-base64-decode-string - (bt-base64-decode-string - (bt-base64-decode-string - (bt-base64-decode-string - (bt-base64-encode-string - (bt-base64-encode-string - (bt-base64-encode-string - (bt-base64-encode-string - (bt-base64-encode-string raw)))))))))) - raw))) diff --git a/tests/glyph-test.el b/tests/glyph-test.el index d0aaf9a..31bdc9a 100644 --- a/tests/glyph-test.el +++ b/tests/glyph-test.el @@ -25,6 +25,29 @@ :face modeline-mousable :descriptor "ok" :callback foo :selected t]))) + +;; tree view +(set-extent-begin-glyph + (make-extent (point) (point)) + (setq tree (make-glyph + [tree :width 10 + :descriptor "My Tree" + :properties (:items (["One" foo] + (["Two" foo] + ["Four" foo] + "Six") + "Three"))]))) + +;; tab control +(set-extent-begin-glyph + (make-extent (point) (point)) + (setq tab (make-glyph + [tab :descriptor "My Tab" + :face default + :properties (:items (["One" foo] + ["Two" foo] + ["Three" foo]))]))) + ;; progress gauge (set-extent-begin-glyph (make-extent (point) (point)) @@ -63,6 +86,7 @@ (set-extent-begin-glyph (make-extent (point) (point)) (make-glyph [button :descriptor ["A Big Button" foo ]])) + ;; edit box (set-extent-begin-glyph (make-extent (point) (point)) -- 1.7.10.4