Add tests for Ast_invariants

master
Jeremie Dimino 2016-01-25 17:10:55 +00:00
parent d8704f6ba8
commit 4ee998dbb4
3 changed files with 93 additions and 0 deletions

View File

@ -0,0 +1,26 @@
#########################################################################
# #
# OCaml #
# #
# Jeremie Dimino, Jane Street Europe #
# #
# Copyright 2015 Jane Street Group LLC #
# #
# All rights reserved. This file is distributed under the terms of #
# the GNU Lesser General Public License version 2.1, with the #
# special exception on linking described in the file ../LICENSE. #
# #
#########################################################################
BASEDIR=../..
COMPFLAGS=-I $(TOPDIR)/parsing -I $(TOPDIR)/utils
LIBRARIES=$(TOPDIR)/compilerlibs/ocamlcommon
MODULES=
MAIN_MODULE=test
include $(BASEDIR)/makefiles/Makefile.one
include $(BASEDIR)/makefiles/Makefile.common
# This test is a bit slow and there is little value in testing both
# versions so we run only the native code one:
NATIVECODE_ONLY=true

View File

@ -0,0 +1,67 @@
(***********************************************************************)
(* *)
(* OCaml *)
(* *)
(* Jeremie Dimino, Jane Street Europe *)
(* *)
(* Copyright 2015 Jane Street Group LLC *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file ../LICENSE. *)
(* *)
(***********************************************************************)
(* This test checks all ml files in the ocaml repository that are accepted
by the parser satisfy [Ast_invariants].
We don't check the invariants on the output of the parser, so this test
is to ensure that we the parser doesn't accept more than [Ast_invariants].
*)
let root = "../../.."
let () = assert (Sys.file_exists (Filename.concat root "VERSION"))
type _ kind =
| Implem : Parsetree.structure kind
| Interf : Parsetree.signature kind
let parse : type a. a kind -> Lexing.lexbuf -> a = function
| Implem -> Parse.implementation
| Interf -> Parse.interface
let invariants : type a. a kind -> a -> unit = function
| Implem -> Ast_invariants.structure
| Interf -> Ast_invariants.signature
let check_file kind fn =
Warnings.parse_options false "-a";
let ic = open_in fn in
Location.input_name := fn;
let lexbuf = Lexing.from_channel ic in
Location.init lexbuf fn;
match parse kind lexbuf with
| exception _ ->
(* A few files don't parse as they are meant for the toplevel;
ignore them *)
close_in ic
| ast ->
close_in ic;
try
invariants kind ast
with exn ->
Location.report_exception Format.std_formatter exn
let rec walk dir =
Array.iter
(fun fn ->
let fn = Filename.concat dir fn in
if Sys.is_directory fn then
walk fn
else if Filename.check_suffix fn ".mli" then
check_file Interf fn
else if Filename.check_suffix fn ".ml" then
check_file Implem fn)
(Sys.readdir dir)
let () = walk root