This is an automated email from the git hooks/post-receive script.

mehdi pushed a commit to branch master
in repository otags.

commit 47e6f8eda938b1f62146033fae062ab931c4b10f
Author: Mehdi Dogguy <me...@debian.org>
Date:   Sat Jan 16 16:54:14 2016 +0100

    Imported Upstream version 4.02.1
---
 ChangeLog              |  57 ++++++++++++++++++++++++++++
 Makefile.in            |  19 +++++++---
 configure              |   4 +-
 contrib/update-otags.8 |   3 +-
 doc/changes.html       |  17 +++++++--
 doc/otags.1            |  36 ++++++++++++------
 doc/otags.html         |  43 ++++++++++++++-------
 make-distribution      |   1 +
 misc.ml                |  11 ++----
 parser_hints.ml        |   5 ++-
 reparse.ml             |  14 ++++---
 tags.ml                | 100 ++++++++++++++++++++++++++++++++++++++++++++++---
 test/a.ml              |  14 +++++++
 test/c.mli             |   9 +++++
 test/g.mli             |   1 +
 test/test.TAGS         |  27 ++++++++++++-
 test/test.tags         |  21 +++++++++++
 util/dump-camlp4.ml    |   8 ++--
 vi.ml                  |  16 ++++----
 19 files changed, 333 insertions(+), 73 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 50e1c68..7c88020 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,60 @@
+2016-01-10  Hendrik Tews <ot...@askra.de>
+
+       * prepare doc/changes.html for release
+
+2016-01-10  Hendrik Tews  <hendrik.t...@fireeye.com>
+
+       * add check question in make-distribution
+
+2016-01-10  Hendrik Tews  <hendrik.t...@fireeye.com>
+
+       * move recent changes end marker
+
+2016-01-10  Hendrik Tews  <hendrik.t...@fireeye.com>
+
+       * update changes.html
+
+2016-01-10  Hendrik Tews  <hendrik.t...@fireeye.com>
+
+       * update update-otags man page
+
+2016-01-10  Hendrik Tews  <hendrik.t...@fireeye.com>
+
+       * test infix or
+
+2016-01-10  Hendrik Tews  <hendrik.t...@fireeye.com>
+
+       * fix otags man page
+
+2016-01-10  Hendrik Tews  <hendrik.t...@fireeye.com>
+
+       * close dir handles for parser hints dir trees
+
+2016-01-08  Hendrik Tews  <hendrik.t...@fireeye.com>
+
+       * make dump-camlp4 string safe
+
+2016-01-08  Hendrik Tews  <hendrik.t...@fireeye.com>
+
+       * update testcases
+
+2016-01-06  Hendrik Tews  <hendrik.t...@fireeye.com>
+
+       * move to -save-string
+
+2016-01-05  Hendrik Tews  <hendrik.t...@fireeye.com>
+
+       * adapt to ocaml 4.02: module aliases, attributes,
+         exception patterns, extensible variants
+
+2013-10-01  Hendrik Tews  <t...@os.inf.tu-dresden.de>
+
+       * fix mli reparsing problem with sexplib
+
+2013-09-25  Hendrik Tews <ot...@askra.de>
+
+       * release version 4.01.1 on 2013-09-25 08:50:31 UTC
+
 2013-09-25  Hendrik Tews <ot...@askra.de>
 
        * prepare doc/changes.html for release
diff --git a/Makefile.in b/Makefile.in
index 691f147..1ed6274 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -19,7 +19,7 @@
 # along with "Otags reloaded". If not, see
 # <http://www.gnu.org/licenses/>.
 # 
-# $Id: Makefile.in,v 1.30 2012/05/22 13:46:45 tews Exp $
+# $Id: Makefile.in,v 1.32 2016/01/06 08:11:19 tews Exp $
 # 
 
 .PHONY: all
@@ -154,7 +154,7 @@ Makefile.deps : $(SOURCES_O) $(SOURCES_RQ)
 include Makefile.deps
 
 CAMLP4INCLUDES:=-I +camlp4 -I +camlp4/Camlp4Parsers
-OCAMLFLAGS:=-w Ae $(CAMLP4INCLUDES) -g
+OCAMLFLAGS:=-w Ae -safe-string $(CAMLP4INCLUDES) -g
 
 %.cmx: %.ml
        $(OCAMLOPT) -c $(OCAMLFLAGS) $<
@@ -224,11 +224,14 @@ TESTSOURCES_ML:= test/a.ml test/b.ml test/d.ml 
test/cpp_h.generated.ml
 TESTSOURCES_MLI:= test/c.mli test/e.mli
 TESTSOURCES_NORM:= $(TESTSOURCES_ML) $(TESTSOURCES_MLI) 
 TESTSOURCES_EXT:= test/cpp_i.generated.ml
