diff --git a/Makefile b/Makefile index f97481bdd..b02bc4ce6 100644 --- a/Makefile +++ b/Makefile @@ -49,7 +49,6 @@ ELFILES = \ haskell-show.el \ haskell-simple-indent.el \ haskell-sort-imports.el \ - haskell-str.el \ haskell-string.el \ haskell-unicode-input-method.el \ haskell-utils.el \ diff --git a/haskell-indent.el b/haskell-indent.el index fea8eb008..217aaa9c1 100644 --- a/haskell-indent.el +++ b/haskell-indent.el @@ -658,8 +658,8 @@ Returns the location of the start of the comment, nil otherwise." (string-match "where[ \t]*" haskell-indent-current-line-first-ident)) (diff-first ; not a function def with the same name (or (null valname-string) - (not (string= (haskell-trim valname-string) - (haskell-trim haskell-indent-current-line-first-ident))))) + (not (string= (haskell-string-trim valname-string) + (haskell-string-trim haskell-indent-current-line-first-ident))))) ;; (is-type-def ;; (and rhs-sign (eq (char-after rhs-sign) ?\:))) diff --git a/haskell-interactive-mode.el b/haskell-interactive-mode.el index 527da3b67..22f6a7e7d 100644 --- a/haskell-interactive-mode.el +++ b/haskell-interactive-mode.el @@ -416,7 +416,7 @@ SESSION, otherwise operate on the current buffer. (message "%s" (concat (car lines) (if (and (cdr lines) (stringp (cadr lines))) - (format " [ %s .. ]" (haskell-string-take (haskell-trim (cadr lines)) 10)) + (format " [ %s .. ]" (haskell-string-take (haskell-string-trim (cadr lines)) 10)) "")))))) (defun haskell-interactive-mode-tab () diff --git a/haskell-process.el b/haskell-process.el index ecf890082..374eadb24 100644 --- a/haskell-process.el +++ b/haskell-process.el @@ -29,7 +29,7 @@ (require 'haskell-compat) (require 'haskell-session) (require 'haskell-customize) -(require 'haskell-str) +(require 'haskell-string) (defconst haskell-process-prompt-regex "\4" "Used for delimiting command replies. 4 is End of Transmission.") @@ -272,17 +272,17 @@ This uses `accept-process-output' internally." (defun haskell-process-get-repl-completions (process inputstr) "Perform `:complete repl ...' query for INPUTSTR using PROCESS." (let* ((reqstr (concat ":complete repl " - (haskell-str-literal-encode inputstr))) + (haskell-string-literal-encode inputstr))) (rawstr (haskell-process-queue-sync-request process reqstr))) (if (string-prefix-p "unknown command " rawstr) (error "GHCi lacks `:complete' support") (let* ((s1 (split-string rawstr "\r?\n" t)) - (cs (mapcar #'haskell-str-literal-decode (cdr s1))) + (cs (mapcar #'haskell-string-literal-decode (cdr s1))) (h0 (car s1))) ;; " " (unless (string-match "\\`\\([0-9]+\\) \\([0-9]+\\) \\(\".*\"\\)\\'" h0) (error "Invalid `:complete' response")) (let ((cnt1 (match-string 1 h0)) - (h1 (haskell-str-literal-decode (match-string 3 h0)))) + (h1 (haskell-string-literal-decode (match-string 3 h0)))) (unless (= (string-to-number cnt1) (length cs)) (error "Lengths inconsistent in `:complete' reponse")) (cons h1 cs)))))) diff --git a/haskell-show.el b/haskell-show.el index b962763e4..69560047c 100644 --- a/haskell-show.el +++ b/haskell-show.el @@ -51,7 +51,7 @@ (defun haskell-show-parse-and-insert (given) "Parse a `string' containing a Show instance value and insert it pretty printed into the current buffer." - (when (not (string= "" (haskell-trim given))) + (when (not (string= "" (haskell-string-trim given))) (let ((current-column (- (point) (line-beginning-position))) (result (haskell-show-parse given))) diff --git a/haskell-str.el b/haskell-str.el deleted file mode 100644 index 9fe2df491..000000000 --- a/haskell-str.el +++ /dev/null @@ -1,167 +0,0 @@ -;;; haskell-str.el --- Haskell related string utilities - -;; Copyright (C) 2013 Herbert Valerio Riedel - -;; Author: Herbert Valerio Riedel - -;; This file is not part of GNU Emacs. - -;; This file 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. - -;; This file 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 this program. If not, see . - -;;; Commentary: - -;;; Todo: - -;; - write ERT tests - -;;; Code: - -(defun haskell-str-trim (string) - "Remove whitespace around STRING. - -A Whitespace character is defined in the Haskell Report as follows - - whitechar -> newline | vertab | space | tab | uniWhite - newline -> return linefeed | return | linefeed | formfeed - uniWhite -> any Unicode character defined as whitespace - -Note: The implementation currently only supports ASCII - white-space characters, i.e. the implemention doesn't - consider uniWhite." - - (let ((s1 (if (string-match "[\t\n\v\f\r ]+\\'" string) (replace-match "" t t string) string))) - (if (string-match "\\`[\t\n\v\f\r ]+" s1) (replace-match "" t t s1) s1))) - -(defun haskell-str-only-spaces-p (string) - "Return t if STRING contains only whitespace (or is empty)." - (string= "" (haskell-str-trim string))) - -(defun haskell-str-take (string n) - "Return (up to) N character length prefix of STRING." - (substring string 0 (min (length string) n))) - -(defconst haskell-str-literal-encode-ascii-array - [ "\\NUL" "\\SOH" "\\STX" "\\ETX" "\\EOT" "\\ENQ" "\\ACK" "\\a" "\\b" "\\t" "\\n" "\\v" "\\f" "\\r" "\\SO" "\\SI" "\\DLE" "\\DC1" "\\DC2" "\\DC3" "\\DC4" "\\NAK" "\\SYN" "\\ETB" "\\CAN" "\\EM" "\\SUB" "\\ESC" "\\FS" "\\GS" "\\RS" "\\US" " " "!" "\\\"" "#" "$" "%" "&" "'" "(" ")" "*" "+" "," "-" "." "/" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" ":" ";" "<" "=" ">" "?" "@" "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" "[" "\\\\" "]" "^" "_" "`" "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" "{" "|" "}" "~" "\\DEL" ] - "Array of encodings for 7-bit ASCII character points indexed by ASCII value.") - -(defun haskell-str-literal-encode (str &optional no-quotes) - "Encode STR according Haskell escape rules using 7-bit ASCII representation. - -The serialization has been implement to closely match the -behaviour of GHC's Show instance for Strings. - -If NO-QUOTES is non-nil, omit wrapping result in quotes. - -This is the dual operation to `haskell-str-literal-decode'." - - (let ((lastc -1)) - (let ((encode (lambda (c) - (let ((lc lastc)) - (setq lastc c) - (if (>= c 128) ;; if non-ASCII code point - (format "\\%d" c) - ;; else, for ASCII code points - (if (or (and (= lc 14) (= c ?H)) ;; "\SO\&H" - (and (>= lc 128) (>= c ?0) (<= c ?9))) ;; "\123\&4" - (concat "\\&" (aref haskell-str-literal-encode-ascii-array c)) - (aref haskell-str-literal-encode-ascii-array c) - )))))) - - (if no-quotes - (mapconcat encode str "") - (concat "\"" (mapconcat encode str "") "\""))))) - -(defconst haskell-str-literal-escapes-regexp - (concat "[\\]\\(?:" - (regexp-opt (append - (mapcar (lambda (c) (format "%c" c)) - "abfnrtv\\\"'&") ;; "charesc" escape sequences - (mapcar (lambda (c) (format "^%c" c)) - "ABCDEFGHIJKLMNOPQRSTUVWXYZ@[\\]^_") ;; "cntrl" escape sequences - (mapcar (lambda (s) (format "%s" s)) - (split-string "NUL SOH STX ETX EOT ENQ ACK BEL BS HT LF VT FF CR - SO SI DLE DC1 DC2 DC3 DC4 NAK SYN ETB CAN EM SUB ESC - FS GS RS US SP DEL")))) ;; "ascii" (w\o "cntrl") escape sequences - "\\|" "[\t\n\v\f\r ]+[\\]" ;; whitespace gaps - "\\|" "[0-9]+" ;; decimal escape sequence - "\\|" "o[0-7]+" ;; octal escape sequence - "\\|" "x[0-9a-f]+" ;; hex escape sequence - "\\)?") ;; everything else is an invalid escape sequence - "Regexp for matching escape codes in string literals. -See Haskell Report Sect 2.6, -URL `http://www.haskell.org/onlinereport/haskell2010/haskellch2.html#x7-200002.6', -for more details.") - -(defconst haskell-str-literal-decode1-table - (let ((h (make-hash-table :test 'equal))) - (mapc (lambda (c) (puthash (concat "\\" (car c)) (cdr c) h)) - '(;; ascii-escapes - ("NUL" . "\x00") ("SOH" . "\x01") ("STX" . "\x02") ("ETX" . "\x03") ("EOT" . "\x04") ("ENQ" . "\x05") - ("ACK" . "\x06") ("BEL" . "\x07") ("BS" . "\x08") ("HT" . "\x09") ("LF" . "\x0a") ("VT" . "\x0b") - ("FF" . "\x0c") ("CR" . "\x0d") ("SO" . "\x0e") ("SI" . "\x0f") ("DLE" . "\x10") ("DC1" . "\x11") - ("DC2" . "\x12") ("DC3" . "\x13") ("DC4" . "\x14") ("NAK" . "\x15") ("SYN" . "\x16") ("ETB" . "\x17") - ("CAN" . "\x18") ("EM" . "\x19") ("SUB" . "\x1a") ("ESC" . "\x1b") ("FS" . "\x1c") ("GS" . "\x1d") - ("RS" . "\x1e") ("US" . "\x1f") ("SP" . "\x20") ("DEL" . "\x7f" ) - ;; C-compatible single-char escape sequences - ("a" . "\x07") ("b" . "\x08") ("f" . "\x0c") ("n" . "\x0a") ("r" . "\x0d") ("t" . "\x09") ("v" . "\x0b") - ;; trivial escapes - ("\\" . "\\") ("\"" . "\"") ("'" . "'") - ;; "empty" escape - ("&" . ""))) - h) - "Hash table containing irregular escape sequences and their decoded strings. -Used by `haskell-str-literal-decode1'.") - -(defun haskell-str-literal-decode1 (l) - "Decode a single string literal escape sequence. -L must contain exactly one escape sequence. -This is an internal function used by `haskell-str-literal-decode'." - (let ((case-fold-search nil)) - (cond - ((gethash l haskell-str-literal-decode1-table)) - ((string-match "\\`[\\][0-9]+\\'" l) (char-to-string (string-to-number (substring l 1) 10))) - ((string-match "\\`[\\]x[[:xdigit:]]+\\'" l) (char-to-string (string-to-number (substring l 2) 16))) - ((string-match "\\`[\\]o[0-7]+\\'" l) (char-to-string (string-to-number (substring l 2) 8))) - ((string-match "\\`[\\]\\^[@-_]\\'" l) (char-to-string (- (aref l 2) ?@))) ;; "cntrl" escapes - ((string-match "\\`[\\][\t\n\v\f\r ]+[\\]\\'" l) "") ;; whitespace gap - (t (error "Invalid escape sequence"))))) - -(defun haskell-str-literal-decode (estr &optional no-quotes) - "Decode a Haskell string-literal. -If NO-QUOTES is nil, ESTR must be surrounded by quotes. - -This is the dual operation to `haskell-str-literal-encode'." - (if (and (not no-quotes) - (string-match-p "\\`\"[^\\\"[:cntrl:]]*\"\\'" estr)) - (substring estr 1 -1) ;; optimized fast-path for trivial strings - (let ((s (if no-quotes ;; else: do general decoding - estr - (if (string-match-p "\\`\".*\"\\'" estr) - (substring estr 1 -1) - (error "String literal must be delimited by quotes")))) - (case-fold-search nil)) - (replace-regexp-in-string haskell-str-literal-escapes-regexp #'haskell-str-literal-decode1 s t t)))) - -(defun haskell-str-ellipsize (string n) - "Return STRING truncated to (at most) N characters. -If truncation occured, last character in string is replaced by `…'. -See also `haskell-str-take'." - (cond - ((<= (length string) n) string) ;; no truncation needed - ((< n 1) "") - (t (concat (substring string 0 (1- n)) "…")))) - -(provide 'haskell-str) - -;;; haskell-str.el ends here diff --git a/haskell-string.el b/haskell-string.el index b471ef7d7..cb049625e 100644 --- a/haskell-string.el +++ b/haskell-string.el @@ -1,18 +1,167 @@ -;;;###autoload -(defun haskell-trim (string) - (replace-regexp-in-string - "^[ \t\n]+" "" - (replace-regexp-in-string - "[ \t\n]+$" "" - string))) - -;;;###autoload +;;; haskell-string.el --- Haskell related string utilities + +;; Copyright (C) 2013 Herbert Valerio Riedel + +;; Author: Herbert Valerio Riedel + +;; This file is not part of GNU Emacs. + +;; This file 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. + +;; This file 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 this program. If not, see . + +;;; Commentary: + +;;; Todo: + +;; - write ERT tests + +;;; Code: + +(defun haskell-string-trim (string) + "Remove whitespace around STRING. + +A Whitespace character is defined in the Haskell Report as follows + + whitechar -> newline | vertab | space | tab | uniWhite + newline -> return linefeed | return | linefeed | formfeed + uniWhite -> any Unicode character defined as whitespace + +Note: The implementation currently only supports ASCII + white-space characters, i.e. the implemention doesn't + consider uniWhite." + + (let ((s1 (if (string-match "[\t\n\v\f\r ]+\\'" string) (replace-match "" t t string) string))) + (if (string-match "\\`[\t\n\v\f\r ]+" s1) (replace-match "" t t s1) s1))) + +(defun haskell-string-only-spaces-p (string) + "Return t if STRING contains only whitespace (or is empty)." + (string= "" (haskell-string-trim string))) + (defun haskell-string-take (string n) - "Take n chars from string." - (substring string - 0 - (min (length string) n))) + "Return (up to) N character length prefix of STRING." + (substring string 0 (min (length string) n))) + +(defconst haskell-string-literal-encode-ascii-array + [ "\\NUL" "\\SOH" "\\STX" "\\ETX" "\\EOT" "\\ENQ" "\\ACK" "\\a" "\\b" "\\t" "\\n" "\\v" "\\f" "\\r" "\\SO" "\\SI" "\\DLE" "\\DC1" "\\DC2" "\\DC3" "\\DC4" "\\NAK" "\\SYN" "\\ETB" "\\CAN" "\\EM" "\\SUB" "\\ESC" "\\FS" "\\GS" "\\RS" "\\US" " " "!" "\\\"" "#" "$" "%" "&" "'" "(" ")" "*" "+" "," "-" "." "/" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" ":" ";" "<" "=" ">" "?" "@" "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" "[" "\\\\" "]" "^" "_" "`" "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" "{" "|" "}" "~" "\\DEL" ] + "Array of encodings for 7-bit ASCII character points indexed by ASCII value.") + +(defun haskell-string-literal-encode (str &optional no-quotes) + "Encode STR according Haskell escape rules using 7-bit ASCII representation. + +The serialization has been implement to closely match the +behaviour of GHC's Show instance for Strings. + +If NO-QUOTES is non-nil, omit wrapping result in quotes. + +This is the dual operation to `haskell-string-literal-decode'." + + (let ((lastc -1)) + (let ((encode (lambda (c) + (let ((lc lastc)) + (setq lastc c) + (if (>= c 128) ;; if non-ASCII code point + (format "\\%d" c) + ;; else, for ASCII code points + (if (or (and (= lc 14) (= c ?H)) ;; "\SO\&H" + (and (>= lc 128) (>= c ?0) (<= c ?9))) ;; "\123\&4" + (concat "\\&" (aref haskell-string-literal-encode-ascii-array c)) + (aref haskell-string-literal-encode-ascii-array c) + )))))) -(defun haskell-string ()) + (if no-quotes + (mapconcat encode str "") + (concat "\"" (mapconcat encode str "") "\""))))) + +(defconst haskell-string-literal-escapes-regexp + (concat "[\\]\\(?:" + (regexp-opt (append + (mapcar (lambda (c) (format "%c" c)) + "abfnrtv\\\"'&") ;; "charesc" escape sequences + (mapcar (lambda (c) (format "^%c" c)) + "ABCDEFGHIJKLMNOPQRSTUVWXYZ@[\\]^_") ;; "cntrl" escape sequences + (mapcar (lambda (s) (format "%s" s)) + (split-string "NUL SOH STX ETX EOT ENQ ACK BEL BS HT LF VT FF CR + SO SI DLE DC1 DC2 DC3 DC4 NAK SYN ETB CAN EM SUB ESC + FS GS RS US SP DEL")))) ;; "ascii" (w\o "cntrl") escape sequences + "\\|" "[\t\n\v\f\r ]+[\\]" ;; whitespace gaps + "\\|" "[0-9]+" ;; decimal escape sequence + "\\|" "o[0-7]+" ;; octal escape sequence + "\\|" "x[0-9a-f]+" ;; hex escape sequence + "\\)?") ;; everything else is an invalid escape sequence + "Regexp for matching escape codes in string literals. +See Haskell Report Sect 2.6, +URL `http://www.haskell.org/onlinereport/haskell2010/haskellch2.html#x7-200002.6', +for more details.") + +(defconst haskell-string-literal-decode1-table + (let ((h (make-hash-table :test 'equal))) + (mapc (lambda (c) (puthash (concat "\\" (car c)) (cdr c) h)) + '(;; ascii-escapes + ("NUL" . "\x00") ("SOH" . "\x01") ("STX" . "\x02") ("ETX" . "\x03") ("EOT" . "\x04") ("ENQ" . "\x05") + ("ACK" . "\x06") ("BEL" . "\x07") ("BS" . "\x08") ("HT" . "\x09") ("LF" . "\x0a") ("VT" . "\x0b") + ("FF" . "\x0c") ("CR" . "\x0d") ("SO" . "\x0e") ("SI" . "\x0f") ("DLE" . "\x10") ("DC1" . "\x11") + ("DC2" . "\x12") ("DC3" . "\x13") ("DC4" . "\x14") ("NAK" . "\x15") ("SYN" . "\x16") ("ETB" . "\x17") + ("CAN" . "\x18") ("EM" . "\x19") ("SUB" . "\x1a") ("ESC" . "\x1b") ("FS" . "\x1c") ("GS" . "\x1d") + ("RS" . "\x1e") ("US" . "\x1f") ("SP" . "\x20") ("DEL" . "\x7f" ) + ;; C-compatible single-char escape sequences + ("a" . "\x07") ("b" . "\x08") ("f" . "\x0c") ("n" . "\x0a") ("r" . "\x0d") ("t" . "\x09") ("v" . "\x0b") + ;; trivial escapes + ("\\" . "\\") ("\"" . "\"") ("'" . "'") + ;; "empty" escape + ("&" . ""))) + h) + "Hash table containing irregular escape sequences and their decoded strings. +Used by `haskell-string-literal-decode1'.") + +(defun haskell-string-literal-decode1 (l) + "Decode a single string literal escape sequence. +L must contain exactly one escape sequence. +This is an internal function used by `haskell-string-literal-decode'." + (let ((case-fold-search nil)) + (cond + ((gethash l haskell-string-literal-decode1-table)) + ((string-match "\\`[\\][0-9]+\\'" l) (char-to-string (string-to-number (substring l 1) 10))) + ((string-match "\\`[\\]x[[:xdigit:]]+\\'" l) (char-to-string (string-to-number (substring l 2) 16))) + ((string-match "\\`[\\]o[0-7]+\\'" l) (char-to-string (string-to-number (substring l 2) 8))) + ((string-match "\\`[\\]\\^[@-_]\\'" l) (char-to-string (- (aref l 2) ?@))) ;; "cntrl" escapes + ((string-match "\\`[\\][\t\n\v\f\r ]+[\\]\\'" l) "") ;; whitespace gap + (t (error "Invalid escape sequence"))))) + +(defun haskell-string-literal-decode (estr &optional no-quotes) + "Decode a Haskell string-literal. +If NO-QUOTES is nil, ESTR must be surrounded by quotes. + +This is the dual operation to `haskell-string-literal-encode'." + (if (and (not no-quotes) + (string-match-p "\\`\"[^\\\"[:cntrl:]]*\"\\'" estr)) + (substring estr 1 -1) ;; optimized fast-path for trivial strings + (let ((s (if no-quotes ;; else: do general decoding + estr + (if (string-match-p "\\`\".*\"\\'" estr) + (substring estr 1 -1) + (error "String literal must be delimited by quotes")))) + (case-fold-search nil)) + (replace-regexp-in-string haskell-string-literal-escapes-regexp #'haskell-string-literal-decode1 s t t)))) + +(defun haskell-string-ellipsize (string n) + "Return STRING truncated to (at most) N characters. +If truncation occured, last character in string is replaced by `…'. +See also `haskell-string-take'." + (cond + ((<= (length string) n) string) ;; no truncation needed + ((< n 1) "") + (t (concat (substring string 0 (1- n)) "…")))) (provide 'haskell-string) + +;;; haskell-string.el ends here diff --git a/haskell.el b/haskell.el index c2df62781..60b07ec7f 100644 --- a/haskell.el +++ b/haskell.el @@ -27,6 +27,7 @@ (require 'haskell-commands) (require 'haskell-sandbox) (require 'haskell-modules) +(require 'haskell-string) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Basic configuration hooks @@ -270,7 +271,7 @@ (let ((ident (haskell-ident-at-point)) (tags-file-name (haskell-session-tags-filename (haskell-session))) (tags-revert-without-query t)) - (when (not (string= "" (haskell-trim ident))) + (when (not (string= "" (haskell-string-trim ident))) (cond ((file-exists-p tags-file-name) (find-tag ident next-p)) (t (haskell-process-generate-tags ident)))))) diff --git a/tests/haskell-str-tests.el b/tests/haskell-str-tests.el deleted file mode 100644 index 3f10f789f..000000000 --- a/tests/haskell-str-tests.el +++ /dev/null @@ -1,114 +0,0 @@ -;; unit tests for haskell-str.el - -(require 'ert) - -(require 'haskell-str ) ;; implementation under test - -(ert-deftest haskell-str-take () - (should (string= (haskell-str-take "" 0) "")) - (should (string= (haskell-str-take "" 1) "")) - (should (string= (haskell-str-take "" 2) "")) - (should (string= (haskell-str-take "x" 0) "")) - (should (string= (haskell-str-take "x" 1) "x")) - (should (string= (haskell-str-take "x" 2) "x")) - (should (string= (haskell-str-take "x" 3) "x")) - (should (string= (haskell-str-take "xy" 0) "")) - (should (string= (haskell-str-take "xy" 1) "x")) - (should (string= (haskell-str-take "xy" 2) "xy")) - (should (string= (haskell-str-take "xy" 3) "xy")) - (should (string= (haskell-str-take "xyz" 0) "")) - (should (string= (haskell-str-take "xyz" 1) "x")) - (should (string= (haskell-str-take "xyz" 2) "xy")) - (should (string= (haskell-str-take "xyz" 3) "xyz")) - (should (string= (haskell-str-take "xyz" 4) "xyz"))) - -(ert-deftest haskell-str-ellipsize () - (should (string= (haskell-str-ellipsize "" 0) "")) - (should (string= (haskell-str-ellipsize "" 1) "")) - (should (string= (haskell-str-ellipsize "" 2) "")) - (should (string= (haskell-str-ellipsize "x" 0) "")) - (should (string= (haskell-str-ellipsize "x" 1) "x")) - (should (string= (haskell-str-ellipsize "x" 2) "x")) - (should (string= (haskell-str-ellipsize "x" 3) "x")) - (should (string= (haskell-str-ellipsize "xy" 0) "")) - (should (string= (haskell-str-ellipsize "xy" 1) "…")) - (should (string= (haskell-str-ellipsize "xy" 2) "xy")) - (should (string= (haskell-str-ellipsize "xy" 3) "xy")) - (should (string= (haskell-str-ellipsize "xyz" 0) "")) - (should (string= (haskell-str-ellipsize "xyz" 1) "…")) - (should (string= (haskell-str-ellipsize "xyz" 2) "x…")) - (should (string= (haskell-str-ellipsize "xyz" 3) "xyz")) - (should (string= (haskell-str-ellipsize "xyz" 4) "xyz"))) - -(ert-deftest haskell-str-literal-encode-empty () - (should (string= (haskell-str-literal-encode "") "\"\"")) - (should (string= (haskell-str-literal-encode "" t) ""))) - -(ert-deftest haskell-str-literal-decode-empty () - (dolist (s0 (list "\"\"" - "\"\\&\"" - "\"\\&\\&\\&\"" - "\"\\ \\\"" - "\"\\ \\\\ \\\"" - "\"\\&\\ \\\"" - "\"\\ \\\\&\\ \\\"")) - (should (string= "" (haskell-str-literal-decode s0))) - (should (string= "" (haskell-str-literal-decode (substring s0 1 -1) t))))) - -(ert-deftest haskell-str-literal-decode-backslash () - "Test some edge cases involving backslashes." - (dolist (cs (list (cons "\\\\" "\\") - (cons "\\x10" "\x10") - (cons "\\\\x10" "\\x10") - (cons "\\ \\x10" "x10") - (cons "\\ \\ \\x30" " 0") - (cons "\\SO\\&H" "\x0eH") - (cons "\\SOH\\&" "\x01") - (cons "\\n" "\n") - (cons "\\'" "'") - (cons "\\\"" "\"") - (cons "\\SOH" "\x01"))) - (should (string= (cdr cs) - (haskell-str-literal-decode (concat "\"" (car cs) "\"")))) - (should (string= (cdr cs) - (haskell-str-literal-decode (car cs) t))))) - -(defun haskell-str-random (n) - "Generate random N characters long string." - (let ((a ())) - (apply #'string (dotimes (_ n a) - (setq a (cons (random 1024) a)))))) - -(ert-deftest haskell-str-literal-decode-encode () - "Test whether decode+encode is the identity function." - (random "c7430a4") - ;; some edge cases - (dolist (s0 (list "\x0e\x48" ;; '\SO' 'H' - "\x01" ;; '\SOH' - "\x00df\x30" ;; '\223' '0' - "'" - "\'" - "\"" - "\x0e&H" - "\\" - " \\ \\" - "\\\\\"" - (string 40 945 8322 946 8323 8743 947 178 949 178 41) - "x" - "xy" - "\\x123" - "\\ \\x123" - " " - " " - "")) - (should (string= s0 (haskell-str-literal-decode (haskell-str-literal-encode s0)))) - (should (string= s0 (haskell-str-literal-decode (haskell-str-literal-encode s0 t) t)))) - - ;; randomized testing - (dotimes (_ 500) - (dotimes (n 15) - (let* ((s0 (haskell-str-random (+ 1 n))) - (s1 (haskell-str-literal-decode (haskell-str-literal-encode s0))) - (s2 (haskell-str-literal-decode (haskell-str-literal-encode s0 t) t))) - (should (string= s0 s1)) - (should (string= s0 s2)))))) diff --git a/tests/haskell-string-tests.el b/tests/haskell-string-tests.el new file mode 100644 index 000000000..2e906c35b --- /dev/null +++ b/tests/haskell-string-tests.el @@ -0,0 +1,114 @@ +;; unit tests for haskell-string.el + +(require 'ert) + +(require 'haskell-string) ;; implementation under test + +(ert-deftest haskell-string-take () + (should (string= (haskell-string-take "" 0) "")) + (should (string= (haskell-string-take "" 1) "")) + (should (string= (haskell-string-take "" 2) "")) + (should (string= (haskell-string-take "x" 0) "")) + (should (string= (haskell-string-take "x" 1) "x")) + (should (string= (haskell-string-take "x" 2) "x")) + (should (string= (haskell-string-take "x" 3) "x")) + (should (string= (haskell-string-take "xy" 0) "")) + (should (string= (haskell-string-take "xy" 1) "x")) + (should (string= (haskell-string-take "xy" 2) "xy")) + (should (string= (haskell-string-take "xy" 3) "xy")) + (should (string= (haskell-string-take "xyz" 0) "")) + (should (string= (haskell-string-take "xyz" 1) "x")) + (should (string= (haskell-string-take "xyz" 2) "xy")) + (should (string= (haskell-string-take "xyz" 3) "xyz")) + (should (string= (haskell-string-take "xyz" 4) "xyz"))) + +(ert-deftest haskell-string-ellipsize () + (should (string= (haskell-string-ellipsize "" 0) "")) + (should (string= (haskell-string-ellipsize "" 1) "")) + (should (string= (haskell-string-ellipsize "" 2) "")) + (should (string= (haskell-string-ellipsize "x" 0) "")) + (should (string= (haskell-string-ellipsize "x" 1) "x")) + (should (string= (haskell-string-ellipsize "x" 2) "x")) + (should (string= (haskell-string-ellipsize "x" 3) "x")) + (should (string= (haskell-string-ellipsize "xy" 0) "")) + (should (string= (haskell-string-ellipsize "xy" 1) "…")) + (should (string= (haskell-string-ellipsize "xy" 2) "xy")) + (should (string= (haskell-string-ellipsize "xy" 3) "xy")) + (should (string= (haskell-string-ellipsize "xyz" 0) "")) + (should (string= (haskell-string-ellipsize "xyz" 1) "…")) + (should (string= (haskell-string-ellipsize "xyz" 2) "x…")) + (should (string= (haskell-string-ellipsize "xyz" 3) "xyz")) + (should (string= (haskell-string-ellipsize "xyz" 4) "xyz"))) + +(ert-deftest haskell-string-literal-encode-empty () + (should (string= (haskell-string-literal-encode "") "\"\"")) + (should (string= (haskell-string-literal-encode "" t) ""))) + +(ert-deftest haskell-string-literal-decode-empty () + (dolist (s0 (list "\"\"" + "\"\\&\"" + "\"\\&\\&\\&\"" + "\"\\ \\\"" + "\"\\ \\\\ \\\"" + "\"\\&\\ \\\"" + "\"\\ \\\\&\\ \\\"")) + (should (string= "" (haskell-string-literal-decode s0))) + (should (string= "" (haskell-string-literal-decode (substring s0 1 -1) t))))) + +(ert-deftest haskell-string-literal-decode-backslash () + "Test some edge cases involving backslashes." + (dolist (cs (list (cons "\\\\" "\\") + (cons "\\x10" "\x10") + (cons "\\\\x10" "\\x10") + (cons "\\ \\x10" "x10") + (cons "\\ \\ \\x30" " 0") + (cons "\\SO\\&H" "\x0eH") + (cons "\\SOH\\&" "\x01") + (cons "\\n" "\n") + (cons "\\'" "'") + (cons "\\\"" "\"") + (cons "\\SOH" "\x01"))) + (should (string= (cdr cs) + (haskell-string-literal-decode (concat "\"" (car cs) "\"")))) + (should (string= (cdr cs) + (haskell-string-literal-decode (car cs) t))))) + +(defun haskell-string-random (n) + "Generate random N characters long string." + (let ((a ())) + (apply #'string (dotimes (_ n a) + (setq a (cons (random 1024) a)))))) + +(ert-deftest haskell-string-literal-decode-encode () + "Test whether decode+encode is the identity function." + (random "c7430a4") + ;; some edge cases + (dolist (s0 (list "\x0e\x48" ;; '\SO' 'H' + "\x01" ;; '\SOH' + "\x00df\x30" ;; '\223' '0' + "'" + "\'" + "\"" + "\x0e&H" + "\\" + " \\ \\" + "\\\\\"" + (string 40 945 8322 946 8323 8743 947 178 949 178 41) + "x" + "xy" + "\\x123" + "\\ \\x123" + " " + " " + "")) + (should (string= s0 (haskell-string-literal-decode (haskell-string-literal-encode s0)))) + (should (string= s0 (haskell-string-literal-decode (haskell-string-literal-encode s0 t) t)))) + + ;; randomized testing + (dotimes (_ 50) + (dotimes (n 15) + (let* ((s0 (haskell-string-random (+ 1 n))) + (s1 (haskell-string-literal-decode (haskell-string-literal-encode s0))) + (s2 (haskell-string-literal-decode (haskell-string-literal-encode s0 t) t))) + (should (string= s0 s1)) + (should (string= s0 s2))))))