# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1294323246 18000
# Node ID bf58ca871c0013fef1f66415d2ca0faacd2603fd
# Parent  ede95ecb4000af1a0483dda4cd9197a8c36d0e4c
Detect missing 'database' directive; don't compile garbage C files

diff -r ede95ecb4000 -r bf58ca871c00 src/cjr_print.sml
--- 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
 
diff -r ede95ecb4000 -r bf58ca871c00 src/compiler.sml
--- 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