typed: improve error handling and work around spin front-end limitations
This commit is contained in:
parent
481b490fd2
commit
fd59e58dc3
|
@ -780,12 +780,15 @@
|
||||||
(indent) (display "(") (gen-ltl q) (displayln ")"))
|
(indent) (display "(") (gen-ltl q) (displayln ")"))
|
||||||
|
|
||||||
;; Assignment -> Void
|
;; Assignment -> Void
|
||||||
|
;; SPIN errors if there are more than 33 items in this, error messages such as:
|
||||||
|
;; tl_spin: expected ')', saw 'predicate'
|
||||||
(define (gen-sanity-ltl assignment)
|
(define (gen-sanity-ltl assignment)
|
||||||
(gen-spec "sanity"
|
(gen-spec "sanity"
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(indent) (displayln "[](")
|
(indent) (displayln "[](")
|
||||||
(with-indent
|
(with-indent
|
||||||
(for ([assertion-var (in-hash-keys assignment)])
|
(for ([assertion-var (in-hash-keys assignment)]
|
||||||
|
[i (in-range 33)])
|
||||||
(indent) (printf "~a >= 0 &&\n" (svar-name assertion-var)))
|
(indent) (printf "~a >= 0 &&\n" (svar-name assertion-var)))
|
||||||
(indent) (displayln "true"))
|
(indent) (displayln "true"))
|
||||||
(indent) (displayln ")"))))
|
(indent) (displayln ")"))))
|
||||||
|
@ -798,25 +801,39 @@
|
||||||
|
|
||||||
;; [LTL τ] [Listof Role] -> Bool
|
;; [LTL τ] [Listof Role] -> Bool
|
||||||
(define (compile+verify spec roles)
|
(define (compile+verify spec roles)
|
||||||
(define role-graphs (for/list ([r (in-list roles)]) (compile/internal-events (compile r))))
|
(let/ec stop
|
||||||
(run-spin (program->spin role-graphs spec)))
|
(define role-graphs
|
||||||
|
(for/list ([r (in-list roles)])
|
||||||
|
(define ans (compile/internal-events (compile r)))
|
||||||
|
(when (detected-cycle? ans)
|
||||||
|
(printf "detected cycle!\n")
|
||||||
|
(describe-detected-cycle ans)
|
||||||
|
(stop #f))
|
||||||
|
ans))
|
||||||
|
(run-spin (program->spin role-graphs spec))))
|
||||||
|
|
||||||
;; SpinThang String -> Bool
|
;; SpinThang String -> Bool
|
||||||
(define (run-spin spin [spec-name "spec"])
|
(define (run-spin spin [spec-name "spec"])
|
||||||
(define tmp (make-temporary-file "typed-syndicate-spin~a.pml"))
|
(define tmp (make-temporary-file "typed-syndicate-spin~a.pml"))
|
||||||
(gen-spin/to-file spin tmp)
|
(gen-spin/to-file spin tmp)
|
||||||
(define out (with-output-to-string
|
(define script-completed? #f)
|
||||||
(thunk (system* RUN-SPIN.EXE tmp spec-name))))
|
(define script-output (with-output-to-string
|
||||||
|
(thunk (set! script-completed? (system* RUN-SPIN.EXE tmp spec-name)))))
|
||||||
(define trail-file (format "~a.trail" (path->string tmp)))
|
(define trail-file (format "~a.trail" (path->string tmp)))
|
||||||
(define trail-exists? (file-exists? trail-file))
|
(define trail-exists? (file-exists? trail-file))
|
||||||
(when (file-exists? trail-file)
|
(cond
|
||||||
(displayln "Detected Trail File!")
|
[(not script-completed?)
|
||||||
(analyze-spin-trail tmp)
|
(displayln "Error running SPIN; Output:")
|
||||||
(copy-file tmp (build-path (current-directory) "model.pml") #t)
|
(display script-output)]
|
||||||
(copy-file trail-file (build-path (current-directory) "model.pml.trail") #t)
|
[trail-exists?
|
||||||
(delete-file trail-file))
|
(displayln "Detected Trail File!")
|
||||||
|
(analyze-spin-trail tmp)
|
||||||
|
(copy-file tmp (build-path (current-directory) "model.pml") #t)
|
||||||
|
(copy-file trail-file (build-path (current-directory) "model.pml.trail") #t)
|
||||||
|
(delete-file trail-file)])
|
||||||
|
(flush-output)
|
||||||
(delete-file tmp)
|
(delete-file tmp)
|
||||||
(not trail-exists?))
|
(and script-completed? (not trail-exists?)))
|
||||||
|
|
||||||
(define SPIN-REPORT-RX #px"(?m:^State-vector \\d+ byte, depth reached \\d+, errors: (\\d+)$)")
|
(define SPIN-REPORT-RX #px"(?m:^State-vector \\d+ byte, depth reached \\d+, errors: (\\d+)$)")
|
||||||
|
|
||||||
|
|
|
@ -1,12 +1,17 @@
|
||||||
#!/bin/sh
|
#!/bin/sh
|
||||||
|
|
||||||
pushd ${1%/*}/
|
pushd ${1%/*}/ > /dev/null
|
||||||
|
|
||||||
EXE="$1-verifier.o"
|
EXE="$1-verifier.o"
|
||||||
|
|
||||||
spin -a $1
|
spin -a $1
|
||||||
|
if [[ $? -ne 0 ]]; then
|
||||||
|
popd > /dev/null
|
||||||
|
exit 1
|
||||||
|
fi
|
||||||
|
|
||||||
gcc -o $EXE pan.c
|
gcc -o $EXE pan.c
|
||||||
$EXE -a -f -n -N $2
|
$EXE -a -f -n -N $2
|
||||||
rm $EXE pan.c
|
rm $EXE pan.*
|
||||||
|
|
||||||
popd
|
popd > /dev/null
|
||||||
|
|
Loading…
Reference in New Issue