XS: new parrser

Signed-off-by: Masatake YAMATO <[email protected]>

Tmain/extras-long.d/run.sh

@@ -3,22 +3,27 @@
 
 CTAGS=$1
 
+ignore_pcre2()
+{
+	grep -v 'XS'
+}
+
 echo '# resetting'
 ${CTAGS} --quiet --options=NONE --with-list-header=no \
-	 --extras='{subparser}' --list-extras
+	 --extras='{subparser}' --list-extras | ignore_pcre2
 
 echo '# enabling 1'
 ${CTAGS} --quiet --options=NONE --with-list-header=no \
-	 --extras=+'{pseudo}' --list-extras
+	 --extras=+'{pseudo}' --list-extras | ignore_pcre2
 
 echo '# disabling 1'
 ${CTAGS} --quiet --options=NONE --with-list-header=no \
-	 --extras=-'{fileScope}' --list-extras
+	 --extras=-'{fileScope}' --list-extras | ignore_pcre2
 
 echo '# combination'
 ${CTAGS} --quiet --options=NONE --with-list-header=no \
-	 --extras=-'{fileScope}+{inputFile}{reference}' --list-extras
+	 --extras=-'{fileScope}+{inputFile}{reference}' --list-extras | ignore_pcre2
 
 echo '# combination with letters'
 ${CTAGS} --quiet --options=NONE --with-list-header=no \
-	 --extras=-'{fileScope}+p{inputFile}q{reference}-f' --list-extras
+	 --extras=-'{fileScope}+p{inputFile}q{reference}-f' --list-extras | ignore_pcre2

Tmain/list-roles.d/run.sh

@@ -23,6 +23,11 @@ ignore_yaml()
     grep -v 'Yaml'
 }
 
+ignore_pcre2()
+{
+	grep -v 'XS'
+}
+
 # When introducing newly rewritten parser, we would like to provide
 # the both new parser and old parser for debugging and providing
 # migration period to users. In such case the prefix "Old" will be
@@ -34,16 +39,16 @@ ignore_old()
 }
 
 title ''
-${CTAGS} --quiet --options=NONE --list-roles= | ignore_xml | ignore_old | ignore_yaml
+${CTAGS} --quiet --options=NONE --list-roles= | ignore_xml | ignore_old | ignore_yaml | ignore_pcre2
 
 title 'all.*'
-${CTAGS} --quiet --options=NONE --list-roles='all.*' | ignore_xml | ignore_old | ignore_yaml
+${CTAGS} --quiet --options=NONE --list-roles='all.*' | ignore_xml | ignore_old | ignore_yaml | ignore_pcre2
 
 title 'C.*'
 ${CTAGS} --quiet --options=NONE --list-roles='C.*'
 
 title 'all.d'
-${CTAGS} --quiet --options=NONE --list-roles='all.d' | ignore_xml | ignore_old | ignore_yaml
+${CTAGS} --quiet --options=NONE --list-roles='all.d' | ignore_xml | ignore_old | ignore_yaml | ignore_pcre2
 
 title 'Sh.s'
 ${CTAGS} --quiet --options=NONE --list-roles='Sh.s'

Units/parser-xs.r/no-noprefix.d/args.ctags

@@ -0,0 +1,2 @@
+--sort=no
+--extras-XS=-{noprefix}

Units/parser-xs.r/no-noprefix.d/expected.tags

@@ -0,0 +1,3 @@
+X	input.xs	/^MODULE = X	PACKAGE = X	PREFIX = xyz_$/;"	m
+X	input.xs	/^MODULE = X	PACKAGE = X	PREFIX = xyz_$/;"	p	module:X
+xyz_f	input.xs	/^xyz_f(dbtype)$/;"	f	package:X.X	typeref:typename:void

Units/parser-xs.r/no-noprefix.d/features

@@ -0,0 +1 @@
+pcre2

Units/parser-xs.r/no-noprefix.d/input.xs

@@ -0,0 +1,5 @@
+MODULE = X	PACKAGE = X	PREFIX = xyz_
+
+void
+xyz_f(dbtype)
+	char *		dbtype

