Commit 2682ccb1 authored by Marco Antoniotti's avatar Marco Antoniotti 💬
Browse files

Added example file.

parent f1cabd81
;;;; -*- Mode: Lisp -*-
;;;; test-multifile-exit-contexts.lisp --
;;;;
;;;; See file COPYING for copyright and licensing information.
;;;;
;;;; This file contains two tests that allow you to see what the
;;;; library can do. The examples are extrapolated from the Python
;;;; documentation at:
;;;;
;;;; https://docs.python.org/3/library/contextlib.html
;;;;
;;;; The two functions test the EXIT-CONTEXT (and the
;;;; DELEGATE-CONTEXT) behavior.
;;;;
;;;; The first function runs to end and must return T.
;;;; The second function generates an error.
;;;;
;;;; In the two examples the files (some of them) will be opened and
;;;; closed. In he first function they will be closed by the explicit
;;;; call to UNWIND on the "transfer exit stack" created by POP-ALL.
;;;; In the second one, the files that have been opened before OPEN
;;;; raised an error on the non existent file, will be closed by the
;;;; WITH macro unwinding the initial "exit stack".
;;;;
;;;; In order to properly check this example, you can either step
;;;; through it, TRACE the CL-CONTEXT:EXIT generic function or
;;;; uncomment the :before method definition below.
(in-package "CL-USER")
(eval-when (:compile-toplevel :load-toplevel)
(unless (find-package "CTXTS")
(error "the package \"CL-CONTEXTS\" (therefore the WITH macro) does not exist.")))
(use-package "CTXTS")
(defmethod ctxts:exit :before ((s stream) &key)
(format t "WITHCTXI: exiting stream associated to ~S.~%"
(file-namestring s)))
(defparameter *file-names*
(mapcar 'namestring (directory "*.*")))
(defun file-namestrings (fs)
(mapcar 'file-namestring fs))
(defun test-exit-stack-1 (&optional
(file-names *file-names*)
&aux
files stack close-file-context)
(assert (every 'probe-file file-names))
(format t "WITHCTXI: You will see as many calls to the EXIT method~@
WITHCTXI: as the list of files below implies.~@
WITHCTXI: (Either TRACE the CTXTS:EXIT method or add a~@
WITHCTXI: :before method on it).~%"
)
(format t "WITHCTXI: Files:~%~{WITHCTXI: ~A~%~}~%"
(file-namestrings file-names))
(with stack = (exit-stack) do
(setf files (mapcar (lambda (f)
(enter-context stack (delegate-context (open f))))
file-names)
close-file-context (pop-all stack))
(format t "WITHCTXI: exit stack popped. ~S~%" t)
)
(format t "WITHCTXI: stack is now ~S~%" stack)
(format t "WITHCTXI: files is now ~S~%"
(file-namestrings file-names))
(format t "WITHCTXI: just after the WITH; 'close' exit-context: ~s~@
WITHCTXI: now UNWINDing it.~%"
close-file-context)
(unwind close-file-context)
(every (complement 'open-stream-p) files))
(defun test-exit-stack-2 (&optional
(file-names *file-names*)
&aux
files stack close-file-context)
;; Ensure that there is a non-existent file in the list.
(let ((non-existent-file-name "foo42bar.lll"))
(assert (every 'probe-file file-names))
(assert (not (probe-file non-existent-file-name))
(non-existent-file-name)
)
(let* ((rindex (random (length file-names)))
(file-names (append (subseq file-names 0 rindex)
(list non-existent-file-name)
(subseq file-names rindex)))
)
(format t "WITHCTXI: First of all you will see an error; just~@
WITHCTXI: pop to the top level from the debugger.~@
WITHCTXI: You will see as many calls to the EXIT method~@
WITHCTXI: as there are files before file name ~S~@
WITHCTXI: (Either TRACE the CTXTS:EXIT method or add a~@
WITHCTXI: :before method on it).~%"
non-existent-file-name)
(format t "WITHCTXI: Files:~%~{WITHCTXI: ~A~%~}~%"
(file-namestrings file-names))
(with stack = (exit-stack) do
(setf files (mapcar (lambda (f)
(enter-context stack (delegate-context (open f))))
file-names)
close-file-context (pop-all stack)))
(format t "WITHCTXI: IF YOU SEE THIS MESSAGE SOMETHING WENT VERY WRONG~%")
(format t "WITHCTXI: stack is now ~S~%" stack)
(format t "WITHCTXI: files is now ~S~%"
(file-namestrings file-names))
(format t "WITHCTXI: just after the WITH; 'close' exit-context: ~s~@
WITHCTXI: We forced an error so the above is NIL.~@
WITHCTXI: now UNWINDing it (pointlessly).~%"
close-file-context)
(unwind close-file-context)))
(every (complement 'open-stream-p) files)
)
;;;; end of file -- test-multifile-exit-contexts.lisp
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment