Simon Génier pushed to branch update-requirements at Stefan / Typer

Commits: b1ea81b1 by Simon Génier at 2020-09-12T20:50:51-04:00 Oops: fix broken tests on OCaml 4.05.0.

- - - - -

5 changed files:

- + src/float.ml - + src/int.ml - + src/option.ml - src/util.ml - tests/utest_lib.ml

Changes:

===================================== src/float.ml ===================================== @@ -0,0 +1,32 @@ +(* + * Typer compiler + * + * --------------------------------------------------------------------------- + * + * copyright (c) 2020 free software foundation, inc. + * + * author: Simon Génier simon.genier@umontreal.ca + * keywords: languages, lisp, dependent types. + * + * this file is part of typer. + * + * typer is free software; you can redistribute it and/or modify it under the + * terms of the gnu general public license as published by the free software + * foundation, either version 3 of the license, or (at your option) any + * later version. + * + * typer is distributed in the hope that it will be useful, but without any + * warranty; without even the implied warranty of merchantability or fitness + * for a particular purpose. see the gnu general public license for + * more details. + * + * you should have received a copy of the gnu general public license along + * with this program. if not, see http://www.gnu.org/licenses/. + * + * ---------------------------------------------------------------------------*) + +type t = float + +let equal (l : t) (r : t) : bool = l = r + +let compare (l : t) (r : t) : int = compare l r

===================================== src/int.ml ===================================== @@ -0,0 +1,32 @@ +(* + * Typer compiler + * + * --------------------------------------------------------------------------- + * + * copyright (c) 2020 free software foundation, inc. + * + * author: Simon Génier simon.genier@umontreal.ca + * keywords: languages, lisp, dependent types. + * + * this file is part of typer. + * + * typer is free software; you can redistribute it and/or modify it under the + * terms of the gnu general public license as published by the free software + * foundation, either version 3 of the license, or (at your option) any + * later version. + * + * typer is distributed in the hope that it will be useful, but without any + * warranty; without even the implied warranty of merchantability or fitness + * for a particular purpose. see the gnu general public license for + * more details. + * + * you should have received a copy of the gnu general public license along + * with this program. if not, see http://www.gnu.org/licenses/. + * + * ---------------------------------------------------------------------------*) + +type t = int + +let equal (l : t) (r : t) : bool = l = r + +let compare (l : t) (r : t) : int = compare l r

===================================== src/option.ml ===================================== @@ -0,0 +1,34 @@ +(* + * Typer compiler + * + * --------------------------------------------------------------------------- + * + * copyright (c) 2020 free software foundation, inc. + * + * author: Simon Génier simon.genier@umontreal.ca + * keywords: languages, lisp, dependent types. + * + * this file is part of typer. + * + * typer is free software; you can redistribute it and/or modify it under the + * terms of the gnu general public license as published by the free software + * foundation, either version 3 of the license, or (at your option) any + * later version. + * + * typer is distributed in the hope that it will be useful, but without any + * warranty; without even the implied warranty of merchantability or fitness + * for a particular purpose. see the gnu general public license for + * more details. + * + * you should have received a copy of the gnu general public license along + * with this program. if not, see http://www.gnu.org/licenses/. + * + * ---------------------------------------------------------------------------*) + +type 'a t = 'a option + +let equal (inner_equal : 'a -> 'a -> bool) (l : 'a t) (r : 'a t) : bool = + match l, r with + | Some l, Some r -> inner_equal l r + | None, None -> true + | _ -> false

===================================== src/util.ml ===================================== @@ -1,6 +1,6 @@ (* util.ml --- Misc definitions for Typer. -*- coding: utf-8 -*-

-Copyright (C) 2011-2018 Free Software Foundation, Inc. +Copyright (C) 2011-2020 Free Software Foundation, Inc.

Author: Stefan Monnier monnier@iro.umontreal.ca Keywords: languages, lisp, dependent types. @@ -20,9 +20,21 @@ more details. You should have received a copy of the GNU General Public License along with this program. If not, see http://www.gnu.org/licenses/. *)

-module SMap = Map.Make (String) - -module IMap = Map.Make (struct type t = int let compare = compare end) +(** Adds the update function to maps. This can be removed when we upgrade to + OCaml >= 4.06 *) +module UPDATABLE(Base : Map.S) = struct + include Base + + let update key f map = + let before = find_opt key map in + match before, f before with + | _, Some after -> add key after map + | Some before, None -> remove key map + | None, None -> map +end + +module SMap = UPDATABLE(Map.Make(String)) +module IMap = UPDATABLE(Map.Make(Int))

type charpos = int type bytepos = int

===================================== tests/utest_lib.ml ===================================== @@ -31,12 +31,10 @@ * --------------------------------------------------------------------------- *)

open Fmt - -module StringMap = - Map.Make (struct type t = string let compare = String.compare end) +open Util

type test_fun = unit -> int -type section = test_fun StringMap.t * string list +type section = test_fun SMap.t * string list

let success = 0 let failure = -1 @@ -48,7 +46,7 @@ let failure = -1 * "Lambda" - "Base Case" * "Lambda" - "Nested" *) -let global_sections = ref StringMap.empty +let global_sections = ref SMap.empty let insertion_order = ref [] let ret_code = ref 0 let number_test = ref 0 @@ -201,21 +199,21 @@ let add_test section_name test_name test_fun = let update_sections section = let updated_entry = match section with | Some (tests, order) - -> StringMap.update test_name update_tests tests, test_name :: order + -> SMap.update test_name update_tests tests, test_name :: order | None -> (insertion_order := section_name :: !insertion_order; - StringMap.singleton test_name test_fun, [test_name]) + SMap.singleton test_name test_fun, [test_name]) in Some updated_entry in - global_sections := StringMap.update section_name update_sections !global_sections + global_sections := SMap.update section_name update_sections !global_sections

(* sk : Section Key * tmap: test_name -> tmap * tk : Test Key *) let for_all_tests sk tmap tk = if (must_run_title tk) then ( - let tv = StringMap.find tk tmap in + let tv = SMap.find tk tmap in flush stdout; Log.clear_log (); try @@ -236,7 +234,7 @@ let for_all_tests sk tmap tk = unexpected_throw sk tk e) else ()

let for_all_sections sk = - let tmap, tst = StringMap.find sk (!global_sections) in + let tmap, tst = SMap.find sk (!global_sections) in let tst = List.rev tst in if must_run_section sk then (

View it on GitLab: https://gitlab.com/monnier/typer/-/commit/b1ea81b1ecac71ebe8f597c4467625f3cd...