diff --git a/src/jbuild.ml b/src/jbuild.ml index 269bb0b2..e3911ec4 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -40,13 +40,20 @@ let module_names = list module_name >>| String.Set.of_list module Lib_name : sig type t + type result = + | Ok of t + | Warn of t + | Invalid + val error_message : string + val warn_message : 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 type t = string @@ -55,28 +62,48 @@ end = struct Hint: library names must be non-empty and composed only of \ 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 of_string name = match name with - | "" -> None + | "" -> Invalid | s -> if s.[0] = '.' then - None + Invalid else - try - String.iter s ~f:(function - | 'A'..'Z' | 'a'..'z' | '_' | '0'..'9' -> () - | _ -> raise_notrace Exit); - Some s - with Exit -> None + let len = String.length s in + let rec loop warn i = + if i = len - 1 then + if warn then Warn s else Ok s + else + 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 -> - match of_string s with - | Some n -> n - | None -> invalid ~loc) + let t = plain_string (fun ~loc s -> (loc, of_string s)) end let file = @@ -925,20 +952,23 @@ module Library = struct in let name = 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) ; _ } -> if dune_version >= (1, 1) then match Lib_name.of_string name, wrapped with - | Some n, _ -> Lib_name.to_string n - | None, false -> - Loc.warn loc - "%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; + | Ok n, _ -> Lib_name.to_string n + | Warn _, false -> + Loc.warn loc "%s" Lib_name.warn_message; name - | None, true -> + | Warn _, true + | Invalid, _ -> of_sexp_errorf loc "%s.\n\ Public library names don't have this restriction. \ diff --git a/test/blackbox-tests/test-cases/name-field-validation/dune b/test/blackbox-tests/test-cases/name-field-validation/dune index dfa79dd3..4e9e2b26 100644 --- a/test/blackbox-tests/test-cases/name-field-validation/dune +++ b/test/blackbox-tests/test-cases/name-field-validation/dune @@ -6,4 +6,4 @@ (executable (modules bar) (name bar) - (libraries foo)) \ No newline at end of file + (libraries foo.bar)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/name-field-validation/run.t b/test/blackbox-tests/test-cases/name-field-validation/run.t index df486f6f..664c8467 100644 --- a/test/blackbox-tests/test-cases/name-field-validation/run.t +++ b/test/blackbox-tests/test-cases/name-field-validation/run.t @@ -1,5 +1,7 @@ $ dune exec ./bar.exe File "dune", line 3, characters 7-14: - Error: invalid library name. - Hint: library names must be non-empty and composed only of the following characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9' - [1] + 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'. + This is temporary allowed for libraries with (wrapped false). + It will not be supported in the future. Please choose a valid name field. + foo