[Pkg-ocaml-maint-commits] [otags] 01/07: Imported Upstream version 4.02.1
Mehdi Dogguy
mehdi at moszumanska.debian.org
Sat Jan 16 16:00:25 UTC 2016
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 <mehdi at 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 <otags at askra.de>
+
+ * prepare doc/changes.html for release
+
+2016-01-10 Hendrik Tews <Hendrik.Tews at FireEye.com>
+
+ * add check question in make-distribution
+
+2016-01-10 Hendrik Tews <Hendrik.Tews at FireEye.com>
+
+ * move recent changes end marker
+
+2016-01-10 Hendrik Tews <Hendrik.Tews at FireEye.com>
+
+ * update changes.html
+
+2016-01-10 Hendrik Tews <Hendrik.Tews at FireEye.com>
+
+ * update update-otags man page
+
+2016-01-10 Hendrik Tews <Hendrik.Tews at FireEye.com>
+
+ * test infix or
+
+2016-01-10 Hendrik Tews <Hendrik.Tews at FireEye.com>
+
+ * fix otags man page
+
+2016-01-10 Hendrik Tews <Hendrik.Tews at FireEye.com>
+
+ * close dir handles for parser hints dir trees
+
+2016-01-08 Hendrik Tews <Hendrik.Tews at FireEye.com>
+
+ * make dump-camlp4 string safe
+
+2016-01-08 Hendrik Tews <Hendrik.Tews at FireEye.com>
+
+ * update testcases
+
+2016-01-06 Hendrik Tews <Hendrik.Tews at FireEye.com>
+
+ * move to -save-string
+
+2016-01-05 Hendrik Tews <Hendrik.Tews at FireEye.com>
+
+ * adapt to ocaml 4.02: module aliases, attributes,
+ exception patterns, extensible variants
+
+2013-10-01 Hendrik Tews <tews at os.inf.tu-dresden.de>
+
+ * fix mli reparsing problem with sexplib
+
+2013-09-25 Hendrik Tews <otags at askra.de>
+
+ * release version 4.01.1 on 2013-09-25 08:50:31 UTC
+
2013-09-25 Hendrik Tews <otags at 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"> </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 <otags at askra.de>
<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 <otags at askra.de>
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 at 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
More information about the Pkg-ocaml-maint-commits
mailing list