From 8afe2db3c6bdf06d2596ddba95cb889991196fc5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Sun, 14 Apr 2019 09:13:24 +0200 Subject: [PATCH] Runtime: hide & rename _T macro (#2075) - Rename _T macro to T to avoid conflict with - Do not use it for ASCII character literals - Guard T macro with CAML_INTERNALS --- Changes | 4 +++ runtime/caml/misc.h | 8 ++++-- runtime/debugger.c | 2 +- runtime/dynlink.c | 12 ++++----- runtime/spacetime_nat.c | 10 +++---- runtime/startup_aux.c | 58 ++++++++++++++++++++--------------------- runtime/startup_byt.c | 24 ++++++++--------- runtime/startup_nat.c | 2 +- runtime/win32.c | 2 +- 9 files changed, 65 insertions(+), 57 deletions(-) diff --git a/Changes b/Changes index 7fa0d8381..72cbd253c 100644 --- a/Changes +++ b/Changes @@ -137,6 +137,10 @@ Working version - #1725, #2279: Deprecate Obj.set_tag and Obj.truncate (Stephen Dolan, review by Gabriel Scherer, Damien Doligez and Xavier Leroy) +- #2075, #7729: rename _T macro used to support Unicode in the (Windows) runtime + in order to avoid compiler warning + (Nicolás Ojeda Bär, review by Gabriel Scherer and David Allsopp) + * #2240: Constify "identifier" in struct custom_operations (Cedric Cellier, review by Xavier Leroy) diff --git a/runtime/caml/misc.h b/runtime/caml/misc.h index 6aa98516b..4466d292e 100644 --- a/runtime/caml/misc.h +++ b/runtime/caml/misc.h @@ -183,7 +183,9 @@ extern int caml_umul_overflow(uintnat a, uintnat b, uintnat * res); #ifdef _WIN32 -#define _T(x) L ## x +#ifdef CAML_INTERNALS +#define T(x) L ## x +#endif #define access_os _waccess #define open_os _wopen @@ -213,7 +215,9 @@ extern int caml_umul_overflow(uintnat a, uintnat b, uintnat * res); #else /* _WIN32 */ -#define _T(x) x +#ifdef CAML_INTERNALS +#define T(x) x +#endif #define access_os access #define open_os open diff --git a/runtime/debugger.c b/runtime/debugger.c index a7c202788..f77cf1eb6 100644 --- a/runtime/debugger.c +++ b/runtime/debugger.c @@ -180,7 +180,7 @@ void caml_debugger_init(void) Store_field(marshal_flags, 0, Val_int(1)); /* Marshal.Closures */ Store_field(marshal_flags, 1, Val_emptylist); - a = caml_secure_getenv(_T("CAML_DEBUG_SOCKET")); + a = caml_secure_getenv(T("CAML_DEBUG_SOCKET")); address = a ? caml_stat_strdup_of_os(a) : NULL; if (address == NULL) return; if (dbg_addr != NULL) caml_stat_free(dbg_addr); diff --git a/runtime/dynlink.c b/runtime/dynlink.c index cf728b0ed..2d61f53cc 100644 --- a/runtime/dynlink.c +++ b/runtime/dynlink.c @@ -73,7 +73,7 @@ static c_primitive lookup_primitive(char * name) /* Parse the OCAML_STDLIB_DIR/ld.conf file and add the directories listed there to the search path */ -#define LD_CONF_NAME _T("ld.conf") +#define LD_CONF_NAME T("ld.conf") static char_os * parse_ld_conf(void) { @@ -86,10 +86,10 @@ static char_os * parse_ld_conf(void) #endif int ldconf, nread; - stdlib = caml_secure_getenv(_T("OCAMLLIB")); - if (stdlib == NULL) stdlib = caml_secure_getenv(_T("CAMLLIB")); + stdlib = caml_secure_getenv(T("OCAMLLIB")); + if (stdlib == NULL) stdlib = caml_secure_getenv(T("CAMLLIB")); if (stdlib == NULL) stdlib = OCAML_STDLIB_DIR; - ldconfname = caml_stat_strconcat_os(3, stdlib, _T("/"), LD_CONF_NAME); + ldconfname = caml_stat_strconcat_os(3, stdlib, T("/"), LD_CONF_NAME); if (stat_os(ldconfname, &st) == -1) { caml_stat_free(ldconfname); return NULL; @@ -109,7 +109,7 @@ static char_os * parse_ld_conf(void) caml_stat_free(config); q = wconfig; for (p = wconfig; *p != 0; p++) { - if (*p == _T('\n')) { + if (*p == '\n') { *p = 0; caml_ext_table_add(&caml_shared_libs_path, q); q = p + 1; @@ -165,7 +165,7 @@ void caml_build_primitive_table(char_os * lib_path, - directories specified in the executable - directories specified in the file /ld.conf */ tofree1 = caml_decompose_path(&caml_shared_libs_path, - caml_secure_getenv(_T("CAML_LD_LIBRARY_PATH"))); + caml_secure_getenv(T("CAML_LD_LIBRARY_PATH"))); if (lib_path != NULL) for (p = lib_path; *p != 0; p += strlen_os(p) + 1) caml_ext_table_add(&caml_shared_libs_path, p); diff --git a/runtime/spacetime_nat.c b/runtime/spacetime_nat.c index b479f3e23..cb3d9b792 100644 --- a/runtime/spacetime_nat.c +++ b/runtime/spacetime_nat.c @@ -176,9 +176,9 @@ static void open_snapshot_channel(void) #else pid = getpid(); #endif - snprintf_os(filename, filename_len, _T("%s/spacetime-%d"), + snprintf_os(filename, filename_len, T("%s/spacetime-%d"), automatic_snapshot_dir, pid); - filename[filename_len-1] = _T('\0'); + filename[filename_len-1] = '\0'; fd = open_os(filename, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY, 0666); if (fd == -1) { automatic_snapshots = 0; @@ -225,10 +225,10 @@ void caml_spacetime_initialize(void) caml_spacetime_static_shape_tables = &caml_spacetime_shapes; - ap_interval = caml_secure_getenv (_T("OCAML_SPACETIME_INTERVAL")); + ap_interval = caml_secure_getenv (T("OCAML_SPACETIME_INTERVAL")); if (ap_interval != NULL) { unsigned int interval = 0; - sscanf_os(ap_interval, _T("%u"), &interval); + sscanf_os(ap_interval, T("%u"), &interval); if (interval != 0) { double time; char_os cwd[4096]; @@ -236,7 +236,7 @@ void caml_spacetime_initialize(void) int dir_ok = 1; user_specified_automatic_snapshot_dir = - caml_secure_getenv(_T("OCAML_SPACETIME_SNAPSHOT_DIR")); + caml_secure_getenv(T("OCAML_SPACETIME_SNAPSHOT_DIR")); if (user_specified_automatic_snapshot_dir == NULL) { #if defined(HAS_GETCWD) diff --git a/runtime/startup_aux.c b/runtime/startup_aux.c index 9c9625d67..a187d91a8 100644 --- a/runtime/startup_aux.c +++ b/runtime/startup_aux.c @@ -69,50 +69,50 @@ int caml_cleanup_on_exit = 0; static void scanmult (char_os *opt, uintnat *var) { - char_os mult = _T(' '); + char_os mult = ' '; unsigned int val = 1; - sscanf_os (opt, _T("=%u%c"), &val, &mult); - sscanf_os (opt, _T("=0x%x%c"), &val, &mult); + sscanf_os (opt, T("=%u%c"), &val, &mult); + sscanf_os (opt, T("=0x%x%c"), &val, &mult); switch (mult) { - case _T('k'): *var = (uintnat) val * 1024; break; - case _T('M'): *var = (uintnat) val * (1024 * 1024); break; - case _T('G'): *var = (uintnat) val * (1024 * 1024 * 1024); break; + case 'k': *var = (uintnat) val * 1024; break; + case 'M': *var = (uintnat) val * (1024 * 1024); break; + case 'G': *var = (uintnat) val * (1024 * 1024 * 1024); break; default: *var = (uintnat) val; break; } } void caml_parse_ocamlrunparam(void) { - char_os *opt = caml_secure_getenv (_T("OCAMLRUNPARAM")); + char_os *opt = caml_secure_getenv (T("OCAMLRUNPARAM")); uintnat p; - if (opt == NULL) opt = caml_secure_getenv (_T("CAMLRUNPARAM")); + if (opt == NULL) opt = caml_secure_getenv (T("CAMLRUNPARAM")); if (opt != NULL){ - while (*opt != _T('\0')){ + while (*opt != '\0'){ switch (*opt++){ - case _T('a'): scanmult (opt, &p); caml_set_allocation_policy (p); break; - case _T('b'): scanmult (opt, &p); caml_record_backtrace(Val_bool (p)); + case 'a': scanmult (opt, &p); caml_set_allocation_policy (p); break; + case 'b': scanmult (opt, &p); caml_record_backtrace(Val_bool (p)); break; - case _T('c'): scanmult (opt, &p); caml_cleanup_on_exit = (p != 0); break; - case _T('h'): scanmult (opt, &caml_init_heap_wsz); break; - case _T('H'): scanmult (opt, &caml_use_huge_pages); break; - case _T('i'): scanmult (opt, &caml_init_heap_chunk_sz); break; - case _T('l'): scanmult (opt, &caml_init_max_stack_wsz); break; - case _T('M'): scanmult (opt, &caml_init_custom_major_ratio); break; - case _T('m'): scanmult (opt, &caml_init_custom_minor_ratio); break; - case _T('n'): scanmult (opt, &caml_init_custom_minor_max_bsz); break; - case _T('o'): scanmult (opt, &caml_init_percent_free); break; - case _T('O'): scanmult (opt, &caml_init_max_percent_free); break; - case _T('p'): scanmult (opt, &p); caml_parser_trace = (p != 0); break; - case _T('R'): break; /* see stdlib/hashtbl.mli */ - case _T('s'): scanmult (opt, &caml_init_minor_heap_wsz); break; - case _T('t'): scanmult (opt, &caml_trace_level); break; - case _T('v'): scanmult (opt, &caml_verb_gc); break; - case _T('w'): scanmult (opt, &caml_init_major_window); break; - case _T('W'): scanmult (opt, &caml_runtime_warnings); break; + case 'c': scanmult (opt, &p); caml_cleanup_on_exit = (p != 0); break; + case 'h': scanmult (opt, &caml_init_heap_wsz); break; + case 'H': scanmult (opt, &caml_use_huge_pages); break; + case 'i': scanmult (opt, &caml_init_heap_chunk_sz); break; + case 'l': scanmult (opt, &caml_init_max_stack_wsz); break; + case 'M': scanmult (opt, &caml_init_custom_major_ratio); break; + case 'm': scanmult (opt, &caml_init_custom_minor_ratio); break; + case 'n': scanmult (opt, &caml_init_custom_minor_max_bsz); break; + case 'o': scanmult (opt, &caml_init_percent_free); break; + case 'O': scanmult (opt, &caml_init_max_percent_free); break; + case 'p': scanmult (opt, &p); caml_parser_trace = (p != 0); break; + case 'R': break; /* see stdlib/hashtbl.mli */ + case 's': scanmult (opt, &caml_init_minor_heap_wsz); break; + case 't': scanmult (opt, &caml_trace_level); break; + case 'v': scanmult (opt, &caml_verb_gc); break; + case 'w': scanmult (opt, &caml_init_major_window); break; + case 'W': scanmult (opt, &caml_runtime_warnings); break; } - while (*opt != _T('\0')){ + while (*opt != '\0'){ if (*opt++ == ',') break; } } diff --git a/runtime/startup_byt.c b/runtime/startup_byt.c index 1f6489566..a996788bc 100644 --- a/runtime/startup_byt.c +++ b/runtime/startup_byt.c @@ -260,40 +260,40 @@ static int parse_command_line(char_os **argv) { int i, j; - for(i = 1; argv[i] != NULL && argv[i][0] == _T('-'); i++) { + for(i = 1; argv[i] != NULL && argv[i][0] == '-'; i++) { switch(argv[i][1]) { - case _T('t'): + case 't': ++ caml_trace_level; /* ignored unless DEBUG mode */ break; - case _T('v'): - if (!strcmp_os (argv[i], _T("-version"))){ + case 'v': + if (!strcmp_os (argv[i], T("-version"))){ printf ("%s\n", "The OCaml runtime, version " OCAML_VERSION_STRING); exit (0); - }else if (!strcmp_os (argv[i], _T("-vnum"))){ + }else if (!strcmp_os (argv[i], T("-vnum"))){ printf ("%s\n", OCAML_VERSION_STRING); exit (0); }else{ caml_verb_gc = 0x001+0x004+0x008+0x010+0x020; } break; - case _T('p'): + case 'p': for (j = 0; caml_names_of_builtin_cprim[j] != NULL; j++) printf("%s\n", caml_names_of_builtin_cprim[j]); exit(0); break; - case _T('b'): + case 'b': caml_record_backtrace(Val_true); break; - case _T('I'): + case 'I': if (argv[i + 1] != NULL) { caml_ext_table_add(&caml_shared_libs_path, argv[i + 1]); i++; } break; - case _T('m'): + case 'm': print_magic = 1; break; - case _T('M'): + case 'M': printf ( "%s\n", EXEC_MAGIC); exit(0); break; @@ -440,7 +440,7 @@ CAMLexport void caml_main(char_os **argv) caml_sys_init(exe_name, argv + pos); #ifdef _WIN32 /* Start a thread to handle signals */ - if (caml_secure_getenv(_T("CAMLSIGPIPE"))) + if (caml_secure_getenv(T("CAMLSIGPIPE"))) _beginthread(caml_signal_thread, 4096, NULL); #endif /* Execute the program */ @@ -488,7 +488,7 @@ CAMLexport value caml_startup_code_exn( caml_install_invalid_parameter_handler(); #endif caml_init_custom_operations(); - cds_file = caml_secure_getenv(_T("CAML_DEBUG_FILE")); + cds_file = caml_secure_getenv(T("CAML_DEBUG_FILE")); if (cds_file != NULL) { caml_cds_file = caml_stat_strdup_os(cds_file); } diff --git a/runtime/startup_nat.c b/runtime/startup_nat.c index 43b85e319..b4e6bc474 100644 --- a/runtime/startup_nat.c +++ b/runtime/startup_nat.c @@ -146,7 +146,7 @@ value caml_startup_common(char_os **argv, int pooling) caml_init_backtrace(); caml_debugger_init (); /* force debugger.o stub to be linked */ exe_name = argv[0]; - if (exe_name == NULL) exe_name = _T(""); + if (exe_name == NULL) exe_name = T(""); proc_self_exe = caml_executable_name(); if (proc_self_exe != NULL) exe_name = proc_self_exe; diff --git a/runtime/win32.c b/runtime/win32.c index f6ae5a0a1..d86d6f83c 100644 --- a/runtime/win32.c +++ b/runtime/win32.c @@ -451,7 +451,7 @@ void caml_signal_thread(void * lpParam) HANDLE h; /* Get an hexa-code raw handle through the environment */ h = (HANDLE) (uintptr_t) - wcstol(caml_secure_getenv(_T("CAMLSIGPIPE")), &endptr, 16); + wcstol(caml_secure_getenv(T("CAMLSIGPIPE")), &endptr, 16); while (1) { DWORD numread; BOOL ret;