From e704e5c674e78e44753f56b9623a10c4c520bf19 Mon Sep 17 00:00:00 2001 From: Hakimba Date: Wed, 11 Jul 2018 16:44:39 +0200 Subject: [PATCH 1/4] le checker pour l'ordre des arguments de meme type dans une fonction, qui ne marche pas (il detecte pas les arguments avec label) --- plugins/ocp-lint-plugin-typedtree/build.ocp | 6 + .../check_order_args.ml | 151 ++++++++++++++++++ tests_me/ref/args_same_types.ml | 1 + 3 files changed, 158 insertions(+) create mode 100644 plugins/ocp-lint-plugin-typedtree/check_order_args.ml create mode 100644 tests_me/ref/args_same_types.ml diff --git a/plugins/ocp-lint-plugin-typedtree/build.ocp b/plugins/ocp-lint-plugin-typedtree/build.ocp index 656d3ad..f7254a2 100644 --- a/plugins/ocp-lint-plugin-typedtree/build.ocp +++ b/plugins/ocp-lint-plugin-typedtree/build.ocp @@ -32,6 +32,12 @@ begin library "ocp-lint-plugin-typedtree" "checkInheritance.ml" "checkModuleUtilization.ml" (pp = "ocp-pp") "polymorphic_comparison.ml" + "must_a_int.ml"; + "check_order_args.ml"; + "mutable_ref.ml"; + "lengthy_tuples.ml"; + + ] requires = [ "ocp-lint-config" diff --git a/plugins/ocp-lint-plugin-typedtree/check_order_args.ml b/plugins/ocp-lint-plugin-typedtree/check_order_args.ml new file mode 100644 index 0000000..e8209bc --- /dev/null +++ b/plugins/ocp-lint-plugin-typedtree/check_order_args.ml @@ -0,0 +1,151 @@ +module Linter = Plugin_typedtree.Plugin.MakeLint(struct + let name = "Detect bad use of arguments when functions are called" + let version = "1" + let short_name = "arg_func_order" + let details = "check if function called, are called with their arguments in good order" + let enabled = true; + end) + +type warning = BadUseArg of (string * string * string) + + + +let w_badusearg = Linter.new_warning + ~id:1 + ~short_name:"arg_func_order" + ~msg:"the function '$func' with parameters ($good) and their types ($types)" + ~severity:9 + +let err_file ?file:(file = "err.txt") str = + let oc = open_out file in Printf.fprintf oc "(%s) \n" str; + close_out oc;; + + + +let rec concat_el l acc = match l with + | [] -> acc + | head::tail -> concat_el tail (acc^" "^head) + + +let rec count_same_type l acc = match l with + | [] -> acc + | hd :: tl -> count_same_type tl (acc + compare_type tl hd 0) + +and compare_type l el acc = match l with + | [] -> acc + | hd::tl -> if(hd = el) then compare_type tl el (acc+1) else compare_type tl el acc + +let rec count_labeled_args l acc = match l with + | [] -> acc + | hd::tl -> if(hd = "nolabel") then count_labeled_args tl (acc+1) else count_labeled_args tl (acc) + +let rec if_need_label l acc_type acc_label = match l with + |[] -> (acc_type,acc_label) + |(label,typ) :: tl -> if_need_label tl (acc_type @ [typ]) (acc_label @ [label]) + + + +let printargs l = match l with + | hd::tl -> Printf.printf "%s \n" hd + | _ -> Printf.printf "%s \n" "" + +module Warnings = Linter.MakeWarnings(struct + type t = warning + let to_warning = function + | BadUseArg (good_order,func,types) -> w_badusearg, [("good",good_order );("func",func);("types",types)] + end) + +let get_string data = match data with + | None -> "none" + | Some str -> str + +let rec check_path p acc = let open Path in match p with + | Pident (ident) -> acc ^ ident.name + | Pdot (t,str,ent) -> check_path t acc^str + | Papply (t_,t__) -> "Papply" + + +let get_arg_label arg = let open Asttypes in match arg with + | Nolabel -> "nolabel" + | Labelled (str) -> "labelled" + | Optional (str) -> "optional" + + +let rec matching_type t types label = let open Typedtree in let open Types in match t.desc with + | Tvar (data) -> Printf.printf "-%s %! \n" label; types @ [(label,get_string data)] + | Tarrow (arg_label,t_exp,t__exp,_) -> Printf.printf "-----%s %! \n" label; matching_type t__exp (matching_type t_exp types (get_arg_label arg_label)) (get_arg_label arg_label) + | Ttuple (t_list) -> Printf.printf "--%s %! \n" label; get_type_args t_list types label + | Tconstr (path,t_list,_) -> Printf.printf "---%s %s %! \n" label (check_path path ""); types @ [(label,check_path path "")] + | Tobject (_,_) -> [("","tobject")] + | Tfield (_,_,_,_) -> [("","tfield")] + | Tnil -> [("","tnil")] + | Tlink (link) -> Printf.printf "----%s %! \n" label; matching_type link types label + | Tsubst (_) -> [("","tsubst")] + | Tvariant (_) -> [("","tvariant")] + | Tunivar (_) -> [("","tunivar")] + | Tpoly (_,_) -> [("","tpoly")] + | Tpackage (_,_,_) -> [("","tpackage")] + +and get_type_args t acc label = let open Typedtree in let open Types in match t with + | [] -> acc + | hd::tl -> get_type_args tl (matching_type hd acc label) label + +let get_type_func val_bind = let open Typedtree in match val_bind.vb_expr.exp_type.desc with + | Tvar (data) -> [("","tvar")] + | Tarrow (arg_label,t_exp,t__exp,commut) -> matching_type t_exp (matching_type t__exp [] "") "" + | Ttuple (t_list) -> [("","ttuple")] + | Tconstr (path,t_list,_) -> [("","tconstr")] + | Tobject (_,_) -> [("","tobject")] + | Tfield (_,_,_,_) -> [("","tfield")] + | Tnil -> [("","tnil")] + | Tlink (link) -> matching_type link [] "" + | Tsubst (_) -> [("","tsubst")] + | Tvariant (_) -> [("","tvariant")] + | Tunivar (_) -> [("","tunivar")] + | Tpoly (_,_) -> [("","tpoly")] + | Tpackage (_,_,_) -> [("","tpackage")] + +let get_func_name pat = let open Typedtree in let open Asttypes in match pat.vb_pat.pat_desc with + | Tpat_var (ident,name_loc) -> (name_loc.txt,name_loc.loc) + | _ -> ("",pat.vb_loc) + +let next_case case = let open Typedtree in match case.c_rhs.exp_desc with + | Texp_function (record) -> List.hd record.cases + | _ -> case + +let rec iter_cases case acc = let open Typedtree in match case.c_lhs.pat_desc with + | Tpat_var (ident,loc) -> if(next_case(case) = case) then acc @ [ident.name] else iter_cases (next_case(case)) (acc @ [ident.name]) + | _ -> acc + + +let rec sub_list l n acc = match n with + | 0 -> acc + | _ -> sub_list (List.tl l) (n-1) (acc @ [List.hd l]) + +let get_args_name val_bind = let open Typedtree in match val_bind.vb_expr.exp_desc with + | Texp_function (record) -> iter_cases (List.hd record.cases) [] + | _ -> [] + +let get_args_type val_bind = let open Typedtree in match val_bind.vb_expr.exp_desc with + | Texp_function (record) -> sub_list (get_type_func val_bind) (List.length (iter_cases(List.hd record.cases) [])) [] + | _ -> [] + + +let iter = + let module IterExp = struct + include Typedtree_iter.DefaultIteratorArgument + + let enter_structure_item strct = + let open Typedtree in + let open Asttypes in + begin match strct.str_desc with + | Tstr_value (rec_flag, binding) -> let args_name = get_args_name (List.hd binding) in let args_type = get_args_type (List.hd binding) in + let (txt,loc) = get_func_name (List.hd binding) in let (types,label) = if_need_label args_type [] [] in let same_type = (count_same_type types 0) in let labeled = (count_labeled_args label 0) in Warnings.report loc (BadUseArg ((concat_el args_name ""),txt, concat_el label "")) + | _ -> () + end + end in + (module IterExp : Typedtree_iter.IteratorArgument) + +module Main = Linter.MakeInputCMT(struct + let main cmt = Typedtree_iter.iter_structure iter cmt +end) diff --git a/tests_me/ref/args_same_types.ml b/tests_me/ref/args_same_types.ml new file mode 100644 index 0000000..a50d0d9 --- /dev/null +++ b/tests_me/ref/args_same_types.ml @@ -0,0 +1 @@ +let func ~a:arg1 arg2 arg3 = (arg2+1,arg1+.1.0,int_of_string(arg3)) From a4a083bb44533efeecb57a4f453efe4ddcbbba72 Mon Sep 17 00:00:00 2001 From: Hakimba Date: Wed, 11 Jul 2018 17:00:28 +0200 Subject: [PATCH 2/4] les commentaires --- .../check_order_args.ml | 36 +++++++++++++++++-- 1 file changed, 34 insertions(+), 2 deletions(-) diff --git a/plugins/ocp-lint-plugin-typedtree/check_order_args.ml b/plugins/ocp-lint-plugin-typedtree/check_order_args.ml index e8209bc..5c036e1 100644 --- a/plugins/ocp-lint-plugin-typedtree/check_order_args.ml +++ b/plugins/ocp-lint-plugin-typedtree/check_order_args.ml @@ -20,8 +20,6 @@ let err_file ?file:(file = "err.txt") str = let oc = open_out file in Printf.fprintf oc "(%s) \n" str; close_out oc;; - - let rec concat_el l acc = match l with | [] -> acc | head::tail -> concat_el tail (acc^" "^head) @@ -39,6 +37,8 @@ let rec count_labeled_args l acc = match l with | [] -> acc | hd::tl -> if(hd = "nolabel") then count_labeled_args tl (acc+1) else count_labeled_args tl (acc) + + let rec if_need_label l acc_type acc_label = match l with |[] -> (acc_type,acc_label) |(label,typ) :: tl -> if_need_label tl (acc_type @ [typ]) (acc_label @ [label]) @@ -71,6 +71,13 @@ let get_arg_label arg = let open Asttypes in match arg with | Optional (str) -> "optional" +(* + t -> le type_expr desc + types -> la liste de couple (type,label) avec label qui peut prendre 3 valeur : nolabel, labelled, optional + label -> la variable temporaire qui sert a stocker le label courant (vu que la fonction est recursive j'ai besoin de garder cette valeur la jusqu'au cas terminaux ou je l'ajoute a la liste (type,label) + +*) + let rec matching_type t types label = let open Typedtree in let open Types in match t.desc with | Tvar (data) -> Printf.printf "-%s %! \n" label; types @ [(label,get_string data)] | Tarrow (arg_label,t_exp,t__exp,_) -> Printf.printf "-----%s %! \n" label; matching_type t__exp (matching_type t_exp types (get_arg_label arg_label)) (get_arg_label arg_label) @@ -86,10 +93,15 @@ let rec matching_type t types label = let open Typedtree in let open Types in ma | Tpoly (_,_) -> [("","tpoly")] | Tpackage (_,_,_) -> [("","tpackage")] +(* + Fonction mutuellement recursive avec matching type, car dans le cas de Tconstr on peut avoir a parser une liste de type_expr donc je l'envoie ici. +*) + and get_type_args t acc label = let open Typedtree in let open Types in match t with | [] -> acc | hd::tl -> get_type_args tl (matching_type hd acc label) label + let get_type_func val_bind = let open Typedtree in match val_bind.vb_expr.exp_type.desc with | Tvar (data) -> [("","tvar")] | Tarrow (arg_label,t_exp,t__exp,commut) -> matching_type t_exp (matching_type t__exp [] "") "" @@ -117,6 +129,10 @@ let rec iter_cases case acc = let open Typedtree in match case.c_lhs.pat_desc wi | Tpat_var (ident,loc) -> if(next_case(case) = case) then acc @ [ident.name] else iter_cases (next_case(case)) (acc @ [ident.name]) | _ -> acc +(* + cette fonction sert a me couper la liste (type,label) pour ne garder que les type des arguments et non le type de sortie, car quand je parse le type de la fonction je récupère tout (argument,sortie). + n elements de la liste l sont transféré dans le tableau acc. +*) let rec sub_list l n acc = match n with | 0 -> acc @@ -138,6 +154,22 @@ let iter = let enter_structure_item strct = let open Typedtree in let open Asttypes in + + (* + donc ici, étape par étape + 1 : je récupère les nom des arguments + 2 : je récupère la (type,label) list + 3 : je récupère le nom de la fonction visé + 4 : je récupère séparemment la liste des types et la liste des label associé, en utilisant "if_need_label" qui va me decouper ma (types,label) list + 5 : je balance chacune des liste sur leurs fonctions respective qui vont compter le nombre d'arguments non labelisé, et le nombre de fois que deux arguments ont le meme type. + + exemple : une fonction string -> int -> int -> (string * int * int), le "count_same_type" renvoie 1 car une seule fois on trouve deux arguments du meme type, c'est pas ce que j'veux faire mais en l'état cette fonction agis comme ça. + et le "count_labeled_args renvoie 3 car aucun argument n'es labelisé. + + 6 : j'appel le warning avec le nom des argument, le nom de la fonction, et le tableau des label qui a été concaténé en une chaine. + *) + + begin match strct.str_desc with | Tstr_value (rec_flag, binding) -> let args_name = get_args_name (List.hd binding) in let args_type = get_args_type (List.hd binding) in let (txt,loc) = get_func_name (List.hd binding) in let (types,label) = if_need_label args_type [] [] in let same_type = (count_same_type types 0) in let labeled = (count_labeled_args label 0) in Warnings.report loc (BadUseArg ((concat_el args_name ""),txt, concat_el label "")) From 18bfa07935affe8b29d8370b7aa4dac007072fdb Mon Sep 17 00:00:00 2001 From: Hakimba Date: Wed, 18 Jul 2018 11:55:59 +0200 Subject: [PATCH 3/4] le checker des arguments finit --- .../check_order_args.ml | 87 +++++++++---------- tests_me/ref/args_same_types.ml | 2 +- 2 files changed, 40 insertions(+), 49 deletions(-) diff --git a/plugins/ocp-lint-plugin-typedtree/check_order_args.ml b/plugins/ocp-lint-plugin-typedtree/check_order_args.ml index 5c036e1..42c6038 100644 --- a/plugins/ocp-lint-plugin-typedtree/check_order_args.ml +++ b/plugins/ocp-lint-plugin-typedtree/check_order_args.ml @@ -13,7 +13,7 @@ type warning = BadUseArg of (string * string * string) let w_badusearg = Linter.new_warning ~id:1 ~short_name:"arg_func_order" - ~msg:"the function '$func' with parameters ($good) and their types ($types)" + ~msg:"'$func' have arguments with same types, ($good) -> $err_msg" ~severity:9 let err_file ?file:(file = "err.txt") str = @@ -25,34 +25,30 @@ let rec concat_el l acc = match l with | head::tail -> concat_el tail (acc^" "^head) -let rec count_same_type l acc = match l with - | [] -> acc - | hd :: tl -> count_same_type tl (acc + compare_type tl hd 0) - -and compare_type l el acc = match l with - | [] -> acc - | hd::tl -> if(hd = el) then compare_type tl el (acc+1) else compare_type tl el acc - -let rec count_labeled_args l acc = match l with - | [] -> acc - | hd::tl -> if(hd = "nolabel") then count_labeled_args tl (acc+1) else count_labeled_args tl (acc) - +let rec key_exist l key = match l with + [] -> false + | (typ,_,_)::tl -> if key = typ then true else key_exist tl key +let rec create_keys l acc = match l with + [] -> acc + | (label,typ) :: tl -> if(key_exist acc typ) then create_keys tl acc else create_keys tl ([(typ,0,0)] @ acc) -let rec if_need_label l acc_type acc_label = match l with - |[] -> (acc_type,acc_label) - |(label,typ) :: tl -> if_need_label tl (acc_type @ [typ]) (acc_label @ [label]) +let rec cumulative l map = match l with + |[] -> map + |(label,typ) :: tl -> cumulative tl (List.map (function (t,occur,occur_label) -> if typ = t then + if label = "labelled" then + (t,occur+1,occur_label+1) + else + (t,occur+1,occur_label) + else + (t,occur,occur_label)) map) -let printargs l = match l with - | hd::tl -> Printf.printf "%s \n" hd - | _ -> Printf.printf "%s \n" "" - module Warnings = Linter.MakeWarnings(struct type t = warning let to_warning = function - | BadUseArg (good_order,func,types) -> w_badusearg, [("good",good_order );("func",func);("types",types)] + | BadUseArg (good_order,func,types) -> w_badusearg, [("good",good_order );("func",func);("err_msg",types)] end) let get_string data = match data with @@ -78,15 +74,17 @@ let get_arg_label arg = let open Asttypes in match arg with *) -let rec matching_type t types label = let open Typedtree in let open Types in match t.desc with - | Tvar (data) -> Printf.printf "-%s %! \n" label; types @ [(label,get_string data)] - | Tarrow (arg_label,t_exp,t__exp,_) -> Printf.printf "-----%s %! \n" label; matching_type t__exp (matching_type t_exp types (get_arg_label arg_label)) (get_arg_label arg_label) - | Ttuple (t_list) -> Printf.printf "--%s %! \n" label; get_type_args t_list types label - | Tconstr (path,t_list,_) -> Printf.printf "---%s %s %! \n" label (check_path path ""); types @ [(label,check_path path "")] +let rec matching_type t map_types label = let open Typedtree in let open Types in match t.desc with + | Tvar (data) -> map_types @ [(label,get_string data)] + | Tarrow (arg_label,arg_type,result_type,_) -> let arg_type = matching_type arg_type [] (get_arg_label arg_label) in + let map_types = map_types @ arg_type in matching_type result_type map_types "" + + | Ttuple (t_list) -> get_type_args t_list map_types label + | Tconstr (path,t_list,_) -> map_types @ [(label,check_path path "")] | Tobject (_,_) -> [("","tobject")] | Tfield (_,_,_,_) -> [("","tfield")] | Tnil -> [("","tnil")] - | Tlink (link) -> Printf.printf "----%s %! \n" label; matching_type link types label + | Tlink (link) -> matching_type link map_types label | Tsubst (_) -> [("","tsubst")] | Tvariant (_) -> [("","tvariant")] | Tunivar (_) -> [("","tunivar")] @@ -98,13 +96,13 @@ let rec matching_type t types label = let open Typedtree in let open Types in ma *) and get_type_args t acc label = let open Typedtree in let open Types in match t with - | [] -> acc - | hd::tl -> get_type_args tl (matching_type hd acc label) label + | [] -> acc + | hd::tl -> get_type_args tl (matching_type hd acc label) label let get_type_func val_bind = let open Typedtree in match val_bind.vb_expr.exp_type.desc with | Tvar (data) -> [("","tvar")] - | Tarrow (arg_label,t_exp,t__exp,commut) -> matching_type t_exp (matching_type t__exp [] "") "" + | Tarrow (arg_label,arg_type,result_type,commut) -> let arg_type = matching_type arg_type [] (get_arg_label arg_label) in let map_types = arg_type @ [] in matching_type result_type map_types "" | Ttuple (t_list) -> [("","ttuple")] | Tconstr (path,t_list,_) -> [("","tconstr")] | Tobject (_,_) -> [("","tobject")] @@ -136,16 +134,19 @@ let rec iter_cases case acc = let open Typedtree in match case.c_lhs.pat_desc wi let rec sub_list l n acc = match n with | 0 -> acc - | _ -> sub_list (List.tl l) (n-1) (acc @ [List.hd l]) + | _ -> sub_list (List.tl l) (n-1) (acc @ [List.hd l]) let get_args_name val_bind = let open Typedtree in match val_bind.vb_expr.exp_desc with | Texp_function (record) -> iter_cases (List.hd record.cases) [] | _ -> [] let get_args_type val_bind = let open Typedtree in match val_bind.vb_expr.exp_desc with - | Texp_function (record) -> sub_list (get_type_func val_bind) (List.length (iter_cases(List.hd record.cases) [])) [] + | Texp_function (record) -> sub_list (get_type_func val_bind) (List.length (iter_cases(List.hd record.cases) [])) [] | _ -> [] +let rec get_err_msg assoc acc = match assoc with + [] -> acc + | (typ,occur_t,occur_label)::tl -> if occur_t > occur_label then get_err_msg tl (acc ^""^string_of_int(occur_t)^" "^typ^" found but "^string_of_int(occur_label)^" labelled. ") else get_err_msg tl acc let iter = let module IterExp = struct @@ -155,24 +156,14 @@ let iter = let open Typedtree in let open Asttypes in - (* - donc ici, étape par étape - 1 : je récupère les nom des arguments - 2 : je récupère la (type,label) list - 3 : je récupère le nom de la fonction visé - 4 : je récupère séparemment la liste des types et la liste des label associé, en utilisant "if_need_label" qui va me decouper ma (types,label) list - 5 : je balance chacune des liste sur leurs fonctions respective qui vont compter le nombre d'arguments non labelisé, et le nombre de fois que deux arguments ont le meme type. - - exemple : une fonction string -> int -> int -> (string * int * int), le "count_same_type" renvoie 1 car une seule fois on trouve deux arguments du meme type, c'est pas ce que j'veux faire mais en l'état cette fonction agis comme ça. - et le "count_labeled_args renvoie 3 car aucun argument n'es labelisé. - - 6 : j'appel le warning avec le nom des argument, le nom de la fonction, et le tableau des label qui a été concaténé en une chaine. - *) - begin match strct.str_desc with - | Tstr_value (rec_flag, binding) -> let args_name = get_args_name (List.hd binding) in let args_type = get_args_type (List.hd binding) in - let (txt,loc) = get_func_name (List.hd binding) in let (types,label) = if_need_label args_type [] [] in let same_type = (count_same_type types 0) in let labeled = (count_labeled_args label 0) in Warnings.report loc (BadUseArg ((concat_el args_name ""),txt, concat_el label "")) + | Tstr_value (rec_flag, binding) -> List.iter (function binding -> let args_name = get_args_name binding in let args_type = get_args_type binding in + let (txt,loc) = get_func_name binding in + let assoc_t = cumulative args_type (create_keys args_type []) in + if((get_err_msg assoc_t "") <> "None") + then + Warnings.report loc (BadUseArg ((concat_el args_name ""),txt,(get_err_msg assoc_t "")))) binding | _ -> () end end in diff --git a/tests_me/ref/args_same_types.ml b/tests_me/ref/args_same_types.ml index a50d0d9..5242b53 100644 --- a/tests_me/ref/args_same_types.ml +++ b/tests_me/ref/args_same_types.ml @@ -1 +1 @@ -let func ~a:arg1 arg2 arg3 = (arg2+1,arg1+.1.0,int_of_string(arg3)) +let func arg1 ~n:arg2 ~j:arg3 arg4 arg5 = (int_of_string(arg4),int_of_string(arg5),arg2+1,arg1+.1.0,arg3+8) From c67f84eabd6fa5b05f6a3a9bfd5312ec1b52e54b Mon Sep 17 00:00:00 2001 From: Hakimba Date: Thu, 19 Jul 2018 11:33:16 +0200 Subject: [PATCH 4/4] =?UTF-8?q?3=20autres=20linters=20et=20les=20fichiers?= =?UTF-8?q?=20de=20tests=20associ=C3=A9?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- plugins/ocp-lint-plugin-text/build.ocp | 1 + .../ocp-lint-plugin-text/duplicate_code.ml | 76 +++++++++++++++ .../lengthy_tuples.ml | 67 +++++++++++++ .../ocp-lint-plugin-typedtree/mutable_ref.ml | 92 ++++++++++++++++++ tests_me/args/args_same_types.cmi | Bin 0 -> 490 bytes tests_me/args/args_same_types.cmo | Bin 0 -> 391 bytes tests_me/args/args_same_types.cmt | Bin 0 -> 4542 bytes tests_me/args/args_same_types.ml | 1 + tests_me/duplicate/.DS_Store | Bin 0 -> 6148 bytes tests_me/duplicate/second_victim.ml | 5 + tests_me/duplicate/victim_io.ml | 11 +++ tests_me/ref_mutable/mutable.cmi | Bin 0 -> 290 bytes tests_me/ref_mutable/mutable.cmo | Bin 0 -> 177 bytes tests_me/ref_mutable/mutable.cmt | Bin 0 -> 2142 bytes tests_me/ref_mutable/mutable.ml | 1 + tests_me/ref_mutable/mutable2.cmi | Bin 0 -> 294 bytes tests_me/ref_mutable/mutable2.cmo | Bin 0 -> 178 bytes tests_me/ref_mutable/mutable2.cmt | Bin 0 -> 2149 bytes tests_me/ref_mutable/mutable2.ml | 1 + tests_me/tuple/tuples.cmi | Bin 0 -> 289 bytes tests_me/tuple/tuples.cmo | Bin 0 -> 221 bytes tests_me/tuple/tuples.cmt | Bin 0 -> 2158 bytes tests_me/tuple/tuples.ml | 1 + 23 files changed, 256 insertions(+) create mode 100644 plugins/ocp-lint-plugin-text/duplicate_code.ml create mode 100644 plugins/ocp-lint-plugin-typedtree/lengthy_tuples.ml create mode 100644 plugins/ocp-lint-plugin-typedtree/mutable_ref.ml create mode 100644 tests_me/args/args_same_types.cmi create mode 100644 tests_me/args/args_same_types.cmo create mode 100644 tests_me/args/args_same_types.cmt create mode 100644 tests_me/args/args_same_types.ml create mode 100644 tests_me/duplicate/.DS_Store create mode 100644 tests_me/duplicate/second_victim.ml create mode 100644 tests_me/duplicate/victim_io.ml create mode 100644 tests_me/ref_mutable/mutable.cmi create mode 100644 tests_me/ref_mutable/mutable.cmo create mode 100644 tests_me/ref_mutable/mutable.cmt create mode 100644 tests_me/ref_mutable/mutable.ml create mode 100644 tests_me/ref_mutable/mutable2.cmi create mode 100644 tests_me/ref_mutable/mutable2.cmo create mode 100644 tests_me/ref_mutable/mutable2.cmt create mode 100644 tests_me/ref_mutable/mutable2.ml create mode 100644 tests_me/tuple/tuples.cmi create mode 100644 tests_me/tuple/tuples.cmo create mode 100644 tests_me/tuple/tuples.cmt create mode 100644 tests_me/tuple/tuples.ml diff --git a/plugins/ocp-lint-plugin-text/build.ocp b/plugins/ocp-lint-plugin-text/build.ocp index 712a685..ce5f34b 100644 --- a/plugins/ocp-lint-plugin-text/build.ocp +++ b/plugins/ocp-lint-plugin-text/build.ocp @@ -28,6 +28,7 @@ begin library "ocp-lint-plugin-text" "code_length.ml" "useless_space.ml" "not_that_char.ml" + "duplicate_code.ml" ] requires = [ "ocp-lint-config" diff --git a/plugins/ocp-lint-plugin-text/duplicate_code.ml b/plugins/ocp-lint-plugin-text/duplicate_code.ml new file mode 100644 index 0000000..b7fcd66 --- /dev/null +++ b/plugins/ocp-lint-plugin-text/duplicate_code.ml @@ -0,0 +1,76 @@ +open Plugin_text + +module Linter = Plugin.MakeLint(struct + let name = "duplicate code" + let version = "1" + let short_name = "duplicated_code" + let details = + "Detect portions of code that duplicated" + let enabled = true + end) + +type warning = + | CodeDuplicated of string + + +let w_code_duplicated = Linter.new_warning + ~id:1 + ~short_name:"dupli_code" + ~msg:"Duplicated code detected in $file " + ~severity:10 + + +module Warnings = Linter.MakeWarnings(struct + type t = warning + + let to_warning = function + | CodeDuplicated name -> w_code_duplicated, ["file",name] + end) + +let read_entire_file filename = + let file = open_in filename in + let file_length = in_channel_length file in + let str = Bytes.create file_length in + really_input file str 0 file_length; + close_in file; + Bytes.unsafe_to_string(str) + +let remove_char regexp replace str = + Str.global_replace regexp replace str + + +let rec get_length_file input_c acc = + let line = try [input_line input_c] with End_of_file -> [] in + match line with + | [] -> acc + | [line] -> get_length_file input_c (1+acc) + | _ -> failwith "weird things not a line" + +let make_portions regex content = + let part = Str.split (Str.regexp regex) content in + List.map (remove_char (Str.regexp "[\n\t ]+") "") part + +let hash_portions portions = + List.map (function e -> Digest.string e) portions + +let rec check_duplicate acc l = match l with + | [] -> acc + | (x,p)::tl -> if(p) then check_duplicate (1 + acc) tl else check_duplicate acc tl + + +let compare_ el l = List.map (function e -> (e,(el = e))) l + + +let rec if_duplicate_portions portions = match portions with + | [] -> failwith "nothing to compare" + | [em] -> false + | hd::tl -> if((check_duplicate 0 (compare_ hd tl)) > 0) then true else if_duplicate_portions tl + +let check_file file = + let portions = hash_portions (make_portions "^\\s*$" (read_entire_file file)) in + if(if_duplicate_portions portions) then Warnings.report_file file (CodeDuplicated file) + else () + + module MainSRC = Linter.MakeInputML(struct + let main source = check_file source + end) diff --git a/plugins/ocp-lint-plugin-typedtree/lengthy_tuples.ml b/plugins/ocp-lint-plugin-typedtree/lengthy_tuples.ml new file mode 100644 index 0000000..43204a3 --- /dev/null +++ b/plugins/ocp-lint-plugin-typedtree/lengthy_tuples.ml @@ -0,0 +1,67 @@ +module Linter = Plugin_typedtree.Plugin.MakeLint(struct + let name = "Detects lengthy tuples.Rationale: When a tuple has too many members, it should be refactored into a record" + let version = "1" + let short_name = "lengthy_tuples" + let details = "blabla" + let enabled = true; + end) + +type warning = TupleTooLong of (string * int) + +let limit = 2;; + + +let w_toolongtuple = Linter.new_warning + ~id:1 + ~short_name:"tuple too long" + ~msg:"the tuple '$var' have '$params' elements, the limit is $limit, When a tuple has too many members, it should be refactored into a record" + ~severity:5 + + +module Warnings = Linter.MakeWarnings(struct + type t = warning + let to_warning = function + | TupleTooLong (var,nb_parms) -> w_toolongtuple, [("var",var);("params",string_of_int nb_parms);("limit",string_of_int limit)] + + end) + + +let get_pattern pat = + let open Typedtree in + let open Location in + begin + match pat.vb_pat.pat_desc with + | Tpat_var (ident,var) -> (var.loc,var.txt) + | _ -> (pat.vb_loc,"") + end + + +let iter_exp exp = + let open Typedtree in + begin + match exp.vb_expr.exp_desc with + | Texp_tuple l -> List.length l + | _ -> 0 + end + + +let check_length_tuples bind = if ((iter_exp bind) > limit) then let (loc,txt) = get_pattern bind in Warnings.report loc (TupleTooLong(txt,iter_exp bind)) + + +let iter = + let module IterExp = struct + open Typedtree + open Asttypes + include Typedtree_iter.DefaultIteratorArgument + + let enter_structure_item strct = + begin match strct.str_desc with + | Tstr_value (rec_flag, binding) -> List.iter check_length_tuples binding + | _ -> () + end + end in + (module IterExp : Typedtree_iter.IteratorArgument) + +module Main = Linter.MakeInputCMT(struct + let main cmt = Typedtree_iter.iter_structure iter cmt +end) diff --git a/plugins/ocp-lint-plugin-typedtree/mutable_ref.ml b/plugins/ocp-lint-plugin-typedtree/mutable_ref.ml new file mode 100644 index 0000000..6fefdb1 --- /dev/null +++ b/plugins/ocp-lint-plugin-typedtree/mutable_ref.ml @@ -0,0 +1,92 @@ +module Linter = Plugin_typedtree.Plugin.MakeLint(struct + + let name = "justify use of ref/mutable field" + let version = "1" + let short_name = "mut_ref" + let details = "Justifier l'utilisation de valeurs mutables. Les protéger par un des mécanismes d'encapsulation recommandés" + let enabled = true; + end) + +type warning = MutableField of string | Ref_use of string + +let w_mutable = Linter.new_warning + ~id:1 + ~short_name:"mutable use" + ~msg:"you use a mutable field '$mut'" + ~severity:3 + +let w_reference = Linter.new_warning + ~id:2 + ~short_name:"ref use" + ~msg: "you use a ref with $p" + ~severity:3 + + +module Warnings = Linter.MakeWarnings(struct + type t = warning + + let to_warning = function + | MutableField mut -> w_mutable, ["mut",mut] + | Ref_use rf -> w_reference, ["p",rf] +end) + + +let err_file funct = + let oc = open_out "err.txt" in Printf.fprintf oc "im in %d " funct; + close_out oc;; + +let if_mutable lab = + let open Asttypes in + begin match lab with + | Immutable -> false + | Mutable -> true + end;; + +let parse_list l = + let open Typedtree in + begin match l.typ_kind with + | Ttype_record v -> let p = List.hd v in if (if_mutable p.ld_mutable) + then Warnings.report p.ld_name.loc (MutableField p.ld_name.txt) else () + | _ -> () + end + +let longident_ li = + let open Longident in + begin match li with + | Lident v -> v + | _ -> "pattern" + end + +let parse_exp_ident exp = + let open Typedtree in + begin match exp.exp_desc with + | Texp_ident (path_t,longident,val_desc) -> let name = longident_ (longident.txt) in let loc = longident.loc in Warnings.report loc ( Ref_use name) + | _ -> () + end + + +let parse_val_binding vb = + let open Typedtree in + begin match vb.vb_expr.exp_desc with + | Texp_apply (exp,l) -> parse_exp_ident exp (*Texp_apply of exp * (arg_label * exp_opt) list*) + | _ -> () + end + + +let iter = + let module IterExp = struct + open Typedtree + open Asttypes + include Typedtree_iter.DefaultIteratorArgument + + let enter_structure_item stru = match stru.str_desc with + | Tstr_type (rec_flag,type_decl) -> List.iter parse_list type_decl + | Tstr_value (rec_flag,val_binding) -> List.iter parse_val_binding val_binding + | _ -> () + + end in + (module IterExp : Typedtree_iter.IteratorArgument) + +module Main = Linter.MakeInputCMT(struct + let main cmt = Typedtree_iter.iter_structure iter cmt + end) diff --git a/tests_me/args/args_same_types.cmi b/tests_me/args/args_same_types.cmi new file mode 100644 index 0000000000000000000000000000000000000000..eaa10d16e5fcc0bc1b94df783cd933cef320bd1c GIT binary patch literal 490 zcmZ=x%*`>hw6ydzFfwYHx@;c<1ET>01A`Y3{{iB!3-ld}(u?DZ6LVAJODYReix(`| zz{vbTC9O0s+2O#3gAN-uPuSq1nwFEFSmNL?!GVeO>q7>H_ZtpQP|O2KIVxx7AxV4y zNn~x<%)$j%`w?o0zglrgQD$B`!jw;785Rz>($5xC^xah38*?5sJL=n58w9S_1P}+ T4?@C@Pv?d?f)Qvr95?^~$;`dC literal 0 HcmV?d00001 diff --git a/tests_me/args/args_same_types.cmo b/tests_me/args/args_same_types.cmo new file mode 100644 index 0000000000000000000000000000000000000000..639a137f02e0d08e69a58d7959998615b5f42e2f GIT binary patch literal 391 zcmZ=x%*`>hw6yd$Ffw9bU|13YB&2{?6Nt5dm<5QLfVdurIe^#B;ee&^1)cipIWCu---o7Y@ZSNG(e11BU&u8|~ZDc;xdzU)+M_LgKgsdpRU zRHnyBIu4fu7lIvWGs^n;Nyd+6c~eP8!qQWWWtpO0{z#I}^OM=>CJkvb;^u&X3pCKl zkHV-t_EXQuicm6T$IUGTD;LEGjL1VT@#h^h3RCiLuAvNSUc4%XLwWg%kZ0%R%LFgD z{>%&abFcrx>;L2R*S-FR*WYBkzfK>_M^$%1V@>^_Xlw~%%;ive1i2fF_X51Do!dyv z)^tzmZ(qIRUvqwZ<-G+rpV+(AamrR2cCVg{_ZrD;&3-uZ;l7W@RZMA^_5ArAANyo5glcX_IC292W5t7s(-J0z_?(m;7r$0woKka7S0p)+tzyUyEjPIoc?j34{$blJX zPgc$mhL(yz4PGpA;Hv_2(ZzHU28#S#%7IETdWA+kFSjirIWSs)zQ}`MOu@i-F?JKj za9L3RP+1rpMS}rF48ZWh`*GrZz*CrC7`RUifH$zBFfd&VsIH{}@t2GD!`!tc2ZocV zeCdml5WSTsE7yg1)f-i=3GtFIekR28zIZ{1XECF5C5JJP2mi5yM_wCn9l7OVd{vqF zo^{*SGYqX%NVu{!ym@~pY+9xf)|m7qEqR9K`O4YG_LN~J1fKb84UM6 z|A8i8B-3CRUl@#T)e#cl`J_QnzL3B;z9<;6tc35q&-pWdxTHf*Bn>2%!Tk(hgoEhG zm8ZDzVP()@B3~R#oAJ~@-Oa_bN`+#`1BMVdgFiUK*lzkbjb;d?c!&6sk^z%-}3d?E7CoCech%XIUJt^eVjSVeN6_!`JmZQNIOoFi8O15LcR;wFjw2sGGD!s*@;8HQ=M|_bvSg}P2Z5SzJ9LM>F z6~*dQwN1CpFfO7*9Lt=Z2>0kIs&}vxRxrM?N=qgUI~DHGJ_r}HQjAX()4BJB0AhD;xZo*A~K8P~DzI>4x3tJuGjyTN) z%3a7Ff=q@VK_}zuN?S9@uwmPljet60yo$`cNSGivU^D(u6=5O?E82w|#mN~}2}He2 zsB$<68OGa6TP&Q4l{RAt&|JVF0@T5)@C4&)XD-gqa|tr@ak<>s^<>BUCf|0roN8 zTDc;fA_BUNZp+RfDC~kx5ojg63qN6eb>(tB72P@@3msk-375*X9M;+`si5hZHD{HCqbM@EpvFzfnnHqzbcy=YsSvf*mA}pK--Ec z$3I>75!|d%Nk$syuXK97kXhD(+zT4d=Z? z(92o!Qa{+sa~f+$@GgyQDtPJgCQzZuLpOwuhbgG{D1&=^C&bY?a?vo@#S0pH7@;p} zEK+b`doCVO<)K^N#bdX)I8QES4|Z`_V^MVRD~)X_xajpEr!XJ^9lWp4j5D(j#vij|~rQ{&NfBuofWQc%V?_1FD>5w2=lzdh@hZ zdFY0EGoc=%eu+Vu$d==sDPsgo56qnZ6(V;SuJp|PC|>N$i^_*i3)p+8mrjo7kp z(2C+v1_4^;KgW{hv9;?CY+cmY<7nm*?#Ig*GTrQ^}Lu4PcL8OWlb56O6yShF6`Im z^L8_zC+U}TNIRNUl|bR$E0oJW7370nE~Nwh!!NSAnI(EGhB;lRLA%4;WJ0?vtMaT# z*!p3E|J;nb*hG;#GLvpzbgOD<>Fqqn}8dGPs!UZC3Qr}0*t>ED?c3Kpg;xD zpv)AhxeRevqc5v*O182HvABEky)Y4LmmHW3Ng}EUfRc9=Qa(}Vip#5-eWqGb3%^!n z4fdOTrj(Wf3+H^MS_|*aB2!BKcaSWd@d^6Ge>k1Zl@e3p;D%i7&vUh3mMwYC5p4bN zg8%&Q0#~tHxGGkai7rXg+-@qCeUB?uzS||MmdL`&DQzIKZWPGcCdm2}E51H&kr&6jiwm#%OLb-cpsHRqu*- zM|3@5rDL7d0^Va=)%1T0+t^-7KcB1d43bLX38&gNI-F@vLv=c7SL0z#PgE!35m$+2 zYm#qvRu+Bj_lHO2DxclmSQhbu?Nybb8%`;WLDCdY5B2N*|M>ZiHstTz{x1Lw>ehc6 GX#WLk->B#S literal 0 HcmV?d00001 diff --git a/tests_me/args/args_same_types.ml b/tests_me/args/args_same_types.ml new file mode 100644 index 0000000..5242b53 --- /dev/null +++ b/tests_me/args/args_same_types.ml @@ -0,0 +1 @@ +let func arg1 ~n:arg2 ~j:arg3 arg4 arg5 = (int_of_string(arg4),int_of_string(arg5),arg2+1,arg1+.1.0,arg3+8) diff --git a/tests_me/duplicate/.DS_Store b/tests_me/duplicate/.DS_Store new file mode 100644 index 0000000000000000000000000000000000000000..5008ddfcf53c02e82d7eee2e57c38e5672ef89f6 GIT binary patch literal 6148 zcmeH~Jr2S!425mzP>H1@V-^m;4Wg<&0T*E43hX&L&p$$qDprKhvt+--jT7}7np#A3 zem<@ulZcFPQ@L2!n>{z**++&mCkOWA81W14cNZlEfg7;MkzE(HCqgga^y>{tEnwC%0;vJ&^%eQ zLs35+`xjp>T0 x +1*) + +let neg e = match e with true -> false | false -> true + +let neg e = match e with true -> false | false ->true + +let rec sort = function + | [] -> [] + | x :: l -> insert x (sort l) and insert elem = function + | [] -> [elem] + | x :: l -> if elem < x then elem :: x :: l else x :: insert elem l;; diff --git a/tests_me/ref_mutable/mutable.cmi b/tests_me/ref_mutable/mutable.cmi new file mode 100644 index 0000000000000000000000000000000000000000..125139753e8c83e3abc52270c1301a021ac2559a GIT binary patch literal 290 zcmZ=x%*`>hw6ydzFfwYHx@;c<14982O962@5T`6q_bn|+Ov*`JuyF$;^Ba|t)Z!8c z4h9At1_y@)3oZb~UMuJ27dSX>*gRo_qjF|miG#xg2PW394;dK#Z8)Hn3(>8Yo8#!< zdw_+>(IL(O2poZU!vPi+Abo&^)zKjy$X@^whPojWXg5C)TLQ7(0=Oe47%cbAFbKZ& z-I>ueJ;cBI2-|`MS^=p=Wr@X^WvRsz3}&;uxikH#fR3z*#-#UEHy15fVBrk(A<$W= tMR|!iZuv#Ii6u@z)yY7`mFs%=wg<1zc9DM&5_Wt#H_UQIprvr&005<{VekL| literal 0 HcmV?d00001 diff --git a/tests_me/ref_mutable/mutable.cmo b/tests_me/ref_mutable/mutable.cmo new file mode 100644 index 0000000000000000000000000000000000000000..fd5181a3ceff29bbbd65c4afd40b91a4116d2a6a GIT binary patch literal 177 zcmZ=x%*`>hw6yd$Ffw9bV34r_5|%&=0xeUQ?E_McKr8~p0YL1^!N8!wpzd2*l9-f} z8sM{F!K4iiEUbT3(o|D z<-QpP!MDCUGn%G{_*WlcTd=^w8R&q_ypq(Syu=*0{G!~%5+|S;$v`72*Y)si4_=?` PBL5&H?D%wU2QUBt7Wq0i literal 0 HcmV?d00001 diff --git a/tests_me/ref_mutable/mutable.cmt b/tests_me/ref_mutable/mutable.cmt new file mode 100644 index 0000000000000000000000000000000000000000..3feac2a4d6a9c4862c08603fdd6d41e0e86b2c5a GIT binary patch literal 2142 zcmb7FU2GIp6rS0hDH;Ouk3k5e-4 z|3%PrG-%D`>q-t5#eRaUlPtz-Nt6>;`ll1a-~G|8?wuMLeBsM_&Rd5}ugLON(ae_< zZ^FIrFa5Y`*OvAj^S{pBd580kZmN*dGChac2V5`5{QZPZ6S(x@`IR3JU!UpOdUxd5 ztxLX@QvuaotW80|_`r3-?KcXdwhb||FHPoZ8MA`eN? z8%WWI|4~Xc@(Zc8Dv)sXgA%R{BwSaM5HIk%u!h4La(GI|(M8y-<2dTKuj1{Suz{E5 z9?@@2I!?fPMA$;fb|@r1s1N?(!j**^ORj~7E)+*wv$o58=6S4Ct)#NG&4%MTrlF(q zm)vxO4l%UXJnNfI-f|ry?K*kiE2MqbL#T)DN=F6GP>(w76Z@m-X-2=+iNR*VTFw;0 za?#TighW^&dZQ`VwX1P2P&1xv$}&4|QUfBDMlXyg1qs)i!lr{wL_R1EL<^2pYh>wr zs$oY<;MiCJHWF}L9BeetI@K7uY+Gn1n-GVZmXys!rRV#p0v);XB4OIdQlc+vTh)=_ z0+t1%F@U;^$r>gmgP0vM*;GSU7nV7!;519Hp0=<$NrS}HBh%u?>8Y1&P8@D_XMK_~ z%#E102Fybtb2>Ue@(0{Qk~K{(Sx{l2V6(PVr0xo zvU%}ri^F^xG&$vPN*rmThdoJIWxsrUx*Z`SCc8$RjG46@Gh=vWy5PytG;(gHV4L0d z%T!32i}|3&scM0TgXN9t5;q~ntG9Ff9Gco|NhIG*USidN8=sgf~gdM>#} zrFuHNDsk)KHAtfv-`VSA3^!|JEm;ff3?cIpvKcPIX%u5E!==1odYxDNWwLE3B~C4 z1GPF2$w0D2KuAOv+=N$9j3oM;BD1ZG!Mv$L&UAcY8j{c>68edR?uSpIjNV5(1zbWg+%{P7r2siI=Xxaq86oH^2^xa0;WCQn+WMKFo?fyG z*~%`M92kdGxC?2S!Z*@y6266ND7u?cB|2UZ?vw>C`Ks%h+OqWfpsDK+HFY)3qR`Zc zrf#5z4>WZf(gCGL?rUlt)Da+s^;jI4+P=mF( literal 0 HcmV?d00001 diff --git a/tests_me/ref_mutable/mutable.ml b/tests_me/ref_mutable/mutable.ml new file mode 100644 index 0000000..09e578a --- /dev/null +++ b/tests_me/ref_mutable/mutable.ml @@ -0,0 +1 @@ +type test = {mutable nop : int} diff --git a/tests_me/ref_mutable/mutable2.cmi b/tests_me/ref_mutable/mutable2.cmi new file mode 100644 index 0000000000000000000000000000000000000000..fb4c601475045a64bc7966ebf8c95c2cfa92ec15 GIT binary patch literal 294 zcmZ=x%*`>hw6ydzFfwYHx@;c<14A(oO962P5T`EC@GUJ#Ov*_$TCi~gBl8>O+{8Qw z4h9At1_y@)3oZbKUaRJ&7Nw**IBwWHVS}S`W?qSd!vqH=)~^p482)WIpq&fVua}$S z=-_*Rg~`z&!2t*yfq26K78W3VfQ8l3AqmJ|01}2eBMWFfKM-31vHk*tJ0=+1ep0xr z`0~}31-nJ3SI?PTwqSu)Kx$E0VsU0!YVibv*(`7FOn)k%BWt2D>3!ABMGF>KI0JnN wbXaOpUSf`0eo<~>i4#zDGEi~lx*opm!RxbKhw6yd$Ffw9bV34r_5|%&=0xeUQ?E_LxKr8~pfk5oW!N8!wpy69ul9-f} zY82qJV8Nsf4lJyW9u5l@Xa%Gel_eHumZcU?FqqBq=Faq|0y?rL8k62v-CVR_0SnIr zgWFFEcNJg0+OlA`==AD2lgkz?uy6*tATzHdwJ0w!$1T4oH?hPCXht&7h{|<6eA|Q9 QXS>Kh2njnro!bEn0R4yoDc%B-&`A@m~{y3Bg26^p9fXkAKy3XCD;AL}%w@=id3w z>pSPn?O<7Z)0Qn;x)aIdi8CL3t|*F6vW8@o#N_ooxqzi?Gs$O!T6L>7%N%?_Q8p@w zoX^qLud%G@WlYq?rGn6FEhj)MU_|@lM@9Kl%r<39`Yl;o$DUb;=y(|E(n-WD0R7K` zreliMTyB@bI7;pxCTS;$^E+`A5;uN&_A~$LwG;eG_4IRZou1&lvETG2m~Ty(ej)KD z-1>g{=cOChwboDlK6(9J&f7XDOA5^N9A7 zUR3t3lGn&S|q=A%cDhIpYwymyE8E zjP3ZJ`BWpn5o1e38kgNolIM|2#Vg|#~FM}6)b&Rv34ydVoj z?_xR*Lp36-qj1|4DgdZ=|8VBRnTzwTnR_l2yBbGqmj%r8SiYP~sl0WD<2t6Hqw<$5 zJVKl3f6P1{n2v9`j*)g9Kk#zt!1WLoKu4*uLSK7c5rjpe zGZwl;SS-4tDc7~jeos+P9*T`H+c&8Tky4`#BT7z+>ovv3gEeHlPi%|k94nZwd$^{) zAylj_0c#03B%Z1@k5~F$m#qtRBnQOy*u1p4C^dc$WuPNhULZ^}NlJ7_ZObot;sO?i z^U;gCjF;6M7!G~5$zW48?d@3Lu$a?8K{b`IJWhRNsZ)l<_t8@q$)wm(=Z*(NWibb` zygsztU$mT#_7eS}?S5%H6CH4~v?lAMy{BSpFRf0B-a4C2=8Zd1ZVGMfDkdX+4wFoY zryCp=(5%T(hr?oLj2<>8WtKhi@$puKj2LbobTa0M<(L`6Gt)UwPN$J|GdbJrxLu$` z3S3NuIUXq|xFcL%EH9CRR{W62NP*^@Kk24v6kCol&oQWfY>Q@^*~T~vl6-A>%(&z~?3QOQ+IEZ3jqSKnN!p2PHjY-pUNi{0j z)8SQ#tA^Jgjbf;&%gGq-h%sWxT%f54nUavTa0ZT|*xN9W_YKqYT#o=r$#{!2^M=Gk z;cf6x9B7f4l%k{UqW|E=%*686|O)5#r~FofThO_ zcf#~&!j2JesOa(wiRy+gVH(9ib6+ly1Z2&u>*Wb#6hU80P(OSN@1S_5xrYVm(Ro!E zDOJJbz&NCeRY=Pau1dXO_zupa=!m8Af$1Y$F9@9XVb?XaVgC0)Q&%Et>N1)|p{Wr~ zT}2NcY3c@~V@i$O*3>GfB0xCtnz}lKt(LIxOQ)&uZ#OAL$SU#~P2Hraje1#Qp{Cyd zMnW#o)Xkc@Q7WRS3;Q&!sfotsl;t!t$8m##rY0ZU93Q0S^y8y!%*v)1v)x?gXgq|E zdu}|)kDH!(yjdPsaiSsciDbTkx5jh67pGofcHFj7MFlJ*9{Qp2tFzC~^&EQrr5hJ6 nU%On&Z6&dD-rtIXCmjC+Izoa7i#`_+EPsSp3nN<8*Ia> literal 0 HcmV?d00001 diff --git a/tests_me/ref_mutable/mutable2.ml b/tests_me/ref_mutable/mutable2.ml new file mode 100644 index 0000000..bc66fdd --- /dev/null +++ b/tests_me/ref_mutable/mutable2.ml @@ -0,0 +1 @@ +type man = { mutable test : int } diff --git a/tests_me/tuple/tuples.cmi b/tests_me/tuple/tuples.cmi new file mode 100644 index 0000000000000000000000000000000000000000..267e404b47356be676a6f97d0ae86d9a14762845 GIT binary patch literal 289 zcmZ=x%*`>hw6ydzFfwYHx@;c<14982%L8#b5T`6q3n?wgNiANmU;`ubYsCtO0~;nS z*syuR21n)0yb=e82@XuGUmr3s`~?cKu*123z-nAn({l0?kyQPLs{ZG&;ecid*kHZf z97hM211wCA4z3Ok4p28_0PW@nVoM;_TL5#!1Ow5d?+^6+HCetVDMIG+-!`uW3$y}K zi^>vhw6yd$Ffw9bU@$QS5+J|@#P(no1A{P-W&~nOD8FUuvVB12R3KIY;vyhU z=U`yaU{DJwEyzhN4oF$BV8SAY1rsJX0W9 zFC@lGOi0{9xFl#i@&M`s95m4=YW6|HgD;wx7!x1rgD>7dktap{&&+OJ0Uw;*KQrf? z@BjYW`OoRrvsOz-M@L_CYwL3-&wngQ(iBMz$w86~s~^oxS%$|Lmlyo7at4e1IOFdW zxLRx4K4JkQ%FS;j=@v~w)%@^}0Mk=9ZaI1d>h}`*Pvpf0KOjzIEfsr;5K*xg5lcQy zknQ_OI!F?%>_nk?*{9cv$8NP>_%OAr`o^sn`Wb5+Hr#35Gp7x&(0mqt{O0s`_cuM# zzWVsJBVV6mY<)KcNS+$5ty>!%H>>+ygiaGUfAQFo_eL&F_SDRc?znpTp0aJ3Y|cL@ z^hJV3=Mz*Fmn7MiB;^Xpp@ovvE|ror%Nc(iS#eGz>w8KTgUHM-JW4N@>{TeJxsJ5`6U?sL|(3!7$V63{^5noZ&y5* zZ+nn$YYa-LyRM!`Vri17NGb_0)@!z78=8vJU!r*O~fv^;5 zLW>c5I9?I@1S^PjIo}w|*`{Bqdmy^HAyAB#fKdY0@J+SGj9td5A}XjOiSo^L6#+9| z+T;TixQa|VN|+{+2HqF5Os`~#ai|JZLJ789}u7G+7Z%xU+0*e zF~&{X$Y`#S&bgxTw5*fKSw{Eu0=Zvc;Q;}{!N5|#I2zt4kEkagoG15G@EKzpoHR9A z;;`=88tog)q;AzMZA$k=+rkVCBHx=(JHBMA}c5syToFnid*TmM#TZK_>dwm z7K@9A}E0Bw0lg#o&0nsmRqKbOSjA z3+Wpobm%H_4KjlD78UtP8a;)gA=gW!_+NkI!OCV>ARZi&1_27Ehm?GCKq5TKyYO2i~Co literal 0 HcmV?d00001 diff --git a/tests_me/tuple/tuples.ml b/tests_me/tuple/tuples.ml new file mode 100644 index 0000000..122768c --- /dev/null +++ b/tests_me/tuple/tuples.ml @@ -0,0 +1 @@ +let x = (1, 2, 3.)