-TESTSOURCES_SEXP:= test/f.ml
+TESTSOURCES_SEXP_ML:= test/f.ml
+TESTSOURCES_SEXP_MLI:= test/g.mli
+TESTSOURCES_SEXP:= $(TESTSOURCES_SEXP_MLI) $(TESTSOURCES_SEXP_ML)
 TESTSOURCES:= $(TESTSOURCES_NORM) $(TESTSOURCES_SEXP)
-COMPILEDTESTS:= $(TESTSOURCES_ML:.ml=.cmo) \
-               $(TESTSOURCES_MLI:.mli=.cmi) \
-               $(TESTSOURCES_SEXP:.ml=.cmo) \
+COMPILEDTESTS:= $(TESTSOURCES_MLI:.mli=.cmi) \
+               $(TESTSOURCES_ML:.ml=.cmo) \
+               $(TESTSOURCES_SEXP_MLI:.mli=.cmi) \
+               $(TESTSOURCES_SEXP_ML:.ml=.cmo) \
                $(TESTSOURCES_EXT:.ml=.cmo)
 
 
@@ -265,6 +268,10 @@ test/f.cmo: test/f.ml
        $(OCAMLC) -pp "camlp4o -I $(TYPECONVDIR) -I $(SEXPLIBDIR) 
pa_type_conv.cma pa_sexp_conv.cma" \
                -w p -I $(SEXPLIBDIR) -c $<
 
+test/g.cmi: test/g.mli
+       $(OCAMLC) -pp "camlp4o -I $(TYPECONVDIR) -I $(SEXPLIBDIR) 
pa_type_conv.cma pa_sexp_conv.cma" \
+               -w p -I $(SEXPLIBDIR) $<
+
 .PHONY: generation
 generation:
        cp test/test.NEWTAGS test/test.TAGS 
diff --git a/configure b/configure
index d0e1bd3..d6df607 100755
--- a/configure
+++ b/configure
@@ -23,13 +23,13 @@
 # along with "Otags reloaded". If not, see
 # <http://www.gnu.org/licenses/>.
 # 
-# $Id: configure,v 1.26 2013/09/25 08:40:49 tews Exp $
+# $Id: configure,v 1.28 2016/01/05 20:26:54 tews Exp $
 # 
 ##############################################################################
 
 set -e
 
-REQUIRED_OCAML_VERSION=4.01
+REQUIRED_OCAML_VERSION=4.02
 OTAGS_VERSION=1
 
 root=/usr/local
diff --git a/contrib/update-otags.8 b/contrib/update-otags.8
index 34f69af..8fb43fc 100644
--- a/contrib/update-otags.8
+++ b/contrib/update-otags.8
@@ -86,7 +86,8 @@ sources. Most notably,
 .B camlp4
 dies on 
 .I pervasives.mli
