# HG changeset patch # User Adam Chlipala # Date 1325542119 18000 # Node ID 3e7c7e20071309a8bd48d9a1bb75b63731b3b3b2 # Parent b694f9153faa38e223862b716cff73f240a11eed Fix handling of quotes in generating C literals diff -r b694f9153faa -r 3e7c7e200713 src/cjr_print.sml --- a/src/cjr_print.sml Mon Jan 02 16:54:18 2012 -0500 +++ b/src/cjr_print.sml Mon Jan 02 17:08:39 2012 -0500 @@ -2388,7 +2388,7 @@ | 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 @@ 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 @@ 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 @@ "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 -r b694f9153faa -r 3e7c7e200713 src/jscomp.sml --- a/src/jscomp.sml Mon Jan 02 16:54:18 2012 -0500 +++ b/src/jscomp.sml Mon Jan 02 17:08:39 2012 -0500 @@ -1324,7 +1324,7 @@ 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 -r b694f9153faa -r 3e7c7e200713 src/mysql.sml --- a/src/mysql.sml Mon Jan 02 16:54:18 2012 -0500 +++ b/src/mysql.sml Mon Jan 02 17:08:39 2012 -0500 @@ -346,7 +346,7 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ (ErrorMsg.error "Non-printing character found in SQL string literal"; "")) - (String.toCString s) ^ "'" + (Prim.toCString s) ^ "'" fun p_cast (s, _) = s diff -r b694f9153faa -r 3e7c7e200713 src/postgres.sml --- a/src/postgres.sml Mon Jan 02 16:54:18 2012 -0500 +++ b/src/postgres.sml Mon Jan 02 17:08:39 2012 -0500 @@ -337,7 +337,7 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 -r b694f9153faa -r 3e7c7e200713 src/prim.sig --- a/src/prim.sig Mon Jan 02 16:54:18 2012 -0500 +++ b/src/prim.sig Mon Jan 02 17:08:39 2012 -0500 @@ -41,4 +41,7 @@ val toString : t -> string + val toCString : string -> string + (* SML's built-in [String.toCString] gets confused by single quotes! *) + end diff -r b694f9153faa -r 3e7c7e200713 src/prim.sml --- a/src/prim.sml Mon Jan 02 16:54:18 2012 -0500 +++ b/src/prim.sml Mon Jan 02 17:08:39 2012 -0500 @@ -70,12 +70,24 @@ 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 -r b694f9153faa -r 3e7c7e200713 src/sources --- a/src/sources Mon Jan 02 16:54:18 2012 -0500 +++ b/src/sources Mon Jan 02 17:08:39 2012 -0500 @@ -31,15 +31,15 @@ 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 -r b694f9153faa -r 3e7c7e200713 src/sqlite.sml --- a/src/sqlite.sml Mon Jan 02 16:54:18 2012 -0500 +++ b/src/sqlite.sml Mon Jan 02 17:08:39 2012 -0500 @@ -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 @@ 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 @@ string "msg[1023] = 0;", newline, uhoh false ("Error preparing statement: " - ^ String.toCString s ^ "
%s") ["msg"]], + ^ Prim.toCString s ^ "
%s") ["msg"]], string "}", newline] end) @@ -659,9 +659,9 @@ 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 "
%s\", sqlite3_errmsg(conn->conn));", newline, if nested then @@ -685,7 +685,7 @@ 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 @@ 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 "
%s\", sqlite3_errmsg(conn->conn));", newline, string "conn->p", @@ -771,7 +771,7 @@ newline, dmlCommon {loc = loc, dml = box [string "\"", - string (String.toCString dml), + string (Prim.toCString dml), string "\""], mode = mode}, string "uw_pop_cleanup(ctx);",