floss/stoe
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Don't resolve the resource promise until resource-initialize has been completed

Browse source
This commit is contained in:
Renaud Casenave-Péré 2016-04-15 14:08:26 +02:00
parent 9ba6982892
commit 24238d87ed
1 changed files with 13 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
core/resources.lisp
View file

@ -41,7 +41,8 @@
(string-upcase extension) "-"
(symbol-name classname))))
(path (first (first fun-decl)))
(retriever (second (first fun-decl)))
(retrieved-value (first (second (first fun-decl))))
(retriever (second (second (first fun-decl))))
(res (third (first fun-decl)))
(proxy (gensym "PROXY"))
(new-res-p (gensym "NEWRES")))
@ -50,15 +51,17 @@
(multiple-value-bind (,proxy ,res ,new-res-p)
(make-resource ,path ',classname)
(values ,proxy (if ,new-res-p
(bb:catcher
(bb:alet (,retriever)
,@(cdr fun-decl)
(resource-initialize ,res)
(setf (slot-value ,res 'loaded) t)
,res)
(t (e)
(unload-resource ,proxy)
(signal e)))
(bb:chain ,retriever
(:attach (,retrieved-value)
,@(cdr fun-decl)
(resource-initialize ,res))
(:attach ()
(setf (slot-value ,res 'loaded) t))
(:catch (e)
(unload-resource ,proxy)
(signal e))
(:finally ()
,res))
(promisify ,res)))))
(setf (getf (gethash ,extension *resource-handlers*) :load) #',fun-name)))))