-(see bug #5495).
+because it cannot parse block attributes (those starting with
+.I [@@\fR).
 Therefore, none of the core library functions are tagged.
 .\" ============= other syntax ===============================================
 .P
diff --git a/doc/changes.html b/doc/changes.html
index 12c8c11..4146592 100644
--- a/doc/changes.html
+++ b/doc/changes.html
@@ -33,6 +33,17 @@ pre {
  ! - </UL>
   -->
 
+<DT>2016-01-10: otags 4.02.1 released
+<DD>
+<UL>
+<LI>upgrade to OCaml 4.02 (module aliases, exception patterns and
+extensible variants are supported, attributes are not because of
+missing support in camlp4)
+<LI>minor bug fixes
+<P></P>
+</LI>
+</UL>
+
 <DT>2013-09-25: otags 4.01.1 released
 <DD>
 <UL>
@@ -49,6 +60,8 @@ pre {
 </LI>
 </UL>
 
+<!-- RECENT CHANGES END -->
+
 <DT>2012-12-05: otags 4.00.1 released
 <DD>
 <UL>
@@ -58,8 +71,6 @@ pre {
 </LI>
 </UL>
 
-<!-- RECENT CHANGES END -->
-
 <DT>2012-05-23: otags 3.12.5 released
 <DD>
 <UL>
@@ -151,7 +162,7 @@ HREF="http://caml.inria.fr/mantis/view.php?id=5159"; 
>#5159</A>
 <HR noshade size=2>
 <FONT SIZE="-2">
 last changed on 
-<!-- hhmts start -->25 Sep 2013
+<!-- hhmts start -->10 Jan 2016
 <!-- hhmts end -->
 by <A HREF="/index.html.en">Hendrik</A>
 </FONT></BODY> </HTML>
diff --git a/doc/otags.1 b/doc/otags.1
index cad5261..de73cec 100644
--- a/doc/otags.1
+++ b/doc/otags.1
@@ -212,7 +212,11 @@ Apply the parser hints in the specified file. Whenever
 tags a file that appears in a parser hints file, it uses the
 parsers specified there instead of the
 .B current parser list\fR,
-see PARSING HINTS FILES below.
+see PARSING HINTS FILES below. This option can be given multiple
+times to process several hints files. If
+.I file
+is a directory then all files in that tree are processed as parser
+hints files.
 .\" ================ -version ================================================
 .IP -version
 Print version and exit.
@@ -611,21 +615,29 @@ some bug caused a crash, from which
 could only marginally recover
 .\"
 .\" ==========================================================================
-.\" ================ Bugs ====================================================
+.\" ================ KNOWN PROBLEMS ==========================================
 .\" ==========================================================================
 .\"
-.SH BUGS
-.\" ============= parse error on open! =======================================
-.B otags
-dies with a parse error on open!, which was introduced in
+.SH KNOWN PROBLEMS
+The
+.B camlp4
+and
 .B OCaml
-version 4.01.0, but forgotten in
-.B camlp4\fR,
-see bug #6175. For the same reason,
-.B otags
-4.01.1 is likely to cause strange problems when used with an
+parsers differed always in subtle ways. Making
+.B camlp4
+independent of
 .B OCaml
-version that fixes #6175.
+aggravated the problem.
+.B camlp4
+version 4.02.3 only accepts very few attributes. It accepts no block
+or stand alone attributes (those with
+.I [@@
+and
+.I [@@@\fR)
+or extension nodes (
+.I [%
+or
+.I [%%\fR).
 .\"
 .\" ==========================================================================
 .\" ================ Missing Features ========================================
diff --git a/doc/otags.html b/doc/otags.html
index 093a1b3..431b715 100644
--- a/doc/otags.html
+++ b/doc/otags.html
@@ -304,7 +304,12 @@ tags a file that appears in a parser hints file, it uses 
the
 parsers specified there instead of the
 <B>current parser list</B>,
 
-see PARSING HINTS FILES below.
+see PARSING HINTS FILES below. This option can be given multiple
+times to process several hints files. If
+<I>file</I>
+
+is a directory then all files in that tree are processed as parser
+hints files.
 
 <DT>-version<DD>
 Print version and exit.
@@ -842,24 +847,36 @@ could only marginally recover
 
 </DL>
 <A NAME="lbAL">&nbsp;</A>
-<H2>BUGS</H2>
+<H2>KNOWN PROBLEMS</H2>
 
+The
+<B>camlp4</B>
 
-<B>otags</B>
+and
+<B>OCaml</B>
+
+parsers differed always in subtle ways. Making
+<B>camlp4</B>
 
-dies with a parse error on open!, which was introduced in
+independent of
 <B>OCaml</B>
 
-version 4.01.0, but forgotten in
-<B>camlp4</B>,
+aggravated the problem.
+<B>camlp4</B>
 
-see bug #6175. For the same reason,
-<B>otags</B>
+version 4.02.3 only accepts very few attributes. It accepts no block
+or stand alone attributes (those with
+<I>[@@</I>
 
-4.01.1 is likely to cause strange problems when used with an
-<B>OCaml</B>
+and
+<I>[@@@</I>)
+
+or extension nodes (
+<I>[%</I>
+
+or
+<I>[%%</I>).
 
-version that fixes #6175.
 
 
 
@@ -961,7 +978,7 @@ Hendrik Tews &lt;otags at askra.de&gt;
 <DT><A HREF="#lbAI">STANDARD CAMLP4 PARSING EXTENSIONS</A><DD>
 <DT><A HREF="#lbAJ">DIAGNOSTICS</A><DD>
 <DT><A HREF="#lbAK">EXIT STATUS</A><DD>
-<DT><A HREF="#lbAL">BUGS</A><DD>
+<DT><A HREF="#lbAL">KNOWN PROBLEMS</A><DD>
 <DT><A HREF="#lbAM">MISSING FEATURES</A><DD>
 <DT><A HREF="#lbAN">CREDITS</A><DD>
 <DT><A HREF="#lbAO">AUTHOR</A><DD>
@@ -971,6 +988,6 @@ Hendrik Tews &lt;otags at askra.de&gt;
 This document was created by
 <A HREF="http://www.nongnu.org/man2html/";>man2html</A>,
 using the manual pages.<BR>
-Time: 08:41:36 GMT, September 25, 2013
+Time: 20:07:13 GMT, January 10, 2016
 </BODY>
 </HTML>
diff --git a/make-distribution b/make-distribution
index 55c3368..16fa520 100755
--- a/make-distribution
+++ b/make-distribution
@@ -32,6 +32,7 @@ otags_version=$(./configure -abra-print-version)
 
 if [ $commit_changes = "yes" ] ; then
     echo
+    echo recent change end marker in changes.html on the right spot??
     echo Prepare changes.html for commit?
     echo -n [Y/n]?
     read answer
diff --git a/misc.ml b/misc.ml
index 2333c95..fb77721 100644
--- a/misc.ml
+++ b/misc.ml
@@ -19,7 +19,7 @@
  * along with "Otags reloaded". If not, see
  * <http://www.gnu.org/licenses/>.
  * 
- * $Id: misc.ml,v 1.9 2012/05/21 09:29:29 tews Exp $
+ * $Id: misc.ml,v 1.10 2016/01/06 08:11:19 tews Exp $
  * 
  * some misc functions
  * 
@@ -104,13 +104,8 @@ let cut_out inc start_pos end_pos =
    * this is fixed in 3.12
    * let end_pos = min end_pos (in_channel_length inc) in
    *)
-  let len = end_pos - start_pos in
-  (* Printf.eprintf "CUTOUT %d %d %d\n%!" start_pos end_pos len; *)
-  let buf = String.create len
-  in
-    seek_in inc start_pos;
-    really_input inc buf 0 len;
-    buf
+  seek_in inc start_pos;
+  really_input_string inc (end_pos - start_pos)
 
 
 let input_line_at ic pos =
diff --git a/parser_hints.ml b/parser_hints.ml
index 61bc9c9..1f1ab4a 100644
--- a/parser_hints.ml
+++ b/parser_hints.ml
@@ -19,7 +19,7 @@
  * along with "Otags reloaded". If not, see
  * <http://www.gnu.org/licenses/>.
  * 
- * $Id: parser_hints.ml,v 1.1 2012/05/21 09:29:29 tews Exp $
+ * $Id: parser_hints.ml,v 1.2 2016/01/10 13:27:03 tews Exp $
  * 
  * parser hints functionality
  * 
@@ -109,7 +109,8 @@ and process_parser_hint_dir dir =
        else process_parser_hint (Filename.concat dir entry)
       | None ->
        not_finished := false
-  done
+  done;
+  U.closedir handle
        
 
 let process_parser_hints =
diff --git a/reparse.ml b/reparse.ml
index 1d095eb..f006d8f 100644
--- a/reparse.ml
+++ b/reparse.ml
@@ -19,7 +19,7 @@
  * along with "Otags reloaded". If not, see
  * <http://www.gnu.org/licenses/>.
  * 
- * $Id: reparse.ml,v 1.14 2012/01/23 14:27:30 tews Exp $
+ * $Id: reparse.ml,v 1.15 2013/10/01 08:04:16 tews Exp $
  * 
  * location-parsing hack for those ast nodes that do not provide
  * sufficient location info
@@ -148,10 +148,14 @@ let rec word_forward buf start_buf pos =
 
 
 let rec space_forward buf start_buf pos = 
-  match buf.[pos.Lexing.pos_cnum - start_buf] with
-    | ' ' | '\t' -> space_forward buf start_buf (incr_pos pos)
-    | '\n' -> space_forward buf start_buf (incr_line pos)
-    | _ -> pos
+  if pos.Lexing.pos_cnum - start_buf >= String.length buf
+  then (* leave buffer at the left hand side *)
+    pos
+  else
+    match buf.[pos.Lexing.pos_cnum - start_buf] with
+      | ' ' | '\t' -> space_forward buf start_buf (incr_pos pos)
+      | '\n' -> space_forward buf start_buf (incr_line pos)
+      | _ -> pos
 
 
 let rec word_backward buf start_buf buf_start pos =
diff --git a/tags.ml b/tags.ml
index 18cb14b..3d7913b 100644
--- a/tags.ml
+++ b/tags.ml
@@ -19,7 +19,7 @@
  * along with "Otags reloaded". If not, see
  * <http://www.gnu.org/licenses/>.
  * 
- * $Id: tags.ml,v 1.29 2012/12/05 09:29:31 tews Exp $
+ * $Id: tags.ml,v 1.32 2016/01/08 21:46:24 tews Exp $
  * 
  * recursive tagging function
  * 
@@ -40,6 +40,25 @@ let empty_str_ast = Struct_ast(<:str_item@no_loc< >>)
 
 (******************************************************************************
  *
+ **********************   utility functions   *********************************
+ *
+ 
******************************************************************************)
+
+
+(** returns the first string of ident, return something arbitrary if 
+    the first element of the ident is an antiquotation.
+*)
+let rec first_string_of_ident = function
+  | <:ident< $x$ . $_$ >>
+  | <:ident< $x$ $_$ >> -> first_string_of_ident x
+  | <:ident< $lid:x$ >> -> x
+  | <:ident< $uid:x$ >> -> x
+  | <:ident< $anti:_$ >> -> "xxx"
+                            
+
+
+(******************************************************************************
+ *
  **********************   tagging functions   *********************************
  *
  
******************************************************************************)
@@ -101,6 +120,13 @@ let rec tag_type write_tag typ = match typ with
       | _ -> assert false
     );
     tag_type write_tag type_def
+  | Ast.TyExt(_loc, id, _param_list, type_def) ->
+     (* For wellformed input, id is just a lowercase ident. I make
+      * this work even if id is something else (and the input is invalid).
+      *)
+     write_tag (translate_loc (Ast.loc_of_ident id))
+              (first_string_of_ident id);
+     tag_type write_tag type_def
   | <:ctyp< $_t1$ == $t2$ >> -> 
     (* don't tag t1, its the abbreviation *)
     tag_type write_tag t2
@@ -113,6 +139,14 @@ let rec tag_type write_tag typ = match typ with
     List.iter
       (tag_record_label_decl write_tag)
       (Ast.list_of_ctyp t [])
+  | Ast.TyAtt(_loc, _attr, _payload, t) ->
+     (* In 4.02 camlp4 does not parse item attributes "[@@foo]" that can be
+      * attachted to whole type definitions. In the future they may appear in
+      * t as TyAtt node wrapped around a variant type. Therefore I recurse
+      * here. In 4.02 t may contain a TyAtt, but only for type equations 
+      * (type a = int [@foo]), for which recursion would not be necessary.
+      *)
+     tag_type write_tag t
 
   | <:ctyp< $tup:_$ >>                 (* tuple *)
   | <:ctyp< [= $_$ ] >>                        (* exact variant type *)
@@ -134,6 +168,7 @@ let rec tag_type write_tag typ = match typ with
   | <:ctyp< $_$ -> $_$ >>
   | <:ctyp< $_$ $_$ >>                 (* type constructor application *)
   | <:ctyp< $_$ as $_$ >>
+  | <:ctyp< .. >>                      (* empty extensible type *)
   | <:ctyp< >>
     -> ()
 
@@ -254,7 +289,13 @@ and tag_class_type write_tag = function
     List.iter
       (tag_class_sig_item write_tag)
       (Ast.list_of_class_sig_item ci [])
-
+  | Ast.CtAtt(_loc, _attr, _payload, ct) ->
+     (* AFAICT there is no camlp4 grammar production constructing CtAtt.
+      * Nevertheless, I would expect CtAtt to be wrapped around class types as
+      * in "class ca = (object end : object end [@foo])", therefore I recurse.
+      *)
+     tag_class_type write_tag ct
+     
   | <:class_type< $virtual:_$ $id:_$ [ $_$] >> 
     (* class id somewhere on the right hand side *)
     -> ()
@@ -285,7 +326,10 @@ let rec tag_sig_item write_tag sig_item = match sig_item 
with
     write_tag id_loc id
   | <:sig_item< module $id$ : $mt$ >> -> 
     (* missing location info for the identifier: See #5147.
-     * we need the second word 
+     * we need the second word
+     *
+     * This case does also match module aliases "module A = B", 
+     * the module type is then a module alias.
      *)
     let wrong_id_loc = translate_loc (Ast.loc_of_sig_item sig_item) in
     write_tag (Reparse.loc_of_second_word wrong_id_loc) id;
@@ -311,6 +355,12 @@ let rec tag_sig_item write_tag sig_item = match sig_item 
with
      * for infix identifiers.
      *)
     let wrong_id_loc = translate_loc (Ast.loc_of_sig_item sig_item) in
+    (* 
+     * Printf.eprintf "SIGVAL %s %s -> %s\n%!" 
+     *   id
+     *   (Source_channel.full_string_of_loc (Ast.loc_of_sig_item sig_item))
+     *   (Source_channel.full_string_of_loc wrong_id_loc);
+     *)
     let loc_without_val = Reparse.loc_without_first_word wrong_id_loc in
     let id_loc = match Reparse.start_char loc_without_val with
       | '(' -> Reparse.loc_inside_parens loc_without_val
@@ -330,7 +380,7 @@ let rec tag_sig_item write_tag sig_item = match sig_item 
with
       (tag_module_sig_binding write_tag)
       (Ast.list_of_module_binding mb [])
 
-  | <:sig_item< open $_$ >> 
+  | Ast.SgOpn _                        (* open x, open! x *)
   | <:sig_item< include $_$ >>
     -> ()
 
@@ -348,6 +398,7 @@ and tag_module_sig_binding write_tag mod_binding = match 
mod_binding with
      *)
     let wrong_id_loc = translate_loc (Ast.loc_of_module_binding mod_binding) in
     write_tag (Reparse.loc_of_first_word wrong_id_loc) id;
+
     tag_module_type write_tag mtyp
 
   | <:module_binding< >>
@@ -372,10 +423,23 @@ and tag_module_type write_tag = function
     List.iter 
       (tag_sig_item write_tag)
       (Ast.list_of_sig_item sig_items [])
+  | Ast.MtAtt(_loc, _attr, _payload, mt) ->
+     (* AFAICT there is no camlp4 grammar production constructing MtAtt.
+      * Nevertheless, I would expect MtAtt to be wrapped around signature
+      * types as in "module type A = sig end [@foo]", therefore I recurse.
+      *)
+     tag_module_type write_tag mt
 
   | <:module_type< >>                  (* emty module type ast *)
   | <:module_type< ' $_$ >>            (* ??? MtQuo ??? *)
   | <:module_type< module type of $_$ >>
+  | <:module_type< (module $id:_$) >>
+      (* module alias as module type; for a module alias in signatures 
+       * "module A = B", the A actually matches 
+       * <:sig_item< module $id$ : $mt$ >> and the mt then matches this 
+       * case. Camlp4 also accepts "functor (A : (module B)) -> ..." 
+       * but ocaml does not.
+       *)
     -> ()
 
   | <:module_type< $anti:_$ >>         (* anti quotations *)
@@ -487,6 +551,12 @@ and tag_class_expr write_tag = function
     tag_class_expr write_tag ce;
     (* ct can contain an object body, therefore tag it *)
     tag_class_type write_tag ct
+  | Ast.CeAtt(_loc, _attr, _payload, ce) ->
+     (* AFAICT there is no camlp4 grammar production constructing CeAtt.
+      * Nevertheless, I would expect CeAtt to be wrapped around classes
+      * as in "class a = object end [@foo]", therefore I recurse.
+      *)
+     tag_class_expr write_tag ce
 
   | <:class_expr< $virtual:_$ $id:_$ [ $_$ ] >>
     (* id on the right hand side -- ignore *)
@@ -559,6 +629,19 @@ let rec tag_let_pattern write_tag = function
     )
   | <:patt< ($p1$ : $_$) >> ->
     tag_let_pattern write_tag p1
+  | Ast.PaAtt(_loc, _attr, _payload, p) ->
+     (* Attributes can be wrapped around patterns, 
+      * eg "let x [@foo] = ..."
+      *)
+     tag_let_pattern write_tag p
+  | <:patt< exception $p$>> ->
+     (* Exception patterns are only permitted in proper matches with at 
+      * least 2 cases and not in let bindings. However, camlp4 parses 
+      * exception patterns in let bindings and only the type checker 
+      * gives an error on them. Therefore, do something here on exceptions 
+      * patterns.
+      *)
+     tag_let_pattern write_tag p
 
   | <:patt< $chr:_$ >>
   | <:patt< $int:_$ >>
@@ -590,7 +673,6 @@ let rec tag_let_pattern write_tag = function
     -> assert false
 
 
-
 let rec tag_str_item write_tag str_item = match str_item with
   | <:str_item< exception $exid$ >> 
   | <:str_item< exception $exid$ = $_$ >> ->
@@ -651,7 +733,7 @@ let rec tag_str_item write_tag str_item = match str_item 
with
       (Ast.list_of_module_binding mb [])
 
 
-  | <:str_item< open $_$ >>
+  | Ast.StOpn _                        (* open x, open! x *)
   | <:str_item< include $_$ >>
   | <:str_item< $exp:_$ >>
   | <:str_item< # $_$ $_$ >>           (* directive *)
@@ -693,6 +775,12 @@ and tag_module_expr write_tag = function
     List.iter
       (tag_str_item write_tag)
       (Ast.list_of_str_item str_items [])
+  | Ast.MeAtt(_loc, _attr, _payload, me) ->
+     (* AFAICT there is no camlp4 grammar production constructing MeAtt.
+      * Nevertheless, I would expect MeAtt to be wrapped around signature
+      * types as in "module A = struct end [@foo]", therefore I recurse.
+      *)
+     tag_module_expr write_tag me
 
   | <:module_expr< $_$ $_$ >>          (* XXX check and probably tag this *)
   | <:module_expr< $id:_$ >>
diff --git a/test/a.ml b/test/a.ml
index d30430c..74f485e 100644
--- a/test/a.ml
+++ b/test/a.ml
@@ -195,6 +195,20 @@ let rec a88_eval : type a. a a87_term -> a = function
   | App(f,x) -> (a88_eval f) (a88_eval x)
 
 
+type a89 = ..
+
+type a89 += A90 of int * string
+
+type a89 += A91
+
+let a90 [@foo "bar"] = 5
+
+let (a91, a92 [@foo 55]) = (3,4)
+
+let (a93 [@foo 55], a94) = (3,4)
+
+let (  or ) l1 l2 = l1 @ l2
+
 (*** Local Variables: ***)
 (*** compile-command: "make -C .. testtrue" ***)
 (*** End: ***)
diff --git a/test/c.mli b/test/c.mli
index beff357..7f66952 100644
--- a/test/c.mli
+++ b/test/c.mli
@@ -28,6 +28,15 @@ end
 
 module type c13
 
+module C4 = C3
+
+type c5 = ..
+
+type c5 += C6 of int * string
+
+type c5 += C7
+             
+
 (*** Local Variables: ***)
 (*** compile-command: "make -C .. test" ***)
 (*** End: ***)
diff --git a/test/g.mli b/test/g.mli
new file mode 100644
index 0000000..18d7346
--- /dev/null
+++ b/test/g.mli
@@ -0,0 +1 @@
+type t with sexp
diff --git a/test/test.TAGS b/test/test.TAGS
index 6eec9e7..e26fbcb 100644
--- a/test/test.TAGS
+++ b/test/test.TAGS
@@ -1,4 +1,10 @@
 
+test/g.mli,62
+G1,0
+type tt1,0
+type tt_of_sexp1,0
+type tsexp_of_t1,0
+
 test/f.ml,149
 F1,0
 type tt1,0
@@ -8,7 +14,7 @@ type t = A | B__t_of_sexp__1,0
 type t = A | Bt_of_sexp1,0
 type t = A | Bsexp_of_t1,0
 
-test/a.ml,2559
+test/a.ml,2834
 A1,0
 let a0a02,1
 let f0f04,13
@@ -108,6 +114,17 @@ type 'a a87_terma87_term187,2623
   | AddAdd189,2672
   | AppApp190,2711
 let rec a88_evala88_eval192,2771
+type a89a89198,2920
+type a89a89200,2935
+type a89 += A90A90200,2935
+type a89a89202,2968
+type a89 += A91A91202,2968
+let a90a90204,2985
+let (a91a91206,3011
+let (a91, a92a92206,3011
+let (a93a93208,3045
+let (a93 [@foo 55], a94a94208,3045
+let (  oror210,3079
 
 test/b.ml,67
 B1,0
@@ -172,7 +189,7 @@ let ccp_h_accp_h_a2,1
 test/cpp_h.generated.ml,21
 Cpp_h.generated1,0
 
-test/c.mli,332
+test/c.mli,454
 C1,0
 val c0c02,1
 exception C1C14,15
@@ -189,6 +206,12 @@ module rec C9C924,224
 and C11C1125,243
   type c12c1226,257
 module type c13c1329,273
+module C4C431,290
+type c5c533,306
+type c5c535,320
+type c5 += C6C635,320
+type c5c537,351
+type c5 += C7C737,351
 
 test/e.mli,420
 E1,0
diff --git a/test/test.tags b/test/test.tags
index 79c4902..b0bbdf8 100644
--- a/test/test.tags
+++ b/test/test.tags
@@ -40,6 +40,8 @@ A83   test/a.ml       /^and A83 : sig $/;
 A85    test/a.ml       /^module type A85 = sig end$/;
 A86    test/a.ml       /^module A86 = (val (module struct end : A85) : A85)$/;
 A9     test/a.ml       /^exception A9 = A8$/;
+A90    test/a.ml       /^type a89 += A90 of int * string$/;
+A91    test/a.ml       /^type a89 += A91$/;
 Add    test/a.ml       /^  | Add : (int -> int -> int) a87_term$/;
 App    test/a.ml       /^  | App : ('b -> 'a) a87_term * 'b a87_term -> 'a 
a87_term$/;
 B      test/b.ml       1;
@@ -53,6 +55,9 @@ C1    test/c.mli      /^exception C1$/;
 C11    test/c.mli      /^and C11 : sig$/;
 C3     test/c.mli      /^module C3 : Map.S$/;
 C4     test/c.mli      /^module type C4 = sig$/;
+C4     test/c.mli      /^module C4 = C3$/;
+C6     test/c.mli      /^type c5 += C6 of int * string$/;
+C7     test/c.mli      /^type c5 += C7$/;
 C9     test/c.mli      /^module rec C9 : C4$/;
 Cpp_h.generated        test/cpp_h.generated.ml 1;
 Cpp_i.generated        test/cpp_i.generated.ml 1;
@@ -61,6 +66,7 @@ E     test/e.mli      1;
 END    test/d.ml       /^module type END = sig $/;
 END    test/e.mli      /^module type END = sig $/;
 F      test/f.ml       1;
+G      test/g.mli      1;
 Int    test/a.ml       /^  | Int : int -> int a87_term$/;
 Modu   test/d.ml       /^module Modu =$/;
 No_value       test/d.ml       /^exception No_value$/;
@@ -119,6 +125,14 @@ a84        test/a.ml       /^  val a84 : int $/;
 a84    test/a.ml       /^  let a84 = 5$/;
 a87_term       test/a.ml       /^type 'a a87_term =$/;
 a88_eval       test/a.ml       /^let rec a88_eval : type a. a a87_term -> a = 
function$/;
+a89    test/a.ml       /^type a89 = ..$/;
+a89    test/a.ml       /^type a89 += A90 of int * string$/;
+a89    test/a.ml       /^type a89 += A91$/;
+a90    test/a.ml       /^let a90 [@foo "bar"] = 5$/;
+a91    test/a.ml       /^let (a91, a92 [@foo 55]) = (3,4)$/;
+a92    test/a.ml       /^let (a91, a92 [@foo 55]) = (3,4)$/;
+a93    test/a.ml       /^let (a93 [@foo 55], a94) = (3,4)$/;
+a94    test/a.ml       /^let (a93 [@foo 55], a94) = (3,4)$/;
 a_type test/d.ml       /^type a_type = $/;
 add    test/d.ml       /^  method add n = match r with$/;
 b      test/d.ml       /^type b = {g:int;           rr:int}$/;
@@ -134,6 +148,9 @@ c12 test/c.mli      /^  type c12$/;
 c13    test/c.mli      /^module type c13$/;
 c2     test/c.mli      /^external c2 : int -> int = "c2"$/;
 c5     test/c.mli      /^  type c5$/;
+c5     test/c.mli      /^type c5 = ..$/;
+c5     test/c.mli      /^type c5 += C6 of int * string$/;
+c5     test/c.mli      /^type c5 += C7$/;
 c6     test/c.mli      /^type c6$/;
 c7     test/c.mli      /^type 'aaaa c7$/;
 c8     test/c.mli      /^type ('aaaa, 'bbbbbb) c8$/;
@@ -173,6 +190,7 @@ int_value1  test/e.mli      /^class ['a] int_value1 : 
object $/;
 int_value2     test/e.mli      /^class type ['a] int_value2 = object $/;
 int_value3     test/e.mli      /^class ['a] int_value3 : 'a -> object $/;
 mof    test/d.ml       /^  struct let mof = 3 end$/;
+or     test/a.ml       /^let (  or ) l1 l2 = l1 @ l2$/;
 r      test/d.ml       /^  val mutable r = init;$/;
 r      test/e.mli      /^  val mutable r : 'a $/;
 r      test/e.mli      /^  val mutable r : 'a $/;
@@ -183,8 +201,11 @@ set        test/e.mli      /^  method set : 'a -> unit$/;
 set    test/e.mli      /^  method set : 'a -> unit$/;
 set    test/e.mli      /^  method set : 'a -> unit$/;
 sexp_of_t      test/f.ml       /^type t = A | B with sexp$/;
+sexp_of_t      test/g.mli      /^type t with sexp$/;
 t      test/f.ml       /^type t = A | B with sexp$/;
+t      test/g.mli      /^type t with sexp$/;
 t_of_sexp      test/f.ml       /^type t = A | B with sexp$/;
+t_of_sexp      test/g.mli      /^type t with sexp$/;
 tx     test/a.ml       /^  type tx$/;
 tx     test/a.ml       /^    type tx = int$/;
 tx     test/a.ml       /^  type tx = int$/;
diff --git a/util/dump-camlp4.ml b/util/dump-camlp4.ml
index ca2ebcf..b5931f6 100644
--- a/util/dump-camlp4.ml
+++ b/util/dump-camlp4.ml
@@ -101,9 +101,8 @@ let loc_printer =
  *      (if Loc.is_ghost loc then " GHOST" else " REAL");;
  * #install_printer loc_printer;;
  * open Camlp4.PreCast.Ast;;
- * let buf = String.create 14
  * let ic = open_in "../camlp4-dump";;
- * really_input ic buf 0 14;
+ * ignore(really_input_string ic 14);   (* cut-off tag in first 14 bytes *)
  * (input_value ic : Ast.str_item);;
  *)
 
@@ -120,11 +119,10 @@ let input =
   (* #directory "+compiler-libs";; *)
   "#install_printer loc_printer;;
    open Camlp4.PreCast.Ast;;
-   let buf = String.create 14 in
    let ic = open_in \""
     ^ ast_file ^
    "\" in
-   really_input ic buf 0 14;
+   ignore(really_input_string ic 14);
    (input_value ic : Ast."
     ^
     (if !parse_impl then "str_item"
@@ -142,5 +140,5 @@ Sys.command ocaml_command
 
 
 (*** Local Variables: ***)
-(*** compile-command: "ocamlopt.opt dump-camlp4.ml -o dump-camlp4" ***)
+(*** compile-command: "ocamlopt.opt -safe-string dump-camlp4.ml -o 
dump-camlp4" ***)
 (*** End: ***)
diff --git a/vi.ml b/vi.ml
index fb28945..548b54b 100644
--- a/vi.ml
+++ b/vi.ml
@@ -19,7 +19,7 @@
  * along with "Otags reloaded". If not, see
  * <http://www.gnu.org/licenses/>.
  * 
- * $Id: vi.ml,v 1.9 2012/01/26 13:16:19 tews Exp $
+ * $Id: vi.ml,v 1.10 2016/01/06 08:11:19 tews Exp $
  * 
  * write vi tags files
  * 
@@ -98,20 +98,20 @@ let ex_search_escape s =
   done;
   if len = !n then s
   else
-    let new_s = String.create !n in
+    let new_s = Bytes.create !n in
     let j = ref 0 in
     for i = 0 to len - 1 do
       match s.[i] with
        | '/' -> 
-         new_s.[!j] <- '\\'; incr j;
-         new_s.[!j] <- '/'; incr j
+         Bytes.set new_s !j '\\'; incr j;
+         Bytes.set new_s !j '/'; incr j
        | '\\' ->
-         new_s.[!j] <- '\\'; incr j;
-         new_s.[!j] <- '\\'; incr j
+         Bytes.set new_s !j '\\'; incr j;
+         Bytes.set new_s !j '\\'; incr j
        | c ->
-         new_s.[!j] <- c; incr j
+         Bytes.set new_s !j c; incr j
     done;
-    new_s
+    Bytes.to_string new_s
   
 
 let ex_search_line line = 

-- 
Alioth's /usr/local/bin/git-commit-notice on 
/srv/git.debian.org/git/pkg-ocaml-maint/packages/otags.git

_______________________________________________
Pkg-ocaml-maint-commits mailing list
Pkg-ocaml-maint-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-ocaml-maint-commits

Reply via email to