me
/
guix
Archived
1
0
Fork 0
Code

marionette: Preserve screen dumps on failures. 

This is to make it easier to debug test failures involving
'wait-for-screen-text': the screendump image used for the OCR is now preserved
for inspection when 'wait-for-screen-text' fails.

* gnu/build/marionette.scm (marionette-screen-text): Return the screendump
image file as the second value.  Adjust doc.
(wait-for-screen-text): Add the preserved screendump image file name to the
error message.  Adjust doc.
master
Maxim Cournoyer 2022-09-19 22:06:54 -04:00
parent 21f641e9fa
commit 4cce84b247
No known key found for this signature in database
GPG Key ID: 1260E46482E63562
1 changed files with 29 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
gnu/build/marionette.scm
View File

@ -22,6 +22,7 @@
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-64) #:use-module (srfi srfi-64)
#:use-module (srfi srfi-71)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 popen) #:use-module (ice-9 popen)
@ -311,18 +312,20 @@ Monitor\")."
(define* (marionette-screen-text marionette #:key (ocr "ocrad")) (define* (marionette-screen-text marionette #:key (ocr "ocrad"))
"Take a screenshot of MARIONETTE, perform optical character "Take a screenshot of MARIONETTE, perform optical character
recognition (OCR), and return the text read from the screen as a string. Do recognition (OCR), and return the text read from the screen as a string, along
this by invoking OCR, which should be the file name of GNU Ocrad's the screen dump image used. Do this by invoking OCR, which should be the file
@command{ocrad} or Tesseract OCR's @command{tesseract} command." name of GNU Ocrad's@command{ocrad} or Tesseract OCR's @command{tesseract}
command. The screen dump image returned as the second value should be deleted
if it is not needed."
(define image (string-append (tmpnam) ".ppm")) (define image (string-append (tmpnam) ".ppm"))
;; Use the QEMU Monitor to save an image of the screen to the host. ;; Use the QEMU Monitor to save an image of the screen to the host.
(marionette-control (string-append "screendump " image) marionette) (marionette-control (string-append "screendump " image) marionette)
;; Process it via the OCR. ;; Process it via the OCR.
(cond (cond
((string-contains ocr "ocrad") ((string-contains ocr "ocrad")
(invoke-ocrad-ocr image #:ocrad ocr)) (values (invoke-ocrad-ocr image #:ocrad ocr) image))
((string-contains ocr "tesseract") ((string-contains ocr "tesseract")
(invoke-tesseract-ocr image #:tesseract ocr)) (values (invoke-tesseract-ocr image #:tesseract ocr) image))
(else (error "unsupported ocr command")))) (else (error "unsupported ocr command"))))
(define* (wait-for-screen-text marionette predicate (define* (wait-for-screen-text marionette predicate
@ -330,21 +333,34 @@ this by invoking OCR, which should be the file name of GNU Ocrad's
(ocr "ocrad") (ocr "ocrad")
(timeout 30)) (timeout 30))
"Wait for TIMEOUT seconds or until the screen text on MARIONETTE matches "Wait for TIMEOUT seconds or until the screen text on MARIONETTE matches
PREDICATE, whichever comes first. Raise an error when TIMEOUT is exceeded." PREDICATE, whichever comes first. Raise an error when TIMEOUT is exceeded.
The error contains the recognized text along the preserved file name of the
screen dump, which is relative to the current working directory."
(define start (define start
(car (gettimeofday))) (car (gettimeofday)))
(define end (define end
(+ start timeout)) (+ start timeout))
(let loop ((last-text #f)) (let loop ((last-text #f)
(last-screendump #f))
(if (> (car (gettimeofday)) end) (if (> (car (gettimeofday)) end)
(error "'wait-for-screen-text' timeout" 'ocr-text: last-text) (let ((screendump-backup (string-drop last-screendump 5)))
(let ((text (marionette-screen-text marionette #:ocr ocr))) ;; Move the file from /tmp/fileXXXXXX.pmm to the current working
(or (predicate text) ;; directory, so that it is preserved in the test derivation output.
(begin (copy-file last-screendump screendump-backup)
(delete-file last-screendump)
(error "'wait-for-screen-text' timeout"
'ocr-text: last-text
'screendump: screendump-backup))
(let* ((text screendump (marionette-screen-text marionette #:ocr ocr))
(result (predicate text)))
(cond (result
(delete-file screendump)
result)
(else
(sleep 1) (sleep 1)
(loop text))))))) (loop text screendump)))))))
(define %qwerty-us-keystrokes (define %qwerty-us-keystrokes
;; Maps "special" characters to their keystrokes. ;; Maps "special" characters to their keystrokes.