This commit was manufactured by cvs2svn to create branch 'cducetrunk'.

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/cducetrunk@8769 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

5 files changed, 227 insertions, 0 deletions

diff --git a/camlp4/camlp4.odocl b/camlp4/camlp4.odocl
new file mode 100644
index 0000000000..715f15e805
--- /dev/null
+++ b/camlp4/camlp4.odocl
@@ -0,0 +1 @@
+Camlp4/Sig
diff --git a/emacs/caml-font-old.el b/emacs/caml-font-old.el
new file mode 100644
index 0000000000..fe5721376c
--- /dev/null
+++ b/emacs/caml-font-old.el
@@ -0,0 +1,141 @@
+;(***********************************************************************)
+;(*                                                                     *)
+;(*                           Objective Caml                            *)
+;(*                                                                     *)
+;(*                Jacques Garrigue and Ian T Zimmerman                 *)
+;(*                                                                     *)
+;(*  Copyright 1997 Institut National de Recherche en Informatique et   *)
+;(*  en Automatique.  All rights reserved.  This file is distributed    *)
+;(*  under the terms of the GNU General Public License.                 *)
+;(*                                                                     *)
+;(***********************************************************************)
+
+;(* $Id$ *)
+
+;; useful colors
+
+(cond
+ ((x-display-color-p)
+  (require 'font-lock)
+  (cond
+   ((not (boundp 'font-lock-type-face))
+    ; make the necessary faces
+    (make-face 'Firebrick)
+    (set-face-foreground 'Firebrick "Firebrick")
+    (make-face 'RosyBrown)
+    (set-face-foreground 'RosyBrown "RosyBrown")
+    (make-face 'Purple)
+    (set-face-foreground 'Purple "Purple")
+    (make-face 'MidnightBlue)
+    (set-face-foreground 'MidnightBlue "MidnightBlue")
+    (make-face 'DarkGoldenRod)
+    (set-face-foreground 'DarkGoldenRod "DarkGoldenRod")
+    (make-face 'DarkOliveGreen)
+    (set-face-foreground 'DarkOliveGreen "DarkOliveGreen4")
+    (make-face 'CadetBlue)
+    (set-face-foreground 'CadetBlue "CadetBlue")
+    ; assign them as standard faces
+    (setq font-lock-comment-face 'Firebrick)
+    (setq font-lock-string-face 'RosyBrown)
+    (setq font-lock-keyword-face 'Purple)
+    (setq font-lock-function-name-face 'MidnightBlue)
+    (setq font-lock-variable-name-face 'DarkGoldenRod)
+    (setq font-lock-type-face 'DarkOliveGreen)
+    (setq font-lock-reference-face 'CadetBlue)))
+  ; extra faces for documention
+  (make-face 'Stop)
+  (set-face-foreground 'Stop "White")
+  (set-face-background 'Stop "Red")
+  (make-face 'Doc)
+  (set-face-foreground 'Doc "Red")
+  (setq font-lock-stop-face 'Stop)
+  (setq font-lock-doccomment-face 'Doc)
+))
+
+; The same definition is in caml.el:
+; we don't know in which order they will be loaded.
+(defvar caml-quote-char "'"
+  "*Quote for character constants. \"'\" for Objective Caml, \"`\" for Caml-Light.")
+
+(defconst caml-font-lock-keywords
+  (list
+;stop special comments
+   '("\\(^\\|[^\"]\\)\\((\\*\\*/\\*\\*)\\)"
+     2 font-lock-stop-face)
+;doccomments
+   '("\\(^\\|[^\"]\\)\\((\\*\\*[^*]*\\([^)*][^*]*\\*+\\)*)\\)"
+     2 font-lock-doccomment-face)
+;comments
+   '("\\(^\\|[^\"]\\)\\((\\*[^*]*\\*+\\([^)*][^*]*\\*+\\)*)\\)"
+     2 font-lock-comment-face)
+;character literals
+   (cons (concat caml-quote-char "\\(\\\\\\([ntbr" caml-quote-char "\\]\\|"
+                 "[0-9][0-9][0-9]\\)\\|.\\)" caml-quote-char
+                 "\\|\"[^\"\\]*\\(\\\\\\(.\\|\n\\)[^\"\\]*\\)*\"")
+         'font-lock-string-face)
+;modules and constructors
+   '("`?\\<[A-Z][A-Za-z0-9_']*\\>" . font-lock-function-name-face)
+;definition
+   (cons (concat
+          "\\<\\(a\\(nd\\|s\\)\\|c\\(onstraint\\|lass\\)"
+          "\\|ex\\(ception\\|ternal\\)\\|fun\\(ct\\(ion\\|or\\)\\)?"
+          "\\|in\\(herit\\|itializer\\)?\\|let"
+          "\\|m\\(ethod\\|utable\\|odule\\)"
+          "\\|of\\|p\\(arser\\|rivate\\)\\|rec\\|type"
+          "\\|v\\(al\\|irtual\\)\\)\\>")
+         'font-lock-type-face)
+;blocking
+   '("\\<\\(begin\\|end\\|object\\|s\\(ig\\|truct\\)\\)\\>"
+     . font-lock-keyword-face)
+;control
+   (cons (concat
+          "\\<\\(do\\(ne\\|wnto\\)?\\|else\\|for\\|i\\(f\\|gnore\\)"
+          "\\|lazy\\|match\\|new\\|or\\|t\\(hen\\|o\\|ry\\)"
+          "\\|w\\(h\\(en\\|ile\\)\\|ith\\)\\)\\>"
+          "\\|\|\\|->\\|&\\|#")
+         'font-lock-reference-face)
+   '("\\<raise\\>" . font-lock-comment-face)
+;labels (and open)
+   '("\\(\\([~?]\\|\\<\\)[a-z][a-zA-Z0-9_']*:\\)[^:=]" 1
+     font-lock-variable-name-face)
+   '("\\<\\(assert\\|open\\|include\\)\\>\\|[~?][ (]*[a-z][a-zA-Z0-9_']*"
+     . font-lock-variable-name-face)))
+
+(defconst inferior-caml-font-lock-keywords
+  (append
+   (list
+;inferior
+    '("^[#-]" . font-lock-comment-face))
+   caml-font-lock-keywords))
+
+;; font-lock commands are similar for caml-mode and inferior-caml-mode
+(defun caml-mode-font-hook ()
+  (cond
+   ((fboundp 'global-font-lock-mode)
+    (make-local-variable 'font-lock-defaults)
+    (setq font-lock-defaults
+	  '(caml-font-lock-keywords nil nil ((?' . "w") (?_ . "w")))))
+   (t
+    (setq font-lock-keywords caml-font-lock-keywords)))
+  (make-local-variable 'font-lock-keywords-only)
+  (setq font-lock-keywords-only t)
+  (font-lock-mode 1))
+
+(add-hook 'caml-mode-hook 'caml-mode-font-hook)
+
+(defun inferior-caml-mode-font-hook ()
+  (cond
+   ((fboundp 'global-font-lock-mode)
+    (make-local-variable 'font-lock-defaults)
+    (setq font-lock-defaults
+          '(inferior-caml-font-lock-keywords
+            nil nil ((?' . "w") (?_ . "w")))))
+   (t
+    (setq font-lock-keywords inferior-caml-font-lock-keywords)))
+  (make-local-variable 'font-lock-keywords-only)
+  (setq font-lock-keywords-only t)
+  (font-lock-mode 1))
+
+(add-hook 'inferior-caml-mode-hooks 'inferior-caml-mode-font-hook)
+
+(provide 'caml-font)
diff --git a/test/Results/weaktest.out b/test/Results/weaktest.out
new file mode 100644
index 0000000000..2ae28399f5
--- /dev/null
+++ b/test/Results/weaktest.out
@@ -0,0 +1 @@
+pass
diff --git a/test/weaktest.ml b/test/weaktest.ml
new file mode 100644
index 0000000000..92ab5576d3
--- /dev/null
+++ b/test/weaktest.ml
@@ -0,0 +1,73 @@
+(* $Id$ *)
+
+let debug = false;;
+
+open Printf;;
+
+module Hashed = struct
+  type t = string list;;
+  let equal x y =
+    eprintf "equal: %s / %s\n" (List.hd x) (List.hd y);
+    x = y
+  ;;
+  let hash x = Hashtbl.hash (List.hd x);;
+end;;
+
+module HT = Weak.Make (Hashed);;
+
+let tbl = HT.create 7;;
+
+let r = ref [];;
+
+let bunch =
+  if Array.length Sys.argv < 2
+  then 10000
+  else int_of_string Sys.argv.(1)
+;;
+
+Random.init 314;;
+
+let random_string n =
+  let result = String.create n in
+  for i = 0 to n - 1 do
+    result.[i] <- Char.chr (32 + Random.int 95);
+  done;
+  result
+;;
+
+let added = ref 0;;
+let mistakes = ref 0;;
+
+let print_status () =
+  let (len, entries, sumbuck, buckmin, buckmed, buckmax) = HT.stats tbl in
+  if entries > bunch * (!added + 1) then begin
+    if debug then begin
+      printf "\n===================\n";
+      printf "len = %d\n" len;
+      printf "entries = %d\n" entries;
+      printf "sum of bucket sizes = %d\n" sumbuck;
+      printf "min bucket = %d\n" buckmin;
+      printf "med bucket = %d\n" buckmed;
+      printf "max bucket = %d\n" buckmax;
+      printf "GC count = %d\n" (Gc.quick_stat ()).Gc.major_collections;
+      flush stdout;
+    end;
+    incr mistakes;
+  end;
+  added := 0;
+;;
+
+Gc.create_alarm print_status;;
+
+for j = 0 to 99 do
+  r := [];
+  incr added;
+
+  for i = 1 to bunch do
+    let c = random_string 7 in
+    r := c :: !r;
+    HT.add tbl !r;
+  done;
+done;;
+
+if !mistakes < 5 then printf "pass\n" else printf "fail\n";;
diff --git a/testlabl/bugs/pr4435.ml b/testlabl/bugs/pr4435.ml
new file mode 100644
index 0000000000..c9e1d4997b
--- /dev/null
+++ b/testlabl/bugs/pr4435.ml
@@ -0,0 +1,11 @@
+(* Two v's in the same class *)
+class c v = object initializer  print_endline v val v = 42 end;;
+new c "42";;
+
+(* Two hidden v's in the same class! *)
+class c (v : int) =
+  object
+    method v0 = v
+    inherit ((fun v -> object method v : string = v end) "42")
+  end;;
+(new c 42)#v0;;