fix bug #4585 and handle virtual flag for class value in all generators

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

9 files changed, 154 insertions, 124 deletions

diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml
index e1e1d33ca..6b5b44b87 100644
--- a/ocamldoc/odoc_ast.ml
+++ b/ocamldoc/odoc_ast.ml
@@ -192,6 +192,20 @@ module Typedtree_search =
       in
       iter cls.Typedtree.cl_field
 
+    let class_sig_of_cltype_decl =
+      let rec iter = function
+        Types.Tcty_constr (_, _, cty) -> iter cty
+      | Types.Tcty_signature s -> s
+      | Types.Tcty_fun (_,_, cty) -> iter cty
+      in
+      fun ct_decl -> iter ct_decl.Types.clty_type
+
+    let search_virtual_attribute_type table ctname name =
+      let ct_decl = search_class_type_declaration table ctname in
+      let cls_sig = class_sig_of_cltype_decl ct_decl in
+      let (_,_,texp) = Types.Vars.find name cls_sig.cty_vars in
+      texp
+
    let search_method_expression cls name =
       let rec iter = function
         | [] ->
@@ -482,7 +496,7 @@ module Analyser =
 
     (** Analysis of a [Parsetree.class_struture] and a [Typedtree.class_structure] to get a couple
        (inherited classes, class elements). *)
-    let analyse_class_structure env current_class_name tt_class_sig last_pos pos_limit p_cls tt_cls =
+    let analyse_class_structure env current_class_name tt_class_sig last_pos pos_limit p_cls tt_cls table =
       let rec iter acc_inher acc_fields last_pos = function
         | [] ->
             let s = get_string_of_file last_pos pos_limit in
@@ -523,13 +537,20 @@ module Analyser =
               p_clexp.Parsetree.pcl_loc.Location.loc_end.Lexing.pos_cnum
               q
 
-        | (Parsetree.Pcf_val (label, mutable_flag, _, loc) |
-           Parsetree.Pcf_valvirt (label, mutable_flag, _, loc)) :: q ->
+      | ((Parsetree.Pcf_val (label, mutable_flag, _, loc) |
+              Parsetree.Pcf_valvirt (label, mutable_flag, _, loc) ) as x) :: q ->
+            let virt = match x with Parsetree.Pcf_val _ -> false | _ -> true in
             let complete_name = Name.concat current_class_name label in
             let (info_opt, ele_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
             let type_exp =
-              try Typedtree_search.search_attribute_type tt_cls label
-              with Not_found -> raise (Failure (Odoc_messages.attribute_not_found_in_typedtree complete_name))
+            try
+              if virt then
+                Typedtree_search.search_virtual_attribute_type table
+                  (Name.simple current_class_name) label
+              else
+                Typedtree_search.search_attribute_type tt_cls label
+            with Not_found ->
+                raise (Failure (Odoc_messages.attribute_not_found_in_typedtree complete_name))
             in
             let att =
               {
@@ -542,6 +563,7 @@ module Analyser =
                               val_loc = { loc_impl = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum) ; loc_inter = None } ;
                             } ;
                 att_mutable = mutable_flag = Asttypes.Mutable ;
+                att_virtual = virt ;
               }
             in
             iter acc_inher (acc_fields @ ele_comments @ [ Class_attribute att ]) loc.Location.loc_end.Lexing.pos_cnum q
@@ -628,7 +650,7 @@ module Analyser =
       iter [] [] last_pos (snd p_cls)
 
     (** Analysis of a [Parsetree.class_expr] and a [Typedtree.class_expr] to get a a couple (class parameters, class kind). *)
-    let rec analyse_class_kind env current_class_name comment_opt last_pos p_class_expr tt_class_exp =
+    let rec analyse_class_kind env current_class_name comment_opt last_pos p_class_expr tt_class_exp table =
       match (p_class_expr.Parsetree.pcl_desc, tt_class_exp.Typedtree.cl_desc) with
         (Parsetree.Pcl_constr (lid, _), tt_class_exp_desc ) ->
           let name =
@@ -672,6 +694,7 @@ module Analyser =
               p_class_expr.Parsetree.pcl_loc.Location.loc_end.Lexing.pos_cnum
               p_class_structure
               tt_class_structure
+              table
           in
           ([],
            Class_structure (inherited_classes, class_elements) )
