From 90b5f607f4092c57097b0c0a391ba6a7f82be8a9 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 31 Jul 2019 13:55:23 +0700 Subject: [PATCH] Remove support for old style subsystems Signed-off-by: Rudi Grinberg --- CHANGES.md | 3 + src/findlib.ml | 14 ++- src/installed_dune_file.boot.ml | 3 - src/installed_dune_file.ml | 103 ------------------ src/installed_dune_file.mli | 9 -- .../test-cases/old-dune-subsystem/run.t | 9 ++ 6 files changed, 22 insertions(+), 119 deletions(-) delete mode 100644 src/installed_dune_file.boot.ml delete mode 100644 src/installed_dune_file.ml delete mode 100644 src/installed_dune_file.mli diff --git a/CHANGES.md b/CHANGES.md index 0bde6b6808a..bc9a72a779d 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -62,6 +62,9 @@ The global configuration merely specifies the default. (#2213, @aalekseyev, @jdimino) +- Remove support for old style subsystems. Dune will now emit a warning to + reinstall the library with the old style subsystem. (#2480, @rgrinberg) + 1.11.0 (23/07/2019) ------------------- diff --git a/src/findlib.ml b/src/findlib.ml index 8227d8ed1fb..c7c1e37d280 100644 --- a/src/findlib.ml +++ b/src/findlib.ml @@ -212,11 +212,17 @@ module Package = struct let to_dune t = let loc = loc t in let add_loc x = (loc, x) in - let sub_systems = - match dune_file t with - | None -> Sub_system_name.Map.empty - | Some p -> Installed_dune_file.load p + let () = + dune_file t + |> Option.iter ~f:(fun p -> + User_warning.emit ~loc:(Loc.in_file p) + [ Pp.text + ".dune files are ignored since 2.0. Reinstall the library with \ + dune >= 2.0 to get rid of this warning and enable support for \ + the subsystem this library provides." + ]) in + let sub_systems = Sub_system_name.Map.empty in let archives = archives t in let obj_dir = Obj_dir.make_external_no_private ~dir:t.dir in let modes : Mode.Dict.Set.t = diff --git a/src/installed_dune_file.boot.ml b/src/installed_dune_file.boot.ml deleted file mode 100644 index 66c41251a75..00000000000 --- a/src/installed_dune_file.boot.ml +++ /dev/null @@ -1,3 +0,0 @@ -let dune_lib_parse_sub_systems _ = - failwith "dune-package not available in bootstrap" -let load _ = failwith "dune-package not available in bootstrap" diff --git a/src/installed_dune_file.ml b/src/installed_dune_file.ml deleted file mode 100644 index 15420baa2f5..00000000000 --- a/src/installed_dune_file.ml +++ /dev/null @@ -1,103 +0,0 @@ -open! Stdune - -let parse_sub_system ~parsing_context ~name ~version ~data = - let (module M) = Sub_system_info.get name in - Syntax.check_supported M.syntax version; - let parsing_context, parse = - (* We set the syntax to the version used when generating this subsystem. - We cannot do this for jbuild defined subsystems however since those use - 1.0 as the version. Which would correspond to the dune syntax (because - subsystems share the syntax of the dune lang) *) - match Univ_map.find_exn parsing_context (Syntax.key Stanza.syntax) with - | (0, 0) -> - parsing_context, M.parse - | (_, _) -> - (Univ_map.add parsing_context (Syntax.key M.syntax) (snd version), - Dune_lang.Decoder.enter M.parse) - in - (* We generate too many parentheses in dune files at the moment *) - M.T (Dune_lang.Decoder.parse parse parsing_context data) - -let dune_lib_parse_sub_systems = - Sub_system_name.Map.mapi ~f:(fun name (version, data) -> - let (module M) = Sub_system_info.get name in - let parsing_context = - Univ_map.singleton (Syntax.key M.syntax) (snd version) in - parse_sub_system ~parsing_context ~name ~version ~data) - -let parse_sub_systems ~parsing_context sexps = - List.filter_map sexps ~f:(fun sexp -> - let name, ver, data = - Dune_lang.Decoder.( - parse - (triple string (located Syntax.Version.decode) raw) - parsing_context) - sexp - in - (* We ignore sub-systems that are not internally known. These - correspond to plugins that are not in use in the current - workspace. *) - Option.map (Sub_system_name.get name) ~f:(fun name -> - (name, (Dune_lang.Ast.loc sexp, ver, data)))) - |> Sub_system_name.Map.of_list - |> (function - | Ok x -> x - | Error (name, _, (loc, _, _)) -> - User_error.raise ~loc - [ Pp.textf "%S present twice" (Sub_system_name.to_string name) ]) - |> Sub_system_name.Map.mapi ~f:(fun name (_, version, data) -> - parse_sub_system ~parsing_context ~name ~version ~data) - -let of_sexp = - let open Dune_lang.Decoder in - let version = - plain_string (fun ~loc -> function - | "1" -> (0, 0) - | "2" -> (1, 0) - | v -> - User_error.raise ~loc - [ Pp.textf "Unsupported version %S, only version 1 is supported" v ]) - in - sum - [ "dune", - (let* version = version in - set (Syntax.key Stanza.syntax) version - (let+ parsing_context = get_all - and+ sub_systems = enter (repeat raw) - in - parse_sub_systems ~parsing_context sub_systems)) - ] - -let load fname = - Io.with_lexbuf_from_file fname ~f:(fun lexbuf -> - (* Installed dune files are versioned but they don't use the - [(lang ...)] line which was introduced after. Installed dune - files in version 1 are using the jbuild syntax and version 2 - are using the dune syntax, so we start by lexing the first - tokens with the dune lexer until we reach the file version, at - which point we can decide what lexer to use for the reset of - the file. *) - let state = ref 0 in - let lexer = ref Dune_lang.Lexer.token in - let lexer ~with_comments lb = - let token : Dune_lang.Lexer.Token.t = !lexer lb ~with_comments in - (match !state, token with - | 0, Lparen -> state := 1 - | 1, Atom (A "dune") -> state := 2 - | 2, Atom (A "1") -> state := 3; lexer := Dune_lang.Lexer.jbuild_token - | 2, Atom (A "2") -> state := 3; lexer := Dune_lang.Lexer.token - | 2, Atom (A version) -> - User_error.raise ~loc:(Loc.of_lexbuf lexbuf) - [ Pp.textf "Unsupported version %S" version ] - | 3, _ -> () - | _ -> - User_error.raise ~loc:(Loc.of_lexbuf lexbuf) - [ Pp.text - "This .dune file looks invalid, it should contain \ - a S-expression of the form (dune x.y ..)" - ] - ); - token - in - Dune_lang.Decoder.parse of_sexp Univ_map.empty - (Dune_lang.Parser.parse ~lexer ~mode:Single lexbuf)) diff --git a/src/installed_dune_file.mli b/src/installed_dune_file.mli deleted file mode 100644 index a6887429048..00000000000 --- a/src/installed_dune_file.mli +++ /dev/null @@ -1,9 +0,0 @@ -(** Dune files that are installed on the system *) - -open! Stdune - -val dune_lib_parse_sub_systems - : ((Loc.t * Syntax.Version.t) * Dune_lang.Ast.t) Sub_system_name.Map.t - -> Sub_system_info.t Sub_system_name.Map.t - -val load : Path.t -> Sub_system_info.t Sub_system_name.Map.t diff --git a/test/blackbox-tests/test-cases/old-dune-subsystem/run.t b/test/blackbox-tests/test-cases/old-dune-subsystem/run.t index 0b9d39d3bde..bc3133c00b2 100644 --- a/test/blackbox-tests/test-cases/old-dune-subsystem/run.t +++ b/test/blackbox-tests/test-cases/old-dune-subsystem/run.t @@ -5,3 +5,12 @@ we understand the old files. $ env OCAMLPATH=install/lib dune runtest --root example Entering directory 'example' + File "$TESTCASE_ROOT/install/lib/dune_inline_tests/dune_inline_tests.dune", line 1, characters 0-0: + Warning: .dune files are ignored since 2.0. Reinstall the library with dune + >= 2.0 to get rid of this warning and enable support for the subsystem this + library provides. + File "src/dune", line 3, characters 25-42: + 3 | (inline_tests (backend dune_inline_tests))) + ^^^^^^^^^^^^^^^^^ + Error: dune_inline_tests is not an inline tests backend + [1]