Skip to content

Commit

Permalink
fixes
Browse files Browse the repository at this point in the history
  • Loading branch information
@pkhry
pkhry committed Jun 2, 2021
1 parent c69667a commit c6668c5
Show file tree
Hide file tree
Showing 4 changed files with 51 additions and 39 deletions.
28 changes: 17 additions & 11 deletions toplevel/byte/topmain.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -156,28 +156,33 @@ let prepare ppf =
Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x);
false

let file_argument ?(constructor=(fun x -> Toploop.File x)) name =
let file_argument name =
let filename =
let open Toploop in
match name with
| File name -> name
| String _ | Stdin -> ""
in
let ppf = Format.err_formatter in
if Filename.check_suffix name ".cmo" || Filename.check_suffix name ".cma"
then preload_objects := name :: !preload_objects
if Filename.check_suffix filename ".cmo"
|| Filename.check_suffix filename ".cma"
then preload_objects := filename :: !preload_objects
else if is_expanded !current then begin
(* Script files are not allowed in expand options because otherwise the
check in override arguments may fail since the new argv can be larger
than the original argv.
*)
Printf.eprintf "For implementation reasons, the toplevel does not support\
\ having script files (here %S) inside expanded arguments passed through the\
\ -args{,0} command-line option.\n" name;
\ -args{,0} command-line option.\n" filename;
raise (Compenv.Exit_with_status 2)
end else begin
let newargs = Array.sub !argv !current
(Array.length !argv - !current)
in
Compenv.readenv ppf Before_link;
Compmisc.read_clflags_from_env ();
let usage =
constructor name in
if prepare ppf && Toploop.run_script ppf usage newargs
if prepare ppf && Toploop.run_script ppf name newargs
then raise (Compenv.Exit_with_status 0)
else raise (Compenv.Exit_with_status 2)
end
Expand All @@ -191,11 +196,11 @@ let wrap_expand f s =

module Options = Main_args.Make_bytetop_options (struct
include Main_args.Default.Topmain
let _stdin () = file_argument ~constructor:(fun _ -> Toploop.Stdin) ""
let _stdin () = file_argument Toploop.Stdin
let _args = wrap_expand Arg.read_arg
let _args0 = wrap_expand Arg.read_arg0
let anonymous s = file_argument s
let _eval s = file_argument ~constructor:(fun x -> Toploop.String x) s
let anonymous s = file_argument (File s)
let _eval s = file_argument (Toploop.String s)
end)

let () =
Expand All @@ -211,7 +216,8 @@ let main () =
let program = "ocaml" in
Compenv.readenv ppf Before_args;
Clflags.add_arguments __LOC__ Options.list;
Compenv.parse_arguments ~current argv file_argument program;
Compenv.parse_arguments ~current argv
(fun x -> file_argument (File x)) program;
Compenv.readenv ppf Before_link;
Compmisc.read_clflags_from_env ();
if not (prepare ppf) then raise (Compenv.Exit_with_status 2);
Expand Down
29 changes: 18 additions & 11 deletions toplevel/native/topmain.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -48,28 +48,34 @@ let prepare ppf =
Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x);
false

let file_argument ?(constructor=(fun x -> Toploop.File x)) name =
let file_argument name =
let filename =
let open Toploop in
match name with
| File name -> name
| String _ | Stdin -> ""
in
let ppf = Format.err_formatter in
if Filename.check_suffix name ".cmxs"
|| Filename.check_suffix name ".cmx"
|| Filename.check_suffix name ".cmxa"
then preload_objects := name :: !preload_objects
if Filename.check_suffix filename ".cmxs"
|| Filename.check_suffix filename ".cmx"
|| Filename.check_suffix filename ".cmxa"
then preload_objects := filename :: !preload_objects
else if is_expanded !current then begin
(* Script files are not allowed in expand options because otherwise the
check in override arguments may fail since the new argv can be larger
than the original argv.
*)
Printf.eprintf "For implementation reasons, the toplevel does not support\
\ having script files (here %S) inside expanded arguments passed through\
\ the -args{,0} command-line option.\n" name;
\ the -args{,0} command-line option.\n" filename;
raise (Compenv.Exit_with_status 2)
end else begin
let newargs = Array.sub !argv !Arg.current
(Array.length !argv - !Arg.current)
in
Compmisc.read_clflags_from_env ();
if prepare ppf && Toploop.run_script ppf
(constructor name) newargs
name newargs
then raise (Compenv.Exit_with_status 0)
else raise (Compenv.Exit_with_status 2)
end
Expand All @@ -82,11 +88,11 @@ let wrap_expand f s =

