Merge pull request #1110 from rgrinberg/1102

Fix #1102

CHANGES.md

@@ -9,8 +9,12 @@ next
 - Fix duplicate profile argument in suggested command when an external library
   is missing (#1109, #1106, @emillon)
 
-- Fix #1107. `-opaque` wasn't correctly being added to modules without
-  an interface. (#1108, fix #1107, @rgrinberg)
+- `-opaque` wasn't correctly being added to modules without an interface.
+  (#1108, fix #1107, @rgrinberg)
+
+- Fix validation of library `name` fields and make sure this validation also
+  applies when the `name` is derived from the `public_name`. (#1110, fix #1102,
+  @rgrinberg)
 
 1.1.0 (06/08/2018)
 ------------------

src/jbuild.ml

@@ -37,21 +37,81 @@ let module_name =
 
 let module_names = list module_name >>| String.Set.of_list
 
-let invalid_lib_name ~loc = of_sexp_errorf loc "invalid library name"
+module Lib_name : sig
+  type t
 
-let library_name =
-  plain_string (fun ~loc name ->
+  type result =
+    | Ok of t
+    | Warn of t
+    | Invalid
+
+  val invalid_message : string
+
+  val to_string : t -> string
+
+  val of_string : string -> result
+
+  val validate : (Loc.t * result) -> wrapped:bool -> t
+
+  val t : (Loc.t * result) Sexp.Of_sexp.t
+end = struct
+  type t = string
+
+  let invalid_message =
+    "invalid library name.\n\
+     Hint: library names must be non-empty and composed only of \
+     the following characters: 'A'..'Z',  'a'..'z', '_'  or '0'..'9'"
+
+  let wrapped_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."
+      invalid_message
+
+  type result =
+    | Ok of t
+    | Warn of t
+    | Invalid
+
+  let validate (loc, res) ~wrapped =
+    match res, wrapped with
+    | Ok s, _ -> s
+    | Warn _, true -> Loc.fail loc "%s" wrapped_message
+    | Warn s, false -> Loc.warn loc "%s" wrapped_message; s
+    | Invalid, _ -> Loc.fail loc "%s" invalid_message
+
+  let valid_char = function
+    | 'A'..'Z' | 'a'..'z' | '_' | '0'..'9' -> true
+    | _ -> false
+
+  let to_string s = s
+
+  let of_string name =
     match name with
-    | "" -> invalid_lib_name ~loc
+    | "" -> Invalid
     | s ->
-      if s.[0] = '.' then invalid_lib_name ~loc
+      if s.[0] = '.' then
+        Invalid
       else
-        try
-          String.iter s ~f:(function
-            | 'A'..'Z' | 'a'..'z' | '_' | '.' | '0'..'9' -> ()
-            | _ -> raise_notrace Exit);
-          s
-        with Exit -> invalid_lib_name ~loc)
+        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 -> (loc, of_string s))
+end
 
 let file =
   plain_string (fun ~loc s ->
@@ -868,7 +928,7 @@ module Library = struct
     record
       (let%map buildable = Buildable.t
        and loc = loc
-       and name = field_o "name" library_name
+       and name = field_o "name" Lib_name.t
        and public = Public_lib.public_name_field
        and synopsis = field_o "synopsis" string
        and install_c_headers =
@@ -899,10 +959,20 @@ module Library = struct
        in
        let name =
          match name, public with
-         | Some n, _ -> n
-         | None, Some { name = (_loc, name) ; _ }  ->
+         | Some n, _ ->
+           Lib_name.validate n ~wrapped
+           |> Lib_name.to_string
+         | None, Some { name = (loc, name) ; _ }  ->
            if dune_version >= (1, 1) then
-             name
+             match Lib_name.of_string name with
+             | Ok m -> Lib_name.to_string m
+             | Warn _ | Invalid ->
+               of_sexp_errorf loc
+                 "%s.\n\
+                  Public library names don't have this restriction. \
+                  You can either change this public name to be a valid library \
+                  name or add a \"name\" field with a valid library name."
+                 Lib_name.invalid_message
            else
              of_sexp_error loc "name field cannot be omitted before version \
                                 1.1 of the dune language"
@@ -1107,13 +1177,7 @@ module Executables = struct
     else
       s ^ "s"
 
-  let common
-    (* :  (Loc.t * string) list option
-     * -> (Loc.t * string) list option
-     * -> multi:bool
-     * -> unit
-     * -> t * Install_conf.t option Sexp.Of_sexp.t *)
-    =
+  let common =
     let%map buildable = Buildable.t
     and (_ : bool) = field "link_executables" ~default:true
                        (Syntax.deleted_in Stanza.syntax (1, 0) >>> bool)

test/blackbox-tests/dune.inc

@@ -490,6 +490,14 @@
     (run %{exe:cram.exe} -skip-versions 4.02.3 -test run.t)
     (diff? run.t run.t.corrected)))))
 
