Remove constructor side validation
And make the tests reflect back Invalid_argument Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
parent
5618be7ab0
commit
99fbac26ab
|
@ -149,7 +149,7 @@ module Lang = struct
|
||||||
in
|
in
|
||||||
let ver =
|
let ver =
|
||||||
Sexp.Of_sexp.parse Syntax.Version.t Univ_map.empty
|
Sexp.Of_sexp.parse Syntax.Version.t Univ_map.empty
|
||||||
(Atom (ver_loc, Sexp.Atom.of_string_exn Sexp.Atom.Dune ver)) in
|
(Atom (ver_loc, Sexp.Atom.of_string ver)) in
|
||||||
match Hashtbl.find langs name with
|
match Hashtbl.find langs name with
|
||||||
| None ->
|
| None ->
|
||||||
Loc.fail name_loc "Unknown language %S.%s" name
|
Loc.fail name_loc "Unknown language %S.%s" name
|
||||||
|
|
|
@ -11,8 +11,7 @@ let int n = Usexp.Atom (Usexp.Atom.of_int n)
|
||||||
let string = Usexp.atom_or_quoted_string
|
let string = Usexp.atom_or_quoted_string
|
||||||
let record l =
|
let record l =
|
||||||
let open Usexp in
|
let open Usexp in
|
||||||
List (List.map l ~f:(fun (n, v) ->
|
List (List.map l ~f:(fun (n, v) -> List [Atom(Atom.of_string n); v]))
|
||||||
List [Atom(Atom.of_string_exn Atom.Dune n); v]))
|
|
||||||
|
|
||||||
let sexp_of_position_no_file (p : Lexing.position) =
|
let sexp_of_position_no_file (p : Lexing.position) =
|
||||||
record
|
record
|
||||||
|
|
|
@ -34,8 +34,7 @@ module To_sexp = struct
|
||||||
let string_set set = list atom (String.Set.to_list set)
|
let string_set set = list atom (String.Set.to_list set)
|
||||||
let string_map f map = list (pair atom f) (String.Map.to_list map)
|
let string_map f map = list (pair atom f) (String.Map.to_list map)
|
||||||
let record l =
|
let record l =
|
||||||
List (List.map l ~f:(fun (n, v) ->
|
List (List.map l ~f:(fun (n, v) -> List [Atom(Atom.of_string n); v]))
|
||||||
List [Atom(Atom.of_string_exn Usexp.Atom.Dune n); v]))
|
|
||||||
let string_hashtbl f h =
|
let string_hashtbl f h =
|
||||||
string_map f
|
string_map f
|
||||||
(Hashtbl.foldi h ~init:String.Map.empty ~f:(fun key data acc ->
|
(Hashtbl.foldi h ~init:String.Map.empty ~f:(fun key data acc ->
|
||||||
|
@ -55,7 +54,7 @@ module To_sexp = struct
|
||||||
|
|
||||||
let record_fields (l : field list) =
|
let record_fields (l : field list) =
|
||||||
List (List.filter_map l ~f:(fun (k, v) ->
|
List (List.filter_map l ~f:(fun (k, v) ->
|
||||||
Option.map v ~f:(fun v -> List[Atom (Atom.of_string_exn Atom.Dune k); v])))
|
Option.map v ~f:(fun v -> List[Atom (Atom.of_string k); v])))
|
||||||
|
|
||||||
let unknown _ = unsafe_atom_of_string "<unknown>"
|
let unknown _ = unsafe_atom_of_string "<unknown>"
|
||||||
end
|
end
|
||||||
|
|
|
@ -4,10 +4,6 @@ let invalid_argf fmt = Printf.ksprintf invalid_arg fmt
|
||||||
|
|
||||||
type syntax = Jbuild | Dune
|
type syntax = Jbuild | Dune
|
||||||
|
|
||||||
let string_of_syntax = function
|
|
||||||
| Jbuild -> "jbuild"
|
|
||||||
| Dune -> "dune"
|
|
||||||
|
|
||||||
let (is_valid_jbuild, is_valid_dune) =
|
let (is_valid_jbuild, is_valid_dune) =
|
||||||
let rec jbuild s i len =
|
let rec jbuild s i len =
|
||||||
i = len ||
|
i = len ||
|
||||||
|
@ -31,29 +27,23 @@ let (is_valid_jbuild, is_valid_dune) =
|
||||||
in
|
in
|
||||||
(make jbuild, make dune)
|
(make jbuild, make dune)
|
||||||
|
|
||||||
let of_string syn s =
|
let of_string s = A s
|
||||||
match syn with
|
|
||||||
| Jbuild when is_valid_jbuild s -> Some (A s)
|
|
||||||
| Dune when is_valid_dune s -> Some (A s)
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let of_string_exn syn s =
|
|
||||||
match of_string syn s with
|
|
||||||
| Some s -> s
|
|
||||||
| None ->
|
|
||||||
invalid_argf "'%s' is not a valid %s atom" s (string_of_syntax syn)
|
|
||||||
|
|
||||||
let to_string (A t) syntax =
|
let to_string (A t) syntax =
|
||||||
match syntax with
|
match syntax with
|
||||||
| Jbuild -> t
|
| Jbuild ->
|
||||||
|
if is_valid_jbuild t then
|
||||||
|
t
|
||||||
|
else
|
||||||
|
invalid_argf "Dune atom '%s' cannot be printed" t
|
||||||
| Dune ->
|
| Dune ->
|
||||||
if is_valid_dune t then
|
if is_valid_dune t then
|
||||||
t
|
t
|
||||||
else
|
else
|
||||||
invalid_argf "Jbuild atom '%s' is not a valid dune atom" t
|
invalid_argf "Jbuild atom '%s' cannot be printed" t
|
||||||
|
|
||||||
let of_int i = of_string_exn Dune (string_of_int i)
|
let of_int i = of_string (string_of_int i)
|
||||||
let of_float x = of_string_exn Dune (string_of_float x)
|
let of_float x = of_string (string_of_float x)
|
||||||
let of_bool x = of_string_exn Dune (string_of_bool x)
|
let of_bool x = of_string (string_of_bool x)
|
||||||
let of_int64 i = of_string_exn Dune (Int64.to_string i)
|
let of_digest d = of_string (Digest.to_hex d)
|
||||||
let of_digest d = of_string_exn Dune (Digest.to_hex d)
|
let of_int64 i = of_string (Int64.to_string i)
|
||||||
|
|
|
@ -2,9 +2,9 @@ type t = private A of string [@@unboxed]
|
||||||
|
|
||||||
type syntax = Jbuild | Dune
|
type syntax = Jbuild | Dune
|
||||||
|
|
||||||
val of_string : syntax -> string -> t option
|
val is_valid_dune : string -> bool
|
||||||
|
|
||||||
val of_string_exn : syntax -> string -> t
|
val of_string : string -> t
|
||||||
|
|
||||||
val to_string : t -> syntax -> string
|
val to_string : t -> syntax -> string
|
||||||
|
|
||||||
|
|
|
@ -77,7 +77,7 @@ let hexdigit = ['0'-'9' 'a'-'f' 'A'-'F']
|
||||||
let atom_char_jbuild =
|
let atom_char_jbuild =
|
||||||
[^ ';' '(' ')' '"' ' ' '\t' '\r' '\n' '\012']
|
[^ ';' '(' ')' '"' ' ' '\t' '\r' '\n' '\012']
|
||||||
let atom_char_dune =
|
let atom_char_dune =
|
||||||
[^ ';' '(' ')' '"' '\000'-'\032' '\127'-'\255']
|
[^ '%' ';' '(' ')' '"' '\000'-'\032' '\127'-'\255']
|
||||||
|
|
||||||
(* rule for jbuild files *)
|
(* rule for jbuild files *)
|
||||||
rule jbuild_token = parse
|
rule jbuild_token = parse
|
||||||
|
@ -124,7 +124,7 @@ and jbuild_atom acc start = parse
|
||||||
error lexbuf "Internal error in the S-expression parser, \
|
error lexbuf "Internal error in the S-expression parser, \
|
||||||
please report upstream.";
|
please report upstream.";
|
||||||
lexbuf.lex_start_p <- start;
|
lexbuf.lex_start_p <- start;
|
||||||
Token.Atom (Atom.of_string_exn Jbuild acc)
|
Token.Atom (Atom.of_string acc)
|
||||||
}
|
}
|
||||||
|
|
||||||
and quoted_string mode = parse
|
and quoted_string mode = parse
|
||||||
|
@ -244,7 +244,8 @@ and token = parse
|
||||||
Quoted_string s
|
Quoted_string s
|
||||||
}
|
}
|
||||||
| atom_char_dune+ as s
|
| atom_char_dune+ as s
|
||||||
{ Token.Atom (Atom.of_string_exn Dune s) }
|
{ Token.Atom (Atom.of_string s) }
|
||||||
|
| _ as c { error lexbuf (Printf.sprintf "Invalid atom character '%c'" c) }
|
||||||
| eof
|
| eof
|
||||||
{ Eof }
|
{ Eof }
|
||||||
|
|
||||||
|
|
|
@ -19,14 +19,15 @@ type t =
|
||||||
|
|
||||||
type sexp = t
|
type sexp = t
|
||||||
|
|
||||||
let atom s = Atom (Atom.of_string_exn Dune s)
|
let atom s = Atom (Atom.of_string s)
|
||||||
|
|
||||||
let unsafe_atom_of_string s = atom s
|
let unsafe_atom_of_string s = atom s
|
||||||
|
|
||||||
let atom_or_quoted_string s =
|
let atom_or_quoted_string s =
|
||||||
match Atom.of_string Atom.Dune s with
|
if Atom.is_valid_dune s then
|
||||||
| None -> Quoted_string s
|
Atom (Atom.of_string s)
|
||||||
| Some a -> Atom a
|
else
|
||||||
|
Quoted_string s
|
||||||
|
|
||||||
let quote_length s =
|
let quote_length s =
|
||||||
let n = ref 0 in
|
let n = ref 0 in
|
||||||
|
@ -221,9 +222,10 @@ module Ast = struct
|
||||||
| List of Loc.t * t list
|
| List of Loc.t * t list
|
||||||
|
|
||||||
let atom_or_quoted_string loc s =
|
let atom_or_quoted_string loc s =
|
||||||
match Atom.of_string Atom.Dune s with
|
match atom_or_quoted_string s with
|
||||||
| None -> Quoted_string (loc, s)
|
| Atom a -> Atom (loc, a)
|
||||||
| Some a -> Atom (loc, a)
|
| Quoted_string s -> Quoted_string (loc, s)
|
||||||
|
| List _ -> assert false
|
||||||
|
|
||||||
let loc (Atom (loc, _) | Quoted_string (loc, _) | List (loc, _)) = loc
|
let loc (Atom (loc, _) | Quoted_string (loc, _) | List (loc, _)) = loc
|
||||||
|
|
||||||
|
|
|
@ -9,9 +9,9 @@ module Atom : sig
|
||||||
|
|
||||||
type syntax = Jbuild | Dune
|
type syntax = Jbuild | Dune
|
||||||
|
|
||||||
val of_string : syntax -> string -> t option
|
val is_valid_dune : string -> bool
|
||||||
|
|
||||||
val of_string_exn : syntax -> string -> t
|
val of_string : string -> t
|
||||||
|
|
||||||
val to_string : t -> syntax -> string
|
val to_string : t -> syntax -> string
|
||||||
|
|
||||||
|
|
|
@ -52,8 +52,9 @@ let parse s =
|
||||||
let f ~lexer =
|
let f ~lexer =
|
||||||
try
|
try
|
||||||
Ok (Sexp.parse_string ~fname:"" ~mode:Many ~lexer s)
|
Ok (Sexp.parse_string ~fname:"" ~mode:Many ~lexer s)
|
||||||
with Sexp.Parse_error e ->
|
with
|
||||||
Error (Sexp.Parse_error.message e)
|
| Sexp.Parse_error e -> Error (Sexp.Parse_error.message e)
|
||||||
|
| Invalid_argument e -> Error e
|
||||||
in
|
in
|
||||||
let jbuild = f ~lexer:Sexp.Lexer.jbuild_token in
|
let jbuild = f ~lexer:Sexp.Lexer.jbuild_token in
|
||||||
let dune = f ~lexer:Sexp.Lexer.token in
|
let dune = f ~lexer:Sexp.Lexer.token in
|
||||||
|
@ -140,7 +141,12 @@ parse {|"$bar%foo%"|}
|
||||||
|
|
||||||
parse {|\%{foo}|}
|
parse {|\%{foo}|}
|
||||||
[%%expect{|
|
[%%expect{|
|
||||||
Exception: Invalid_argument "'\\%{foo}' is not a valid dune atom".
|
- : parse_result =
|
||||||
|
Different
|
||||||
|
{jbuild =
|
||||||
|
Ok
|
||||||
|
[<printer pp_sexp_ast raised an exception: Invalid_argument("Jbuild atom '\\%{foo}' cannot be printed")>];
|
||||||
|
dune = Error "Invalid atom character '%'"}
|
||||||
|}]
|
|}]
|
||||||
|
|
||||||
parse {|\${foo}|}
|
parse {|\${foo}|}
|
||||||
|
@ -150,15 +156,30 @@ parse {|\${foo}|}
|
||||||
|
|
||||||
parse {|\$bar%foo%|}
|
parse {|\$bar%foo%|}
|
||||||
[%%expect{|
|
[%%expect{|
|
||||||
Exception: Invalid_argument "'\\$bar%foo%' is not a valid dune atom".
|
- : parse_result =
|
||||||
|
Different
|
||||||
|
{jbuild =
|
||||||
|
Ok
|
||||||
|
[<printer pp_sexp_ast raised an exception: Invalid_argument("Jbuild atom '\\$bar%foo%' cannot be printed")>];
|
||||||
|
dune = Error "Invalid atom character '%'"}
|
||||||
|}]
|
|}]
|
||||||
|
|
||||||
parse {|\$bar\%foo%|}
|
parse {|\$bar\%foo%|}
|
||||||
[%%expect{|
|
[%%expect{|
|
||||||
Exception: Invalid_argument "'\\$bar\\%foo%' is not a valid dune atom".
|
- : parse_result =
|
||||||
|
Different
|
||||||
|
{jbuild =
|
||||||
|
Ok
|
||||||
|
[<printer pp_sexp_ast raised an exception: Invalid_argument("Jbuild atom '\\$bar\\%foo%' cannot be printed")>];
|
||||||
|
dune = Error "Invalid atom character '%'"}
|
||||||
|}]
|
|}]
|
||||||
|
|
||||||
parse {|\$bar\%foo%{bar}|}
|
parse {|\$bar\%foo%{bar}|}
|
||||||
[%%expect{|
|
[%%expect{|
|
||||||
Exception: Invalid_argument "'\\$bar\\%foo%{bar}' is not a valid dune atom".
|
- : parse_result =
|
||||||
|
Different
|
||||||
|
{jbuild =
|
||||||
|
Ok
|
||||||
|
[<printer pp_sexp_ast raised an exception: Invalid_argument("Jbuild atom '\\$bar\\%foo%{bar}' cannot be printed")>];
|
||||||
|
dune = Error "Invalid atom character '%'"}
|
||||||
|}]
|
|}]
|
||||||
|
|
|
@ -23,8 +23,7 @@ let () =
|
||||||
| Atom _ -> true
|
| Atom _ -> true
|
||||||
| _ -> false
|
| _ -> false
|
||||||
in
|
in
|
||||||
let valid_dune_atom =
|
let valid_dune_atom = Usexp.Atom.is_valid_dune s in
|
||||||
Option.is_some (Usexp.Atom.of_string Dune s) in
|
|
||||||
if valid_dune_atom <> parser_recognizes_as_atom then begin
|
if valid_dune_atom <> parser_recognizes_as_atom then begin
|
||||||
Printf.eprintf
|
Printf.eprintf
|
||||||
"Usexp.Atom.is_valid error:\n\
|
"Usexp.Atom.is_valid error:\n\
|
||||||
|
|
Loading…
Reference in New Issue