Fix handling of quotes in generating C literals

8 files changed, 52 insertions, 37 deletions

diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 8bb2f64d..851fa02d 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -2388,7 +2388,7 @@ fun p_decl env (dAll as (d, _) : decl) =
       | DPreparedStatements _ => box []
 
       | DJavaScript s => box [string "static char jslib[] = \"",
-                              string (String.toCString s),
+                              string (Prim.toCString s),
                               string "\";"]
       | DCookie s => box [string "/*",
                           space,
@@ -2863,7 +2863,7 @@ fun p_file env (ds, ps) =
                             prefix ^ s
             in
                 box [string "if (!strncmp(request, \"",
-                     string (String.toCString s),
+                     string (Prim.toCString s),
                      string "\", ",
                      string (Int.toString (size s)),
                      string ") && (request[",
@@ -3090,10 +3090,10 @@ fun p_file env (ds, ps) =
                           box [string "if (!str",
                                case #kind rule of
                                    Settings.Exact => box [string "cmp(s, \"",
-                                                          string (String.toCString (#pattern rule)),
+                                                          string (Prim.toCString (#pattern rule)),
                                                           string "\"))"]
                                  | Settings.Prefix => box [string "ncmp(s, \"",
-                                                           string (String.toCString (#pattern rule)),
+                                                           string (Prim.toCString (#pattern rule)),
                                                            string "\", ",
                                                            string (Int.toString (size (#pattern rule))),
                                                            string "))"],
@@ -3402,7 +3402,7 @@ fun p_file env (ds, ps) =
                          "uw_handle",
                          "uw_input_num", "uw_cookie_sig", "uw_check_url", "uw_check_mime", "uw_check_requestHeader", "uw_check_responseHeader",
                          case onError of NONE => "NULL" | SOME _ => "uw_onError", "my_periodics",
-                         "\"" ^ String.toCString (Settings.getTimeFormat ()) ^ "\""],
+                         "\"" ^ Prim.toCString (Settings.getTimeFormat ()) ^ "\""],
              string "};",
              newline]
     end
diff --git a/src/jscomp.sml b/src/jscomp.sml
index 7a5bf85d..57f59b12 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -1324,7 +1324,7 @@ fun process file =
         val script =
             if !foundJavaScript then
                 lines ^ urlRules ^ String.concat (rev (#script st))
-                ^ "\ntime_format = \"" ^ String.toCString (Settings.getTimeFormat ()) ^ "\";\n"
+                ^ "\ntime_format = \"" ^ Prim.toCString (Settings.getTimeFormat ()) ^ "\";\n"
             else
                 ""
     in
diff --git a/src/mysql.sml b/src/mysql.sml
index 0715d253..686f430f 100644
--- a/src/mysql.sml
+++ b/src/mysql.sml
@@ -346,7 +346,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
         fun stringOf r = case !r of
                              NONE => string "NULL"
                            | SOME s => box [string "\"",
-                                            string (String.toCString s),
+                                            string (Prim.toCString s),
                                             string "\""]
     in
         app (fn s =>
@@ -479,7 +479,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
                                                                newline,
 
                                                                string "if (mysql_stmt_prepare(stmt, \"",
-                                                               string (String.toCString s),
+                                                               string (Prim.toCString s),
                                                                string "\", ",
                                                                string (Int.toString (size s)),
                                                                string ")) {",
@@ -978,7 +978,7 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} =
               else
                   box [],
               string "if (mysql_stmt_prepare(stmt, \"",
-              string (String.toCString query),
+              string (Prim.toCString query),
               string "\", ",
               string (Int.toString (size query)),
               string ")) {",
@@ -1189,7 +1189,7 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} =
          newline,
 
          queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
-                                                                            string (String.toCString query),
+                                                                            string (Prim.toCString query),
                                                                             string "\""]},
 
          if nested then
@@ -1283,7 +1283,7 @@ fun dmlPrepared {loc, id, dml, inputs, mode} =
               string "if (stmt == NULL) uw_error(ctx, FATAL, \"Out of memory allocating prepared statement\");",
               newline,
               string "if (mysql_stmt_prepare(stmt, \"",
-              string (String.toCString dml),
+              string (Prim.toCString dml),
               string "\", ",
               string (Int.toString (size dml)),
               string ")) {",
@@ -1477,7 +1477,7 @@ fun dmlPrepared {loc, id, dml, inputs, mode} =
          newline,
 
          dmlCommon {loc = loc, dml = box [string "\"",
-                                          string (String.toCString dml),
+                                          string (Prim.toCString dml),
                                           string "\""], mode = mode}]
 
 fun nextval {loc, seqE, seqName} =
@@ -1521,7 +1521,7 @@ fun sqlifyString s = "'" ^ String.translate (fn #"'" => "\\'"
                                                     (ErrorMsg.error
                                                          "Non-printing character found in SQL string literal";
                                                      ""))
-                                            (String.toCString s) ^ "'"
+                                            (Prim.toCString s) ^ "'"
 
 fun p_cast (s, _) = s
 
diff --git a/src/postgres.sml b/src/postgres.sml
index c180e38f..3a2fd40d 100644
--- a/src/postgres.sml
+++ b/src/postgres.sml
@@ -337,7 +337,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
                                                   box [string "res = PQprepare(conn, \"uw",
                                                        string (Int.toString i),
                                                        string "\", \"",
-                                                       string (String.toCString s),
+                                                       string (Prim.toCString s),
                                                        string "\", ",
                                                        string (Int.toString n),
                                                        string ", NULL);",
@@ -355,7 +355,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
                                                             string "PQfinish(conn);",
                                                             newline,
                                                             string "uw_error(ctx, FATAL, \"Unable to create prepared statement:\\n",
-                                                            string (String.toCString s),
+                                                            string (Prim.toCString s),
                                                             string "\\n%s\", msg);",
                                                             newline],
                                                        string "}",
@@ -481,7 +481,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
          string "char *env_db_str = getenv(\"URWEB_PQ_CON\");",
 	 newline,
          string "PGconn *conn = PQconnectdb(env_db_str == NULL ? \"",
-         string (String.toCString dbstring),
+         string (Prim.toCString dbstring),
          string "\" : env_db_str);",
          newline,
          string "if (conn == NULL) uw_error(ctx, FATAL, ",
@@ -732,14 +732,14 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols, nested = _} =
                   string ", paramValues, paramLengths, paramFormats, 0);"]
          else
              box [string "PQexecParams(conn, \"",
-                  string (String.toCString query),
+                  string (Prim.toCString query),
                   string "\", ",
                   string (Int.toString (length inputs)),
                   string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
          newline,
          newline,
          queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
-                                                                            string (String.toCString query),
+                                                                            string (Prim.toCString query),
                                                                             string "\""]}]
 
 fun dmlCommon {loc, dml, mode} =
@@ -888,14 +888,14 @@ fun dmlPrepared {loc, id, dml, inputs, mode} =
                   string ", paramValues, paramLengths, paramFormats, 0);"]
          else
              box [string "PQexecParams(conn, \"",
-                  string (String.toCString dml),
+                  string (Prim.toCString dml),
                   string "\", ",
                   string (Int.toString (length inputs)),
                   string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
          newline,
          newline,
          dmlCommon {loc = loc, dml = box [string "\"",
-                                          string (String.toCString dml),
+                                          string (Prim.toCString dml),
                                           string "\""], mode = mode}]
 
 fun nextvalCommon {loc, query} =
@@ -972,12 +972,12 @@ fun nextvalPrepared {loc, id, query} =
                   string "\", 0, NULL, NULL, NULL, 0);"]
          else
              box [string "PQexecParams(conn, \"",
-                  string (String.toCString query),
+                  string (Prim.toCString query),
                   string "\", 0, NULL, NULL, NULL, NULL, 0);"],
          newline,
          newline,
          nextvalCommon {loc = loc, query = box [string "\"",
-                                                string (String.toCString query),
+                                                string (Prim.toCString query),
                                                 string "\""]}]
 
 fun setvalCommon {loc, query} =
@@ -1030,7 +1030,7 @@ fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'"
                                                  else
                                                      "\\" ^ StringCvt.padLeft #"0" 3
                                                                               (Int.fmt StringCvt.OCT (ord ch)))
-                                             (String.toCString s) ^ "'::text"
+                                             (Prim.toCString s) ^ "'::text"
 
 fun p_cast (s, t) = s ^ "::" ^ p_sql_type t
 
diff --git a/src/prim.sig b/src/prim.sig
index fb067b3a..74147471 100644
--- a/src/prim.sig
+++ b/src/prim.sig
@@ -41,4 +41,7 @@ signature PRIM = sig
 
     val toString : t -> string
 
+    val toCString : string -> string
+    (* SML's built-in [String.toCString] gets confused by single quotes! *)
+
 end
diff --git a/src/prim.sml b/src/prim.sml
index 96880487..94801e7f 100644
--- a/src/prim.sml
+++ b/src/prim.sml
@@ -70,12 +70,24 @@ fun pad (n, ch, s) =
     else
         str ch ^ pad (n-1, ch, s)
 
+fun quoteDouble ch =
+    case ch of
+        #"'" => str ch
+      | _ => Char.toCString ch
+
+fun toCChar ch =
+    case ch of
+        #"\"" => str ch
+      | _ => Char.toCString ch
+
+val toCString = String.translate quoteDouble
+
 fun p_t_GCC t =
     case t of
         Int n => string (int2s n)
       | Float n => string (float2s n)
-      | String s => box [string "\"", string (String.toCString s), string "\""]
-      | Char ch => box [string "'", string (Char.toCString ch), string "'"]
+      | String s => box [string "\"", string (toCString s), string "\""]
+      | Char ch => box [string "'", string (toCChar ch), string "'"]
 
 fun equal x =
     case x of
diff --git a/src/sources b/src/sources
index 5d1f099d..aebe9de6 100644
--- a/src/sources
+++ b/src/sources
@@ -31,15 +31,15 @@ fastcgi.sml
 static.sig
 static.sml
 
+prim.sig
+prim.sml
+
 mysql.sig
 mysql.sml
 
 sqlite.sig
 sqlite.sml
 
-prim.sig
-prim.sml
-
 datatype_kind.sml
 
 export.sig
diff --git a/src/sqlite.sml b/src/sqlite.sml
index d6f5ffec..1dc0b754 100644
--- a/src/sqlite.sml
+++ b/src/sqlite.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2009-2010, Adam Chlipala
+ (* Copyright (c) 2009-2010, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -230,7 +230,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
                                                                    newline]
                                                       in
                                                           box [string "if (sqlite3_prepare_v2(conn->conn, \"",
-                                                               string (String.toCString s),
+                                                               string (Prim.toCString s),
                                                                string "\", -1, &conn->p",
                                                                string (Int.toString i),
                                                                string ", NULL) != SQLITE_OK) {",
@@ -242,7 +242,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
                                                                     string "msg[1023] = 0;",
                                                                     newline,
                                                                     uhoh false ("Error preparing statement: "
-                                                                                ^ String.toCString s ^ "<br />%s") ["msg"]],
+                                                                                ^ Prim.toCString s ^ "<br />%s") ["msg"]],
                                                                string "}",
                                                                newline]
                                                       end)