+(alias
+ (name name-field-validation)
+ (deps (package dune) (source_tree test-cases/name-field-validation))
+ (action
+  (chdir
+   test-cases/name-field-validation
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name no-installable-mode)
  (deps (package dune) (source_tree test-cases/no-installable-mode))
@@ -818,6 +826,7 @@
   (alias missing-loc-run)
   (alias multi-dir)
   (alias multiple-private-libs)
+  (alias name-field-validation)
   (alias no-installable-mode)
   (alias no-name-field)
   (alias null-dep)
@@ -908,6 +917,7 @@
   (alias misc)
   (alias missing-loc-run)
   (alias multi-dir)
+  (alias name-field-validation)
   (alias no-installable-mode)
   (alias no-name-field)
   (alias null-dep)

test/blackbox-tests/test-cases/name-field-validation/bar.ml

@@ -0,0 +1 @@
+Foo.run ();;

test/blackbox-tests/test-cases/name-field-validation/dune

@@ -0,0 +1,9 @@
+(library
+ (modules foo)
+ (name foo.bar)
+ (wrapped false))
+
+(executable
+ (modules bar)
+ (name bar)
+ (libraries foo.bar))

test/blackbox-tests/test-cases/name-field-validation/dune-project

@@ -0,0 +1 @@
+(lang dune 1.1)

test/blackbox-tests/test-cases/name-field-validation/foo.ml

@@ -0,0 +1 @@
+let run () = print_endline "foo"

test/blackbox-tests/test-cases/name-field-validation/run.t

@@ -0,0 +1,7 @@
+  $ dune exec ./bar.exe
+  File "dune", line 3, characters 7-14:
+  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

test/blackbox-tests/test-cases/no-name-field/public-name-invalid-name/dune

@@ -0,0 +1 @@
+(library (public_name c.find))

test/blackbox-tests/test-cases/no-name-field/public-name-invalid-name/dune-project

@@ -0,0 +1 @@
+(lang dune 1.1)

test/blackbox-tests/test-cases/no-name-field/public-name-invalid-wrapped-false/dune

@@ -0,0 +1,3 @@
+(library
+ (wrapped false)
+ (public_name foo.bar))

test/blackbox-tests/test-cases/no-name-field/run.t

@@ -4,7 +4,7 @@ the name field can be omitted for libraries when public_name is present
 
 this isn't possible for older syntax <= (1, 0)
   $ dune build --root no-name-lib-syntax-1-0
-  File "dune", line 1, characters 0-27:
+  File "dune", line 1, characters 22-25:
   Error: name field cannot be omitted before version 1.1 of the dune language
   [1]
 
@@ -17,3 +17,23 @@ executable(s) stanza works the same way
   File "dune", line 1, characters 0-36:
   Error: name field may not be omitted before dune version 1.1
   [1]
+
+there's only a public name but it's invalid as a name
+
+  $ dune build --root public-name-invalid-name
+  File "dune", line 1, characters 22-28:
+  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'.
+  Public library names don't have this restriction. You can either change this public name to be a valid library name or add a "name" field with a valid library name.
+  [1]
+
+there's only a public name which is invalid, but sine the library is unwrapped,
+it's just a warning
+
+  $ dune build --root public-name-invalid-wrapped-false
+  Info: creating file dune-project with this contents: (lang dune 1.1)
+  File "dune", line 3, characters 14-21:
+  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'.
+  Public library names don't have this restriction. You can either change this public name to be a valid library name or add a "name" field with a valid library name.
+  [1]