Recompile components in a test-op call in ASDF - common-lisp

I'm trying to find a way to always recompile the components (test-1, test-2, test-3, test-4) every time I call (asdf: test-system: my-system), but I do not know how to do it yet.
(defsystem :my-system/test
:author "noloop"
:description "Test."
:depends-on (:test-lib :my-system)
:components ((:module "test"
:components
((:file "test-1")
(:file "test-2")
(:file "test-3")
(:file "test-4"))))
:perform (test-op (op system)
(symbol-call :test-lib '#:run)))
An imaginary function to show where I want to go:
:perform (test-op (op system)
(progn (recompile-components system)
(symbol-call :test-lib '#:run))))

I solved the question thus:
First I created an asdf.lisp file with a package lib-test-asdf.lisp:
(in-package #:cl-user)
(defpackage #:lib-test-asdf
(:nicknames #:lib-test-asdf)
(:use #:common-lisp
#:asdf)
(:export #:test-file
#:run-lib-test-asdf))
(in-package #:lib-test-asdf)
(defvar *system-test-files* (make-hash-table))
(defclass test-file (asdf:cl-source-file) ())
(defmethod asdf:perform ((op asdf:compile-op) (c test-file))
;; do nothing
)
(defmethod asdf:perform ((op asdf:load-op) (c test-file))
(pushnew c (gethash (asdf:component-system c) *system-test-files*)
:key #'asdf:component-pathname
:test #'equal))
(defun run-lib-test-asdf (system-designator)
"Runs a testing ASDF system."
#+quicklisp (ql:quickload (if (typep system-designator 'asdf:system)
(asdf:component-name system-designator)
system-designator))
#-quicklisp (asdf:load-system system-designator)
(restart-case
(dolist (c (reverse
(gethash (asdf:find-system system-designator) *system-test-files*)))
(restart-case
(asdf:perform 'asdf:load-source-op c)))))
(import 'test-file :asdf)
then I imported the following lib-test-asdf functions into the package.lisp file, where it is my defpackage of lib-test:
(:import-from #:lib-test-asdf
#:test-file
#:run-lib-test-asdf)
I created a new system definition for lib-test-asdf:
(defsystem :lib-test-asdf
:components ((:module "src"
:components
((:file "asdf")))))
With this I can use lib-test like this in my apps:
(defsystem :your-app
;; ...
:in-order-to ((test-op (test-op your-app/test))))
(defsystem :your-app/test
:author "your <your#youremail.com>"
:depends-on (:your-app :lib-test)
:defsystem-depends-on (:lib-test-asdf)
:components ((:module "test"
:components
((:test-file "your-app-test"))))
:perform (test-op :after (op c)
(progn (funcall (intern #.(string :run-lib-test-asdf) :lib-test) c)
(symbol-call :lib-test '#:run))))
To run tests with ASDF:
(asdf:test-system :your-app)
I based on Prove:
https://github.com/fukamachi/prove/blob/master/src/asdf.lisp

Related

Cannot get input stream working in SBCL sb-ext:run-program

While the following works:
(let* ((i (make-string-input-stream "foo bar baz"))
(p (sb-ext:run-program "/bin/cat" '()
:input i :output *trace-output* :wait t)))
(sb-ext:process-close p))
the code below does not - it will stop after writing "001":
(let* ((_1 (format t "001~%"))
(p (sb-ext:run-program "/bin/cat" '()
:input :stream :output *trace-output* :wait t))
(_2 (format t "010~s~%" p))
(s (sb-ext:process-input p)))
(declare (ignore _1 _2))
(format s "foo bar baz~%")
(finish-output s)
(sb-ext:process-close p))
So it seems to silently leave execution in sb-ext:run-program.
This is with SBCL 1.3.6 on Ubuntu 16.04.1.
Any ideas? Thanks in advance, Frank
As I mentioned in the comments, the problem is the :WAIT T argument. It causes the call to SB-EXT:RUN-PROGRAM to not return until the child process exits.
In the first example you passed a string input stream to the child process. cat will read input from the stream, and when the input ends there will be a End of File, so cat exits. In the second example there is no input available for the program, so it's effectively an infinite loop (just like if you run cat on the command line, and don't give any input to it; it will never exit).
The solution is to use :WAIT NIL. You will also have to close the input stream with CLOSE, because otherwise there will be no EOF and cat keeps listening for more input. You'll also want to use SB-EXT:PROCESS-WAIT after closing the stream to wait for cat to exit itself.
(let* ((p (sb-ext:run-program "/bin/cat" '()
:input :stream
:output *standard-output*
:wait nil))
(s (sb-ext:process-input p)))
(format s "foo bar baz~%")
(finish-output s)
(close s)
(sb-ext:process-wait p)
(sb-ext:process-close p))
I'm not sure why you used *TRACE-OUTPUT* for the child output, so I changed it to *STANDARD-OUTPUT*.
Also, using FORMAT for debugging like that is kind of ugly. Common Lisp provides actual debugging tools. In this case you could use STEP:
(step (let* ((p (sb-ext:run-program "/bin/cat" '()
:input :stream
:output *standard-output*
:wait nil))
(s (sb-ext:process-input p)))
(format s "foo bar baz~%")
(finish-output s)
(close s)
(sb-ext:process-wait p)
(sb-ext:process-close p)))
This will put you in the debugger, showing the call being evaluated next. You can invoke the STEP-NEXT-restart to continue to the next call.
This is what works, as suggested by jkiiski:
(let* ((p (sb-ext:run-program "/bin/cat" '()
:input :stream
:output *standard-output*
:wait nil))
(s (sb-ext:process-input p)))
(format s "foo bar baz~%")
(finish-output s)
(sb-ext:process-wait p)
(sb-ext:process-close p))

How to integrate flowtype with spacemacs

I'm spacemacs fan. I want to use Facebook Flow but I have not idea how to integrate it with spacemacs. I'm using flow with nuclide but I need to relearn everything to be productive. There is this script on flow repository to use it with emacs. I need a guide for how to use it within spacemacs.
Thanks.
I used Bodil's flow flycheck config here: https://github.com/bodil/emacs.d/blob/d28264cf072bb8a62459a48813d0cb30804b4f5b/bodil/bodil-js.el#L121-L154
I made it work with spacemacs's react-mode and default eslint flychecker by adding the following to my dotspacemacs/user-config (https://github.com/saltycrane/.spacemacs.d/blob/9d985ace9251529c2b8d7857e2ec9835b103084c/init.el#L383-L414):
;; Flow (JS) flycheck config (http://flowtype.org)
;; from https://github.com/bodil/emacs.d/blob/master/bodil/bodil-js.el
(require 'f)
(require 'json)
(require 'flycheck)
(defun flycheck-parse-flow (output checker buffer)
(let ((json-array-type 'list))
(let ((o (json-read-from-string output)))
(mapcar #'(lambda (errp)
(let ((err (cadr (assoc 'message errp))))
(flycheck-error-new
:line (cdr (assoc 'line err))
:column (cdr (assoc 'start err))
:level 'error
:message (cdr (assoc 'descr err))
:filename (f-relative
(cdr (assoc 'path err))
(f-dirname (file-truename
(buffer-file-name))))
:buffer buffer
:checker checker)))
(cdr (assoc 'errors o))))))
(flycheck-define-checker javascript-flow
"Javascript type checking using Flow."
:command ("flow" "--json" source-original)
:error-parser flycheck-parse-flow
:modes react-mode
:next-checkers ((error . javascript-eslint))
)
(add-to-list 'flycheck-checkers 'javascript-flow)
Also be sure the Flow command line tool is installed. Install it like this:
npm install -g flow-bin
I think Bodil intended to make the messages short, but I would like to have flycheck display more verbose messages. If anyone knows how to do that, I'd appreciate it.
EDIT 2016-08-12: the original version I posted gave a Symbol's function definition is void: flycheck-define-checker error on initial load. I updated the code above to add a require 'flycheck to get rid of that error.
The answer by saltycrane worked fine for me. Thanks! The solution gives a very short error messages as he points out. I have improved the error messages to be more verbose and look more like the output from flow cli output.
A note to new users who wants to use this script is to make sure you edit it to use the correct mode in flycheck-define-checker at the bottom. I use this in js2-mode, and saltycrane uses react-mode. Edit it to use whatever you are using.
(require 'f)
(require 'json)
(require 'flycheck)
(defun flycheck-parse-flow (output checker buffer)
(let ((json-array-type 'list))
(let ((o (json-read-from-string output)))
(mapcar #'(lambda (errp)
(let ((err (cadr (assoc 'message errp)))
(err2 (cadr (cdr (assoc 'message errp)))))
(flycheck-error-new
:line (cdr (assoc 'line err))
:column (cdr (assoc 'start err))
:level 'error
:message (concat (cdr (assoc 'descr err)) ". " (cdr (assoc 'descr err2)))
:filename (f-relative
(cdr (assoc 'path err))
(f-dirname (file-truename
(buffer-file-name))))
:buffer buffer
:checker checker)))
(cdr (assoc 'errors o))))))
(flycheck-define-checker javascript-flow
"Static type checking using Flow."
:command ("flow" "--json" source-original)
:error-parser flycheck-parse-flow
:modes js2-mode)
(add-to-list 'flycheck-checkers 'javascript-flow)

common lisp: how to suppress newline or "soft return"

This code
(defun arabic_to_roman (filename)
(let ((arab_roman_dp '())
(arab nil)
(roman nil))
(with-open-file (in filename
:direction :input
:if-does-not-exist nil)
(when in
(loop for line = (read-line in nil)
while line do
(setq arab (subseq line 0 (search "=" line)))
(setq roman (subseq line (1+ (search "=" line)) (length line)))
(setf arab_roman_dp (acons arab roman arab_roman_dp))
;(format t "~S ~S~%" arab roman)
)))
(with-open-file (stream #p"ar_out.txt"
:direction :output
:if-exists :overwrite
:if-does-not-exist :create )
(write arab_roman_dp :stream stream :escape nil :readably nil))
'done!))
seems to work well. It takes a file with entries like this
1=I
2=II
...
and builds one large list of dotted pairs. However when I look at the output file, it seems as though soft returns or newlines have been inserted.
((4999 . MMMMCMXCIX) (4998 . MMMMCMXCVIII) (4997 . MMMMCMXCVII)
(4996 . MMMMCMXCVI) (4995 . MMMMCMXCV) (4994 . MMMMCMXCIV)
(4993 . MMMMCMXCIII) (4992 . MMMMCMXCII) (4991 . MMMMCMXCI) (4990 . MMMMCMXC)
...
I was expecting the output to look more like just one continuous line:
((4999 . MMMMCMXCIX) (4998 . MMMMCMXCVIII) (4997 . MMMMCMXCVII) (4996 . MMMCMXCVI) (4995 . MMMMCMXCV) (4994 . MMMMCMXCIV) (4993 . MMMMCMXCIII) (4992 . MMMMCMXCII) (4991 . MMMMCMXCI) (4990 . MMMMCMXC) ...
Is my code the way it is indeed throwing in newlines somehow? I've used the write version of princ which supposedly suppresses newlines. Later I want to read this file back into the program as just one big list, so I don't want newline issues.
It looks like the pretty-printer is being invoked (the default is implementation-dependent), to print it with indentation and human-readable line lengths. Use :pretty nil to disable this.
(write arab_roman_dp :stream stream :escape nil :readably nil :pretty nil)
A better way to write it:
use functions to create blocks of code, which can be combined
less side effects and fewer variables
no need to test for in
easy to understand control flow
Example:
(defun arabic_to_roman (filename)
(flet ((read-it ()
(with-open-file (in filename
:direction :input
:if-does-not-exist nil)
(loop for line = (read-line in nil)
for pos = (position #\= line)
while line collect (cons (subseq line 0 pos)
(subseq line (1+ pos))))))
(write-it (list)
(with-open-file (stream #p"ar_out.txt"
:direction :output
:if-exists :overwrite
:if-does-not-exist :create)
(write list :stream stream :escape nil :readably nil :pretty nil))))
(write-it (read-it))
'done-read-write))

How to translate (make-pathname :directory '(:absolute :home "directoryiwant") into absolute path

I want to be able to translate a certain directory in my homedirectory on any OS to the actual absolute path on that OS e.g. (make-pathname :directory '(:absolute :home "directoryiwant") should be translated to "/home/weirdusername/directoryiwant" on a unixlike system.
What would be the function of choice to do that? As
(directory-namestring
(make-pathname :directory '(:absolute :home "directoryiwant"))
> "~/"
does not actually do the deal.
If you need something relative to your home directory, the Common Lisp functions user-homedir-pathname and merge-pathnames can help you:
CL-USER> (merge-pathnames
(make-pathname
:directory '(:relative "directoryyouwant"))
(user-homedir-pathname))
#P"/home/username/directoryyouwant/"
The namestring functions (e.g., namestring, directory-namestring) work on this pathname as expected:
CL-USER> (directory-namestring
(merge-pathnames
(make-pathname
:directory '(:relative "directoryyouwant"))
(user-homedir-pathname)))
"/home/username/directoryyouwant/"
CL-USER > (make-pathname :directory (append (pathname-directory
(user-homedir-pathname))
(list "directoryiwant"))
:defaults (user-homedir-pathname))
#P"/Users/joswig/directoryiwant/"
The function NAMESTRING returns it as a string.
CL-USER > (namestring #P"/Users/joswig/directoryiwant/")
"/Users/joswig/directoryiwant/"

How to interact with a process input/output in SBCL/Common Lisp

I have a text file with one sentence per line. I would like to lemmatize the worlds in each line using hunspell (-s option). Since I want to have the lemmas of each line separately, it wouldn't make sense to submit the whole text file to hunspell. I do need to send one line after another and have the hunspell output for each line.
Following the answers from How to process input and output streams in Steel Bank Common Lisp?, I was able to send the whole text file for hunspell one line after another but I was not able to capture the output of hunspell for each line. How interact with the process sending the line and reading the output before send another line?
My current code to read the whole text file is
(defun parse-spell-sb (file-in)
(with-open-file (in file-in)
(let ((p (sb-ext:run-program "/opt/local/bin/hunspell" (list "-i" "UTF-8" "-s" "-d" "pt_BR")
:input in :output :stream :wait nil)))
(when p
(unwind-protect
(with-open-stream (o (process-output p))
(loop
:for line := (read-line o nil nil)
:while line
:collect line))
(process-close p))))))
Once more, this code give me the output of hunspell for the whole text file. I would like to have the output of hunspell for each input line separately.
Any idea?
I suppose you have a buffering problem with the program you want to run. For example:
(defun program-stream (program &optional args)
(let ((process (sb-ext:run-program program args
:input :stream
:output :stream
:wait nil
:search t)))
(when process
(make-two-way-stream (sb-ext:process-output process)
(sb-ext:process-input process)))))
Now, on my system, this will work with cat:
CL-USER> (defparameter *stream* (program-stream "cat"))
*STREAM*
CL-USER> (format *stream* "foo bar baz~%")
NIL
CL-USER> (finish-output *stream*) ; will hang without this
NIL
CL-USER> (read-line *stream*)
"foo bar baz"
NIL
CL-USER> (close *stream*)
T
Notice the finish-output – without this, the read will hang. (There's also force-output.)
Python in interactive mode will work, too:
CL-USER> (defparameter *stream* (program-stream "python" '("-i")))
*STREAM*
CL-USER> (loop while (read-char-no-hang *stream*)) ; skip startup message
NIL
CL-USER> (format *stream* "1+2~%")
NIL
CL-USER> (finish-output *stream*)
NIL
CL-USER> (read-line *stream*)
"3"
NIL
CL-USER> (close *stream*)
T
But if you try this without the -i option (or similar options like -u), you'll probably be out of luck, because of the buffering going on. For example, on my system, reading from tr will hang:
CL-USER> (defparameter *stream* (program-stream "tr" '("a-z" "A-Z")))
*STREAM*
CL-USER> (format *stream* "foo bar baz~%")
NIL
CL-USER> (finish-output *stream*)
NIL
CL-USER> (read-line *stream*) ; hangs
; Evaluation aborted on NIL.
CL-USER> (read-char-no-hang *stream*)
NIL
CL-USER> (close *stream*)
T
Since tr doesn't provide a switch to turn off buffering, we'll wrap the call with a pty wrapper (in this case unbuffer from expect):
CL-USER> (defparameter *stream* (program-stream "unbuffer"
'("-p" "tr" "a-z" "A-Z")))
*STREAM*
CL-USER> (format *stream* "foo bar baz~%")
NIL
CL-USER> (finish-output *stream*)
NIL
CL-USER> (read-line *stream*)
"FOO BAR BAZ
"
NIL
CL-USER> (close *stream*)
T
So, long story short: Try using finish-output on the stream before reading. If that doesn't work, check for command line options preventing buffering. If it still doesn't work, you could try wrapping the programm in some kind of pty-wrapper.

Resources