Fix overly strict validation of invalid names
Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
parent
ca7696f2c3
commit
d30361a180
|
@ -40,13 +40,20 @@ let module_names = list module_name >>| String.Set.of_list
|
||||||
module Lib_name : sig
|
module Lib_name : sig
|
||||||
type t
|
type t
|
||||||
|
|
||||||
|
type result =
|
||||||
|
| Ok of t
|
||||||
|
| Warn of t
|
||||||
|
| Invalid
|
||||||
|
|
||||||
val error_message : string
|
val error_message : string
|
||||||
|
|
||||||
|
val warn_message : string
|
||||||
|
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
|
|
||||||
val of_string : string -> t option
|
val of_string : string -> result
|
||||||
|
|
||||||
val t : t Sexp.Of_sexp.t
|
val t : (Loc.t * result) Sexp.Of_sexp.t
|
||||||
end = struct
|
end = struct
|
||||||
type t = string
|
type t = string
|
||||||
|
|
||||||
|
@ -55,28 +62,48 @@ end = struct
|
||||||
Hint: library names must be non-empty and composed only of \
|
Hint: library names must be non-empty and composed only of \
|
||||||
the following characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'"
|
the following characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'"
|
||||||
|
|
||||||
let invalid ~loc = of_sexp_error loc error_message
|
let warn_message =
|
||||||
|
sprintf
|
||||||
|
"%s.\n\
|
||||||
|
This is temporary allowed for libraries with (wrapped false).\
|
||||||
|
\nIt will not be supported in the future. \
|
||||||
|
Please choose a valid name field."
|
||||||
|
error_message
|
||||||
|
|
||||||
|
type result =
|
||||||
|
| Ok of t
|
||||||
|
| Warn of t
|
||||||
|
| Invalid
|
||||||
|
|
||||||
|
let valid_char = function
|
||||||
|
| 'A'..'Z' | 'a'..'z' | '_' | '0'..'9' -> true
|
||||||
|
| _ -> false
|
||||||
|
|
||||||
let to_string s = s
|
let to_string s = s
|
||||||
|
|
||||||
let of_string name =
|
let of_string name =
|
||||||
match name with
|
match name with
|
||||||
| "" -> None
|
| "" -> Invalid
|
||||||
| s ->
|
| s ->
|
||||||
if s.[0] = '.' then
|
if s.[0] = '.' then
|
||||||
None
|
Invalid
|
||||||
else
|
else
|
||||||
try
|
let len = String.length s in
|
||||||
String.iter s ~f:(function
|
let rec loop warn i =
|
||||||
| 'A'..'Z' | 'a'..'z' | '_' | '0'..'9' -> ()
|
if i = len - 1 then
|
||||||
| _ -> raise_notrace Exit);
|
if warn then Warn s else Ok s
|
||||||
Some s
|
else
|
||||||
with Exit -> None
|
let c = String.unsafe_get s i in
|
||||||
|
if valid_char c then
|
||||||
|
loop warn (i + 1)
|
||||||
|
else if c = '.' then
|
||||||
|
loop true (i + 1)
|
||||||
|
else
|
||||||
|
Invalid
|
||||||
|
in
|
||||||
|
loop false 0
|
||||||
|
|
||||||
let t = plain_string (fun ~loc s ->
|
let t = plain_string (fun ~loc s -> (loc, of_string s))
|
||||||
match of_string s with
|
|
||||||
| Some n -> n
|
|
||||||
| None -> invalid ~loc)
|
|
||||||
end
|
end
|
||||||
|
|
||||||
let file =
|
let file =
|
||||||
|
@ -925,20 +952,23 @@ module Library = struct
|
||||||
in
|
in
|
||||||
let name =
|
let name =
|
||||||
match name, public with
|
match name, public with
|
||||||
| Some n, _ -> Lib_name.to_string n
|
| Some (loc, n), _ ->
|
||||||
|
begin match n, wrapped with
|
||||||
|
| Ok n, _ -> n
|
||||||
|
| Warn _, true -> Loc.fail loc "%s" Lib_name.error_message
|
||||||
|
| Warn n, false -> Loc.warn loc "%s" Lib_name.warn_message; n
|
||||||
|
| Invalid, _ -> Loc.fail loc "%s" Lib_name.error_message
|
||||||
|
end
|
||||||
|
|> Lib_name.to_string
|
||||||
| None, Some { name = (loc, name) ; _ } ->
|
| None, Some { name = (loc, name) ; _ } ->
|
||||||
if dune_version >= (1, 1) then
|
if dune_version >= (1, 1) then
|
||||||
match Lib_name.of_string name, wrapped with
|
match Lib_name.of_string name, wrapped with
|
||||||
| Some n, _ -> Lib_name.to_string n
|
| Ok n, _ -> Lib_name.to_string n
|
||||||
| None, false ->
|
| Warn _, false ->
|
||||||
Loc.warn loc
|
Loc.warn loc "%s" Lib_name.warn_message;
|
||||||
"%s.\n\
|
|
||||||
This is temporary allowed for libraries with (wrapped false).\
|
|
||||||
\nIt will not be supported in the future. \
|
|
||||||
Please choose a valid name field."
|
|
||||||
Lib_name.error_message;
|
|
||||||
name
|
name
|
||||||
| None, true ->
|
| Warn _, true
|
||||||
|
| Invalid, _ ->
|
||||||
of_sexp_errorf loc
|
of_sexp_errorf loc
|
||||||
"%s.\n\
|
"%s.\n\
|
||||||
Public library names don't have this restriction. \
|
Public library names don't have this restriction. \
|
||||||
|
|
|
@ -6,4 +6,4 @@
|
||||||
(executable
|
(executable
|
||||||
(modules bar)
|
(modules bar)
|
||||||
(name bar)
|
(name bar)
|
||||||
(libraries foo))
|
(libraries foo.bar))
|
|
@ -1,5 +1,7 @@
|
||||||
$ dune exec ./bar.exe
|
$ dune exec ./bar.exe
|
||||||
File "dune", line 3, characters 7-14:
|
File "dune", line 3, characters 7-14:
|
||||||
Error: invalid library name.
|
Warning: invalid library name.
|
||||||
Hint: library names must be non-empty and composed only of the following characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'
|
Hint: library names must be non-empty and composed only of the following characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'.
|
||||||
[1]
|
This is temporary allowed for libraries with (wrapped false).
|
||||||
|
It will not be supported in the future. Please choose a valid name field.
|
||||||
|
foo
|
||||||
|
|
Loading…
Reference in New Issue