procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

; Fix SHR test on MS-Windows

Browse source 
* test/lisp/net/shr-tests.el (shr-test/zoom-image): Ensure the image URL
is properly formatted: it should always have 3 slashes after "file:".
This commit is contained in:
Jim Porter 2024-06-28 10:40:05 -07:00
parent 57880f597c
commit eaf2dc96c1
1 changed files with 9 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
test/lisp/net/shr-tests.el
View file

@ -136,13 +136,15 @@ settings, then once more for each (OPTION . VALUE) pair.")
(ert-deftest shr-test/zoom-image () (ert-deftest shr-test/zoom-image ()
"Test that `shr-zoom-image' properly replaces the original image." "Test that `shr-zoom-image' properly replaces the original image."
(skip-unless (bound-and-true-p image-types)) (skip-unless (bound-and-true-p image-types))
(let ((image (expand-file-name "data/image/blank-100x200.png" (let* ((image (expand-file-name "data/image/blank-100x200.png"
(getenv "EMACS_TEST_DIRECTORY")))) (getenv "EMACS_TEST_DIRECTORY")))
(image-url (concat "file://" (if (string-prefix-p "/" image)
image (concat "/" image)))))
(dolist (alt '(nil "" "nothing to see here")) (dolist (alt '(nil "" "nothing to see here"))
(with-temp-buffer (with-temp-buffer
(ert-info ((format "image with alt=%S" alt)) (ert-info ((format "image with alt=%S" alt))
(let ((attrs (if alt (format " alt=\"%s\"" alt) ""))) (let ((attrs (if alt (format " alt=\"%s\"" alt) "")))
(insert (format "<img src=\"file://%s\" %s" image attrs))) (insert (format "<img src=\"%s\" %s" image-url attrs)))
(cl-letf* (;; Pretend we're a graphical display. (cl-letf* (;; Pretend we're a graphical display.
((symbol-function 'display-graphic-p) #'always) ((symbol-function 'display-graphic-p) #'always)
((symbol-function 'url-queue-retrieve) ((symbol-function 'url-queue-retrieve)
@ -161,11 +163,13 @@ settings, then once more for each (OPTION . VALUE) pair.")
;; Render the document. ;; Render the document.
(erase-buffer) (erase-buffer)
(shr-insert-document dom) (shr-insert-document dom)
(shr-test-wait-for (lambda () (= put-image-calls 1))) (shr-test-wait-for (lambda () (= put-image-calls 1))
"Timed out waiting for initial load")
;; Now zoom the image. ;; Now zoom the image.
(goto-char (point-min)) (goto-char (point-min))
(shr-zoom-image) (shr-zoom-image)
(shr-test-wait-for (lambda () (= put-image-calls 2))) (shr-test-wait-for (lambda () (= put-image-calls 2))
"Timed out waiting to zoom image")
;; Check that we got a sliced image. ;; Check that we got a sliced image.
(let ((slice-count 0)) (let ((slice-count 0))
(goto-char (point-min)) (goto-char (point-min))