Permalink
Browse files

[fix] preprocessing,error: add file and line position

CHANGELOG Preprocessing error with file and line position
  • Loading branch information...
1 parent a5b9574 commit f4bd094e5465d68a43b4ebe70e156da251ec256d @OpaOnWindowsNow OpaOnWindowsNow committed Apr 30, 2012
Showing with 57 additions and 28 deletions.
  1. +3 −3 opa/checkopacapi.ml
  2. +2 −2 opa/pass_JavascriptCompilation.ml
  3. +2 −2 opa/pass_JavascriptCompilation.mli
  4. +2 −2 opa/s3Passes.ml
  5. +44 −15 pplib/pprocess.ml
  6. +2 −2 pplib/pprocess.mli
  7. +2 −2 qml2js/qml2js.ml
View
6 opa/checkopacapi.ml
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -143,7 +143,7 @@ let pprocess =
let ppenv = Pprocess.fill_with_sysenv Pprocess.empty_env in
let ppenv = List.fold_left (fun ppenv (var, value) -> Pprocess.add_env var value ppenv) ppenv pplib_spec in
let ppopt = Pprocess.default_options ppenv in
- (fun s -> Pprocess.process Pplang.opa_description ppopt s)
+ Pprocess.process Pplang.opa_description ppopt
let fold
( fold : (SurfaceAst.nonuid, SurfaceAst.parsing_directive) SurfaceAst.code -> 'acc -> 'acc )
@@ -153,7 +153,7 @@ let fold
| None ->
OManager.error "[!] I/O error: cannot read file @{<bright>%S@}" filename
| Some content ->
- let content = pprocess content in
+ let content = pprocess ~name:filename content in
let code = OpaParser.code ~cache:true ~filename content in
fold code acc
View
4 opa/pass_JavascriptCompilation.ml
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -277,7 +277,7 @@ let full_serialize
register_plugin plugin_id ;
let fold rev_ast (filename, content, conf) =
let key_prefix = plugin_id ^ filename in
- let content = bsl_pp content in
+ let content = bsl_pp ~name:filename content in
match conf with
| BslJsConf.Verbatim ->
let code_elt = make_root key_prefix content in
View
4 opa/pass_JavascriptCompilation.mli
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -61,7 +61,7 @@ val process :
renaming_client:QmlRenamingMap.t ->
client_roots:IdentSet.t ->
typing:QmlTyper.env -> (* currently unused *)
- bsl_pp:(string -> string) ->
+ bsl_pp:(name:string-> string -> string) ->
bsl_client:BslLib.env_bsl ->
server: QmlBlender.qml_milkshake ->
client: QmlBlender.qml_milkshake ->
View
4 opa/s3Passes.ml
@@ -409,11 +409,11 @@ let pass_PreProcess =
let ppenv =
OpaEnv.Options.to_ppenv e.PH.options ppenv in
let ppopt = Pprocess.default_options ppenv in
- let process = (Pprocess.process Pplang.opa_description ppopt) in
+ let process = Pprocess.process Pplang.opa_description ppopt in
let process =
List.map
(fun f ->
- {f with P.inputFile_content = process f.P.inputFile_content})
+ {f with P.inputFile_content = process ~name:f.P.inputFile_filename f.P.inputFile_content})
in
{ e with PH.env = (process files, process ufiles) })
View
59 pplib/pprocess.ml
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -168,8 +168,34 @@ let print_code ?(doeval=false) ?(eval=fun _ -> true) description buf code =
in
print_lexpr ~block:false ~comment:false code
+(* we avoid the dependency to libbase *)
+let rec compute_line content pos pos_line line pos_max =
+ let len = min pos_max (String.length content) in
+ if pos < len then
+ if
+ content.[pos] = '\n' ||
+ content.[pos] = '\r' && ( ( (pos<len-1) && content.[pos+1]<>'\n' ) ||
+ ( (pos>1 ) && content.[pos-1]<>'\n' ) )
+ then
+ compute_line content (pos+1) (pos+1) (line+1) pos_max
+ else
+ compute_line content (pos+1) pos_line line pos_max
+ else
+ (line, pos-pos_line)
+
(* Parse a string *)
-let parse content options =
+let parse filename content options =
+ let pp_pos remain =
+ let remain_size =
+ List.fold_left (fun acc e ->
+ match e with
+ | Str.Delim s | Str.Text s -> acc+String.length(s)
+ ) 0 remain
+ in
+ let pos_max = (String.length content) - remain_size in
+ let (line, pos) = compute_line content 0 0 0 pos_max in
+ Printf.sprintf "File \"%s\", line %d, character %d (%d:%d-%d:%d)" filename line pos line pos line pos
+ in
let set_debugvar, get_debugvar =
let dvar = ref None in
(fun str -> dvar := Some str),
@@ -186,16 +212,19 @@ let parse content options =
let cond3_regexp = Str.regexp "\\([^ ]*\\) \\([^ ]*\\)" in
let dvar_regexp = Str.regexp "#<Debugvar: *\\([^ ]*\\) *" in
+ let error i lst =
+ raise (PPParse_error (Format.sprintf "Error %s.\n%s" i (pp_pos lst)))
+ in
+ let unknown tag lst =
+ error ("Unknown preprocessing directive "^tag^" (authorized only #<{If,Ifstatic,Else,End}>)") lst
+ in
+
let rec aux (result, lst) =
match lst with
| Str.Delim "#<Else>"::_
| Str.Delim "#<End>"::_ -> (List.rev result), lst
| Str.Delim tag::queue ->
(try
- let error i =
- raise (PPParse_error
- (Printf.sprintf "Error (%d) on pptag \"%s\" : Bad formatted" i tag))
- in
if Str.string_match dvar_regexp tag 0 then (
set_debugvar (Str.matched_group 1 tag);
aux (result, queue)
@@ -206,7 +235,7 @@ let parse content options =
`dyn
else if tag = "#<Ifstatic>" || Str.matched_group 1 tag = "Ifstatic" then
`static
- else error 1
+ else unknown tag lst
in
let cond =
if tag = "#<If>" || tag = "#<Ifstatic>"then(
@@ -245,8 +274,8 @@ let parse content options =
|`dyn -> If if_)::result
in
aux (result, queue)
- | _ -> failwith ("Error expected end"))
- ) else error 2
+ | _ -> error "Expected end" lst)
+ ) else unknown tag lst
with | PPParse_error _ -> aux (result, (Str.Text tag)::queue)
)
@@ -255,15 +284,15 @@ let parse content options =
| _ -> (List.rev result), lst
in match aux ([], content) with
| content, [] -> content
- | _, t::_ ->
+ | _, (t::_ as lst) ->
(match t with
- | Str.Delim r
- | Str.Text r -> failwith (Printf.sprintf "Error on \"%s\"" r))
+ | Str.Delim _r
+ | Str.Text _r -> error "Unfinished parsing" lst)
(* Process *)
-let process description options content =
+let process ~name description options content =
(* Parsing *)
- let content = parse content options in
+ let content = parse name content options in
(* Eval function *)
let eval cond =
try
@@ -344,7 +373,7 @@ module Exe = struct
match files with
| t::q ->
begin
- let result = process description options (content t) in
+ let result = process ~name:t description options (content t) in
match options.output_suffix with
| None -> output_string stdout result
| Some s ->
View
4 pplib/pprocess.mli
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -82,7 +82,7 @@ type lang_description = {
debug_module : string; (** The debug module *)
}
-val process : lang_description -> options -> string -> string
+val process : name:string -> lang_description -> options -> string -> string
(** {6 Executable} *)
(** A module for easy executable making. *)
View
4 qml2js/qml2js.ml
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -117,7 +117,7 @@ struct
let ppenv = Pprocess.fill_with_sysenv Pprocess.empty_env in
(* TODO modifier ppenv avec des choses *)
let ppopt = Pprocess.default_options ppenv in
- Pprocess.process Pplang.js_description ppopt in
+ Pprocess.process ~name:filename Pplang.js_description ppopt in
let content = ppjs content in
let () =
(*

0 comments on commit f4bd094

Please sign in to comment.