diff options
| -rw-r--r-- | src/cjr_print.sml | 38 | ||||
| -rw-r--r-- | src/compiler.sml | 41 |
2 files changed, 59 insertions, 20 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml index cb6c6d3c..4237fd90 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -2756,7 +2756,43 @@ fun p_file env (ds, ps) = | 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 diff --git a/src/compiler.sml b/src/compiler.sml index 0668ac42..df7cdb4c 100644 --- a/src/compiler.sml +++ b/src/compiler.sml @@ -1337,10 +1337,10 @@ fun compile job = 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 @@ fun compile job = 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; - - compileC {cname = cname, oname = oname, ename = ename, libs = libs, - profile = #profile job, debug = #debug job, link = #link job} - - before cleanup () + 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 ()) end handle ex => (((cleanup ()) handle _ => ()); raise ex) end |