shl...@cec68495-dca5-4e2b-845c-11fdaaa4f967  committed abee6e4

Added the return-an-integer version of the test script.

  • Participants
  • Parent commits 48c1b0c
  • Branches default

Comments (0)

Files changed (20)

File perl5/ext-embed-internals/docbook/examples/0003-return-an-integer/XSTest/.cvsignore


File perl5/ext-embed-internals/docbook/examples/0003-return-an-integer/XSTest/Build.PL

+use strict;
+use warnings;
+use File::Spec;
+use lib File::Spec->catdir(File::Spec->curdir(), "inc");
+use Test::Run::Builder;
+my $builder = Test::Run::Builder->new(
+    module_name         => 'XSTest',
+    license             => 'perl',
+    dist_author         => 'Shlomi Fish <>',
+    dist_version_from   => 'lib/',
+    include_dirs        => ['.'],
+    requires => {
+        'Test::More' => 0,
+    },
+    add_to_cleanup      => [ 'XSTest-*' ],

File perl5/ext-embed-internals/docbook/examples/0003-return-an-integer/XSTest/Changes

+0.0003    Sun Jul  1 00:04:01 IDT 2007
+          Added the get_24() function to return a 24 integer.
+0.0002    Sat Jun 30 23:46:23 IDT 2007
+          Added the hello() function to print "Hello World!\n" on the
+          screen.
+0.0001    Sat Jun 30 22:57:54 IDT 2007
+          As generated by the skeleton of Module::Starter::XSimple.

File perl5/ext-embed-internals/docbook/examples/0003-return-an-integer/XSTest/MANIFEST

+META.yml # Will be created by "make dist"

File perl5/ext-embed-internals/docbook/examples/0003-return-an-integer/XSTest/README

+This module is meant for experimenting with XS code as part of the book
+about Extending and Embeding Perl internals.
+To install this module, run the following commands:
+    perl Build.PL
+    ./Build
+    ./Build test
+    ./Build install
+After installing, you can find documentation for this module with the perldoc command.
+    perldoc XSTest
+Copyright (C) 2007 Shlomi Fish
+This program is free software; you can redistribute it and/or modify it
+under the terms of either the MIT X11 or the Public Domain.

File perl5/ext-embed-internals/docbook/examples/0003-return-an-integer/XSTest/inc/Test/Run/

+package Test::Run::Builder;
+use strict;
+use warnings;
+use Module::Build;
+use vars qw(@ISA);
+@ISA = (qw(Module::Build));
+sub ACTION_runtest
+    my ($self) = @_;
+    my $p = $self->{properties};
+    $self->depends_on('code');
+    local @INC = @INC;
+    # Make sure we test the module in blib/
+    unshift @INC, (File::Spec->catdir($p->{base_dir}, $self->blib, 'lib'),
+		 File::Spec->catdir($p->{base_dir}, $self->blib, 'arch'));
+    $self->do_test_run_tests;
+sub ACTION_distruntest {
+  my ($self) = @_;
+  $self->depends_on('distdir');
+  my $start_dir = $self->cwd;
+  my $dist_dir = $self->dist_dir;
+  chdir $dist_dir or die "Cannot chdir to $dist_dir: $!";
+  # XXX could be different names for scripts
+  $self->run_perl_script('Build.PL') # XXX Should this be run w/ --nouse-rcfile
+      or die "Error executing 'Build.PL' in dist directory: $!";
+  $self->run_perl_script('Build')
+      or die "Error executing 'Build' in dist directory: $!";
+  $self->run_perl_script('Build', [], ['runtest'])
+      or die "Error executing 'Build test' in dist directory";
+  chdir $start_dir;
+sub do_test_run_tests
+    my $self = shift;
+    require Test::Run::CmdLine::Iface;
+    my $test_run =
+        Test::Run::CmdLine::Iface->new(
+            {
+                'test_files' => [glob("t/*.t")],
+            }   
+            # 'backend_params' => $self->_get_backend_params(),
+        );
+    return $test_run->run();

File perl5/ext-embed-internals/docbook/examples/0003-return-an-integer/XSTest/lib/

+package XSTest;
+use warnings;
+use strict;
+=head1 NAME
+XSTest - Module that serves as a playground for writing XS code.
+=head1 VERSION
+Version 0.0003
+our $VERSION = '0.0003';
+require XSLoader;
+XSLoader::load('XSTest', $VERSION);
+=head1 SYNOPSIS
+Perhaps a little code snippet.
+    use XSTest;
+    my $foo = XSTest->new();
+    ...
+=head1 EXPORT
+A list of functions that can be exported.  You can delete this section
+if you don't export anything, such as for a purely object-oriented module.
+=head2 new
+Creates a new XSTest object.  Takes the following optional parameters:
+=over 4
+=item value
+If you pass a single numeric value, it will be stored in the 'value' slot
+of the object hash.
+=item key/value pair
+A generic input method which takes an unlimited number of key/value pairs
+and stores them in the object hash.  Performs no validation.
+#sub new {
+# Defined in the XS code
+=head2 increment
+An object method which increments the 'value' slot of the the object hash,
+if it exists.  Called like this:
+  my $obj = XSTest->new(5);
+  $obj->increment(); # now equal to 6
+=head2 hello
+A function that prints "C<Hello, World!\n>" to the (C) stdout filehandle.
+=head2 get_24
+A function that returns the 24 integer implemented as XS.
+=head1 AUTHOR
+Shlomi Fish, C<< <> >>
+=head1 BUGS
+Please report any bugs or feature requests to
+C<>, or through the web interface at
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+Copyright 2007 Shlomi Fish, All Rights Reserved.
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+1; # End of XSTest

File perl5/ext-embed-internals/docbook/examples/0003-return-an-integer/XSTest/lib/XSTest.xs

+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "ppport.h"
+typedef SV * XSTest;
+    INIT:
+    	char *classname;
+	/* get the class name if called as an object method */
+	if ( sv_isobject(ST(0)) ) {
+	    classname = HvNAME(SvSTASH(SvRV(ST(0))));
+	}
+	else {
+	    classname = (char *)SvPV_nolen(ST(0));
+	}
+    CODE:
+    	/* This is a standard hash-based object */
+    	RETVAL = (XSTest)newHV();
+	/* Single init value */
+	if ( items == 2 ) 
+	    hv_store((HV *)RETVAL, "value", 5, newSVsv(ST(1)), 0);
+	/* name/value pairs */
+	else if ( (items-1)%2 == 0 ) {
+	    int i;
+	    for ( i=1; i < items; i += 2 ) {
+		hv_store_ent((HV *)RETVAL, ST(i), newSVsv(ST(i+1)), 0);
+	    }
+	}
+	/* odd number of parameters */
+	else {
+	    Perl_croak(aTHX_
+		"Usage: XSTest->new()\n"
+		"    or XSTest->new(number)\n"
+		"    or XSTest->new(key => value, ...)\n"
+	    );
+	}
+    OUTPUT:
+    	RETVAL
+    XSTest obj
+    INIT:
+    	RETVAL = 0;
+	if ( items > 1 )
+	    Perl_croak(aTHX_ "Usage: XSTest->increment()");
+    CODE:
+    	SV **svp;
+	if ((svp = hv_fetch((HV*)obj, "value", 5, FALSE))) {
+	    RETVAL = SvIV(*svp);
+	    RETVAL++;
+	    hv_store((HV *)obj, "value", 5, newSViv(RETVAL), 0);
+	}
+    OUTPUT:
+    	RETVAL
+    CODE:
+        printf("%s", "Hello World!\n");
+    CODE:
+        RETVAL = 24;
+    OUTPUT:
+        RETVAL

File perl5/ext-embed-internals/docbook/examples/0003-return-an-integer/XSTest/lib/typemap

+##    Typemap for XSTest objects
+##    Copyright (c) 2007 Shlomi Fish
+##    All rights reserved.
+##    This typemap is designed specifically to make it easier to handle
+##    Perl-style blessed objects in XS.  In particular, it takes care of
+##    blessing the object into the correct class (even for derived classes).
+## vi:et:sw=4 ts=4
+    if (sv_derived_from($arg, \"${(my $ntt=$ntype)=~s/_/::/g;\$ntt}\")) {
+	$var = SvRV($arg);
+    }
+    else
+	croak(\"$var is not of type ${(my $ntt=$ntype)=~s/_/::/g;\$ntt}\")
+    /* inherited new() */
+    if ( strcmp(classname,\"${(my $ntt=$ntype)=~s/_/::/g;\$ntt}\") != 0 )
+	$arg = sv_bless(newRV_noinc($var),
+	    gv_stashpv(classname,TRUE));
+    else
+	$arg = sv_bless(newRV_noinc($var),
+	    gv_stashpv(\"${(my $ntt=$ntype)=~s/_/::/g;\$ntt}\",TRUE));

File perl5/ext-embed-internals/docbook/examples/0003-return-an-integer/XSTest/ppport.h

+#if 0
+    XSTest/ppport.h -- Perl/Pollution/Portability Version 3.06_01
+    Automatically created by Devel::PPPort running under
+    perl 5.008008 on Sat Jun 30 22:50:41 2007.
+    Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
+    includes in parts/inc/ instead.
+    Use 'perldoc XSTest/ppport.h' to view the documentation below.
+=head1 NAME
+XSTest/ppport.h - Perl/Pollution/Portability version 3.06_01
+=head1 SYNOPSIS
+  perl XSTest/ppport.h [options] [source files]
+  Searches current directory for files if no [source files] are given
+  --help                      show short help
+  --patch=file                write one patch file with changes
+  --copy=suffix               write changed copies with suffix
+  --diff=program              use diff program and options
+  --compat-version=version    provide compatibility with Perl version
+  --cplusplus                 accept C++ comments
+  --quiet                     don't output anything except fatal errors
+  --nodiag                    don't show diagnostics
+  --nohints                   don't show hints
+  --nochanges                 don't suggest changes
+  --nofilter                  don't filter input files
+  --list-provided             list provided API
+  --list-unsupported          list unsupported API
+  --api-info=name             show Perl API portability information
+This version of F<XSTest/ppport.h> is designed to support operation with Perl
+installations back to 5.003, and has been tested up to 5.9.3.
+=head1 OPTIONS
+=head2 --help
+Display a brief usage summary.
+=head2 --patch=I<file>
+If this option is given, a single patch file will be created if
+any changes are suggested. This requires a working diff program
+to be installed on your system.
+=head2 --copy=I<suffix>
+If this option is given, a copy of each file will be saved with
+the given suffix that contains the suggested changes. This does
+not require any external programs.
+If neither C<--patch> or C<--copy> are given, the default is to
+simply print the diffs for each file. This requires either
+C<Text::Diff> or a C<diff> program to be installed.
+=head2 --diff=I<program>
+Manually set the diff program and options to use. The default
+is to use C<Text::Diff>, when installed, and output unified
+context diffs.
+=head2 --compat-version=I<version>
+Tell F<XSTest/ppport.h> to check for compatibility with the given
+Perl version. The default is to check for compatibility with Perl
+version 5.003. You can use this option to reduce the output
+of F<XSTest/ppport.h> if you intend to be backward compatible only
+up to a certain Perl version.
+=head2 --cplusplus
+Usually, F<XSTest/ppport.h> will detect C++ style comments and
+replace them with C style comments for portability reasons.
+Using this option instructs F<XSTest/ppport.h> to leave C++
+comments untouched.
+=head2 --quiet
+Be quiet. Don't print anything except fatal errors.
+=head2 --nodiag
+Don't output any diagnostic messages. Only portability
+alerts will be printed.
+=head2 --nohints
+Don't output any hints. Hints often contain useful portability
+=head2 --nochanges
+Don't suggest any changes. Only give diagnostic output and hints
+unless these are also deactivated.
+=head2 --nofilter
+Don't filter the list of input files. By default, files not looking
+like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
+=head2 --list-provided
+Lists the API elements for which compatibility is provided by
+F<XSTest/ppport.h>. Also lists if it must be explicitly requested,
+if it has dependencies, and if there are hints for it.
+=head2 --list-unsupported
+Lists the API elements that are known not to be supported by
+F<XSTest/ppport.h> and below which version of Perl they probably
+won't be available or work.
+=head2 --api-info=I<name>
+Show portability information for API elements matching I<name>.
+If I<name> is surrounded by slashes, it is interpreted as a regular
+In order for a Perl extension (XS) module to be as portable as possible
+across differing versions of Perl itself, certain steps need to be taken.
+=over 4
+=item *
+Including this header is the first major one. This alone will give you
+access to a large part of the Perl API that hasn't been available in
+earlier Perl releases. Use
+    perl XSTest/ppport.h --list-provided
+to see which API elements are provided by XSTest/ppport.h.
+=item *
+You should avoid using deprecated parts of the API. For example, using
+global Perl variables without the C<PL_> prefix is deprecated. Also,
+some API functions used to have a C<perl_> prefix. Using this form is
+also deprecated. You can safely use the supported API, as F<XSTest/ppport.h>
+will provide wrappers for older Perl versions.
+=item *
+If you use one of a few functions that were not present in earlier
+versions of Perl, and that can't be provided using a macro, you have
+to explicitly request support for these functions by adding one or
+more C<#define>s in your source code before the inclusion of F<XSTest/ppport.h>.
+These functions will be marked C<explicit> in the list shown by
+Depending on whether you module has a single or multiple files that
+use such functions, you want either C<static> or global variants.
+For a C<static> function, use:
+    #define NEED_function
+For a global function, use:
+    #define NEED_function_GLOBAL
+Note that you mustn't have more than one global request for one
+function in your project.
+    Function                  Static Request               Global Request
+    -----------------------------------------------------------------------------------------
+    eval_pv()                 NEED_eval_pv                 NEED_eval_pv_GLOBAL
+    grok_bin()                NEED_grok_bin                NEED_grok_bin_GLOBAL
+    grok_hex()                NEED_grok_hex                NEED_grok_hex_GLOBAL
+    grok_number()             NEED_grok_number             NEED_grok_number_GLOBAL
+    grok_numeric_radix()      NEED_grok_numeric_radix      NEED_grok_numeric_radix_GLOBAL
+    grok_oct()                NEED_grok_oct                NEED_grok_oct_GLOBAL
+    newCONSTSUB()             NEED_newCONSTSUB             NEED_newCONSTSUB_GLOBAL
+    newRV_noinc()             NEED_newRV_noinc             NEED_newRV_noinc_GLOBAL
+    sv_2pv_nolen()            NEED_sv_2pv_nolen            NEED_sv_2pv_nolen_GLOBAL
+    sv_2pvbyte()              NEED_sv_2pvbyte              NEED_sv_2pvbyte_GLOBAL
+    sv_catpvf_mg()            NEED_sv_catpvf_mg            NEED_sv_catpvf_mg_GLOBAL
+    sv_catpvf_mg_nocontext()  NEED_sv_catpvf_mg_nocontext  NEED_sv_catpvf_mg_nocontext_GLOBAL
+    sv_setpvf_mg()            NEED_sv_setpvf_mg            NEED_sv_setpvf_mg_GLOBAL
+    sv_setpvf_mg_nocontext()  NEED_sv_setpvf_mg_nocontext  NEED_sv_setpvf_mg_nocontext_GLOBAL
+    vnewSVpvf()               NEED_vnewSVpvf               NEED_vnewSVpvf_GLOBAL
+To avoid namespace conflicts, you can change the namespace of the
+explicitly exported functions using the C<DPPP_NAMESPACE> macro.
+Just C<#define> the macro before including C<XSTest/ppport.h>:
+    #define DPPP_NAMESPACE MyOwnNamespace_
+    #include "XSTest/ppport.h"
+The default namespace is C<DPPP_>.
+The good thing is that most of the above can be checked by running
+F<XSTest/ppport.h> on your source code. See the next section for
+=head1 EXAMPLES
+To verify whether F<XSTest/ppport.h> is needed for your module, whether you
+should make any changes to your code, and whether any special defines
+should be used, F<XSTest/ppport.h> can be run as a Perl script to check your
+source code. Simply say:
+    perl XSTest/ppport.h
+The result will usually be a list of patches suggesting changes
+that should at least be acceptable, if not necessarily the most
+efficient solution, or a fix for all possible problems.
+If you know that your XS module uses features only available in
+newer Perl releases, if you're aware that it uses C++ comments,
+and if you want all suggestions as a single patch file, you could
+use something like this:
+    perl XSTest/ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
+If you only want your code to be scanned without any suggestions
+for changes, use:
+    perl XSTest/ppport.h --nochanges
+You can specify a different C<diff> program or options, using
+the C<--diff> option:
+    perl XSTest/ppport.h --diff='diff -C 10'
+This would output context diffs with 10 lines of context.
+To display portability information for the C<newSVpvn> function,
+    perl XSTest/ppport.h --api-info=newSVpvn
+Since the argument to C<--api-info> can be a regular expression,
+you can use
+    perl XSTest/ppport.h --api-info=/_nomg$/
+to display portability information for all C<_nomg> functions or
+    perl XSTest/ppport.h --api-info=/./
+to display information for all known API elements.
+=head1 BUGS
+If this version of F<XSTest/ppport.h> is causing failure during
+the compilation of this module, please check if newer versions
+of either this module or C<Devel::PPPort> are available on CPAN
+before sending a bug report.
+If F<XSTest/ppport.h> was generated using the latest version of
+C<Devel::PPPort> and is causing failure of this module, please
+file a bug report using the CPAN Request Tracker at L<>.
+Please include the following information:
+=over 4
+=item 1.
+The complete output from running "perl -V"
+=item 2.
+This file.
+=item 3.
+The name and version of the module you were trying to build.
+=item 4.
+A full log of the build that failed.
+=item 5.
+Any other information that you think could be relevant.
+For the latest version of this code, please get the C<Devel::PPPort>
+module from CPAN.
+Version 3.x, Copyright (c) 2004-2005, Marcus Holland-Moritz.
+Version 2.x, Copyright (C) 2001, Paul Marquess.
+Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+=head1 SEE ALSO
+See L<Devel::PPPort>.
+use strict;
+my %opt = (
+  quiet     => 0,
+  diag      => 1,
+  hints     => 1,
+  changes   => 1,
+  cplusplus => 0,
+  filter    => 1,
+my($ppport) = $0 =~ /([\w.]+)$/;
+my $LF = '(?:\r\n|[\r\n])';   # line feed
+my $HS = "[ \t]";             # horizontal whitespace
+eval {
+  require Getopt::Long;
+  Getopt::Long::GetOptions(\%opt, qw(
+    help quiet diag! filter! hints! changes! cplusplus
+    patch=s copy=s diff=s compat-version=s
+    list-provided list-unsupported api-info=s
+  )) or usage();
+if ($@ and grep /^-/, @ARGV) {
+  usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
+  die "Getopt::Long not found. Please don't use any options.\n";
+usage() if $opt{help};
+if (exists $opt{'compat-version'}) {
+  my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
+  if ($@) {
+    die "Invalid version number format: '$opt{'compat-version'}'\n";
+  }
+  die "Only Perl 5 is supported\n" if $r != 5;
+  die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
+  $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
+else {
+  $opt{'compat-version'} = 5;
+# Never use C comments in this file!!!!!
+my $ccs  = '/'.'*';
+my $cce  = '*'.'/';
+my $rccs = quotemeta $ccs;
+my $rcce = quotemeta $cce;
+my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
+                ? ( $1 => {
+                      ($2                  ? ( base     => $2 ) : ()),
+                      ($3                  ? ( todo     => $3 ) : ()),
+                      (index($4, 'v') >= 0 ? ( varargs  => 1  ) : ()),
+                      (index($4, 'p') >= 0 ? ( provided => 1  ) : ()),
+                      (index($4, 'n') >= 0 ? ( nothxarg => 1  ) : ()),
+                    } )
+                : die "invalid spec: $_" } qw(