re-sync after the big svn loss1.2.41.2.3

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