diff options
author | Richard W.M. Jones <rjones@redhat.com> | 2008-01-08 10:21:51 +0000 |
---|---|---|
committer | Richard W.M. Jones <rjones@redhat.com> | 2008-01-08 10:21:51 +0000 |
commit | 6f3635fe4dc9989745d154c8b346c47e4d384121 (patch) | |
tree | f813954eeae58b41e222236489929530fbb94303 | |
parent | 8dcda6c7457eca53d8d1e10b282a0cb77201899e (diff) | |
download | virt-top-6f3635fe4dc9989745d154c8b346c47e4d384121.tar.gz virt-top-6f3635fe4dc9989745d154c8b346c47e4d384121.tar.xz virt-top-6f3635fe4dc9989745d154c8b346c47e4d384121.zip |
Fix native virt-ctrl on Windows.
* virt-ctrl/Makefile.in, virt-ctrl/mingw-gcc-wrapper.ml: Wrapper
around 'gcc' to fix native virt-ctrl builds on Windows/MinGW.
* .hgignore: Ignore *.exe files.
-rw-r--r-- | .hgignore | 1 | ||||
-rw-r--r-- | ChangeLog | 7 | ||||
-rw-r--r-- | virt-ctrl/Makefile.in | 19 | ||||
-rwxr-xr-x | virt-ctrl/mingw-gcc-wrapper.ml | 70 |
4 files changed, 95 insertions, 2 deletions
@@ -23,6 +23,7 @@ core.* *.a *.opt *.dll +*.exe *~ libvirt/libvirt_version.ml examples/list_domains @@ -1,3 +1,10 @@ +2008-01-08 Richard Jones <rjones@redhat.com> + + Fix native virt-ctrl on Windows. + * virt-ctrl/Makefile.in, virt-ctrl/mingw-gcc-wrapper.ml: Wrapper + around 'gcc' to fix native virt-ctrl builds on Windows/MinGW. + * .hgignore: Ignore *.exe files. + 2008-01-07 Richard Jones <rjones@redhat.com> Updated MANIFEST. diff --git a/virt-ctrl/Makefile.in b/virt-ctrl/Makefile.in index c6966a8..26d6fe5 100644 --- a/virt-ctrl/Makefile.in +++ b/virt-ctrl/Makefile.in @@ -72,10 +72,25 @@ virt-ctrl: $(OBJS) $(OCAMLC) $(OCAMLCINCS) $(OCAMLCFLAGS) $(OCAMLCLIBS) \ ../libvirt/mllibvirt.cma gtkInit.cmo -o $@ $^ +host_os = @host_os@ + +ifneq ($(host_os),mingw32) virt-ctrl.opt: $(XOBJS) - $(OCAMLOPT) -verbose $(OCAMLOPTINCS) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ - -cclib "$(LDFLAGS)" \ + $(OCAMLOPT) $(OCAMLOPTINCS) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ + $(patsubst %,-cclib %,$(LDFLAGS)) \ ../libvirt/mllibvirt.cmxa gtkInit.cmx -o $@ $^ +else +# On MinGW, use a hacked 'gcc' wrapper which understands the @... +# syntax for extending the command line. +gcc.exe: mingw-gcc-wrapper.ml + $(OCAMLC) unix.cma $< -o $@ + +virt-ctrl.opt: $(XOBJS) gcc.exe + PATH=.:$$PATH \ + $(OCAMLOPT) $(OCAMLOPTINCS) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ + $(patsubst %,-cclib %,$(LDFLAGS)) \ + ../libvirt/mllibvirt.cmxa gtkInit.cmx -o $@ $(XOBJS) +endif endif install: diff --git a/virt-ctrl/mingw-gcc-wrapper.ml b/virt-ctrl/mingw-gcc-wrapper.ml new file mode 100755 index 0000000..21cdb8f --- /dev/null +++ b/virt-ctrl/mingw-gcc-wrapper.ml @@ -0,0 +1,70 @@ +(* Wrapper around 'gcc'. On MinGW, this wrapper understands the '@...'
+ * syntax for extending the command line.
+ *)
+
+open Printf
+open Unix
+
+let (//) = Filename.concat
+
+(* Substitute any @... arguments with the file content. *)
+let rec input_all_lines chan =
+ try
+ let line = input_line chan in
+ line :: input_all_lines chan
+ with
+ End_of_file -> []
+
+let argv = Array.map (
+ fun arg ->
+ if arg.[0] = '@' then (
+ let chan = open_in (String.sub arg 1 (String.length arg - 1)) in
+ let lines = input_all_lines chan in
+ close_in chan;
+ lines
+ ) else
+ [arg]
+) Sys.argv
+
+let argv = Array.to_list argv
+let argv = List.flatten argv
+
+(* Find the real gcc.exe on $PATH, but ignore any '.' elements in the path.
+ * Note that on Windows, $PATH is split with ';' characters.
+ *)
+let rec split_find str sep f =
+ try
+ let i = String.index str sep in
+ let n = String.length str in
+ let str, str' = String.sub str 0 i, String.sub str (i+1) (n-i-1) in
+ match f str with
+ | None -> split_find str' sep f (* not found, keep searching *)
+ | Some found -> found
+ with
+ Not_found ->
+ match f str with
+ | None -> raise Not_found (* not found at all *)
+ | Some found -> found
+
+let exists filename =
+ try access filename [F_OK]; true with Unix_error _ -> false
+
+let gcc =
+ split_find (Sys.getenv "PATH") ';'
+ (function
+ | "." -> None (* ignore current directory in path *)
+ | path ->
+ let gcc = path // "gcc.exe" in
+ if exists gcc then Some gcc else None)
+
+(* Finally execute the real gcc with the full argument list.
+ * Can't use execv here because then the parent process (ocamlopt) thinks
+ * that this process has finished and deletes all the temp files. Stupid
+ * Windoze!
+ *)
+let _ =
+ let argv = List.map Filename.quote (List.tl argv) in
+ let cmd = String.concat " " (gcc :: argv) in
+ eprintf "mingw-gcc-wrapper: %s\n%!" cmd;
+ let r = Sys.command cmd in
+ exit r
|