From 2537fba42cfd9265d3dfe9f78a80862ce9c1fdbc Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Thu, 6 Jan 2011 09:14:06 -0500
Subject: Detect missing 'database' directive; don't compile garbage C files

---
 src/cjr_print.sml | 38 +++++++++++++++++++++++++++++++++++++-
 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
-- 
cgit v1.2.3