From 44ece46b45d4a16f7c661d488106906c2adf9e78 Mon Sep 17 00:00:00 2001
From: Xavier Leroy <xavier.leroy@inria.fr>
Date: Tue, 2 Mar 1999 14:49:26 +0000
Subject: [PATCH] Bug dans matching de tableaux de flottants

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2321 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
---
 bytecomp/matching.ml      | 22 ++++++++++++++--------
 test/Moretest/patmatch.ml | 35 +++++++++++++++++++++++++++++------
 2 files changed, 43 insertions(+), 14 deletions(-)

diff --git a/bytecomp/matching.ml b/bytecomp/matching.ml
index 360568502..a9714a8b8 100644
--- a/bytecomp/matching.ml
+++ b/bytecomp/matching.ml
@@ -220,17 +220,23 @@ let divide_orpat = function
 
 (* Matching against an array pattern *)
 
-let make_array_matching len = function
+let make_array_matching kind len = function
     [] -> fatal_error "Matching.make_array_matching"
   | ((arg, mut) :: argl) ->
-      {cases = []; args = make_field_args StrictOpt arg 0 (len - 1) argl}
+      let rec make_args pos =
+        if pos >= len
+        then argl
+        else (Lprim(Parrayrefu kind, [arg; Lconst(Const_base(Const_int pos))]),
+              StrictOpt) :: make_args (pos + 1) in
+      {cases = []; args = make_args 0}
 
-let divide_array {cases = cl; args = al} =
+let divide_array kind {cases = cl; args = al} =
   let rec divide = function
       ({pat_desc = Tpat_array(args)} :: patl, action) :: rem ->
         let len = List.length args in
         let (constructs, others) = divide rem in
-        (add (make_array_matching len) constructs len (args @ patl, action) al,
+        (add (make_array_matching kind len) constructs len
+             (args @ patl, action) al,
          others)
     | cl ->
       ([], {cases = cl; args = al})
@@ -456,10 +462,10 @@ let rec compile_match repr m =
                 combine_var (compile_match repr records)
                             (compile_match repr others)
             | Tpat_array(patl) ->
-                let (arrays, others) = divide_array pm in
-                combine_array (Typeopt.array_pattern_kind pat) newarg
-                              (compile_list arrays)
-                              (compile_match repr others)
+                let kind = Typeopt.array_pattern_kind pat in
+                let (arrays, others) = divide_array kind pm in
+                combine_array kind newarg (compile_list arrays)
+                                          (compile_match repr others)
             | Tpat_or(pat1, pat2) ->
                 (* Avoid duplicating the code of the action *)
                 let (or_match, remainder_line, others) = divide_orpat pm in
diff --git a/test/Moretest/patmatch.ml b/test/Moretest/patmatch.ml
index 3e3609dd3..f27c1a445 100644
--- a/test/Moretest/patmatch.ml
+++ b/test/Moretest/patmatch.ml
@@ -25,12 +25,26 @@ let h = function
 (* Matching with orpats *)
 
 let k = function
-    ' ' | '\t' | '\n' | '\r' -> "blank"
-  | 'A'..'Z' | 'a'..'z' | '\192'..'\255' -> "letter"
-  | '0'..'9' -> "digit"
+    ' ' | '\t' | '\n' | '\r' -> "blk"
+  | 'A'..'Z' | 'a'..'z' | '\192'..'\255' -> "letr"
+  | '0'..'9' -> "dig"
   | '!'|'%'|'&'|'$'|'#'|'+'|'/'|':'|'<'|'='|'>'|'?'|'@'|'\\'|
-             '~'|'^'|'|'|'*' -> "operator"
-  | _ -> "other"
+             '~'|'^'|'|'|'*' -> "oper"
+  | _ -> "othr"
+
+(* Matching on arrays *)
+
+let p = function [| x |] -> x | _ -> assert false
+
+let q = function [| x |] -> x | _ -> 0
+
+let r = function [| x |] -> x | _ -> 0.0
+
+let l = function
+    [||] -> 0
+  | [|x|] -> x + 1
+  | [|x;y|] -> x + y
+  | [|x;y;z|] -> x + y + z
 
 (* The test *)
 
@@ -47,8 +61,17 @@ let _ =
   done;
   for i = 0 to 255 do
     let c = Char.chr i in
-    printf "k(%s) = %s\n" (Char.escaped c) (k c)
+    printf "k(%s) = %s\t" (Char.escaped c) (k c)
   done;
+  printf "\n";
+  printf "p([|\"hello\"|]) = %s\n" (p [|"hello"|]);
+  printf "p([|1.0|]) = %f\n" (p [|1.0|]);
+  printf "q([|2|]) = %d\n" (q [|2|]);
+  printf "r([|3.0|]) = %f\n" (r [|3.0|]);
+  printf "l([||]) = %d\n" (l [||]);
+  printf "l([|1|]) = %d\n" (l [|1|]);
+  printf "l([|2;3|]) = %d\n" (l [|2;3|]);
+  printf "l([|4;5;6|]) = %d\n" (l [|4;5;6|]);
   exit 0