@@ -5,16 +5,23 @@ open Type
5
5
type safety_message = {
6
6
sm_msg : string ;
7
7
sm_pos : pos ;
8
+ sm_type : WarningList .warning option
8
9
}
9
10
10
11
type safety_report = {
11
12
mutable sr_errors : safety_message list ;
13
+ mutable sr_warnings : safety_message list ;
12
14
}
13
15
14
16
let 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
16
18
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;
18
25
19
26
type scope_type =
20
27
| STNormal
@@ -447,7 +454,7 @@ let rec contains_safe_meta metadata =
447
454
let safety_enabled meta =
448
455
(contains_safe_meta meta) && not (contains_unsafe_meta meta)
449
456
450
- let safety_mode (metadata :Ast.metadata ) =
457
+ let get_safety_mode (metadata :Ast.metadata ) =
451
458
let rec traverse mode meta =
452
459
match mode, meta with
453
460
| Some SMOff , _
@@ -1053,7 +1060,6 @@ class expr_checker mode immediate_execution report =
1053
1060
val mutable in_closure = false
1054
1061
(* if this flag is `true` then spotted errors and warnings will not be reported *)
1055
1062
val mutable is_pretending = false
1056
- (* val mutable cnt = 0 *)
1057
1063
(* *
1058
1064
Get safety mode for this expression checker
1059
1065
*)
@@ -1072,6 +1078,33 @@ class expr_checker mode immediate_execution report =
1072
1078
in
1073
1079
add_error report msg (get_first_valid_pos positions)
1074
1080
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
+ | _ -> ()
1075
1108
(* *
1076
1109
Check if `e` is nullable even if the type is reported not-nullable.
1077
1110
Haxe type system lies sometimes.
@@ -1180,7 +1213,9 @@ class expr_checker mode immediate_execution report =
1180
1213
| TConst _ -> ()
1181
1214
| TLocal _ -> ()
1182
1215
| 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
1184
1219
| TField (target , access ) -> self#check_field target access e.epos
1185
1220
| TTypeExpr _ -> ()
1186
1221
| TParenthesis e -> self#check_expr e
@@ -1539,7 +1574,7 @@ class class_checker cls immediate_execution report (main_expr : texpr option) =
1539
1574
object (self )
1540
1575
val is_safe_class = (safety_enabled cls_meta)
1541
1576
val mutable checker = new expr_checker SMLoose immediate_execution report
1542
- val mutable mode = None
1577
+ val mutable mode : safety_mode option = None
1543
1578
(* *
1544
1579
Entry point for checking a class
1545
1580
*)
@@ -1549,7 +1584,7 @@ class class_checker cls immediate_execution report (main_expr : texpr option) =
1549
1584
self#check_var_fields;
1550
1585
let check_field is_static f = if not (has_class_field_flag f CfPostProcessed ) then begin
1551
1586
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
1553
1588
| SMOff -> ()
1554
1589
| mode ->
1555
1590
(match f.cf_expr with
@@ -1560,7 +1595,7 @@ class class_checker cls immediate_execution report (main_expr : texpr option) =
1560
1595
self#check_accessors is_static f
1561
1596
end in
1562
1597
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);
1564
1599
Option. may (check_field false ) cls.cl_constructor;
1565
1600
List. iter (check_field false ) cls.cl_ordered_fields;
1566
1601
List. iter (check_field true ) cls.cl_ordered_statics;
@@ -1601,7 +1636,7 @@ class class_checker cls immediate_execution report (main_expr : texpr option) =
1601
1636
match mode with
1602
1637
| Some mode -> mode
1603
1638
| None ->
1604
- let m = safety_mode cls_meta in
1639
+ let m = get_safety_mode cls_meta in
1605
1640
mode < - Some m;
1606
1641
m
1607
1642
(* *
@@ -1784,7 +1819,10 @@ class class_checker cls immediate_execution report (main_expr : texpr option) =
1784
1819
*)
1785
1820
let run (com :Common.context ) (types :module_type list ) =
1786
1821
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
1788
1826
let immediate_execution = new immediate_execution in
1789
1827
let traverse module_type =
1790
1828
match module_type with
@@ -1798,11 +1836,21 @@ let run (com:Common.context) (types:module_type list) =
1798
1836
) () in
1799
1837
match com.callbacks#get_null_safety_report with
1800
1838
| [] ->
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)
1802
1846
| callbacks ->
1847
+ let warnings =
1848
+ List. map (fun warn -> (warn.sm_type, warn.sm_msg, warn.sm_pos)) report.sr_warnings
1849
+ in
1803
1850
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
1805
1852
in
1806
- List. iter (fun fn -> fn errors) callbacks
1853
+ let all = warnings @ errors in
1854
+ List. iter (fun fn -> fn all) callbacks
1807
1855
1808
1856
;;
0 commit comments