Stefan pushed to branch graveline at Stefan / Typer

Commits: 2abe090c by Stefan Monnier at 2018-07-24T00:25:35Z Move String.uppercase to a single place

Don't use String.uppercase_ascii yet, since it's not available in Debian stable's OCaml package. Also get rid of some leading underscores.

* src/util.ml (string_uppercase): New function. * tests/utest_lib.ml (must_run_section, must_run_title): * tests/utest_main.ml (must_run): Use it and simplify.

- - - - - c08685e0 by Stefan Monnier at 2018-07-24T00:57:53Z Merge branch 'trunk' into graveline

- - - - -

4 changed files:

- src/util.ml - tests/env_test.ml - tests/utest_lib.ml - tests/utest_main.ml

Changes:

===================================== src/util.ml ===================================== @@ -55,7 +55,7 @@ let loc_print loc = print_string (loc_string loc) * 3 - Info *)

-let _typer_verbose = ref 20 +let typer_verbose = ref 20

exception Internal_error of string let internal_error s = raise (Internal_error s) @@ -75,7 +75,7 @@ let msg_message stop lvl kind section (loc: location) msg = ^ ":" ^ kind ^ (if section = "" then " " else "(" ^ section ^ ") ") ^ msg ^ "\n") in - if lvl <= !_typer_verbose then + if lvl <= !typer_verbose then (print_string (preppend_loc msg); if stop then stop_compilation (preppend_loc "Compiler stopped on first error") @@ -98,13 +98,17 @@ let msg_info = msg_message false 3 "Info:"

(* Compiler Internal Debug print *) let debug_msg expr = - if 4 <= !_typer_verbose then (print_string expr; flush stdout) else () + if 4 <= !typer_verbose then (print_string expr; flush stdout) else ()

let not_implemented_error () = internal_error "not implemented"

let string_implode chars = String.concat "" (List.map (String.make 1) chars) let string_sub str b e = String.sub str b (e - b)

+(* `String.uppercase` is deprecated since OCaml-4.03, but the replacement + * `String.uppercase_ascii` is not yet available in Debian stable's `ocaml`. *) +let string_uppercase s = String.uppercase s + let opt_map f x = match x with None -> None | Some x -> Some (f x)

let str_split str sep =

===================================== tests/env_test.ml ===================================== @@ -42,7 +42,7 @@ let make_val value = Vstring(value)

let _ = (add_test "ENV" "Set Variables" (fun () ->

- if 10 <= (!_global_verbose_lvl) then ( + if 10 <= (!global_verbose_lvl) then (

let var = [ ((dloc, Some "a"), DB.type_int, (make_val "a"));

===================================== tests/utest_lib.ml ===================================== @@ -3,7 +3,7 @@ * * --------------------------------------------------------------------------- * - * Copyright (C) 2011-2016, 2018 Free Software Foundation, Inc. + * Copyright (C) 2011-2018 Free Software Foundation, Inc. * * Author: Pierre Delaunay pierre.delaunay@hec.ca * Keywords: languages, lisp, dependent types. @@ -31,7 +31,7 @@ * --------------------------------------------------------------------------- *)

-open Util +module U = Util open Fmt

module StringMap = @@ -52,10 +52,10 @@ let failure () = (-1) * "Lambda" - "Base Case" * "Lambda" - "Nested" *) -let _global_sections = ref StringMap.empty -let _insertion_order = ref [] -let _ret_code = ref 0 -let _number_test = ref 0 +let global_sections = ref StringMap.empty +let insertion_order = ref [] +let ret_code = ref 0 +let number_test = ref 0

(* Exception *) exception Unexpected_result of string @@ -69,47 +69,43 @@ exception Unexpected_result of string * 2: Print Each composing Test * 3: use debug *) -let _global_verbose_lvl = ref 0 -let _global_sample_dir = ref "" -let _global_fsection = ref "" -let _global_ftitle = ref "" +let global_verbose_lvl = ref 0 +let global_sample_dir = ref "" +let global_fsection = ref "" +let global_ftitle = ref ""

let set_verbose lvl = - _global_verbose_lvl := lvl; - (if lvl >= 3 then _typer_verbose := 20 else _typer_verbose := (-1)) + global_verbose_lvl := lvl; + (if lvl >= 3 then U.typer_verbose := 20 else U.typer_verbose := (-1))

let arg_defs = [ ("--verbose=", Arg.Int set_verbose, " Set verbose level"); ("--samples=", - Arg.String (fun g -> _global_sample_dir := g), " Set sample directory"); + Arg.String (fun g -> global_sample_dir := g), " Set sample directory"); (* Allow users to select which test to run *) ("--fsection=", - Arg.String (fun g -> _global_fsection := String.uppercase_ascii g), + Arg.String (fun g -> global_fsection := U.string_uppercase g), " Set test filter"); ("--ftitle=", - Arg.String (fun g -> _global_ftitle := String.uppercase_ascii g), + Arg.String (fun g -> global_ftitle := U.string_uppercase g), " Set test filter"); ]

let must_run_section str = - if (String.length !_global_fsection) != 0 then - let name = String.uppercase_ascii str in - if name = !_global_fsection then true else false - else true + !global_fsection = "" + || U.string_uppercase str = !global_fsection

let must_run_title str = - if (String.length !_global_ftitle) != 0 then - let name = String.uppercase_ascii str in - if name = !_global_ftitle then true else false - else true + !global_ftitle = "" + || U.string_uppercase str = !global_ftitle

let parse_args () = Arg.parse arg_defs (fun s -> ()) ""

(* Utest printing function *) (* ---------------------------------------- *) -let ut_string vb msg = if vb <= (!_global_verbose_lvl) then print_string msg else () +let ut_string vb msg = if vb <= (!global_verbose_lvl) then print_string msg else () let ut_string2 = ut_string 2

@@ -142,10 +138,10 @@ let expect_equal_str = _expect_equal_t (fun g -> g)

let add_section sname = try - StringMap.find sname (!_global_sections) + StringMap.find sname (!global_sections) with Not_found -> - _insertion_order := sname::(!_insertion_order); + insertion_order := sname::(!insertion_order); (StringMap.empty, ref [])

(* USAGE *) @@ -173,9 +169,9 @@ let add_test sname tname tfun =

(* add test *) let ntmap = StringMap.add tname tfun tmap in - _global_sections := StringMap.add sname (ntmap, lst) (!_global_sections); + global_sections := StringMap.add sname (ntmap, lst) (!global_sections);

- _number_test := (!_number_test + 1) + number_test := (!number_test + 1)

(* sk : Section Key * tmap: test_name -> tmap @@ -190,13 +186,13 @@ let for_all_tests sk tmap tk = ut_string2 (green ^ "[ OK] " ^ sk ^ " - " ^ tk ^ "\n" ^ reset)) else( ut_string2 (red ^ "[ FAIL] " ^ sk ^ " - " ^ tk ^ "\n" ^ reset); - _ret_code := failure ()) + ret_code := failure ()) with e -> - _ret_code := failure (); + ret_code := failure (); unexpected_throw sk tk e) else ()

let for_all_sections sk = - let tmap, tst = StringMap.find sk (!_global_sections) in + let tmap, tst = StringMap.find sk (!global_sections) in

if (must_run_section sk) then( ut_string2 ("[RUN ] " ^ sk ^ " \n"); @@ -209,10 +205,10 @@ let for_all_sections sk = let run_all () = parse_args ();

- _insertion_order := List.rev (!_insertion_order); + insertion_order := List.rev (!insertion_order);

(* iter over all sections *) - List.iter for_all_sections (!_insertion_order); + List.iter for_all_sections (!insertion_order);

(* return success or failure *) - exit !_ret_code + exit !ret_code

===================================== tests/utest_main.ml ===================================== @@ -3,7 +3,7 @@ * * --------------------------------------------------------------------------- * - * Copyright (C) 2011-2016, 2018 Free Software Foundation, Inc. + * Copyright (C) 2011-2018 Free Software Foundation, Inc. * * Author: Pierre Delaunay pierre.delaunay@hec.ca * Keywords: languages, lisp, dependent types. @@ -30,35 +30,36 @@ * * --------------------------------------------------------------------------- *) open Fmt +module U = Util

let cut_name str = String.sub str 0 (String.length str - 12)

-let _global_verbose_lvl = ref 5 -let _global_sample_dir = ref "./" -let _global_tests_dir = ref "./_build/tests/" -let _global_fsection = ref "" -let _global_ftitle = ref "" -let _global_filter = ref false +let global_verbose_lvl = ref 5 +let global_sample_dir = ref "./" +let global_tests_dir = ref "./_build/tests/" +let global_fsection = ref "" +let global_ftitle = ref "" +let global_filter = ref false

let arg_defs = [ ("--verbose=", - Arg.Int (fun g -> _global_verbose_lvl := g), " Set verbose level"); + Arg.Int (fun g -> global_verbose_lvl := g), " Set verbose level"); ("--samples=", - Arg.String (fun g -> _global_sample_dir := g), " Set sample directory"); + Arg.String (fun g -> global_sample_dir := g), " Set sample directory"); ("--tests=", - Arg.String (fun g -> _global_tests_dir := g), " Set tests directory"); + Arg.String (fun g -> global_tests_dir := g), " Set tests directory"); (* Allow users to select which test to run *) ("--fsection=", - Arg.String (fun g -> _global_fsection := String.uppercase_ascii g; - _global_filter := true), " Set test filter"); + Arg.String (fun g -> global_fsection := U.string_uppercase g; + global_filter := true), " Set test filter"); ("--ftitle=", - Arg.String (fun g -> _global_ftitle := String.uppercase_ascii g; - _global_filter := true), " Set test filter"); + Arg.String (fun g -> global_ftitle := U.string_uppercase g; + global_filter := true), " Set test filter"); ]