module Options = Main_args.Make_opttop_options (struct
include Main_args.Default.Opttopmain
let _stdin () = file_argument ~constructor:(fun _ -> Toploop.Stdin) ""
let _stdin () = file_argument Toploop.Stdin
let _args = wrap_expand Arg.read_arg
let _args0 = wrap_expand Arg.read_arg0
let anonymous s = file_argument s
let _eval s = file_argument ~constructor:(fun x -> Toploop.String x) s
let anonymous s = file_argument (Toploop.String s)
let _eval s = file_argument (Toploop.String s)

end);;

Expand All @@ -104,7 +110,8 @@ let main () =
let program = "ocamlnat" in
Compenv.readenv ppf Before_args;
Clflags.add_arguments __LOC__ Options.list;
Compenv.parse_arguments ~current argv file_argument program;
Compenv.parse_arguments ~current argv
(fun x -> file_argument (File x)) program;
Compmisc.read_clflags_from_env ();
if not (prepare Format.err_formatter) then raise (Compenv.Exit_with_status 2);
Compmisc.init_path ();
Expand Down
21 changes: 10 additions & 11 deletions toplevel/toploop.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,15 +17,14 @@ open Format
include Topcommon
include Topeval

(* Read and execute commands from a file, or from stdin if [name] is "". *)
type input_type =
type input =
| Stdin
| File of string
| String of string

let use_print_results = ref true

let use_channel ppf ~wrap_in_module lb name filename =
let use_lexbuf ppf ~wrap_in_module lb name filename =
Warnings.reset_fatal ();
Location.init lb filename;
(* Skip initial #! line if any *)
Expand Down Expand Up @@ -64,27 +63,27 @@ let use_output ppf command =
Misc.try_finally ~always:(fun () -> close_in ic)
(fun () ->
let lexbuf = (Lexing.from_channel ic) in
use_channel ppf ~wrap_in_module:false lexbuf "" "(command-output)")
use_lexbuf ppf ~wrap_in_module:false lexbuf "" "(command-output)")
| n ->
fprintf ppf "Command exited with code %d.@." n;
false)

let use_file ppf ~wrap_in_module usage =
match usage with
let use_file ppf ~wrap_in_module input =
match input with
| Stdin ->
let lexbuf = Lexing.from_channel stdin in
use_channel ppf ~wrap_in_module lexbuf "" "(stdin)"
use_lexbuf ppf ~wrap_in_module lexbuf "" "(stdin)"
| String value ->
let lexbuf = Lexing.from_string value in
use_channel ppf ~wrap_in_module lexbuf "" "(stdin)"
use_lexbuf ppf ~wrap_in_module lexbuf "" "(command-line input)"
| File name ->
match Load_path.find name with
| filename ->
let ic = open_in_bin filename in
Misc.try_finally ~always:(fun () -> close_in ic)
(fun () ->
let lexbuf = Lexing.from_channel ic in
use_channel ppf ~wrap_in_module lexbuf name filename)
use_lexbuf ppf ~wrap_in_module lexbuf name filename)
| exception Not_found ->
fprintf ppf "Cannot find file %s.@." name;
false
Expand All @@ -108,7 +107,7 @@ let run_script ppf name args =
let filename =
match name with
| File name -> name
| _ -> "" in
| Stdin | String _ -> "" in
Compmisc.init_path ~dir:(Filename.dirname filename) ();
(* Note: would use [Filename.abspath] here, if we had it. *)
begin
Expand All @@ -125,7 +124,7 @@ let run_script ppf name args =
if name <> "" && Filename.is_implicit name
then File (Filename.concat Filename.current_dir_name name)
else filename)
| x -> x
| (Stdin | String _) as x -> x
in
use_silently ppf explicit_name

Expand Down
12 changes: 6 additions & 6 deletions toplevel/toploop.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,8 +15,8 @@

open Format

(* type of toplevel usages *)
type input_type =
(* type of toplevel inputs *)
type input =
| Stdin
| File of string
| String of string
Expand All @@ -36,7 +36,7 @@ val loop : formatter -> unit

(* Read and execute a script from the given file *)

val run_script : formatter -> input_type -> string array -> bool
val run_script : formatter -> input -> string array -> bool
(* true if successful, false if error *)

(* Interface with toplevel directives *)
Expand Down Expand Up @@ -87,10 +87,10 @@ val preprocess_phrase :
formatter -> Parsetree.toplevel_phrase -> Parsetree.toplevel_phrase
(* Preprocess the given toplevel phrase using regular and ppx
preprocessors. Return the updated phrase. *)
val use_file : formatter -> input_type -> bool
val use_file : formatter -> input -> bool
val use_output : formatter -> string -> bool
val use_silently : formatter -> input_type -> bool
val mod_use_file : formatter -> input_type -> bool
val use_silently : formatter -> input -> bool
val mod_use_file : formatter -> input -> bool
(* Read and execute commands from a file.
[use_file] prints the types and values of the results.
[use_silently] does not print them.
Expand Down

0 comments on commit c6668c5

Please sign in to comment.