@@ -5,16 +5,23 @@ open Type
55type safety_message = {
66 sm_msg : string ;
77 sm_pos : pos ;
8+ sm_type : WarningList .warning option
89}
910
1011type safety_report = {
1112 mutable sr_errors : safety_message list ;
13+ mutable sr_warnings : safety_message list ;
1214}
1315
1416let add_error report msg pos =
15- let error = { sm_msg = (" Null safety: " ^ msg); sm_pos = pos; } in
17+ let error = { sm_type = None ; sm_msg = (" Null safety: " ^ msg); sm_pos = pos; } in
1618 if not (List. mem error report.sr_errors) then
17- report.sr_errors < - error :: report.sr_errors;
19+ report.sr_errors < - error :: report.sr_errors;;
20+
21+ let add_warning report wtype msg pos =
22+ let warning = { sm_type = Some wtype; sm_msg = (" Null safety: " ^ msg); sm_pos = pos; } in
23+ if not (List. mem warning report.sr_warnings) then
24+ report.sr_warnings < - warning :: report.sr_warnings;
1825
1926type scope_type =
2027 | STNormal
@@ -447,7 +454,7 @@ let rec contains_safe_meta metadata =
447454let safety_enabled meta =
448455 (contains_safe_meta meta) && not (contains_unsafe_meta meta)
449456
450- let safety_mode (metadata :Ast.metadata ) =
457+ let get_safety_mode (metadata :Ast.metadata ) =
451458 let rec traverse mode meta =
452459 match mode, meta with
453460 | Some SMOff , _
@@ -1053,7 +1060,6 @@ class expr_checker mode immediate_execution report =
10531060 val mutable in_closure = false
10541061 (* if this flag is `true` then spotted errors and warnings will not be reported *)
10551062 val mutable is_pretending = false
1056- (* val mutable cnt = 0 *)
10571063 (* *
10581064 Get safety mode for this expression checker
10591065 *)
@@ -1072,6 +1078,33 @@ class expr_checker mode immediate_execution report =
10721078 in
10731079 add_error report msg (get_first_valid_pos positions)
10741080 end
1081+ (* *
1082+ Register a warning
1083+ *)
1084+ method warning wtype msg (positions :Globals.pos list ) =
1085+ if not is_pretending then begin
1086+ let rec get_first_valid_pos positions =
1087+ match positions with
1088+ | [] -> null_pos
1089+ | p :: rest ->
1090+ if p <> null_pos then p
1091+ else get_first_valid_pos rest
1092+ in
1093+ add_warning report wtype msg (get_first_valid_pos positions)
1094+ end
1095+
1096+ method private check_binop_redundant_null_checks e =
1097+ match e.eexpr with
1098+ | TBinop ((OpEq | OpNotEq ), { eexpr = TConst TNull }, expr)
1099+ | TBinop ((OpEq | OpNotEq ), expr, { eexpr = TConst TNull })
1100+ | TBinop (OpAssignOp OpNullCoal , expr, _)
1101+ | TBinop (OpNullCoal, expr , _ ) ->
1102+ if not (is_nullable_type ~dynamic_is_nullable: true expr.etype) then
1103+ self#warning
1104+ WRedundantNullCheck
1105+ (" The operand type is not nullable, so null-check should be redundant." )
1106+ [expr.epos; e.epos];
1107+ | _ -> ()
10751108 (* *
10761109 Check if `e` is nullable even if the type is reported not-nullable.
10771110 Haxe type system lies sometimes.
@@ -1180,7 +1213,9 @@ class expr_checker mode immediate_execution report =
11801213 | TConst _ -> ()
11811214 | TLocal _ -> ()
11821215 | TArray (arr , idx ) -> self#check_array_access arr idx e.epos
1183- | TBinop (op , left_expr , right_expr ) -> self#check_binop op left_expr right_expr e.epos
1216+ | TBinop (op , left_expr , right_expr ) ->
1217+ self#check_binop_redundant_null_checks e;
1218+ self#check_binop op left_expr right_expr e.epos
11841219 | TField (target , access ) -> self#check_field target access e.epos
11851220 | TTypeExpr _ -> ()
11861221 | TParenthesis e -> self#check_expr e
@@ -1539,7 +1574,7 @@ class class_checker cls immediate_execution report (main_expr : texpr option) =
15391574 object (self )
15401575 val is_safe_class = (safety_enabled cls_meta)
15411576 val mutable checker = new expr_checker SMLoose immediate_execution report
1542- val mutable mode = None
1577+ val mutable mode : safety_mode option = None
15431578 (* *
15441579 Entry point for checking a class
15451580 *)
@@ -1549,7 +1584,7 @@ class class_checker cls immediate_execution report (main_expr : texpr option) =
15491584 self#check_var_fields;
15501585 let check_field is_static f = if not (has_class_field_flag f CfPostProcessed ) then begin
15511586 validate_safety_meta report f.cf_meta;
1552- match (safety_mode (cls_meta @ f.cf_meta)) with
1587+ match (get_safety_mode (cls_meta @ f.cf_meta)) with
15531588 | SMOff -> ()
15541589 | mode ->
15551590 (match f.cf_expr with
@@ -1560,7 +1595,7 @@ class class_checker cls immediate_execution report (main_expr : texpr option) =
15601595 self#check_accessors is_static f
15611596 end in
15621597 if is_safe_class then
1563- Option. may ((self#get_checker (safety_mode cls_meta))#check_root_expr) (TClass. get_cl_init cls);
1598+ Option. may ((self#get_checker (get_safety_mode cls_meta))#check_root_expr) (TClass. get_cl_init cls);
15641599 Option. may (check_field false ) cls.cl_constructor;
15651600 List. iter (check_field false ) cls.cl_ordered_fields;
15661601 List. iter (check_field true ) cls.cl_ordered_statics;
@@ -1601,7 +1636,7 @@ class class_checker cls immediate_execution report (main_expr : texpr option) =
16011636 match mode with
16021637 | Some mode -> mode
16031638 | None ->
1604- let m = safety_mode cls_meta in
1639+ let m = get_safety_mode cls_meta in
16051640 mode < - Some m;
16061641 m
16071642 (* *
@@ -1784,7 +1819,10 @@ class class_checker cls immediate_execution report (main_expr : texpr option) =
17841819*)
17851820let run (com :Common.context ) (types :module_type list ) =
17861821 let report = Timer. time com.timer_ctx [" null safety" ] (fun () ->
1787- let report = { sr_errors = [] } in
1822+ let report = {
1823+ sr_errors = [] ;
1824+ sr_warnings = [] ;
1825+ } in
17881826 let immediate_execution = new immediate_execution in
17891827 let traverse module_type =
17901828 match module_type with
@@ -1798,11 +1836,21 @@ let run (com:Common.context) (types:module_type list) =
17981836 ) () in
17991837 match com.callbacks#get_null_safety_report with
18001838 | [] ->
1801- List. iter (fun err -> Common. display_error com err.sm_msg err.sm_pos) (List. rev report.sr_errors)
1839+ List. iter (fun warn ->
1840+ com.warning (Option. get warn.sm_type) [] warn.sm_msg warn.sm_pos
1841+ ) (List. rev report.sr_warnings);
1842+
1843+ List. iter (fun err ->
1844+ Common. display_error com err.sm_msg err.sm_pos
1845+ ) (List. rev report.sr_errors)
18021846 | callbacks ->
1847+ let warnings =
1848+ List. map (fun warn -> (warn.sm_type, warn.sm_msg, warn.sm_pos)) report.sr_warnings
1849+ in
18031850 let errors =
1804- List. map (fun err -> (err.sm_msg, err.sm_pos)) report.sr_errors
1851+ List. map (fun err -> (err.sm_type, err. sm_msg, err.sm_pos)) report.sr_errors
18051852 in
1806- List. iter (fun fn -> fn errors) callbacks
1853+ let all = warnings @ errors in
1854+ List. iter (fun fn -> fn all) callbacks
18071855
18081856;;
0 commit comments