Units/parser-xs.r/pod.d/args.ctags

@@ -0,0 +1,3 @@
+--sort=no
+--extras=+g
+--fields=+Sl

Units/parser-xs.r/pod.d/expected.tags

@@ -0,0 +1,6 @@
+XS::Typemap	input.xs	/^MODULE = XS::Typemap   PACKAGE = XS::Typemap$/;"	m	language:XS
+XS::Typemap	input.xs	/^MODULE = XS::Typemap   PACKAGE = XS::Typemap$/;"	p	language:XS	module:XS::Typemap
+T_SV	input.xs	/^T_SV( sv )$/;"	f	language:XS	package:XS::Typemap.XS::Typemap	typeref:typename:SV *	signature:(SV * sv)
+T_SVREF	input.xs	/^T_SVREF( svref )$/;"	f	language:XS	package:XS::Typemap.XS::Typemap	typeref:typename:SVREF	signature:(SVREF svref)
+intArrayPtr	input.xs	/^intArray * intArrayPtr( int nelem ) {$/;"	f	language:C	typeref:typename:intArray *	signature:(int nelem)
+TYPEMAPS	input.xs	/^=head1 TYPEMAPS$/;"	c	language:Pod

Units/parser-xs.r/pod.d/features

@@ -0,0 +1 @@
+pcre2

Units/parser-xs.r/pod.d/input.xs

@@ -0,0 +1,59 @@
+/* Taken from perl-5.10.1/ext/XS-Typemap/Typemap.xs */
+
+/* T_ARRAY - allocate some memory */
+intArray * intArrayPtr( int nelem ) {
+    intArray * array;
+    Newx(array, nelem, intArray);
+    return array;
+}
+
+
+MODULE = XS::Typemap   PACKAGE = XS::Typemap
+
+PROTOTYPES: DISABLE
+
+=head1 TYPEMAPS
+
+Each C type is represented by an entry in the typemap file that
+is responsible for converting perl variables (SV, AV, HV and CV) to
+and from that type.
+
+=over 4
+
+=item T_SV
+
+This simply passes the C representation of the Perl variable (an SV*)
+in and out of the XS layer. This can be used if the C code wants
+to deal directly with the Perl variable.
+
+=cut
+
+SV *
+T_SV( sv )
+  SV * sv
+ CODE:
+  /* create a new sv for return that is a copy of the input
+     do not simply copy the pointer since the SV will be marked
+     mortal by the INPUT typemap when it is pushed back onto the stack */
+  RETVAL = sv_mortalcopy( sv );
+  /* increment the refcount since the default INPUT typemap mortalizes
+     by default and we don't want to decrement the ref count twice
+     by mistake */
+  SvREFCNT_inc(RETVAL);
+ OUTPUT:
+  RETVAL
+
+=item T_SVREF
+
+Used to pass in and return a reference to an SV.
+
+=cut
+
+SVREF
+T_SVREF( svref )
+  SVREF svref
+ CODE:
+  RETVAL = svref;
+ OUTPUT:
+  RETVAL
+

Units/parser-xs.r/simple-xs.d/args.ctags

@@ -0,0 +1,4 @@
+--sort=no
+--extras=+g
+--extras=+r
+--fields=+rSE

Units/parser-xs.r/simple-xs.d/expected.tags

@@ -0,0 +1,60 @@
+SDBM_File	input.xs	/^MODULE = SDBM_File	PACKAGE = SDBM_File	PREFIX = sdbm_$/;"	m	roles:def
+SDBM_File	input.xs	/^MODULE = SDBM_File	PACKAGE = SDBM_File	PREFIX = sdbm_$/;"	p	module:SDBM_File	roles:def
+sdbm_TIEHASH	input.xs	/^sdbm_TIEHASH(dbtype, filename, flags, mode, pagname=NULL)$/;"	f	package:SDBM_File.SDBM_File	typeref:typename:SDBM_File	signature:(char * dbtype,char * filename,int flags,int mode,char * pagname)	roles:def
+TIEHASH	input.xs	/^sdbm_TIEHASH(dbtype, filename, flags, mode, pagname=NULL)$/;"	f	package:SDBM_File.SDBM_File	typeref:typename:SDBM_File	signature:(char * dbtype,char * filename,int flags,int mode,char * pagname)	roles:def	extras:noprefix
+sdbm_DESTROY	input.xs	/^sdbm_DESTROY(db)$/;"	f	package:SDBM_File.SDBM_File	typeref:typename:void	signature:(SDBM_File db)	roles:def
+DESTROY	input.xs	/^sdbm_DESTROY(db)$/;"	f	package:SDBM_File.SDBM_File	typeref:typename:void	signature:(SDBM_File db)	roles:def	extras:noprefix
+sdbm_FETCH	input.xs	/^sdbm_FETCH(db, key)$/;"	f	package:SDBM_File.SDBM_File	typeref:typename:datum_value	signature:(SDBM_File db,datum_key key)	roles:def
+FETCH	input.xs	/^sdbm_FETCH(db, key)$/;"	f	package:SDBM_File.SDBM_File	typeref:typename:datum_value	signature:(SDBM_File db,datum_key key)	roles:def	extras:noprefix
+sdbm_STORE	input.xs	/^sdbm_STORE(db, key, value, flags = DBM_REPLACE)$/;"	f	package:SDBM_File.SDBM_File	typeref:typename:int	signature:(SDBM_File db,datum_key key,datum_value value,int flags)	roles:def
+STORE	input.xs	/^sdbm_STORE(db, key, value, flags = DBM_REPLACE)$/;"	f	package:SDBM_File.SDBM_File	typeref:typename:int	signature:(SDBM_File db,datum_key key,datum_value value,int flags)	roles:def	extras:noprefix
+sdbm_DELETE	input.xs	/^sdbm_DELETE(db, key)$/;"	f	package:SDBM_File.SDBM_File	typeref:typename:int	signature:(SDBM_File db,datum_key key)	roles:def
+DELETE	input.xs	/^sdbm_DELETE(db, key)$/;"	f	package:SDBM_File.SDBM_File	typeref:typename:int	signature:(SDBM_File db,datum_key key)	roles:def	extras:noprefix
+sdbm_EXISTS	input.xs	/^sdbm_EXISTS(db,key)$/;"	f	package:SDBM_File.SDBM_File	typeref:typename:int	signature:(SDBM_File db,datum_key key)	roles:def
+EXISTS	input.xs	/^sdbm_EXISTS(db,key)$/;"	f	package:SDBM_File.SDBM_File	typeref:typename:int	signature:(SDBM_File db,datum_key key)	roles:def	extras:noprefix
+sdbm_FIRSTKEY	input.xs	/^sdbm_FIRSTKEY(db)$/;"	f	package:SDBM_File.SDBM_File	typeref:typename:datum_key	signature:(SDBM_File db)	roles:def
+FIRSTKEY	input.xs	/^sdbm_FIRSTKEY(db)$/;"	f	package:SDBM_File.SDBM_File	typeref:typename:datum_key	signature:(SDBM_File db)	roles:def	extras:noprefix
+sdbm_NEXTKEY	input.xs	/^sdbm_NEXTKEY(db, key)$/;"	f	package:SDBM_File.SDBM_File	typeref:typename:datum_key	signature:(SDBM_File db)	roles:def
+NEXTKEY	input.xs	/^sdbm_NEXTKEY(db, key)$/;"	f	package:SDBM_File.SDBM_File	typeref:typename:datum_key	signature:(SDBM_File db)	roles:def	extras:noprefix
+sdbm_error	input.xs	/^sdbm_error(db)$/;"	f	package:SDBM_File.SDBM_File	typeref:typename:int	signature:(SDBM_File db)	roles:def
+error	input.xs	/^sdbm_error(db)$/;"	f	package:SDBM_File.SDBM_File	typeref:typename:int	signature:(SDBM_File db)	roles:def	extras:noprefix
+sdbm_clearerr	input.xs	/^	sdbm_clearerr = 1$/;"	a	function:SDBM_File.SDBM_File.sdbm_error	roles:def
+filter_fetch_key	input.xs	/^filter_fetch_key(db, code)$/;"	f	package:SDBM_File.SDBM_File	typeref:typename:SV *	signature:(SDBM_File db,SV * code,SV * RETVAL)	roles:def
+SDBM_File::filter_fetch_key	input.xs	/^	SDBM_File::filter_fetch_key = fetch_key$/;"	a	function:SDBM_File.SDBM_File.filter_fetch_key	roles:def
+SDBM_File::filter_store_key	input.xs	/^	SDBM_File::filter_store_key = store_key$/;"	a	function:SDBM_File.SDBM_File.filter_fetch_key	roles:def
+SDBM_File::filter_fetch_value	input.xs	/^	SDBM_File::filter_fetch_value = fetch_value$/;"	a	function:SDBM_File.SDBM_File.filter_fetch_key	roles:def
+SDBM_File::filter_store_value	input.xs	/^	SDBM_File::filter_store_value = store_value$/;"	a	function:SDBM_File.SDBM_File.filter_fetch_key	roles:def
+SDBM_File	input.xs	/^MODULE = SDBM_File	PACKAGE = SDBM_X	PREFIX = sdbm_X_$/;"	m	roles:def
+SDBM_X	input.xs	/^MODULE = SDBM_File	PACKAGE = SDBM_X	PREFIX = sdbm_X_$/;"	p	module:SDBM_File	roles:def
+constants.xs	input.xs	/^INCLUDE: constants.xs$/;"	M	roles:included	extras:reference
+sdbm_X_DELETE0	input.xs	/^sdbm_X_DELETE0(db, key)$/;"	f	package:SDBM_File.SDBM_X	typeref:typename:int	signature:(SDBM_File db,datum_key key)	roles:def
+DELETE0	input.xs	/^sdbm_X_DELETE0(db, key)$/;"	f	package:SDBM_File.SDBM_X	typeref:typename:int	signature:(SDBM_File db,datum_key key)	roles:def	extras:noprefix
+sdbm_X_DELETE1	input.xs	/^sdbm_X_DELETE1(db, key)$/;"	f	package:SDBM_File.SDBM_X	typeref:typename:int	signature:(SDBM_File db,datum_key key)	roles:def
+DELETE1	input.xs	/^sdbm_X_DELETE1(db, key)$/;"	f	package:SDBM_File.SDBM_X	typeref:typename:int	signature:(SDBM_File db,datum_key key)	roles:def	extras:noprefix
+sin0	input.xs	/^sin0()$/;"	f	package:SDBM_File.SDBM_X	typeref:typename:double	signature:()	roles:def
+sin1	input.xs	/^sin1();$/;"	f	package:SDBM_File.SDBM_X	typeref:typename:double	signature:()	roles:def
+PERL_NO_GET_CONTEXT	input.xs	/^#define PERL_NO_GET_CONTEXT$/;"	d	file:	roles:def	extras:fileScope,guest
+EXTERN.h	input.xs	/^#include "EXTERN.h"/;"	h	roles:local	extras:reference,guest
+perl.h	input.xs	/^#include "perl.h"/;"	h	roles:local	extras:reference,guest
+XSUB.h	input.xs	/^#include "XSUB.h"/;"	h	roles:local	extras:reference,guest
+sdbm.h	input.xs	/^#include "sdbm.h"/;"	h	roles:local	extras:reference,guest
+fetch_key	input.xs	/^#define fetch_key /;"	d	file:	roles:def	extras:fileScope,guest
+store_key	input.xs	/^#define store_key /;"	d	file:	roles:def	extras:fileScope,guest
+fetch_value	input.xs	/^#define fetch_value /;"	d	file:	roles:def	extras:fileScope,guest
+store_value	input.xs	/^#define store_value /;"	d	file:	roles:def	extras:fileScope,guest
+__anoned1397e40108	input.xs	/^typedef struct {$/;"	s	file:	roles:def	extras:fileScope,guest,anonymous
+dbp	input.xs	/^	DBM *	dbp ;$/;"	m	struct:__anoned1397e40108	typeref:typename:DBM *	file:	roles:def	extras:fileScope,guest
+filter	input.xs	/^	SV *    filter[4];$/;"	m	struct:__anoned1397e40108	typeref:typename:SV * [4]	file:	roles:def	extras:fileScope,guest
+filtering	input.xs	/^	int     filtering ;$/;"	m	struct:__anoned1397e40108	typeref:typename:int	file:	roles:def	extras:fileScope,guest
+SDBM_File_type	input.xs	/^	} SDBM_File_type;$/;"	t	typeref:struct:__anoned1397e40108	file:	roles:def	extras:fileScope,guest
+SDBM_File	input.xs	/^typedef SDBM_File_type * SDBM_File ;$/;"	t	typeref:typename:SDBM_File_type *	file:	roles:def	extras:fileScope,guest
+datum_key	input.xs	/^typedef datum datum_key ;$/;"	t	typeref:typename:datum	file:	roles:def	extras:fileScope,guest
+datum_value	input.xs	/^typedef datum datum_value ;$/;"	t	typeref:typename:datum	file:	roles:def	extras:fileScope,guest
+sdbm_FETCH	input.xs	/^#define sdbm_FETCH(/;"	d	file:	signature:(db,key)	roles:def	extras:fileScope,guest
+sdbm_STORE	input.xs	/^#define sdbm_STORE(/;"	d	file:	signature:(db,key,value,flags)	roles:def	extras:fileScope,guest
+sdbm_DELETE	input.xs	/^#define sdbm_DELETE(/;"	d	file:	signature:(db,key)	roles:def	extras:fileScope,guest
+sdbm_EXISTS	input.xs	/^#define sdbm_EXISTS(/;"	d	file:	signature:(db,key)	roles:def	extras:fileScope,guest
+sdbm_FIRSTKEY	input.xs	/^#define sdbm_FIRSTKEY(/;"	d	file:	signature:(db)	roles:def	extras:fileScope,guest
+sdbm_NEXTKEY	input.xs	/^#define sdbm_NEXTKEY(/;"	d	file:	signature:(db,key)	roles:def	extras:fileScope,guest
+X	input.xs	/^#define X "X"/;"	d	file:	roles:def	extras:fileScope,guest
+Y	input.xs	/^#define Y "Y"/;"	d	file:	roles:def	extras:fileScope,guest

Units/parser-xs.r/simple-xs.d/features

@@ -0,0 +1 @@
+pcre2

Units/parser-xs.r/simple-xs.d/input.xs

@@ -0,0 +1,167 @@
+/* Derrive from perl5/ext/SDBM_File/SDBM_File.xs */
+#define PERL_NO_GET_CONTEXT
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "sdbm.h"
+
+#define fetch_key 0
+#define store_key 1
+#define fetch_value 2
+#define store_value 3
+
+typedef struct {
+	DBM *	dbp ;
+	SV *    filter[4];
+	int     filtering ;
+	} SDBM_File_type;
+
+typedef SDBM_File_type * SDBM_File ;
+typedef datum datum_key ;
+typedef datum datum_value ;
+
+#define sdbm_FETCH(db,key)			sdbm_fetch(db->dbp,key)
+#define sdbm_STORE(db,key,value,flags)		sdbm_store(db->dbp,key,value,flags)
+#define sdbm_DELETE(db,key)			sdbm_delete(db->dbp,key)
+#define sdbm_EXISTS(db,key)			sdbm_exists(db->dbp,key)
+#define sdbm_FIRSTKEY(db)			sdbm_firstkey(db->dbp)
+#define sdbm_NEXTKEY(db,key)			sdbm_nextkey(db->dbp)
+
+
+MODULE = SDBM_File	PACKAGE = SDBM_File	PREFIX = sdbm_
+
+PROTOTYPES: DISABLE
+
+SDBM_File
+sdbm_TIEHASH(dbtype, filename, flags, mode, pagname=NULL)
+	char *		dbtype
+	char *		filename
+	int		flags
+	int		mode
+	char *		pagname
+	CODE:
+	{
+	    DBM *	dbp ;
+
+	    RETVAL = NULL ;
+	    if (pagname == NULL) {
+		dbp = sdbm_open(filename, flags, mode);
+	    }
+	    else {
+		dbp = sdbm_prep(filename, pagname, flags, mode);
+	    }
+	    if (dbp) {
+		RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
+		RETVAL->dbp = dbp ;
+	    }
+
+	}
+	OUTPUT:
+	  RETVAL
+
+void
+sdbm_DESTROY(db)
+	SDBM_File	db
+	CODE:
+	if (db) {
+	    int i = store_value;
+	    sdbm_close(db->dbp);
+	    do {
+		if (db->filter[i])
+		    SvREFCNT_dec_NN(db->filter[i]);
+	    } while (i-- > 0);
+	    safefree(db) ;
+	}
+
+datum_value
+sdbm_FETCH(db, key)
+	SDBM_File	db
+	datum_key	key
+
+int
+sdbm_STORE(db, key, value, flags = DBM_REPLACE)
+	SDBM_File	db
+	datum_key	key
+	datum_value	value
+	int		flags
+    CLEANUP:
+	if (RETVAL) {
+	    if (RETVAL < 0 && errno == EPERM)
+		croak("No write permission to sdbm file");
+	    croak("sdbm store returned %d, errno %d, key \"%s\"",
+			RETVAL,errno,key.dptr);
+	    sdbm_clearerr(db->dbp);
+	}
+
+int
+sdbm_DELETE(db, key)
+	SDBM_File	db
+	datum_key	key
+
+int
+sdbm_EXISTS(db,key)
+	SDBM_File	db
+	datum_key	key
+
+datum_key
+sdbm_FIRSTKEY(db)
+	SDBM_File	db
+
+datum_key
+sdbm_NEXTKEY(db, key)
+	SDBM_File	db
+
+int
+sdbm_error(db)
+	SDBM_File	db
+	ALIAS:
+	sdbm_clearerr = 1
+	CODE:
+	RETVAL = ix ? sdbm_clearerr(db->dbp) : sdbm_error(db->dbp);
+	OUTPUT:
+	  RETVAL
+
+SV                                                          *
+filter_fetch_key(db, code)
+	SDBM_File	db
+	SV *		code
+	SV *		RETVAL = &PL_sv_undef ;
+	ALIAS:
+	SDBM_File::filter_fetch_key = fetch_key
+	SDBM_File::filter_store_key = store_key
+	SDBM_File::filter_fetch_value = fetch_value
+	SDBM_File::filter_store_value = store_value
+	CODE:
+	    DBM_setFilter(db->filter[ix], code);
+
+BOOT:
+	{
+	    HV *stash = gv_stashpvs("SDBM_File", 1);
+	    newCONSTSUB(stash, "PAGFEXT", newSVpvs(PAGFEXT));
+	    newCONSTSUB(stash, "DIRFEXT", newSVpvs(DIRFEXT));
+	    newCONSTSUB(stash, "PAIRMAX", newSVuv(PAIRMAX));
+	}
+
+MODULE = SDBM_File	PACKAGE = SDBM_X	PREFIX = sdbm_X_
+
+INCLUDE: constants.xs
+
+int
+sdbm_X_DELETE0(db, key)
+	SDBM_File	db
+	datum_key	key
+
+#define X "X"
+
+int
+sdbm_X_DELETE1(db, key)
+	SDBM_File	db
+	datum_key	key
+
+#define Y "Y"
+
+double
+sin0()
+
+double
+sin1();

docs/news.rst

@@ -482,6 +482,7 @@ The following parsers have been added:
 * TypeScript
 * Varlink *peg/packcc*
 * WindRes
+* XS *optlib pcre2*
 * XSLT v1.0 *libxml*
 * Yacc
 * Yaml *libyaml*