-let verbose n = (n <= (!_global_verbose_lvl)) +let verbose n = (n <= (!global_verbose_lvl))

let parse_args () = Arg.parse arg_defs (fun s -> ()) ""

@@ -86,10 +87,8 @@ let print_file_name i n name pass = print_string reset

let must_run str = - if (!_global_filter) then - let name = String.uppercase_ascii (cut_name str) in - if name = !_global_fsection then true else false - else true + not (!global_filter) + || U.string_uppercase (cut_name str) = !global_fsection

(* search *_test.byte executable en run them Usage: @@ -104,12 +103,12 @@ let main () = (*print_string ("[ ] Test folder: " ^ folder ^ "\n"); *)

(* get tests files *) - let folder = !_global_tests_dir in - let root_folder = !_global_sample_dir in + let folder = !global_tests_dir in + let root_folder = !global_sample_dir in

let files = try Sys.readdir folder with e ->( - print_string ("The folder: " ^ (! _global_tests_dir) ^ " does not exist.\n" ^ + print_string ("The folder: " ^ (! global_tests_dir) ^ " does not exist.\n" ^ "Have you tried "./utests --tests= ./tests" ?\n"); raise e; ) in @@ -132,9 +131,9 @@ let main () = let failed_test = ref 0 in let tests_n = ref 0 in let test_args = " --samples= " ^ root_folder ^ - " --verbose= " ^ (string_of_int !_global_verbose_lvl) ^ - (if (String.length !_global_ftitle) != 0 then - (" --ftitle= " ^ !_global_ftitle) else "") in + " --verbose= " ^ (string_of_int !global_verbose_lvl) ^ + (if not (!global_ftitle = "") then + (" --ftitle= " ^ !global_ftitle) else "") in

List.iter (fun file -> flush stdout;

View it on GitLab: https://gitlab.com/monnier/typer/compare/33a235957c9c9a3f09bd54598f54a001d0b...