@@ -659,9 +659,9 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} =
                   newline],
 
          string "if (sqlite3_prepare_v2(conn->conn, \"",
-         string (String.toCString query),
+         string (Prim.toCString query),
          string "\", -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: ",
-         string (String.toCString query),
+         string (Prim.toCString query),
          string "<br />%s\", sqlite3_errmsg(conn->conn));",
          newline,
          if nested then
@@ -685,7 +685,7 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} =
          newline,
 
          queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
-                                                                            string (String.toCString query),
+                                                                            string (Prim.toCString query),
                                                                             string "\""]},
 
          string "uw_pop_cleanup(ctx);",
@@ -750,9 +750,9 @@ fun dmlPrepared {loc, id, dml, inputs, mode = mode} =
          string "if (stmt == NULL) {",
          newline,
          box [string "if (sqlite3_prepare_v2(conn->conn, \"",
-              string (String.toCString dml),
+              string (Prim.toCString dml),
               string "\", -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: ",
-              string (String.toCString dml),
+              string (Prim.toCString dml),
               string "<br />%s\", sqlite3_errmsg(conn->conn));",
               newline,
               string "conn->p",
@@ -771,7 +771,7 @@ fun dmlPrepared {loc, id, dml, inputs, mode = mode} =
          newline,
 
          dmlCommon {loc = loc, dml = box [string "\"",
-                                          string (String.toCString dml),
+                                          string (Prim.toCString dml),
                                           string "\""], mode = mode},
 
          string "uw_pop_cleanup(ctx);",