summaryrefslogtreecommitdiffstats
path: root/src/parser_helper.ml
diff options
context:
space:
mode:
Diffstat (limited to 'src/parser_helper.ml')
-rw-r--r--src/parser_helper.ml97
1 files changed, 79 insertions, 18 deletions
diff --git a/src/parser_helper.ml b/src/parser_helper.ml
index 43d60a4..d798e14 100644
--- a/src/parser_helper.ml
+++ b/src/parser_helper.ml
@@ -56,7 +56,9 @@ let is_a_scalar = function
| Num _
| Raw_string _
| String _
- | Call(Deref(I_func, Ident(None, "N", _)), _) -> true
+ | Call(Deref(I_func, Ident(None, "N", _)), _)
+ | Call(Deref(I_func, Ident(None, "P", _)), _)
+ -> true
| My_our(_, [ context, _ ], _)
| Deref_with(_, context, _, _)
| Deref(context, _) -> is_scalar_context context
@@ -415,7 +417,7 @@ let function_to_context word_alone = function
| "any" | "every" -> M_bool
| "find_index" -> M_int
| "each_index" -> M_none
- | "N" | "N_" -> M_string
+ | "N" | "P" | "N_" -> M_string
| "chop" | "chomp" | "push" | "unshift" -> M_none
| "hex" | "length" | "time" | "fork" | "getppid" -> M_int
@@ -425,7 +427,7 @@ let function_to_context word_alone = function
| "split" -> M_array
| "shift" | "pop" -> M_unknown_scalar
- | "die" | "return" | "redo" | "next" | "last" -> M_unknown
+ | "die" | "return" | "redo" | "next" | "last" | "exit" -> M_break_control_flow
| "caller" -> M_mixed [M_string ; M_list]
| "ref" -> M_ref M_unknown_scalar
@@ -535,6 +537,7 @@ let check_ternary_paras(cond, a, b) =
| String ([(_, List [])], _)
-> true
| Call(Deref(I_func, Ident(None, "N", _)), [ List(String _ :: l) ])
+ | Call(Deref(I_func, Ident(None, "P", _)), [ List(String _ :: l) ])
| Call_op(".", l, _)
| Ref(I_hash, List l)
| List l -> List.for_all dont_need_short_circuit_rec l
@@ -695,6 +698,7 @@ let to_Local esp =
Some(context, ident)
| Deref(I_scalar, Ident _)
| Deref(I_array, Ident _)
+ | Deref(I_hash, Ident _)
| Deref(I_star, Ident _)
| Deref_with(I_hash, I_scalar, Ident _, _)
| Deref_with(I_hash, I_scalar, Deref(I_scalar, _), _)
@@ -832,6 +836,7 @@ let followed_by_comma expr true_comma =
| l, Ident(None, s, pos) -> l @ [Raw_string(s, pos)]
| _ -> expr
+type msgid_t = No_plural of string | With_plural of string * string
let pot_strings = Hashtbl.create 16
let po_comments = ref []
@@ -872,6 +877,7 @@ msgstr \"\"
\"MIME-Version: 1.0\\n\"
\"Content-Type: text/plain; charset=CHARSET\\n\"
\"Content-Transfer-Encoding: 8-bit\\n\"
+\"Plural-Forms: nplurals=INTEGER; plural=EXPRESSION;\\n\"
") ;
@@ -883,12 +889,12 @@ msgstr \"\"
| c -> output_char fd c
in
let sorted_pot_strings = List.sort (fun (_, pos_a) (_, pos_b) -> compare pos_a pos_b)
- (Hashtbl.fold (fun k (v, _) l -> (k,v) :: l) pot_strings [] ) in
- List.iter (fun (s, _) ->
- match Hashtbl.find_all pot_strings s with
+ (Hashtbl.fold (fun msgid (pos, _) l -> (msgid,pos) :: l) pot_strings [] ) in
+ List.iter (fun (msgid, _) ->
+ match Hashtbl.find_all pot_strings msgid with
| [] -> ()
| l ->
- List.iter (fun _ -> Hashtbl.remove pot_strings s) l ;
+ List.iter (fun _ -> Hashtbl.remove pot_strings msgid) l ;
List.iter (fun po_comment -> output_string fd ("#. " ^ po_comment ^ "\n")) (collect snd l);
@@ -896,10 +902,19 @@ msgstr \"\"
fprintf fd "#: %s\n" (String.concat " " (List.map Info.pos2s_for_po pos_l)) ;
output_string fd "#, c-format\n" ;
- output_string fd (if String.contains s '\n' then "msgid \"\"\n\"" else "msgid \"") ;
- String.iter print_formatted_char s ;
- output_string fd "\"\n" ;
- output_string fd "msgstr \"\"\n\n"
+ let output_it msgid_s s =
+ output_string fd (msgid_s ^ if String.contains s '\n' then " \"\"\n\"" else " \"") ;
+ String.iter print_formatted_char s ;
+ output_string fd "\"\n"
+ in
+ match msgid with
+ | No_plural s_ ->
+ output_it "msgid" s_ ;
+ output_string fd "msgstr \"\"\n\n"
+ | With_plural (s1, sn) ->
+ output_it "msgid" s1 ;
+ output_it "msgid_plural" sn ;
+ output_string fd "msgstr[0] \"\"\nmsgstr[1] \"\"\n\n"
) sorted_pot_strings ;
close_out fd
@@ -948,7 +963,7 @@ let call_raw force_non_builtin_func (e, para) =
(match para with
| [ List(String([ s, List [] ], (_, pos_offset, _ as pos)) :: para) ] ->
if !Flags.generate_pot then (
- Hashtbl.add pot_strings s (pos, !po_comments) ;
+ Hashtbl.add pot_strings (No_plural s) (pos, !po_comments) ;
po_comments := []
) ;
let contexts = check_format_a_la_printf s pos_offset in
@@ -962,6 +977,29 @@ let call_raw force_non_builtin_func (e, para) =
| [ List(String _ :: _) ] -> die_rule "don't use interpolated translated string, use %s or %d instead"
| _ -> die_rule (sprintf "%s() must be used with a string" f))
+ | "P" ->
+ (match para with
+ | [ List(String([ s1, List [] ], (_, pos1_offset, _ as pos)) ::
+ String([ sn, List [] ], (_, posn_offset, _)) :: _n :: para) ] ->
+ if !Flags.generate_pot then (
+ Hashtbl.add pot_strings (With_plural(s1, sn)) (pos, !po_comments) ;
+ po_comments := []
+ ) ;
+ let contexts1 = check_format_a_la_printf s1 pos1_offset in
+ let contextsn = check_format_a_la_printf sn posn_offset in
+ if List.length contexts1 > List.length contextsn then
+ warn_rule [Warn_traps; Warn_MDK_Common] "the singular string must not use more parameters than the plural string"
+ else if contexts1 <> (take (List.length contexts1) contextsn) then
+ warn_rule [Warn_traps; Warn_MDK_Common] "the singular and plural strings do not use same parameters"
+ else if List.length para < List.length contextsn then
+ warn_rule [Warn_traps; Warn_MDK_Common] "not enough parameters"
+ else if List.length para > List.length contextsn then
+ warn_rule [Warn_traps; Warn_MDK_Common] "too many parameters" ;
+ (*if String.contains s '\t' then warn_rule "tabulation in translated string must be written \\\\t";*)
+ (*if count_matching_char s '\n' > 10 then warn_rule "long string";*)
+ | [ List(String _ :: _) ] -> die_rule "don't use interpolated translated string, use %s or %d instead"
+ | _ -> die_rule (sprintf "%s() must be used with a string" f))
+
| "if_" ->
(match para with
| [ List [ _ ] ] -> warn_rule [Warn_traps; Warn_MDK_Common] "not enough parameters";
@@ -1187,8 +1225,13 @@ let rec mcontext2s = function
| M_unknown -> "unknown"
| M_mixed l -> String.concat " | " (List.map mcontext2s l)
+ | M_break_control_flow -> "break control flow"
+
let rec mcontext_lower c1 c2 =
match c1, c2 with
+ | M_break_control_flow, _ -> false
+ | _, M_break_control_flow -> false
+
| M_special, _ | _, M_special -> internal_error "M_special in mcontext_compare"
| M_unknown, _
@@ -1296,8 +1339,8 @@ let mcontext_check_unop_l wanted_mcontext esp =
let mcontext_check_non_none esp =
if esp.mcontext = M_none then warn_rule [Warn_context] "() context not accepted here"
-let mcontext_check_none msg expr esp =
- let rec mcontext_check_none_rec msg expr = function
+let rec mcontext_check_none_rec msg expr = function
+ | M_break_control_flow -> ()
| M_none | M_unknown -> ()
| M_mixed l when List.exists (fun c -> c = M_none) l -> ()
| M_tuple l ->
@@ -1318,10 +1361,28 @@ let mcontext_check_none msg expr esp =
| [List [Num("1", _)]; Semi_colon] -> () (* allow "1;" for package return value. It would be much better to check we are at toplevel, but hell i don't want to wire this information up to here *)
| [List [Call_op ("<>", [Ident (None, "STDIN", _)], _)]; Semi_colon] -> () (* allow <STDIN> to ask "press return" *)
| [List [Call(Deref(I_func, Ident(None, "map", _)), _)]; Semi_colon] -> warn_rule [Warn_void] "if you don't use the return value, use \"foreach\" instead of \"map\""
- | _ -> warn [Warn_void] esp.pos msg
- in
+ | _ -> warn_rule [Warn_void] msg
+
+let mcontext_check_none msg expr esp =
mcontext_check_none_rec msg expr esp.mcontext
+let mcontext_check_none_no_drop expr esp =
+ mcontext_check_none "value is dropped" expr esp
+
+let mcontext_check_none_should_drop expr esp =
+ mcontext_check_none "value should be dropped" expr esp
+
+let mcontext_check_none_no_drop_always esp1 esp_next =
+ match esp1.mcontext with
+ | M_break_control_flow ->
+ let not_Sub_declaration = function Sub_declaration _ -> false | _ -> true in
+ let l = List.filter not_Sub_declaration (fst esp_next.any) in
+ (match l with
+ | Label _ :: _ -> () (* that's ok, we have something like "... goto foo; ... return; foo: ..." *)
+ | [] -> () (* there are only sub declarations *)
+ | _ -> warn [Warn_traps] esp_next.pos "unreachable code")
+ | _ -> mcontext_check_none_no_drop esp1.any esp1
+
(* only returns M_float when there is at least one float *)
let mcontext_float_or_int l =
List.iter (mcontext_check_raw M_float) l;
@@ -1365,7 +1426,7 @@ let call_op_if_infix left right esp_start esp_end =
warn_rule [Warn_suggest_simpler] "\"$foo = ... if !$foo\" can be written \"$foo ||= ...\""
| _ -> ());
- mcontext_check_none "value is dropped" [left] esp_start;
+ mcontext_check_none_no_drop [left] esp_start;
(match right with
| List [ Num("0", _)] -> () (* allow my $x if 0 *)
| _ -> check_My_under_condition "replace \"my $foo = ... if <cond>\" with \"my $foo = <cond> && ...\"" left);
@@ -1386,7 +1447,7 @@ let call_op_unless_infix left right esp_start esp_end =
| _ -> ());
| _ -> ());
- mcontext_check_none "value is dropped" [left] esp_start;
+ mcontext_check_none_no_drop [left] esp_start;
check_My_under_condition "replace \"my $foo = ... unless <cond>\" with \"my $foo = !<cond> && ...\"" left;
let pos = raw_pos_range esp_start esp_end in