helm/DEVEL/pxp/netstring/tests/test_recode.ml

   1
   2
   3 let make_iso enc =
   4   let s = ref "" in
   5   for i = 0 to 255 do
   6     let u = try Netconversion.makechar (enc :> Netconversion.encoding) i
   7             with Not_found -> "" in
   8     s := !s ^ u
   9   done;
  10   !s
  11 ;;
  12
  13 let make_ucs2 start stop =
  14   let s = String.create ((stop - start) * 2) in
  15   for i = 0 to stop-start-1 do
  16     let k = 2 * i in
  17     let c = i + start in
  18     s.[k]   <- Char.chr(c lsr 8);
  19     s.[k+1] <- Char.chr(c land 0xff);
  20   done;
  21   s
  22 ;;
  23
  24 let make_ucs4 start stop =
  25   let s = String.create ((stop - start) * 4) in
  26   for i = 0 to stop-start-1 do
  27     let k = 4 * i in
  28     let c = i + start in
  29     s.[k]   <- Char.chr(c lsr 24);
  30     s.[k+1] <- Char.chr((c lsr 16) land 0xff);
  31     s.[k+2] <- Char.chr((c lsr 8) land 0xff);
  32     s.[k+3] <- Char.chr(c land 0xff);
  33   done;
  34   s
  35 ;;
  36
  37 let name_of_encoding enc =
  38   match enc with
  39       `Enc_iso88591 -> "ISO_8859-1"
  40     | `Enc_iso88592 -> "ISO_8859-2"
  41     | `Enc_iso88593 -> "ISO_8859-3"
  42     | `Enc_iso88594 -> "ISO_8859-4"
  43     | `Enc_iso88595 -> "ISO_8859-5"
  44     | `Enc_iso88596 -> "ISO_8859-6"
  45     | `Enc_iso88597 -> "ISO_8859-7"
  46     | `Enc_iso88598 -> "ISO_8859-8"
  47     | `Enc_iso88599 -> "ISO_8859-9"
  48     | `Enc_iso885910 -> "ISO_8859-10"
  49     | `Enc_iso885913 -> "ISO_8859-13"
  50     | `Enc_iso885914 -> "ISO_8859-14"
  51     | `Enc_iso885915 -> "ISO_8859-15"
  52     | `Enc_utf8     -> "UTF-8"
  53     | `Enc_ucs4     -> "UCS-4"
  54     | `Enc_ucs2     -> "UCS-2"
  55     | `Enc_utf16    -> "UTF-16"
  56
  57   (* Note: GNU-iconv assumes big endian byte order *)
  58 ;;
  59
  60 let iconv_recode_string in_enc out_enc in_s =
  61   let in_enc_name  = name_of_encoding in_enc in
  62   let out_enc_name = name_of_encoding out_enc in
  63   let out_s = ref "" in
  64
  65   let out_ch,in_ch = Unix.open_process ("iconv -f " ^ in_enc_name ^ " -t " ^
  66                                         out_enc_name) in
  67   (* Write in_s to in_ch in a new thread: *)
  68   ignore
  69     (Thread.create
  70        (fun () ->
  71           output_string in_ch in_s;
  72           close_out in_ch;
  73        )
  74        ()
  75     );
  76   (* Read the result in the current thread: *)
  77   let buf = String.create 1024 in
  78   let n = ref 1 in
  79   while !n <> 0 do
  80     let n' = input out_ch buf 0 1024 in
  81     out_s := !out_s ^ String.sub buf 0 n';
  82     n := n'
  83   done;
  84   ignore(Unix.close_process (out_ch,in_ch));
  85   !out_s
  86 ;;
  87
  88 let test_iso_and_utf8 enc  =
  89   let name = name_of_encoding enc in
  90   print_string ("Recode: " ^ name ^ " and UTF-8... "); flush stdout;
  91   let s = make_iso enc in
  92   let s1' = Netconversion.recode_string (enc :> Netconversion.encoding)
  93                                         `Enc_utf8 s in
  94   let s2' = iconv_recode_string         enc `Enc_utf8 s in
  95   assert(s1' = s2');
  96   let s1  = Netconversion.recode_string `Enc_utf8
  97                                         (enc :> Netconversion.encoding) s1' in
  98   let s2  = iconv_recode_string         `Enc_utf8 enc s1' in
  99   assert(s1 = s2 && s1 = s);
 100   print_endline "OK"; flush stdout
 101 ;;
 102
 103 let test_utf16_and_utf8_0000_d7ff () =
 104   print_string "Recode: UTF-16-BE and UTF-8, #0000-#D7FF... ";
 105   flush stdout;
 106   let s = make_ucs2 0 0xd800 in
 107   let s1' = Netconversion.recode_string `Enc_utf16_be `Enc_utf8 s in
 108   let s2' = iconv_recode_string        `Enc_utf16    `Enc_utf8 s in
 109   assert(s1' = s2');
 110   let s1  = Netconversion.recode_string `Enc_utf8 `Enc_utf16_be s1' in
 111   let s2  = iconv_recode_string        `Enc_utf8 `Enc_utf16 s1' in
 112   assert(s1 = s2 && s1 = s);
 113   print_endline "OK"; flush stdout
 114 ;;
 115
 116 let test_utf16_and_utf8_e000_fffd () =
 117   print_string "Recode: UTF-16-BE and UTF-8, #E000-#FFFD... ";
 118   flush stdout;
 119   let s = make_ucs2 0xe000 0xfffe in
 120   let s1' = Netconversion.recode_string `Enc_utf16_be `Enc_utf8 s in
 121   let s2' = iconv_recode_string        `Enc_utf16    `Enc_utf8 s in
 122   assert(s1' = s2');
 123   let s1  = Netconversion.recode_string `Enc_utf8 `Enc_utf16_be s1' in
 124   let s2  = iconv_recode_string        `Enc_utf8 `Enc_utf16 s1' in
 125   assert(s1 = s2 && s1 = s);
 126   print_endline "OK"; flush stdout
 127 ;;
 128
 129 let test_utf16_and_utf8_10000_10FFFF () =
 130   print_string "Recode: UTF-16-BE and UTF-8, #10000-#10FFFF... ";
 131   flush stdout;
 132   for i = 1 to 16 do
 133     let s0  = make_ucs4 (i * 0x10000) (i * 0x10000 + 0x10000) in
 134     let s   = iconv_recode_string        `Enc_ucs4     `Enc_utf16 s0 in
 135     let s1' = Netconversion.recode_string `Enc_utf16_be `Enc_utf8 s in
 136     let s2' = iconv_recode_string        `Enc_utf16    `Enc_utf8 s in
 137     assert(s1' = s2');
 138     let s1  = Netconversion.recode_string `Enc_utf8 `Enc_utf16_be s1' in
 139     let s2  = iconv_recode_string        `Enc_utf8 `Enc_utf16 s1' in
 140     assert(s1 = s2 && s1 = s);
 141     print_string "+"; flush stdout;
 142   done;
 143   print_endline "OK"; flush stdout
 144 ;;
 145
 146
 147 print_endline "Warning: You need the command 'iconv' to run this test!";
 148 flush stdout;
 149 test_iso_and_utf8 `Enc_iso88591;
 150 test_iso_and_utf8 `Enc_iso88592;
 151 test_iso_and_utf8 `Enc_iso88593;
 152 test_iso_and_utf8 `Enc_iso88594;
 153 test_iso_and_utf8 `Enc_iso88595;
 154 test_iso_and_utf8 `Enc_iso88596;
 155 test_iso_and_utf8 `Enc_iso88597;
 156 (* test_iso_and_utf8 `Enc_iso88598; *)
 157 test_iso_and_utf8 `Enc_iso88599;
 158 test_iso_and_utf8 `Enc_iso885910;
 159 (* test_iso_and_utf8 `Enc_iso885913; *)
 160 (* test_iso_and_utf8 `Enc_iso885914; *)
 161 (* test_iso_and_utf8 `Enc_iso885915; *)
 162 test_utf16_and_utf8_0000_d7ff();
 163 test_utf16_and_utf8_e000_fffd();
 164 (* This test does not work because iconv does not support the surrogate
 165  * representation of UTF-16:
 166  * test_utf16_and_utf8_10000_10FFFF();
 167  *)
 168 ()
 169 ;;