Mercurial > urweb
changeset 1381:bf58ca871c00
Detect missing 'database' directive; don't compile garbage C files
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Thu, 06 Jan 2011 09:14:06 -0500 |
parents | ede95ecb4000 |
children | 5cb95fb7d4d5 |
files | src/cjr_print.sml src/compiler.sml |
diffstat | 2 files changed, 58 insertions(+), 19 deletions(-) [+] |
line wrap: on
line diff
--- a/src/cjr_print.sml Thu Jan 06 08:55:53 2011 -0500 +++ b/src/cjr_print.sml Thu Jan 06 09:14:06 2011 -0500 @@ -2756,7 +2756,43 @@ | DPreparedStatements ss => prepped := ss | _ => ()) ds - val hasDb = !hasDb + val hasDb = !hasDb + + fun expDb (e, _) = + case e of + ECon (_, _, SOME e) => expDb e + | ESome (_, e) => expDb e + | EFfiApp (_, _, es) => List.exists expDb es + | EApp (e, es) => expDb e orelse List.exists expDb es + | EUnop (_, e) => expDb e + | EBinop (_, e1, e2) => expDb e1 orelse expDb e2 + | ERecord (_, xes) => List.exists (expDb o #2) xes + | EField (e, _) => expDb e + | ECase (e, pes, _) => expDb e orelse List.exists (expDb o #2) pes + | EError (e, _) => expDb e + | EReturnBlob {blob = e1, mimeType = e2, ...} => expDb e1 orelse expDb e2 + | ERedirect (e, _) => expDb e + | EWrite e => expDb e + | ESeq (e1, e2) => expDb e1 orelse expDb e2 + | ELet (_, _, e1, e2) => expDb e1 orelse expDb e2 + | EQuery _ => true + | EDml _ => true + | ENextval _ => true + | ESetval _ => true + | EUnurlify (e, _, _) => expDb e + | _ => false + + fun declDb (d, _) = + case d of + DVal (_, _, _, e) => expDb e + | DFun (_, _, _, _, e) => expDb e + | DFunRec vis => List.exists (expDb o #5) vis + | _ => false + + val () = if not hasDb andalso List.exists declDb ds then + ErrorMsg.error "Application uses a database but has none configured with 'database' in .urp file." + else + () val cookies = List.mapPartial (fn (DCookie s, _) => SOME s | _ => NONE) ds
--- a/src/compiler.sml Thu Jan 06 08:55:53 2011 -0500 +++ b/src/compiler.sml Thu Jan 06 09:14:06 2011 -0500 @@ -1337,10 +1337,10 @@ in OS.FileSys.mkDir dir; (cname, oname, - fn () => (OS.FileSys.remove cname; - OS.FileSys.remove oname; - OS.FileSys.rmDir dir) - handle OS.SysErr _ => OS.FileSys.rmDir dir) + fn () => (OS.FileSys.remove cname; + OS.FileSys.remove oname; + OS.FileSys.rmDir dir) + handle OS.SysErr _ => OS.FileSys.rmDir dir) end val ename = #exe job in @@ -1359,21 +1359,24 @@ TextIO.output1 (outf, #"\n"); TextIO.closeOut outf; - case #sql job of - NONE => () - | SOME sql => - let - val outf = TextIO.openOut sql - val s = TextIOPP.openOut {dst = outf, wid = 80} - in - Print.fprint s (CjrPrint.p_sql CjrEnv.empty file); - TextIO.closeOut outf - end; + if ErrorMsg.anyErrors () then + false + else + (case #sql job of + NONE => () + | SOME sql => + let + val outf = TextIO.openOut sql + val s = TextIOPP.openOut {dst = outf, wid = 80} + in + Print.fprint s (CjrPrint.p_sql CjrEnv.empty file); + TextIO.closeOut outf + end; - compileC {cname = cname, oname = oname, ename = ename, libs = libs, - profile = #profile job, debug = #debug job, link = #link job} - - before cleanup () + compileC {cname = cname, oname = oname, ename = ename, libs = libs, + profile = #profile job, debug = #debug job, link = #link job} + + before cleanup ()) end handle ex => (((cleanup ()) handle _ => ()); raise ex) end