Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Rename types, modules, and module types (many new tests)

  • Loading branch information...
commit 7704e2f49a85d1b350ad44481d3400e89383a2e7 1 parent 6c8555c
Tiphaine Turpin authored
View
2  ocamlwizard/common/typedtreeOps.ml
@@ -201,6 +201,8 @@ let locate priority loc =
(function t ->
if
(match t with
+ | `module_expr e -> contains e.mod_loc
+ | `module_type t -> contains t.mty_loc
| `pattern p -> contains p.pat_loc
| `expression e -> contains e.exp_loc
| `structure_item i -> contains i.str_loc
View
4 ocamlwizard/common/typedtreeOps.mli
@@ -78,7 +78,9 @@ val find_map : [`outermost | `innermost] -> (node -> 'a option) -> 'a sfun
val find_all_map : (node -> 'a option) -> 'a list sfun
(** Return the innermost subtree whose locations contains a given
- character number interval [a, b[. *)
+ character number interval [a, b[.
+
+ Warning: most node kinds are missing ! *)
val locate : [`outermost | `innermost] -> int * int -> node sfun
View
75 ocamlwizard/refactor/findName.ml
@@ -201,23 +201,25 @@ let get_occurrences lid2loc lid2env s =
(* We should check that keys are bound only once *)
Longident.LongidentTbl.fold
(fun lid loc acc ->
- let envs = Env.LongidentTbl.find_all lid2env lid in
- let envs = List.filter (function kind, _ -> kind <> Env.Annot) envs in
- match envs with
- | [] ->
- Location.print Format.std_formatter loc;
- Printf.printf "Warning: lident %s has no environment\n" (lid_to_str lid);
-(*
- failwith ("lident" ^ lid_to_str lid ^ "has no environment");
-*)
- acc
- | l ->
- debugln "testing %s" (lid_to_str lid);
- let kind, env = check_same l in
- if kind = Env.Value || kind = Env.Type then
- (loc, (env, kind)) :: acc
- else
- acc)
+ if not (List.mem (lid_to_str lid) ["false" ; "()"]) then
+ let envs = Env.LongidentTbl.find_all lid2env lid in
+ let envs = List.filter (function kind, _ -> kind <> Env.Annot) envs in
+ match envs with
+ | [] ->
+ Location.print Format.std_formatter loc;
+ Printf.printf "Warning: lident %s has no environment\n" (lid_to_str lid);
+ (*
+ failwith ("lident" ^ lid_to_str lid ^ "has no environment");
+ *)
+ acc
+ | l ->
+ debugln "testing %s" (lid_to_str lid);
+ let kind, env = check_same l in
+ if kind <> Env.Annot then
+ (loc, (env, kind)) :: acc
+ else
+ acc
+ else acc)
lid2loc
[]
@@ -235,28 +237,29 @@ let get_lids env file lidents paths ast =
extract_longident
(source_locations file (get_occurrences lidents paths ast))
-let ident_of_subtree = function
- | `pattern {pat_desc = Tpat_var id}
- | `expression {exp_desc = Texp_for (id, _, _, _, _)}
- | `signature_item {sig_desc = Tsig_value (id, _)}
- -> Env.Value, id
- | `structure_item {str_desc = Tstr_module (id, _)}
- -> Env.Module, id
- | `structure_item {str_desc = Tstr_modtype (id, _)}
- -> Env.Modtype, id
- | `structure_item {str_desc = Tstr_type types}
- -> (match types with
- | [id, _] -> Env.Type, id
- | _ -> failwith "multiple type definitions are not yes supported")
- | _ -> raise Not_found
-
(* Should be almost complete for expressions, but this is not a safety
requirement anyway. *)
let locate_renamed_id s loc =
- try
- let kind, id = ident_of_subtree (locate `innermost loc s) in kind, id
- with Not_found ->
- invalid_arg "rename"
+ let open Env in
+ match locate `innermost loc s with
+ | `pattern {pat_desc = Tpat_var id}
+ | `expression {exp_desc = Texp_for (id, _, _, _, _)}
+ | `signature_item {sig_desc = Tsig_value (id, _)}
+ -> Value, id
+ | `structure_item {str_desc = Tstr_module (id, _)}
+ | `signature_item {sig_desc = Tsig_module (id, _)}
+ | `module_expr {mod_desc = Tmod_functor (id, _, _)}
+ | `module_type {mty_desc = Tmty_functor (id, _, _)}
+ -> Module, id
+ | `structure_item {str_desc = Tstr_modtype (id, _)}
+ | `signature_item {sig_desc = Tsig_modtype (id, _)}
+ -> Modtype, id
+ | `structure_item {str_desc = Tstr_type types}
+ | `signature_item {sig_desc = Tsig_type types}
+ -> (match types with
+ | [id, _] -> Type, id
+ | _ -> failwith "multiple type definitions are not yet supported")
+ | _ -> invalid_arg "rename"
let find_id_def table id =
StringTbl.find table (Ident.name id)
View
28 ocamlwizard/refactor/resolve.ml
@@ -25,9 +25,7 @@ let wrap_lookup to_string name lookup x e =
try lookup x e
with Not_found -> failwith ("unbound " ^ name ^ " " ^ to_string x)
-let keep_first name f lid env = fst (wrap_lookup lid_to_str name f lid env)
-
-let keep_first' f lid env = fst (f lid env)
+let keep_first f lid env = fst (f lid env)
let parse parser s =
let lexbuf = Lexing.from_string s in
@@ -47,14 +45,14 @@ let kind2str = function
let lookup kind lid e =
let lookup =
match kind with
- | Value -> keep_first' lookup_value
- | Type -> keep_first' lookup_type
- | Module -> keep_first' lookup_module
- | Constructor -> keep_first' lookup_constructor
- | Label -> keep_first' lookup_label
- | Modtype -> keep_first' lookup_modtype
- | Class -> keep_first' lookup_class
- | Cltype -> keep_first' lookup_cltype
+ | Value -> keep_first lookup_value
+ | Type -> keep_first lookup_type
+ | Module -> keep_first lookup_module
+ | Constructor -> keep_first lookup_constructor
+ | Label -> keep_first lookup_label
+ | Modtype -> keep_first lookup_modtype
+ | Class -> keep_first lookup_class
+ | Cltype -> keep_first lookup_cltype
| Annot -> assert false
in
wrap_lookup lid_to_str (kind2str kind) lookup lid e
@@ -84,9 +82,13 @@ let parse_lid kind =
try parse Parser.val_longident s
with _ -> Longident.Lident (parse Parser.operator s))
| Type -> parse Parser.type_longident
- | Module -> parse Parser.mod_longident (* extended ? *)
+ | Module -> parse Parser.mod_ext_longident
| Modtype -> parse Parser.mty_longident
- | _ -> assert false
+ | Constructor -> parse Parser.constr_longident
+ | Label -> parse Parser.label_longident
+ | Class -> parse Parser.class_longident
+ | Cltype -> parse Parser.clty_longident
+ | Annot -> assert false
(*
let sig_item_ops = function
View
9 ocamlwizard/test/Makefile
@@ -7,8 +7,11 @@ R_CASES=renameSimple.ml renameSigNewCaptured.ml renameSigOldCaptured.ml \
renameIncludeNewCaptured.ml renameIncludeOldCaptured.ml \
renameOpenNewCaptured.ml renameOpenOldCaptured.ml \
renameMultiple.ml renameProp.ml renamePropFunctor.ml \
- renamePropFunctorNoApp.ml renameType.ml
-# renameModtype.ml
+ renamePropFunctorNoApp.ml renameFor.ml renameVal.ml \
+ renameType.ml renameTypeInSig.ml \
+ renameModtype.ml renameModtypeInSig.ml \
+ renameModule.ml renameModuleInSig.ml renameModuleInFunctor.ml \
+ renameModuleInFunctorType.ml
R_TESTS=$(subst .ml,_rres.ml, $(R_CASES))
RES=match_cases_res.ml expansion_res.ml path_res.ml errors_res.ml \
@@ -16,7 +19,7 @@ RES=match_cases_res.ml expansion_res.ml path_res.ml errors_res.ml \
all: $(RES)
for i in $(RES); do \
- diff expected/$$i $$i || exit 1; \
+ diff expected/$$i $$i || (echo $$i failed ; exit 1); \
done
#Generic rules and functions
View
6 ocamlwizard/test/expected/renameFor_rres.ml
@@ -0,0 +1,6 @@
+let _ =
+ for y = 1 to 2 do
+ ignore y
+ done
+Renamed 1 definition(s) and 1 reference(s)
+
View
7 ocamlwizard/test/expected/renameModtype_rres.ml
@@ -0,0 +1,7 @@
+module type Y = sig end
+
+module type N = Y
+
+module M : Y = struct end
+Renamed 1 definition(s) and 2 reference(s)
+
View
16 ocamlwizard/test/expected/renameModuleInFunctorType_rres.ml
@@ -0,0 +1,16 @@
+module type F = functor (Y : sig
+
+ val x : unit
+ type t = A
+ type t' = {a : unit}
+ module M : sig end
+ module type T = sig end
+
+end) -> sig
+
+ type t = Y.t
+ module type U = Y.T
+
+end
+Renamed 1 definition(s) and 2 reference(s)
+
View
16 ocamlwizard/test/expected/renameModuleInFunctor_rres.ml
@@ -0,0 +1,16 @@
+module F(Y : sig
+
+ val x : unit
+ type t = A
+ type t' = {a : unit}
+ module M : sig end
+ module type T = sig end
+
+end) = struct
+
+ type t = Y.t
+ module type U = Y.T
+
+end
+Renamed 1 definition(s) and 2 reference(s)
+
View
17 ocamlwizard/test/expected/renameModuleInSig_rres.ml
@@ -0,0 +1,17 @@
+module type M = sig
+ module Y : sig
+
+ val x : unit
+ type t = A
+ type t' = {a : unit}
+ module M : sig end
+ module type T = sig end
+
+ end
+
+ type t = Y.t
+ module type U = Y.T
+
+end
+Renamed 1 definition(s) and 2 reference(s)
+
View
6 ocamlwizard/test/expected/renameTypeInSig_rres.ml
@@ -0,0 +1,6 @@
+module type T = sig
+ type y = [`foo]
+ type z = y
+end
+Renamed 1 definition(s) and 1 reference(s)
+
View
5 ocamlwizard/test/expected/renameVal_rres.ml
@@ -0,0 +1,5 @@
+module type M = sig
+ val y : unit
+end
+Renamed 1 definition(s) and 0 reference(s)
+
View
4 ocamlwizard/test/renameFor.ml
@@ -0,0 +1,4 @@
+let _ =
+ for $x€ = 1 to 2 do
+ ignore x
+ done
View
1  ocamlwizard/test/renameModtype.ml
@@ -1,4 +1,3 @@
-(* Does not work because modtypes don't have environments. *)
module type $M= sig end
module type N = M
View
5 ocamlwizard/test/renameModtypeInSig.ml
@@ -0,0 +1,5 @@
+module type M = sig
+ module type $M= sig end
+
+ module type N = M
+end
View
17 ocamlwizard/test/renameModule.ml
@@ -0,0 +1,17 @@
+module $M= struct
+
+ let x = ()
+ type t = A
+ type t' = {a : unit}
+ module M = struct end
+ module type T = sig end
+
+end
+
+module N = M
+let y = M.x
+type t = M.t
+module O = M.M
+module type U = M.T
+let _ = match M.A with M.A -> ()
+let _ = match {M.a = ()} with {M.a = ()} -> ()
View
14 ocamlwizard/test/renameModuleInFunctor.ml
@@ -0,0 +1,14 @@
+module F($M€ : sig
+
+ val x : unit
+ type t = A
+ type t' = {a : unit}
+ module M : sig end
+ module type T = sig end
+
+end) = struct
+
+ type t = M.t
+ module type U = M.T
+
+end
View
14 ocamlwizard/test/renameModuleInFunctorType.ml
@@ -0,0 +1,14 @@
+module type F = functor ($M€ : sig
+
+ val x : unit
+ type t = A
+ type t' = {a : unit}
+ module M : sig end
+ module type T = sig end
+
+end) -> sig
+
+ type t = M.t
+ module type U = M.T
+
+end
View
15 ocamlwizard/test/renameModuleInSig.ml
@@ -0,0 +1,15 @@
+module type M = sig
+ module $M€ : sig
+
+ val x : unit
+ type t = A
+ type t' = {a : unit}
+ module M : sig end
+ module type T = sig end
+
+ end
+
+ type t = M.t
+ module type U = M.T
+
+end
View
4 ocamlwizard/test/renameTypeInSig.ml
@@ -0,0 +1,4 @@
+module type T = sig
+ type $x€ = [`foo]
+ type z = x
+end
View
3  ocamlwizard/test/renameVal.ml
@@ -0,0 +1,3 @@
+module type M = sig
+ val $x€ : unit
+end
Please sign in to comment.
Something went wrong with that request. Please try again.