@@ -710,7 +733,10 @@ module Analyser =
                  in
                  (new_param, tt_class_expr2)
            in
-           let (params, k) = analyse_class_kind env current_class_name comment_opt last_pos p_class_expr2 next_tt_class_exp in
+           let (params, k) = analyse_class_kind
+              env current_class_name comment_opt last_pos p_class_expr2
+                next_tt_class_exp table
+            in
            (parameter :: params, k)
 
       | (Parsetree.Pcl_apply (p_class_expr2, _), Tclass_apply (tt_class_expr2, exp_opt_optional_list)) ->
@@ -754,12 +780,17 @@ module Analyser =
 
       | (Parsetree.Pcl_let (_, _, p_class_expr2), Typedtree.Tclass_let (_, _, _, tt_class_expr2)) ->
           (* we don't care about these lets *)
-          analyse_class_kind env current_class_name comment_opt last_pos p_class_expr2 tt_class_expr2
+          analyse_class_kind
+              env current_class_name comment_opt last_pos p_class_expr2
+              tt_class_expr2 table
 
       | (Parsetree.Pcl_constraint (p_class_expr2, p_class_type2),
          Typedtree.Tclass_constraint (tt_class_expr2, _, _, _)) ->
-          let (l, class_kind)  = analyse_class_kind env current_class_name comment_opt last_pos p_class_expr2 tt_class_expr2 in
-          (* A VOIR : analyse du class type ? on n'a pas toutes les infos. cf. Odoc_sig.analyse_class_type_kind *)
+          let (l, class_kind) = analyse_class_kind
+              env current_class_name comment_opt last_pos p_class_expr2
+                tt_class_expr2 table
+            in
+            (* A VOIR : analyse du class type ? on n'a pas toutes les infos. cf. Odoc_sig.analyse_class_type_kind *)
           let class_type_kind =
             (*Sig.analyse_class_type_kind
               env
@@ -777,7 +808,7 @@ module Analyser =
           raise (Failure "analyse_class_kind: Parsetree and typedtree don't match.")
 
     (** Analysis of a [Parsetree.class_declaration] and a [Typedtree.class_expr] to return a [t_class].*)
-    let analyse_class env current_module_name comment_opt p_class_decl tt_type_params tt_class_exp =
+    let analyse_class env current_module_name comment_opt p_class_decl tt_type_params tt_class_exp table =
       let name = p_class_decl.Parsetree.pci_name in
       let complete_name = Name.concat current_module_name name in
       let pos_start = p_class_decl.Parsetree.pci_expr.Parsetree.pcl_loc.Location.loc_start.Lexing.pos_cnum in
@@ -791,6 +822,7 @@ module Analyser =
           pos_start
           p_class_decl.Parsetree.pci_expr
           tt_class_exp
+          table
       in
       let cl =
         {
@@ -1391,6 +1423,7 @@ module Analyser =
                     class_decl
                     tt_type_params
                     tt_class_exp
+                    table
                 in
                 ele_comments @ ((Element_class new_class) :: (f last_pos2 q))
           in
diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml
index 8f93fcf75..81cf904ce 100644
--- a/ocamldoc/odoc_html.ml
+++ b/ocamldoc/odoc_html.ml
@@ -1476,12 +1476,17 @@ class html =
       (* html mark *)
       bp b "<a name=\"%s\"></a>" (Naming.attribute_target a);
       (
-       if a.att_mutable then
-         bs b ((self#keyword Odoc_messages.mutab)^ " ")
+       if a.att_virtual then
+         bs b ((self#keyword "virtual")^ " ")
        else
          ()
       );
       (
+       if a.att_mutable then
+         bs b ((self#keyword Odoc_messages.mutab)^ " ")
+       else
+         ()
+      );(
        match a.att_value.val_code with
          None -> bs b (Name.simple a.att_value.val_name)
        | Some c ->
@@ -1490,7 +1495,7 @@ class html =
            bp b "<a href=\"%s\">%s</a>" file (Name.simple a.att_value.val_name);
       );
       bs b " : ";
-      self#html_of_type_expr b module_name  a.att_value.val_type;
+      self#html_of_type_expr b module_name a.att_value.val_type;
       bs b "</pre>";
       self#html_of_info b a.att_value.val_info
 
diff --git a/ocamldoc/odoc_info.mli b/ocamldoc/odoc_info.mli
index edf356073..58c872801 100644
--- a/ocamldoc/odoc_info.mli
+++ b/ocamldoc/odoc_info.mli
@@ -251,6 +251,7 @@ module Value :
         {
           att_value : t_value ; (** an attribute has almost all the same information as a value *)
           att_mutable : bool ;  (** [true] if the attribute is mutable. *)
+          att_virtual : bool ;  (** [true] if the attribute is virtual. *)
         }
 
     (** Representation of a class method. *)
diff --git a/ocamldoc/odoc_man.ml b/ocamldoc/odoc_man.ml
index eb2a1bac4..fefbe0877 100644
--- a/ocamldoc/odoc_man.ml
+++ b/ocamldoc/odoc_man.ml
@@ -479,6 +479,7 @@ class man =
     (** Print groff string for a class attribute. *)
     method man_of_attribute b a =
       bs b ".I val ";
+      if a.att_virtual then bs b ("virtual ");
       if a.att_mutable then bs b (Odoc_messages.mutab^" ");
       bs b ((Name.simple a.att_value.val_name)^" : ");
       self#man_of_type_expr b (Name.father a.att_value.val_name) a.att_value.val_type;
diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml
index 9e0fc743e..d15d868e7 100644
--- a/ocamldoc/odoc_sig.ml
+++ b/ocamldoc/odoc_sig.ml
@@ -259,11 +259,6 @@ module Analyser =
        signature. @return the couple (inherited_class list, elements).*)
     let analyse_class_elements env current_class_name last_pos pos_limit
         class_type_field_list class_signature =
-      print_DEBUG "Types.Tcty_signature class_signature";
-      let f_DEBUG var (mutable_flag, type_exp) = print_DEBUG var in
-      Types.Vars.iter f_DEBUG class_signature.Types.cty_vars;
-      print_DEBUG ("Type de la classe "^current_class_name^" : ");
-      print_DEBUG (Odoc_print.string_of_type_expr class_signature.Types.cty_self);
       let get_pos_limit2 q =
         match q with
           [] -> pos_limit
@@ -330,7 +325,7 @@ module Analyser =
             in
             ([], ele_comments)
 
-        | Parsetree.Pctf_val (name, mutable_flag, _, _, loc) :: q ->
+        | Parsetree.Pctf_val (name, mutable_flag, virtual_flag, _, loc) :: q ->
             (* of (string * mutable_flag * core_type option * Location.t)*)
             let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
             let complete_name = Name.concat current_class_name name in
@@ -353,6 +348,7 @@ module Analyser =
                   val_loc = { loc_impl = None ; loc_inter = Some (!file_name, loc.Location.loc_start.Lexing.pos_cnum)} ;
                 } ;
                 att_mutable = mutable_flag = Asttypes.Mutable ;
+                att_virtual = virtual_flag = Asttypes.Virtual ;
               }
             in
             let pos_limit2 = get_pos_limit2 q in
@@ -1181,11 +1177,6 @@ module Analyser =
            ([], k)
 
       | (Parsetree.Pcty_signature (_, class_type_field_list), Types.Tcty_signature class_signature) ->
-          print_DEBUG "Types.Tcty_signature class_signature";
-          let f_DEBUG var (mutable_flag, type_exp) = print_DEBUG var in
-          Types.Vars.iter f_DEBUG class_signature.Types.cty_vars;
-          print_DEBUG ("Type de la classe "^current_class_name^" : ");
-          print_DEBUG (Odoc_print.string_of_type_expr class_signature.Types.cty_self);
           (* we get the elements of the class in class_type_field_list *)
           let (inher_l, ele) = analyse_class_elements env current_class_name
               last_pos
@@ -1235,11 +1226,6 @@ module Analyser =
            k
 
       | (Parsetree.Pcty_signature (_, class_type_field_list), Types.Tcty_signature class_signature) ->
-          print_DEBUG "Types.Tcty_signature class_signature";
-          let f_DEBUG var (mutable_flag, type_exp) = print_DEBUG var in
-          Types.Vars.iter f_DEBUG class_signature.Types.cty_vars;
-          print_DEBUG ("Type de la classe "^current_class_name^" : ");
-          print_DEBUG (Odoc_print.string_of_type_expr class_signature.Types.cty_self);
           (* we get the elements of the class in class_type_field_list *)
           let (inher_l, ele) = analyse_class_elements env current_class_name
               last_pos
diff --git a/ocamldoc/odoc_str.ml b/ocamldoc/odoc_str.ml
index 3fafb9622..b321a5d49 100644
--- a/ocamldoc/odoc_str.ml
+++ b/ocamldoc/odoc_str.ml
@@ -256,6 +256,7 @@ let string_of_value v =
 let string_of_attribute a =
   let module M = Odoc_value in
   "val "^
+  (if a.M.att_virtual then "virtual " else "")^
   (if a.M.att_mutable then Odoc_messages.mutab^" " else "")^
   (Name.simple a.M.att_value.M.val_name)^" : "^
   (Odoc_print.string_of_type_expr a.M.att_value.M.val_type)^"\n"^
diff --git a/ocamldoc/odoc_texi.ml b/ocamldoc/odoc_texi.ml
index 33d589f3c..ec7d50c70 100644
--- a/ocamldoc/odoc_texi.ml
+++ b/ocamldoc/odoc_texi.ml
@@ -577,6 +577,7 @@ class texi =
       let t = [ self#fixedblock
                   [ Newline ; minus ;
                     Raw "val " ;
+                    Raw (if a.att_virtual then "virtual " else "") ;
                     Raw (if a.att_mutable then "mutable " else "") ;
                     Raw (Name.simple a.att_value.val_name) ;
                     Raw " :\n" ;
diff --git a/ocamldoc/odoc_to_text.ml b/ocamldoc/odoc_to_text.ml
index 1e5717b6b..523d2fa56 100644
--- a/ocamldoc/odoc_to_text.ml
+++ b/ocamldoc/odoc_to_text.ml
@@ -13,10 +13,10 @@
 
 (** Text generation.
 
-   This module contains the class [to_text] with methods used to transform 
+   This module contains the class [to_text] with methods used to transform
    information about elements to a [text] structure.*)
 
-open Odoc_info 
+open Odoc_info
 open Exception
 open Type
 open Value
@@ -28,7 +28,7 @@ open Parameter
 class virtual info =
   object (self)
     (** The list of pairs [(tag, f)] where [f] is a function taking
-       the [text] associated to [tag] and returning a [text]. 
+       the [text] associated to [tag] and returning a [text].
        Add a pair here to handle a tag.*)
     val mutable tag_functions = ([] : (string * (Odoc_info.text -> Odoc_info.text)) list)
 
@@ -40,8 +40,8 @@ class virtual info =
       | _ ->
           [ Bold [Raw (Odoc_messages.authors^": ")] ;
             Raw (String.concat ", " l) ;
-            Newline 
-          ] 
+            Newline
+          ]
 
     (** @return [text] value for the given optional version information.*)
     method text_of_version_opt v_opt =
@@ -58,19 +58,19 @@ class virtual info =
         None -> []
       | Some s -> [ Bold [Raw (Odoc_messages.since^": ")] ;
                     Raw s ;
-                    Newline 
+                    Newline
                   ]
 
     (** @return [text] value for the given list of raised exceptions.*)
     method text_of_raised_exceptions l =
       match l with
         [] -> []
-      | (s, t) :: [] -> 
+      | (s, t) :: [] ->
           [ Bold [ Raw Odoc_messages.raises ] ;
             Raw " " ;
             Code s ;
             Raw " "
-          ]  
+          ]
           @ t
           @ [ Newline ]
       | _ ->
@@ -82,28 +82,28 @@ class virtual info =
                  l
               ) ;
             Newline
-          ] 
+          ]
 
     (** Return [text] value for the given "see also" reference. *)
     method text_of_see (see_ref, t)  =
-      let t_ref = 
+      let t_ref =
         match see_ref with
           Odoc_info.See_url s -> [ Odoc_info.Link (s, t) ]
         | Odoc_info.See_file s -> (Odoc_info.Code s) :: (Odoc_info.Raw " ") :: t
         | Odoc_info.See_doc s -> (Odoc_info.Italic [Odoc_info.Raw s]) :: (Odoc_info.Raw " ") :: t
       in
       t_ref
-        
+
     (** Return [text] value for the given list of "see also" references.*)
     method text_of_sees l =
       match l with
         [] -> []
-      | see :: [] -> 
-          (Bold [ Raw Odoc_messages.see_also ]) :: 
-          (Raw " ") :: 
+      | see :: [] ->
+          (Bold [ Raw Odoc_messages.see_also ]) ::
+          (Raw " ") ::
           (self#text_of_see see) @ [ Newline ]
       | _ ->
-          (Bold [ Raw Odoc_messages.see_also ]) :: 
+          (Bold [ Raw Odoc_messages.see_also ]) ::
           [ List
               (List.map
                  (fun see -> self#text_of_see see)
@@ -120,7 +120,7 @@ class virtual info =
 
     (** Return a [text] for the given list of custom tagged texts. *)
     method text_of_custom l =
-      List.fold_left 
+      List.fold_left
         (fun acc -> fun (tag, text) ->
           try
             let f = List.assoc tag tag_functions in
@@ -141,7 +141,7 @@ class virtual info =
         None ->
           []
       | Some info ->
-          let t = 
+          let t =
             (match info.i_deprecated with
               None -> []
             | Some t -> ( Italic [Raw (Odoc_messages.deprecated^" ")] ) :: t
@@ -160,8 +160,8 @@ class virtual info =
             (self#text_of_custom info.i_custom)
           in
           if block then
-            [Block t] 
-          else 
+            [Block t]
+          else
             t
   end
 
@@ -172,11 +172,11 @@ class virtual to_text =
 
     method virtual label : ?no_: bool -> string -> string
 
-    (** Take a string and return the string where fully qualified idents 
+    (** Take a string and return the string where fully qualified idents
        have been replaced by idents relative to the given module name.
        Also remove the "hidden modules".*)
     method relative_idents m_name s =
-      let f str_t = 
+      let f str_t =
         let match_s = Str.matched_string str_t in
         let rel = Name.get_relative m_name match_s in
         Odoc_info.apply_if_equal Odoc_info.use_hidden_modules match_s rel
@@ -188,11 +188,11 @@ class virtual to_text =
       in
       s2
 
-    (** Take a string and return the string where fully qualified idents 
+    (** Take a string and return the string where fully qualified idents
        have been replaced by idents relative to the given module name.
        Also remove the "hidden modules".*)
     method relative_module_idents m_name s =
-      let f str_t = 
+      let f str_t =
         let match_s = Str.matched_string str_t in
         let rel = Name.get_relative m_name match_s in
         Odoc_info.apply_if_equal Odoc_info.use_hidden_modules match_s rel
@@ -228,41 +228,41 @@ class virtual to_text =
     (** Get a string for the parameters of a class (with arrows) where all idents are relative. *)
     method normal_class_params m_name c =
       let s = Odoc_info.string_of_class_params c in
-      self#relative_idents m_name 
+      self#relative_idents m_name
 	(Odoc_info.remove_ending_newline s)
 
     (** @return [text] value to represent a [Types.type_expr].*)
     method text_of_type_expr module_name t =
-      let t = List.flatten 
+      let t = List.flatten
           (List.map
              (fun s -> [Code s ; Newline ])
-             (Str.split (Str.regexp "\n") 
+             (Str.split (Str.regexp "\n")
                 (self#normal_type module_name t))
           )
       in
       t
 
     (** Return [text] value for a given short [Types.type_expr].*)
-    method text_of_short_type_expr module_name t = 
+    method text_of_short_type_expr module_name t =
       [ Code (self#normal_type module_name t) ]
 
     (** Return [text] value or the given list of [Types.type_expr], with
        the given separator. *)
     method text_of_type_expr_list module_name sep l =
-      [ Code (self#normal_type_list module_name sep l) ]        
+      [ Code (self#normal_type_list module_name sep l) ]
 
-    (** Return [text] value or the given list of [Types.type_expr], 
+    (** Return [text] value or the given list of [Types.type_expr],
        as type parameters of a class of class type. *)
     method text_of_class_type_param_expr_list module_name l =
-      [ Code (self#normal_class_type_param_list module_name l) ]        
+      [ Code (self#normal_class_type_param_list module_name l) ]
 
     (** @return [text] value to represent parameters of a class (with arraows).*)
     method text_of_class_params module_name c =
-      let t = Odoc_info.text_concat 
+      let t = Odoc_info.text_concat
 	  [Newline]
           (List.map
              (fun s -> [Code s])
-	     (Str.split (Str.regexp "\n") 
+	     (Str.split (Str.regexp "\n")
                 (self#normal_class_params module_name c))
 	  )
       in
@@ -274,18 +274,18 @@ class virtual to_text =
           (Str.split (Str.regexp "\n") (Odoc_info.string_of_module_type t))
       in
       [ Code s ]
-    
+
     (** @return [text] value for a value. *)
     method text_of_value v =
       let name = v.val_name in
       let s_name = Name.simple name in
-      let s = 
+      let s =
 	Format.fprintf Format.str_formatter "@[<hov 2>val %s :@ %s"
           s_name
           (self#normal_type (Name.father v.val_name) v.val_type);
 	Format.flush_str_formatter ()
       in
-      [ CodePre s ] @ 
+      [ CodePre s ] @
       [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")] @
       (self#text_of_info v.val_info)
 
@@ -293,14 +293,15 @@ class virtual to_text =
     method text_of_attribute a =
       let s_name = Name.simple a.att_value.val_name in
       let mod_name = Name.father a.att_value.val_name in
-      let s = 
-	Format.fprintf Format.str_formatter "@[<hov 2>val %s%s :@ %s"
+      let s =
+	Format.fprintf Format.str_formatter "@[<hov 2>val %s%s%s :@ %s"
+          (if a.att_virtual then "virtual " else "")
           (if a.att_mutable then "mutable " else "")
           s_name
 	  (self#normal_type mod_name a.att_value.val_type);
 	Format.flush_str_formatter ()
       in
-      (CodePre s) :: 
+      (CodePre s) ::
       [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")] @
       (self#text_of_info a.att_value.val_info)
 
@@ -308,11 +309,11 @@ class virtual to_text =
     method text_of_method m =
       let s_name = Name.simple m.met_value.val_name in
       let mod_name = Name.father m.met_value.val_name in
-      let s = 
+      let s =
 	Format.fprintf Format.str_formatter "@[<hov 2>method %s%s%s :@ %s"
           (if m.met_private then "private " else "")
           (if m.met_virtual then "virtual " else "")
-          s_name 
+          s_name
 	  (self#normal_type mod_name m.met_value.val_type);
 	Format.flush_str_formatter ()
       in
@@ -327,18 +328,18 @@ class virtual to_text =
       Format.fprintf Format.str_formatter "@[<hov 2>exception %s" s_name ;
         (match e.ex_args with
           [] -> ()
-        | _ -> 
+        | _ ->
             Format.fprintf Format.str_formatter "@ of "
         );
-      let s = self#normal_type_list 
-	  ~par: false (Name.father e.ex_name) " * " e.ex_args 
+      let s = self#normal_type_list
+	  ~par: false (Name.father e.ex_name) " * " e.ex_args
       in
-      let s2 = 
+      let s2 =
         Format.fprintf Format.str_formatter "%s" s ;
         (match e.ex_alias with
           None -> ()
-        | Some ea -> 
-            Format.fprintf Format.str_formatter " = %s" 
+        | Some ea ->
+            Format.fprintf Format.str_formatter " = %s"
               (
                match ea.ea_ex with
                  None -> ea.ea_name
@@ -377,7 +378,7 @@ class virtual to_text =
                      )
                      l2
                   )
-              ] 
+              ]
 
 
     (** Return [text] value for a list of parameters. *)
@@ -396,13 +397,13 @@ class virtual to_text =
                    | s -> Code s
                    ) ::
                    [Code " : "] @
-                   (self#text_of_short_type_expr m_name (Parameter.typ p)) @ 
+                   (self#text_of_short_type_expr m_name (Parameter.typ p)) @
                    [Newline] @
                    (self#text_of_parameter_description p)
                  )
                  l
               )
-          ] 
+          ]
 
     (** Return [text] value for a list of module parameters. *)
     method text_of_module_parameter_list l =
@@ -410,7 +411,7 @@ class virtual to_text =
         [] ->
           []
       | _ ->
-          [ Newline ; 
+          [ Newline ;
             Bold [Raw Odoc_messages.parameters] ;
             Raw ":" ;
             List
@@ -424,18 +425,18 @@ class virtual to_text =
                  )
                  l
               )
-          ] 
+          ]
 
 (**/**)
 
     (** Return [text] value for the given [class_kind].*)
     method text_of_class_kind father ckind =
       match ckind with
-        Class_structure _ -> 
+        Class_structure _ ->
           [Code Odoc_messages.object_end]
 
       | Class_apply capp ->
-          [Code 
+          [Code
               (
                (
                 match capp.capp_class with
@@ -448,13 +449,13 @@ class virtual to_text =
                      (fun s -> "("^s^")")
                      capp.capp_params_code))
               )
-          ] 
-            
+          ]
+
       | Class_constr cco ->
           (
            match cco.cco_type_parameters with
              [] -> []
-           | l -> 
+           | l ->
                (Code "[")::
                (self#text_of_type_expr_list father ", " l)@
                [Code "] "]
@@ -465,7 +466,7 @@ class virtual to_text =
             | Some (Cl cl) -> Name.get_relative father cl.cl_name
             | Some (Cltype (clt,_)) -> Name.get_relative father clt.clt_name
            )
-          ] 
+          ]
 
       | Class_constraint (ck, ctk) ->
           [Code "( "] @
@@ -478,11 +479,11 @@ class virtual to_text =
     (** Return [text] value for the given [class_type_kind].*)
     method text_of_class_type_kind father ctkind =
       match ctkind with
-        Class_type cta -> 
+        Class_type cta ->
           (
            match cta.cta_type_parameters with
              [] -> []
-           | l -> 
+           | l ->
                (Code "[") ::
                (self#text_of_class_type_param_expr_list father l) @
                [Code "] "]
@@ -490,16 +491,16 @@ class virtual to_text =
           (
            match cta.cta_class with
              None -> [ Code cta.cta_name ]
-           | Some (Cltype (clt, _)) -> 
-               let rel = Name.get_relative father clt.clt_name in 
+           | Some (Cltype (clt, _)) ->
+               let rel = Name.get_relative father clt.clt_name in
                [Code rel]
-           | Some (Cl cl) -> 
+           | Some (Cl cl) ->
                let rel = Name.get_relative father cl.cl_name in
                [Code rel]
           )
       | Class_signature _ ->
           [Code Odoc_messages.object_end]
-   
+
     (** Return [text] value for a [module_kind]. *)
     method text_of_module_kind ?(with_def_syntax=true) k =
       match k with
@@ -518,12 +519,12 @@ class virtual to_text =
           [Code " ( "] @
           (self#text_of_module_kind ~with_def_syntax: false k2) @
           [Code " ) "]
-                                                                         
+
       | Module_with (tk, code) ->
           (if with_def_syntax then [Code " : "] else []) @
           (self#text_of_module_type_kind ~with_def_syntax: false tk) @
           [Code code]
-            
+
       | Module_constraint (k, tk) ->
           (if with_def_syntax then [Code " : "] else []) @
           [Code "( "] @
@@ -531,7 +532,7 @@ class virtual to_text =
           [Code " : "] @
           (self#text_of_module_type_kind ~with_def_syntax: false tk) @
           [Code " )"]
-                                                                        
+
       | Module_struct _ ->
           [Code ((if with_def_syntax then " : " else "")^
                  Odoc_messages.struct_end^" ")]
@@ -550,14 +551,14 @@ class virtual to_text =
 
       | Module_type_functor (p, k) ->
           let t1 =
-	    [Code ("("^p.mp_name^" : ")] @ 
+	    [Code ("("^p.mp_name^" : ")] @
             (self#text_of_module_type_kind p.mp_kind) @
             [Code ") -> "]
           in
           let t2 = self#text_of_module_type_kind ~with_def_syntax: false k in
           (if with_def_syntax then [Code " = "] else []) @ t1 @ t2
-          
-      | Module_type_with (tk2, code) -> 
+
+      | Module_type_with (tk2, code) ->
           let t = self#text_of_module_type_kind ~with_def_syntax: false tk2 in
           (if with_def_syntax then [Code " = "] else []) @
           t @ [Code code]
@@ -567,7 +568,7 @@ class virtual to_text =
                  (match mt_alias.mta_module with
                    None -> mt_alias.mta_name
                  | Some mt -> mt.mt_name))
-          ] 
+          ]
 
 
   end
diff --git a/ocamldoc/odoc_value.ml b/ocamldoc/odoc_value.ml
index 62cf0ccf4..1812068ae 100644
--- a/ocamldoc/odoc_value.ml
+++ b/ocamldoc/odoc_value.ml
@@ -26,22 +26,23 @@ type t_value = {
     mutable val_parameters : Odoc_parameter.parameter list ;
     mutable val_code : string option ;
     mutable val_loc : Odoc_types.location ;
-  } 
+  }
 
 (** Representation of a class attribute. *)
 type t_attribute = {
     att_value : t_value ; (** an attribute has almost all the same information
                              as a value *)
-    att_mutable : bool ; 
-  } 
+    att_mutable : bool ;
+    att_virtual : bool ;
+  }
 
 (** Representation of a class method. *)
 type t_method = {
     met_value : t_value ; (** a method has almost all the same information
                              as a value *)
-    met_private : bool ; 
+    met_private : bool ;
     met_virtual : bool ;
-  } 
+  }
 
 (** Functions *)
 
@@ -60,27 +61,27 @@ let value_parameter_text_by_name v name =
 
 (** Update the parameters text of a t_value, according to the val_info field. *)
 let update_value_parameters_text v =
-  let f p = 
-    Odoc_parameter.update_parameter_text (value_parameter_text_by_name v) p 
+  let f p =
+    Odoc_parameter.update_parameter_text (value_parameter_text_by_name v) p
   in
   List.iter f v.val_parameters
 
-(** Create a list of (parameter name, typ) from a type, according to the arrows. 
+(** Create a list of (parameter name, typ) from a type, according to the arrows.
    [parameter_list_from_arrows t = [ a ; b ]] if t = a -> b -> c.*)
 let parameter_list_from_arrows typ =
-  let rec iter t = 
+  let rec iter t =
     match t.Types.desc with
       Types.Tarrow (l, t1, t2, _) ->
         (l, t1) :: (iter t2)
-    | Types.Tlink texp 
+    | Types.Tlink texp
     | Types.Tsubst texp ->
 	iter texp
     | Types.Tpoly (texp, _) -> iter texp
     | Types.Tvar
-    | Types.Ttuple _ 
-    | Types.Tconstr _ 
+    | Types.Ttuple _
+    | Types.Tconstr _
     | Types.Tobject _
-    | Types.Tfield _ 
+    | Types.Tfield _
     | Types.Tnil
     | Types.Tunivar
     | Types.Tvariant _ ->
@@ -88,16 +89,16 @@ let parameter_list_from_arrows typ =
   in
   iter typ
 
-(** Create a list of parameters with dummy names "??" from a type list. 
+(** Create a list of parameters with dummy names "??" from a type list.
    Used when we want to merge the parameters of a value, from the .ml
    and the .mli file. In the .mli file we don't have parameter names
    so there is nothing to merge. With this dummy list we can merge the
    parameter names from the .ml and the type from the .mli file. *)
 let dummy_parameter_list typ =
-  let normal_name s = 
-    match s with 
+  let normal_name s =
+    match s with
       "" -> s
-    | _ -> 
+    | _ ->
         match s.[0] with
           '?' -> String.sub s 1 ((String.length s) - 1)
         | _ -> s
@@ -106,26 +107,26 @@ let dummy_parameter_list typ =
   let liste_param = parameter_list_from_arrows typ in
   let rec iter (label, t) =
     match t.Types.desc with
-    | Types.Ttuple l -> 
+    | Types.Ttuple l ->
         if label = "" then
-          Odoc_parameter.Tuple 
+          Odoc_parameter.Tuple
             (List.map (fun t2 -> iter ("", t2)) l, t)
         else
           (* if there is a label, then we don't want to decompose the tuple *)
-          Odoc_parameter.Simple_name 
+          Odoc_parameter.Simple_name
             { Odoc_parameter.sn_name = normal_name label ;
               Odoc_parameter.sn_type = t ;
               Odoc_parameter.sn_text = None }
-    | Types.Tlink t2  
+    | Types.Tlink t2
     | Types.Tsubst t2 ->
         (iter (label, t2))
 
     | _ ->
-        Odoc_parameter.Simple_name 
+        Odoc_parameter.Simple_name
           { Odoc_parameter.sn_name = normal_name label ;
              Odoc_parameter.sn_type = t ;
             Odoc_parameter.sn_text = None }
-  in 
+  in
   List.map iter liste_param
 
 (** Return true if the value is a function, i.e. has a functional type.*)
@@ -141,4 +142,4 @@ let is_function v =
       in
   f v.val_type
 
-        
+