From b32159c8f3480093ff8ba3b04ff933fdbc2bc4cf Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Wed, 29 May 2024 13:28:55 +0200 Subject: [PATCH 1/3] Remove the light mode --- .depend | 38 +---- Makefile | 15 +- bin/ocamlbuild.ml | 1 - bin/ocamlbuildlight.ml | 16 -- bin/ocamlbuildlight.mli | 16 -- bootstrap/_tags | 3 +- bootstrap/bootstrap.itarget | 2 - plugin-lib/ocamlbuild_unix_plugin.ml | 104 ------------ plugin-lib/ocamlbuild_unix_plugin.mli | 16 -- src/command.ml | 3 +- src/log.ml | 2 +- src/my_unix.ml | 176 ++++++++------------ src/my_unix.mli | 25 --- src/ocaml_specific.ml | 1 - {plugin-lib => src}/ocamlbuild_executor.ml | 0 {plugin-lib => src}/ocamlbuild_executor.mli | 0 src/plugin.ml | 31 +--- src/resource.ml | 8 +- src/shell.ml | 2 +- src/slurp.ml | 21 +-- testsuite/ocamlbuild_test.ml | 8 +- 21 files changed, 98 insertions(+), 390 deletions(-) delete mode 100644 bin/ocamlbuildlight.ml delete mode 100644 bin/ocamlbuildlight.mli delete mode 100644 plugin-lib/ocamlbuild_unix_plugin.ml delete mode 100644 plugin-lib/ocamlbuild_unix_plugin.mli rename {plugin-lib => src}/ocamlbuild_executor.ml (100%) rename {plugin-lib => src}/ocamlbuild_executor.mli (100%) diff --git a/.depend b/.depend index 371850c3..d0db0554 100644 --- a/.depend +++ b/.depend @@ -1,15 +1,8 @@ bin/ocamlbuild.cmo : \ - plugin-lib/ocamlbuild_unix_plugin.cmi \ bin/ocamlbuild.cmi bin/ocamlbuild.cmx : \ - plugin-lib/ocamlbuild_unix_plugin.cmx \ bin/ocamlbuild.cmi bin/ocamlbuild.cmi : -bin/ocamlbuildlight.cmo : \ - bin/ocamlbuildlight.cmi -bin/ocamlbuildlight.cmx : \ - bin/ocamlbuildlight.cmi -bin/ocamlbuildlight.cmi : bin/ppcache.cmo : \ src/shell.cmi \ src/pathname.cmi \ @@ -25,29 +18,11 @@ bin/ppcache.cmx : \ src/command.cmx \ bin/ppcache.cmi bin/ppcache.cmi : -plugin-lib/ocamlbuild_executor.cmo : \ - plugin-lib/ocamlbuild_executor.cmi -plugin-lib/ocamlbuild_executor.cmx : \ - plugin-lib/ocamlbuild_executor.cmi -plugin-lib/ocamlbuild_executor.cmi : plugin-lib/ocamlbuild_plugin.cmo : \ plugin-lib/ocamlbuild_plugin.cmi plugin-lib/ocamlbuild_plugin.cmx : \ plugin-lib/ocamlbuild_plugin.cmi plugin-lib/ocamlbuild_plugin.cmi : -plugin-lib/ocamlbuild_unix_plugin.cmo : \ - plugin-lib/ocamlbuild_executor.cmi \ - src/my_unix.cmi \ - src/my_std.cmi \ - src/exit_codes.cmi \ - plugin-lib/ocamlbuild_unix_plugin.cmi -plugin-lib/ocamlbuild_unix_plugin.cmx : \ - plugin-lib/ocamlbuild_executor.cmx \ - src/my_unix.cmx \ - src/my_std.cmx \ - src/exit_codes.cmx \ - plugin-lib/ocamlbuild_unix_plugin.cmi -plugin-lib/ocamlbuild_unix_plugin.cmi : src/bool.cmo : \ src/bool.cmi src/bool.cmx : \ @@ -349,10 +324,14 @@ src/my_std.cmx : \ src/my_std.cmi : \ src/signatures.cmi src/my_unix.cmo : \ + src/ocamlbuild_executor.cmi \ src/my_std.cmi \ + src/exit_codes.cmi \ src/my_unix.cmi src/my_unix.cmx : \ + src/ocamlbuild_executor.cmx \ src/my_std.cmx \ + src/exit_codes.cmx \ src/my_unix.cmi src/my_unix.cmi : src/ocaml_arch.cmo : \ @@ -515,6 +494,11 @@ src/ocaml_utils.cmi : \ src/command.cmi src/ocamlbuild_config.cmo : src/ocamlbuild_config.cmx : +src/ocamlbuild_executor.cmo : \ + src/ocamlbuild_executor.cmi +src/ocamlbuild_executor.cmx : \ + src/ocamlbuild_executor.cmi +src/ocamlbuild_executor.cmi : src/ocamlbuild_where.cmo : \ src/ocamlbuild_config.cmo \ src/ocamlbuild_where.cmi @@ -590,7 +574,6 @@ src/plugin.cmo : \ src/param_tags.cmi \ src/options.cmi \ src/ocamlbuild_where.cmi \ - src/my_unix.cmi \ src/my_std.cmi \ src/log.cmi \ src/exit_codes.cmi \ @@ -606,7 +589,6 @@ src/plugin.cmx : \ src/param_tags.cmx \ src/options.cmx \ src/ocamlbuild_where.cmx \ - src/my_unix.cmx \ src/my_std.cmx \ src/log.cmx \ src/exit_codes.cmx \ @@ -635,7 +617,6 @@ src/resource.cmo : \ src/shell.cmi \ src/pathname.cmi \ src/options.cmi \ - src/my_unix.cmi \ src/my_std.cmi \ src/log.cmi \ src/lexers.cmi \ @@ -650,7 +631,6 @@ src/resource.cmx : \ src/shell.cmx \ src/pathname.cmx \ src/options.cmx \ - src/my_unix.cmx \ src/my_std.cmx \ src/log.cmx \ src/lexers.cmx \ diff --git a/Makefile b/Makefile index 2cd1511d..124085be 100644 --- a/Makefile +++ b/Makefile @@ -38,7 +38,9 @@ PACK_CMO= $(addprefix src/,\ loc.cmo \ discard_printf.cmo \ signatures.cmi \ + exit_codes.cmo \ my_std.cmo \ + ocamlbuild_executor.cmo \ my_unix.cmo \ tags.cmo \ display.cmo \ @@ -73,7 +75,6 @@ PACK_CMO= $(addprefix src/,\ ocaml_compiler.cmo \ ocaml_tools.cmo \ ocaml_specific.cmo \ - exit_codes.cmo \ plugin.cmo \ hooks.cmo \ main.cmo \ @@ -81,8 +82,6 @@ PACK_CMO= $(addprefix src/,\ EXTRA_CMO=$(addprefix plugin-lib/,\ ocamlbuild_plugin.cmo \ - ocamlbuild_executor.cmo \ - ocamlbuild_unix_plugin.cmo \ ) PACK_CMX=$(PACK_CMO:.cmo=.cmx) @@ -117,7 +116,7 @@ all: byte man endif byte: ocamlbuild.byte plugin-lib/ocamlbuildlib.cma - # ocamlbuildlight.byte ocamlbuildlightlib.cma + native: ocamlbuild.native plugin-lib/ocamlbuildlib.cmxa allopt: all # compatibility alias @@ -129,9 +128,6 @@ distclean:: clean ocamlbuild.byte: src/ocamlbuild_pack.cmo $(EXTRA_CMO) bin/ocamlbuild.cmo $(OCAMLC) $(LINKFLAGS) -o $@ -I +unix unix.cma $^ -ocamlbuildlight.byte: src/ocamlbuild_pack.cmo bin/ocamlbuildlight.cmo - $(OCAMLC) $(LINKFLAGS) -o $@ $^ - ocamlbuild.native: src/ocamlbuild_pack.cmx $(EXTRA_CMX) bin/ocamlbuild.cmx $(OCAMLOPT) $(LINKFLAGS) -o $@ -I +unix unix.cmxa $^ @@ -140,9 +136,6 @@ ocamlbuild.native: src/ocamlbuild_pack.cmx $(EXTRA_CMX) bin/ocamlbuild.cmx plugin-lib/ocamlbuildlib.cma: src/ocamlbuild_pack.cmo $(EXTRA_CMO) $(OCAMLC) -a -o $@ $^ -bin/ocamlbuildlightlib.cma: src/ocamlbuild_pack.cmo bin/ocamlbuildlight.cmo - $(OCAMLC) -a -o $@ $^ - plugin-lib/ocamlbuildlib.cmxa: src/ocamlbuild_pack.cmx $(EXTRA_CMX) $(OCAMLOPT) -a -o $@ $^ @@ -213,7 +206,7 @@ distclean:: rm -f man/ocamlbuild.1 man/options_man.byte: src/ocamlbuild_pack.cmo - $(OCAMLC) $^ -I src man/options_man.ml -o man/options_man.byte + $(OCAMLC) -I +unix unix.cma $^ -I src man/options_man.ml -o man/options_man.byte clean:: rm -f man/options_man.cm* diff --git a/bin/ocamlbuild.ml b/bin/ocamlbuild.ml index a0c31c4f..adf29b9c 100644 --- a/bin/ocamlbuild.ml +++ b/bin/ocamlbuild.ml @@ -13,5 +13,4 @@ (* Original author: Nicolas Pouillard *) -Ocamlbuild_unix_plugin.setup (); Ocamlbuild_pack.Main.main () diff --git a/bin/ocamlbuildlight.ml b/bin/ocamlbuildlight.ml deleted file mode 100644 index fc90994b..00000000 --- a/bin/ocamlbuildlight.ml +++ /dev/null @@ -1,16 +0,0 @@ -(***********************************************************************) -(* *) -(* ocamlbuild *) -(* *) -(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) -(* *) -(* Copyright 2007 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../LICENSE. *) -(* *) -(***********************************************************************) - - -(* Original author: Nicolas Pouillard *) -Ocamlbuild_pack.Main.main ();; diff --git a/bin/ocamlbuildlight.mli b/bin/ocamlbuildlight.mli deleted file mode 100644 index 5cd73796..00000000 --- a/bin/ocamlbuildlight.mli +++ /dev/null @@ -1,16 +0,0 @@ -(***********************************************************************) -(* *) -(* ocamlbuild *) -(* *) -(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) -(* *) -(* Copyright 2007 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../LICENSE. *) -(* *) -(***********************************************************************) - - -(* Original author: Nicolas Pouillard *) -(* Nothing *) diff --git a/bootstrap/_tags b/bootstrap/_tags index f7683544..4c773747 100644 --- a/bootstrap/_tags +++ b/bootstrap/_tags @@ -18,10 +18,9 @@ true: debug "plugin-lib": include <**/*.ml> or <**/*.mli>: warn_L, warn_R, warn_Z, annot "src/discard_printf.ml": rectypes -"ocamlbuildlib.cma" or "ocamlbuildlightlib.cma": linkall +"ocamlbuildlib.cma": linkall <**/*.byte> or <**/*.native> or <**/*.top>: use_unix : use_unix -"ocamlbuildlight.byte": -use_unix, nopervasives : for-pack(Ocamlbuild_pack) # we have several build stages using different build directories, diff --git a/bootstrap/bootstrap.itarget b/bootstrap/bootstrap.itarget index 1b9a18a1..5fe4fc6b 100644 --- a/bootstrap/bootstrap.itarget +++ b/bootstrap/bootstrap.itarget @@ -1,9 +1,7 @@ ocamlbuild_pack.cmo ocamlbuild_pack.cmx -ocamlbuildlightlib.cma ocamlbuildlib.cma ocamlbuild.top ocamlbuild.docdir/index.html -bin/ocamlbuildlight.byte bin/ocamlbuild.byte bin/ocamlbuild.native diff --git a/plugin-lib/ocamlbuild_unix_plugin.ml b/plugin-lib/ocamlbuild_unix_plugin.ml deleted file mode 100644 index 2e60926d..00000000 --- a/plugin-lib/ocamlbuild_unix_plugin.ml +++ /dev/null @@ -1,104 +0,0 @@ -(***********************************************************************) -(* *) -(* ocamlbuild *) -(* *) -(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) -(* *) -(* Copyright 2007 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../LICENSE. *) -(* *) -(***********************************************************************) - - -(* Original author: Nicolas Pouillard *) -open Format -open Ocamlbuild_pack -open My_unix - -let report_error f = - function - | Unix.Unix_error(err, fun_name, arg) -> - fprintf f "%s: %S failed" Sys.argv.(0) fun_name; - if String.length arg > 0 then - fprintf f " on %S" arg; - fprintf f ": %s" (Unix.error_message err) - | exn -> raise exn - -let mkstat unix_stat x = - let st = - try unix_stat x - with Unix.Unix_error _ as e -> raise (Sys_error (My_std.sbprintf "%a" report_error e)) - in - { stat_key = sprintf "(%d,%d)" st.Unix.st_dev st.Unix.st_ino; - stat_file_kind = - match st.Unix.st_kind with - | Unix.S_LNK -> FK_link - | Unix.S_DIR -> FK_dir - | Unix.S_CHR | Unix.S_BLK | Unix.S_FIFO | Unix.S_SOCK -> FK_other - | Unix.S_REG -> FK_file } - -let is_link s = (Unix.lstat s).Unix.st_kind = Unix.S_LNK - -let at_exit_once callback = - let pid = Unix.getpid () in - at_exit begin fun () -> - if pid = Unix.getpid () then callback () - end - -let run_and_open s kont = - let s = - (* Be consistent! My_unix.run_and_open uses My_std.sys_command and - sys_command uses bash. *) - if Sys.win32 then - "bash --norc -c " ^ Filename.quote s - else - s - in - let ic = Unix.open_process_in s in - let close () = - match Unix.close_process_in ic with - | Unix.WEXITED 0 -> () - | Unix.WEXITED _ | Unix.WSIGNALED _ | Unix.WSTOPPED _ -> - failwith (Printf.sprintf "Error while running: %s" s) in - let res = try - kont ic - with e -> (close (); raise e) - in close (); res - -let stdout_isatty () = - Unix.isatty Unix.stdout && - try Unix.getenv "TERM" <> "dumb" with Not_found -> true - -let execute_many = - let exit i = raise (My_std.Exit_with_code i) in - let exit = function - | Ocamlbuild_executor.Subcommand_failed -> exit Exit_codes.rc_executor_subcommand_failed - | Ocamlbuild_executor.Subcommand_got_signal -> exit Exit_codes.rc_executor_subcommand_got_signal - | Ocamlbuild_executor.Io_error -> exit Exit_codes.rc_executor_io_error - | Ocamlbuild_executor.Exceptionl_condition -> exit Exit_codes.rc_executor_excetptional_condition - in - Ocamlbuild_executor.execute ~exit - -(* Ocamlbuild code assumes throughout that [readlink] will return a file name - relative to the current directory. Let's make it so. *) -let myunixreadlink x = - let y = Unix.readlink x in - if Filename.is_relative y then - Filename.concat (Filename.dirname x) y - else - y - -let setup () = - implem.is_degraded <- false; - implem.stdout_isatty <- stdout_isatty; - implem.gettimeofday <- Unix.gettimeofday; - implem.report_error <- report_error; - implem.execute_many <- execute_many; - implem.readlink <- myunixreadlink; - implem.run_and_open <- run_and_open; - implem.at_exit_once <- at_exit_once; - implem.is_link <- is_link; - implem.stat <- mkstat Unix.stat; - implem.lstat <- mkstat Unix.lstat;; diff --git a/plugin-lib/ocamlbuild_unix_plugin.mli b/plugin-lib/ocamlbuild_unix_plugin.mli deleted file mode 100644 index 521d4643..00000000 --- a/plugin-lib/ocamlbuild_unix_plugin.mli +++ /dev/null @@ -1,16 +0,0 @@ -(***********************************************************************) -(* *) -(* ocamlbuild *) -(* *) -(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) -(* *) -(* Copyright 2007 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../LICENSE. *) -(* *) -(***********************************************************************) - - -(* Original author: Nicolas Pouillard *) -val setup : unit -> unit diff --git a/src/command.ml b/src/command.ml index b305f8fe..35a4b8eb 100644 --- a/src/command.ml +++ b/src/command.ml @@ -260,7 +260,6 @@ let flatten_commands quiet pretend cmd = let execute_many ?(quiet=false) ?(pretend=false) cmds = add_parallel_stat (List.length cmds); - let degraded = !*My_unix.is_degraded || Sys.win32 in let jobs = !jobs in if jobs < 0 then invalid_arg "jobs < 0"; let max_jobs = if jobs = 0 then None else Some jobs in @@ -281,7 +280,7 @@ let execute_many ?(quiet=false) ?(pretend=false) cmds = else begin reset_filesys_cache (); - if degraded then + if Sys.win32 then let res, opt_exn = List.fold_left begin fun (acc_res, acc_exn) cmds -> match acc_exn with diff --git a/src/log.ml b/src/log.ml index 61aa10ae..f9a736c8 100644 --- a/src/log.ml +++ b/src/log.ml @@ -33,7 +33,7 @@ let ( !- ) r = let init log_file = let mode = - if !classic_display || !*My_unix.is_degraded || !level <= 0 || not (My_unix.stdout_isatty ()) then + if !classic_display || !level <= 0 || not (My_unix.stdout_isatty ()) then `Classic else `Sophisticated diff --git a/src/my_unix.ml b/src/my_unix.ml index fd960300..00d46231 100644 --- a/src/my_unix.ml +++ b/src/my_unix.ml @@ -27,116 +27,88 @@ type stats = stat_key : string } -type implem = - { - mutable is_degraded : bool; - mutable is_link : string -> bool; - mutable run_and_open : 'a . string -> (in_channel -> 'a) -> 'a; - mutable readlink : string -> string; - mutable execute_many : ?max_jobs:int -> - ?ticker:(unit -> unit) -> - ?period:float -> - ?display:((out_channel -> unit) -> unit) -> - ((unit -> string) list list) -> - (bool list * exn) option; - mutable report_error : Format.formatter -> exn -> unit; - mutable at_exit_once : (unit -> unit) -> unit; - mutable gettimeofday : unit -> float; - mutable stdout_isatty : unit -> bool; - mutable stat : string -> stats; - mutable lstat : string -> stats; - } - -let is_degraded = true - -let stat f = - { stat_key = f; +let report_error f = + function + | Unix.Unix_error(err, fun_name, arg) -> + Format.fprintf f "%s: %S failed" Sys.argv.(0) fun_name; + if String.length arg > 0 then + Format.fprintf f " on %S" arg; + Format.fprintf f ": %s" (Unix.error_message err) + | exn -> raise exn + +let mkstat unix_stat x = + let st = + try unix_stat x + with Unix.Unix_error _ as e -> raise (Sys_error (My_std.sbprintf "%a" report_error e)) + in + { stat_key = Printf.sprintf "(%d,%d)" st.Unix.st_dev st.Unix.st_ino; stat_file_kind = - if sys_file_exists f then - if Sys.is_directory f then - FK_dir - else - FK_file - else let _ = with_input_file f input_char in assert false } - -let run_and_open s kont = - with_temp_file "ocamlbuild" "out" begin fun tmp -> - let s = Printf.sprintf "%s > '%s'" s tmp in - let st = sys_command s in - if st <> 0 then failwith (Printf.sprintf "Error while running: %s" s); - with_input_file tmp kont + match st.Unix.st_kind with + | Unix.S_LNK -> FK_link + | Unix.S_DIR -> FK_dir + | Unix.S_CHR | Unix.S_BLK | Unix.S_FIFO | Unix.S_SOCK -> FK_other + | Unix.S_REG -> FK_file } + +let is_link s = (Unix.lstat s).Unix.st_kind = Unix.S_LNK + +let at_exit_once callback = + let pid = Unix.getpid () in + at_exit begin fun () -> + if pid = Unix.getpid () then callback () end -exception Not_a_link -exception No_such_file -exception Link_to_directories_not_supported - -let readlinkcmd = - let cache = Hashtbl.create 32 in - fun x -> - try Hashtbl.find cache x - with Not_found -> - run_and_open (Printf.sprintf "readlink %s" (Filename.quote x)) begin fun ic -> - let y = String.chomp (input_line ic) in - Hashtbl.replace cache x y; y - end - -let rec readlink x = - if sys_file_exists x then - try - let y = readlinkcmd x in - let y = - if Filename.is_relative y then - Filename.concat (Filename.dirname x) y - else - y - in - if (lstat y).stat_file_kind = FK_dir then raise Link_to_directories_not_supported else y - with Failure(_) -> raise Not_a_link - else raise No_such_file - -and is_link x = - try ignore(readlink x); true with - | No_such_file | Not_a_link -> false - -and lstat x = - if is_link x then { stat_key = x; stat_file_kind = FK_link } else stat x - -let implem = - { - is_degraded = true; - - stat = stat; - lstat = lstat; - readlink = readlink; - is_link = is_link; - run_and_open = run_and_open; - - (* at_exit_once is at_exit in the degraded mode since fork is not accessible in this mode *) - at_exit_once = at_exit; - report_error = (fun _ -> raise); - gettimeofday = (fun () -> assert false); - stdout_isatty = (fun () -> false); - execute_many = (fun ?max_jobs:(_) ?ticker:(_) ?period:(_) ?display:(_) _ -> assert false) - } - -let is_degraded = lazy implem.is_degraded -let stat x = implem.stat x -let lstat x = implem.lstat x -let readlink x = implem.readlink x -let is_link x = implem.is_link x -let run_and_open x = implem.run_and_open x -let at_exit_once x = implem.at_exit_once x -let report_error x = implem.report_error x -let gettimeofday x = implem.gettimeofday x -let stdout_isatty x = implem.stdout_isatty x -let execute_many ?max_jobs = implem.execute_many ?max_jobs +let run_and_open s kont = + let s = + (* Be consistent! My_unix.run_and_open uses My_std.sys_command and + sys_command uses bash. *) + if Sys.win32 then + "bash --norc -c " ^ Filename.quote s + else + s + in + let ic = Unix.open_process_in s in + let close () = + match Unix.close_process_in ic with + | Unix.WEXITED 0 -> () + | Unix.WEXITED _ | Unix.WSIGNALED _ | Unix.WSTOPPED _ -> + failwith (Printf.sprintf "Error while running: %s" s) in + let res = try + kont ic + with e -> (close (); raise e) + in close (); res + +let stdout_isatty () = + Unix.isatty Unix.stdout && + try Unix.getenv "TERM" <> "dumb" with Not_found -> true + +let execute_many = + let exit i = raise (My_std.Exit_with_code i) in + let exit = function + | Ocamlbuild_executor.Subcommand_failed -> exit Exit_codes.rc_executor_subcommand_failed + | Ocamlbuild_executor.Subcommand_got_signal -> exit Exit_codes.rc_executor_subcommand_got_signal + | Ocamlbuild_executor.Io_error -> exit Exit_codes.rc_executor_io_error + | Ocamlbuild_executor.Exceptionl_condition -> exit Exit_codes.rc_executor_excetptional_condition + in + Ocamlbuild_executor.execute ~exit + +(* Ocamlbuild code assumes throughout that [readlink] will return a file name + relative to the current directory. Let's make it so. *) +let readlink x = + let y = Unix.readlink x in + if Filename.is_relative y then + Filename.concat (Filename.dirname x) y + else + y + +let stat = mkstat Unix.stat +let lstat = mkstat Unix.lstat +let gettimeofday = Unix.gettimeofday let run_and_read cmd = let bufsiz = 2048 in let buf = Bytes.create bufsiz in let totalbuf = Buffer.create 4096 in - implem.run_and_open cmd begin fun ic -> + run_and_open cmd begin fun ic -> let rec loop pos = let len = input ic buf 0 bufsiz in if len > 0 then begin diff --git a/src/my_unix.mli b/src/my_unix.mli index d9cd7d00..03997b0e 100644 --- a/src/my_unix.mli +++ b/src/my_unix.mli @@ -25,8 +25,6 @@ type stats = stat_key : string } -val is_degraded : bool Lazy.t - val is_link : string -> bool val run_and_open : string -> (in_channel -> 'a) -> 'a val readlink : string -> string @@ -50,26 +48,3 @@ val stdout_isatty : unit -> bool val stat : string -> stats val lstat : string -> stats - -(** internal usage only *) -type implem = - { - mutable is_degraded : bool; - mutable is_link : string -> bool; - mutable run_and_open : 'a . string -> (in_channel -> 'a) -> 'a; - mutable readlink : string -> string; - mutable execute_many : ?max_jobs:int -> - ?ticker:(unit -> unit) -> - ?period:float -> - ?display:((out_channel -> unit) -> unit) -> - ((unit -> string) list list) -> - (bool list * exn) option; - mutable report_error : Format.formatter -> exn -> unit; - mutable at_exit_once : (unit -> unit) -> unit; - mutable gettimeofday : unit -> float; - mutable stdout_isatty : unit -> bool; - mutable stat : string -> stats; - mutable lstat : string -> stats; - } - -val implem : implem diff --git a/src/ocaml_specific.ml b/src/ocaml_specific.ml index e41889b5..7bb5af12 100644 --- a/src/ocaml_specific.ml +++ b/src/ocaml_specific.ml @@ -1005,7 +1005,6 @@ pflag ["ocaml"; "doc"; "man"] "man_section" (fun param -> S [A "-man-section"; A param]);; ocaml_lib "ocamlbuildlib";; -ocaml_lib "ocamlbuildlightlib";; begin let ccflag ~lang ~phase ~flag = diff --git a/plugin-lib/ocamlbuild_executor.ml b/src/ocamlbuild_executor.ml similarity index 100% rename from plugin-lib/ocamlbuild_executor.ml rename to src/ocamlbuild_executor.ml diff --git a/plugin-lib/ocamlbuild_executor.mli b/src/ocamlbuild_executor.mli similarity index 100% rename from plugin-lib/ocamlbuild_executor.mli rename to src/ocamlbuild_executor.mli diff --git a/src/plugin.ml b/src/plugin.ml index 5024f1f3..dfcedb3a 100644 --- a/src/plugin.ml +++ b/src/plugin.ml @@ -93,8 +93,6 @@ module Make(U:sig end) = let (unix_spec, ocamlbuild_lib_spec, ocamlbuild_module_spec) = - let use_light_mode = - not !Options.native_plugin && !*My_unix.is_degraded in let use_ocamlfind_pkgs = !Options.plugin_use_ocamlfind && !Options.plugin_tags <> [] in (* The plugin has the following dependencies that must be @@ -107,20 +105,9 @@ module Make(U:sig end) = modules of ocamlbuildlib.cmxa We pass all this stuff to the compilation command for the - plugin, with two independent important details to handle: + plugin, with an important detail to handle: - (1) ocamlbuild is designed to still work in environments - where Unix is not available for some reason; in this - case, we should not link unix, and use the - "ocamlbuildlight.cmo" initialization module, which runs - a "light" version of ocamlbuild without unix. There is - also an ocamlbuildlightlib.cma archive to be used in that - case. - - The boolean variable [use_light_mode] tells us whether we - are in this unix-deprived scenario. - - (2) there are risks of compilation error due to + There are risks of compilation error due to double-linking of native modules when the user passes its own tags to the plugin compilation process (as was added to support modular construction of @@ -161,30 +148,18 @@ module Make(U:sig end) = is available), but allows the behavior in absence of -plugin-tags to be completely unchanged, to reassure us about potential regressions introduced by this option. - - [1]: we may wonder whether to use "-package ocamlbuildlight" - in unix-deprived situations, but currently ocamlfind - doesn't know about the ocamlbuildlight library. As - a compromise we always use "-package ocamlbuild" when - use_ocamlfind_pkgs is set. An ocamlfind and -plugin-tags - user in unix-deprived environment may want to mutate the - META of ocamlbuild to point to ocamlbuildlightlib instead - of ocamlbuildlib. *) let unix_lib = if use_ocamlfind_pkgs then `Package "unix" - else if use_light_mode then `Nothing else `Lib ("+unix", "unix") in let ocamlbuild_lib = if use_ocamlfind_pkgs then `Package "ocamlbuild" - else if use_light_mode then `Local_lib "ocamlbuildlightlib" else `Local_lib "ocamlbuildlib" in let ocamlbuild_module = - if use_light_mode then `Local_mod "ocamlbuildlight" - else `Local_mod "ocamlbuild" in + `Local_mod "ocamlbuild" in let dir = !Ocamlbuild_where.libdir in let dir = if Pathname.is_implicit dir then Pathname.pwd/dir else dir in diff --git a/src/resource.ml b/src/resource.ml index 2a9cdf36..8cabab7e 100644 --- a/src/resource.ml +++ b/src/resource.ml @@ -57,14 +57,10 @@ let source_dir_path_set_without_links_to_build = end let clean_links () = - if !*My_unix.is_degraded then - () - else - ignore (clean_up_link_to_build ()) + ignore (clean_up_link_to_build ()) let exists_in_source_dir p = - if !*My_unix.is_degraded then sys_file_exists (in_source_dir p) - else StringSet.mem p !*source_dir_path_set_without_links_to_build + StringSet.mem p !*source_dir_path_set_without_links_to_build let clean p = Shell.rm_f p diff --git a/src/shell.ml b/src/shell.ml index 197267f1..5bcc6b6b 100644 --- a/src/shell.ml +++ b/src/shell.ml @@ -37,7 +37,7 @@ let chdir dir = let run args target = reset_readdir_cache (); let cmd = String.concat " " (List.map quote_filename_if_needed args) in - if !*My_unix.is_degraded || Sys.win32 then + if Sys.win32 then begin Log.event cmd target Tags.empty; let st = sys_command cmd in diff --git a/src/slurp.ml b/src/slurp.ml index c1cb049a..6a044918 100644 --- a/src/slurp.ml +++ b/src/slurp.ml @@ -39,7 +39,7 @@ let rec filter predicate = function | Nothing -> Nothing | Error _ as e -> e -let real_slurp path = +let slurp path = let cwd = Sys.getcwd () in let abs x = if Filename.is_implicit x || Filename.is_relative x then cwd/x else x in let visited = Hashtbl.create 1024 in @@ -130,25 +130,6 @@ let rec add root path entries = Dir(fpath, fname, fst, fattr, lazy (add (root/xpath) xspath [])) :: entries' else f :: add root path entries' -let slurp_with_find path = - let find_cmd = try Sys.getenv "OCAMLBUILD_FIND" with _ -> "find" in - let lines = - My_unix.run_and_open (Printf.sprintf "%s %s" find_cmd (Filename.quote path)) begin fun ic -> - let acc = ref [] in - try while true do acc := input_line ic :: !acc done; [] - with End_of_file -> !acc - end in - let res = - List.fold_right begin fun line acc -> - add path (split line) acc - end lines [] in - match res with - | [] -> Nothing - | [entry] -> entry - | entries -> Dir(path, Filename.basename path, lazy (My_unix.stat path), (), lazy entries) - -let slurp x = if !*My_unix.is_degraded then slurp_with_find x else real_slurp x - let rec print print_attr f entry = match entry with | Dir(path, name, _, attr, entries) -> diff --git a/testsuite/ocamlbuild_test.ml b/testsuite/ocamlbuild_test.ml index 9442d885..d43ca3d1 100644 --- a/testsuite/ocamlbuild_test.ml +++ b/testsuite/ocamlbuild_test.ml @@ -469,13 +469,7 @@ let run ~root = "src/ocamlbuild_pack.o"; "plugin-lib/ocamlbuild_plugin.cmi"; "plugin-lib/ocamlbuild_plugin.cmx"; - "plugin-lib/ocamlbuild_plugin.o"; - "plugin-lib/ocamlbuild_executor.cmi"; - "plugin-lib/ocamlbuild_executor.cmx"; - "plugin-lib/ocamlbuild_executor.o"; - "plugin-lib/ocamlbuild_unix_plugin.cmi"; - "plugin-lib/ocamlbuild_unix_plugin.cmx"; - "plugin-lib/ocamlbuild_unix_plugin.o"] + "plugin-lib/ocamlbuild_plugin.o" ] install_lib_dir; copy [ "ocamlbuild.byte"; From ccdce65022e09cac56043f7749eca5812ddaa101 Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Wed, 29 May 2024 14:03:43 +0200 Subject: [PATCH 2/3] fix bootstrap --- bootstrap/_tags | 3 +-- bootstrap/ocamlbuild.mltop | 4 +--- bootstrap/ocamlbuild_pack.mlpack | 3 ++- bootstrap/ocamlbuildlib.mllib | 4 +--- bootstrap/ocamlbuildlightlib.mllib | 2 -- 5 files changed, 5 insertions(+), 11 deletions(-) delete mode 100644 bootstrap/ocamlbuildlightlib.mllib diff --git a/bootstrap/_tags b/bootstrap/_tags index 4c773747..2182df6e 100644 --- a/bootstrap/_tags +++ b/bootstrap/_tags @@ -16,11 +16,10 @@ true: debug "src": include "bin": include "plugin-lib": include -<**/*.ml> or <**/*.mli>: warn_L, warn_R, warn_Z, annot +<**/*.ml> or <**/*.mli>: warn_L, warn_R, warn_Z, annot, use_unix "src/discard_printf.ml": rectypes "ocamlbuildlib.cma": linkall <**/*.byte> or <**/*.native> or <**/*.top>: use_unix -: use_unix : for-pack(Ocamlbuild_pack) # we have several build stages using different build directories, diff --git a/bootstrap/ocamlbuild.mltop b/bootstrap/ocamlbuild.mltop index 767ed32c..5175d8c5 100644 --- a/bootstrap/ocamlbuild.mltop +++ b/bootstrap/ocamlbuild.mltop @@ -1,4 +1,2 @@ Ocamlbuild_pack -Ocamlbuild_plugin -Ocamlbuild_unix_plugin -Ocamlbuild_executor +Ocamlbuild_plugin \ No newline at end of file diff --git a/bootstrap/ocamlbuild_pack.mlpack b/bootstrap/ocamlbuild_pack.mlpack index a04a1a4d..fe1df24d 100644 --- a/bootstrap/ocamlbuild_pack.mlpack +++ b/bootstrap/ocamlbuild_pack.mlpack @@ -2,7 +2,9 @@ Const Loc Log My_unix +Ocamlbuild_executor My_std +Exit_codes Signatures Shell Display @@ -37,7 +39,6 @@ Ocaml_utils Ocaml_tools Ocaml_compiler Ocaml_dependencies -Exit_codes Digest_cache Findlib Param_tags diff --git a/bootstrap/ocamlbuildlib.mllib b/bootstrap/ocamlbuildlib.mllib index 767ed32c..5175d8c5 100644 --- a/bootstrap/ocamlbuildlib.mllib +++ b/bootstrap/ocamlbuildlib.mllib @@ -1,4 +1,2 @@ Ocamlbuild_pack -Ocamlbuild_plugin -Ocamlbuild_unix_plugin -Ocamlbuild_executor +Ocamlbuild_plugin \ No newline at end of file diff --git a/bootstrap/ocamlbuildlightlib.mllib b/bootstrap/ocamlbuildlightlib.mllib deleted file mode 100644 index dc38da3d..00000000 --- a/bootstrap/ocamlbuildlightlib.mllib +++ /dev/null @@ -1,2 +0,0 @@ -Ocamlbuild_pack -Ocamlbuild_plugin From 5e14339f3a28dd3242a29a824da3ede4d7ed85a8 Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Wed, 29 May 2024 14:28:21 +0200 Subject: [PATCH 3/3] restore Ocamlbuild_unix_plugin --- .depend | 2 ++ Makefile | 1 + bootstrap/ocamlbuild.mltop | 3 ++- plugin-lib/ocamlbuild_unix_plugin.ml | 17 +++++++++++++++++ 4 files changed, 22 insertions(+), 1 deletion(-) create mode 100644 plugin-lib/ocamlbuild_unix_plugin.ml diff --git a/.depend b/.depend index d0db0554..6336647d 100644 --- a/.depend +++ b/.depend @@ -23,6 +23,8 @@ plugin-lib/ocamlbuild_plugin.cmo : \ plugin-lib/ocamlbuild_plugin.cmx : \ plugin-lib/ocamlbuild_plugin.cmi plugin-lib/ocamlbuild_plugin.cmi : +plugin-lib/ocamlbuild_unix_plugin.cmo : +plugin-lib/ocamlbuild_unix_plugin.cmx : src/bool.cmo : \ src/bool.cmi src/bool.cmx : \ diff --git a/Makefile b/Makefile index 124085be..2f5b0a8a 100644 --- a/Makefile +++ b/Makefile @@ -82,6 +82,7 @@ PACK_CMO= $(addprefix src/,\ EXTRA_CMO=$(addprefix plugin-lib/,\ ocamlbuild_plugin.cmo \ + ocamlbuild_unix_plugin.cmo \ ) PACK_CMX=$(PACK_CMO:.cmo=.cmx) diff --git a/bootstrap/ocamlbuild.mltop b/bootstrap/ocamlbuild.mltop index 5175d8c5..41c1afb0 100644 --- a/bootstrap/ocamlbuild.mltop +++ b/bootstrap/ocamlbuild.mltop @@ -1,2 +1,3 @@ Ocamlbuild_pack -Ocamlbuild_plugin \ No newline at end of file +Ocamlbuild_plugin +Ocamlbuild_unix_plugin diff --git a/plugin-lib/ocamlbuild_unix_plugin.ml b/plugin-lib/ocamlbuild_unix_plugin.ml new file mode 100644 index 00000000..7dfbec99 --- /dev/null +++ b/plugin-lib/ocamlbuild_unix_plugin.ml @@ -0,0 +1,17 @@ +(***********************************************************************) +(* *) +(* ocamlbuild *) +(* *) +(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file ../LICENSE. *) +(* *) +(***********************************************************************) + + +(* This is kept here for compatibility reason. *) + +let setup () = ()