summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ext/ByteLoader/ByteLoader.xs6
-rw-r--r--ext/DB_File/DB_File.xs25
-rw-r--r--ext/DB_File/version.c1
-rw-r--r--ext/Devel/DProf/DProf.xs2
-rw-r--r--ext/DynaLoader/dl_dlopen.xs25
-rw-r--r--ext/DynaLoader/dlutils.c4
-rw-r--r--ext/Encode/Encode.xs11
-rw-r--r--ext/File/Glob/bsd_glob.c2
-rw-r--r--ext/Filter/Util/Call/Call.xs4
-rw-r--r--ext/GDBM_File/GDBM_File.xs4
-rw-r--r--ext/List/Util/Util.xs2
-rw-r--r--ext/MIME/Base64/Base64.xs2
-rw-r--r--ext/POSIX/POSIX.xs7
-rw-r--r--ext/PerlIO/Scalar/Scalar.xs1
-rw-r--r--ext/PerlIO/Via/Via.xs1
-rw-r--r--ext/Time/HiRes/HiRes.xs3
-rw-r--r--ext/Time/Piece/Piece.xs24
-rw-r--r--ext/attrs/attrs.xs5
-rw-r--r--globals.c2
-rwxr-xr-xlib/ExtUtils/xsubpp15
20 files changed, 102 insertions, 44 deletions
diff --git a/ext/ByteLoader/ByteLoader.xs b/ext/ByteLoader/ByteLoader.xs
index 05b795ca25..d8b15c102a 100644
--- a/ext/ByteLoader/ByteLoader.xs
+++ b/ext/ByteLoader/ByteLoader.xs
@@ -117,7 +117,8 @@ MODULE = ByteLoader PACKAGE = ByteLoader
PROTOTYPES: ENABLE
void
-import(...)
+import(package="ByteLoader", ...)
+ char *package
PREINIT:
SV *sv = newSVpvn ("", 0);
PPCODE:
@@ -126,6 +127,7 @@ import(...)
filter_add(byteloader_filter, sv);
void
-unimport(...)
+unimport(package="ByteLoader", ...)
+ char *package
PPCODE:
filter_del(byteloader_filter);
diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
index 8a9ce8a2b6..4942e25578 100644
--- a/ext/DB_File/DB_File.xs
+++ b/ext/DB_File/DB_File.xs
@@ -95,6 +95,7 @@
*/
+#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
@@ -138,6 +139,10 @@
#endif
+/* avoid -Wall; DB_File xsubs never make use of `ix' setup for ALIASes */
+#undef dXSI32
+#define dXSI32 dNOOP
+
/* If Perl has been compiled with Threads support,the symbol op will
be defined here. This clashes with a field name in db.h, so get rid of it.
*/
@@ -1703,11 +1708,13 @@ db_EXISTS(db, key)
OUTPUT:
RETVAL
-int
+void
db_FETCH(db, key, flags=0)
DB_File db
DBTKEY key
u_int flags
+ PREINIT:
+ int RETVAL;
CODE:
{
DBT value ;
@@ -1730,9 +1737,11 @@ db_STORE(db, key, value, flags=0)
CurrentDB = db ;
-int
+void
db_FIRSTKEY(db)
DB_File db
+ PREINIT:
+ int RETVAL;
CODE:
{
DBTKEY key ;
@@ -1746,10 +1755,12 @@ db_FIRSTKEY(db)
OutputKey(ST(0), key) ;
}
-int
+void
db_NEXTKEY(db, key)
DB_File db
DBTKEY key
+ PREINIT:
+ int RETVAL;
CODE:
{
DBT value ;
@@ -1806,10 +1817,12 @@ unshift(db, ...)
OUTPUT:
RETVAL
-I32
+void
pop(db)
DB_File db
ALIAS: POP = 1
+ PREINIT:
+ I32 RETVAL;
CODE:
{
DBTKEY key ;
@@ -1833,10 +1846,12 @@ pop(db)
}
}
-I32
+void
shift(db)
DB_File db
ALIAS: SHIFT = 1
+ PREINIT:
+ I32 RETVAL;
CODE:
{
DBT value ;
diff --git a/ext/DB_File/version.c b/ext/DB_File/version.c
index 82b3e8b27b..2801ffa2c7 100644
--- a/ext/DB_File/version.c
+++ b/ext/DB_File/version.c
@@ -22,6 +22,7 @@
*/
+#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
diff --git a/ext/Devel/DProf/DProf.xs b/ext/Devel/DProf/DProf.xs
index 92256754e1..c34a366181 100644
--- a/ext/Devel/DProf/DProf.xs
+++ b/ext/Devel/DProf/DProf.xs
@@ -513,7 +513,7 @@ check_depth(pTHX_ void *foo)
XS(XS_DB_sub)
{
- dXSARGS;
+ dMARK;
dORIGMARK;
SV *Sub = GvSV(PL_DBsub); /* name of current sub */
diff --git a/ext/DynaLoader/dl_dlopen.xs b/ext/DynaLoader/dl_dlopen.xs
index e1b2a82410..7d099bee02 100644
--- a/ext/DynaLoader/dl_dlopen.xs
+++ b/ext/DynaLoader/dl_dlopen.xs
@@ -155,12 +155,13 @@ BOOT:
(void)dl_private_init(aTHX);
-void *
+void
dl_load_file(filename, flags=0)
char * filename
int flags
PREINIT:
int mode = RTLD_LAZY;
+ void *handle;
CODE:
{
#if defined(DLOPEN_WONT_DO_RELATIVE_PATHS)
@@ -184,13 +185,13 @@ dl_load_file(filename, flags=0)
Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
#endif
DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
- RETVAL = dlopen(filename, mode) ;
- DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL));
+ handle = dlopen(filename, mode) ;
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) handle));
ST(0) = sv_newmortal() ;
- if (RETVAL == NULL)
+ if (handle == NULL)
SaveError(aTHX_ "%s",dlerror()) ;
else
- sv_setiv( ST(0), PTR2IV(RETVAL));
+ sv_setiv( ST(0), PTR2IV(handle));
}
@@ -207,10 +208,12 @@ dl_unload_file(libref)
RETVAL
-void *
+void
dl_find_symbol(libhandle, symbolname)
void * libhandle
char * symbolname
+ PREINIT:
+ void *sym;
CODE:
#ifdef DLSYM_NEEDS_UNDERSCORE
symbolname = Perl_form_nocontext("_%s", symbolname);
@@ -218,19 +221,19 @@ dl_find_symbol(libhandle, symbolname)
DLDEBUG(2, PerlIO_printf(Perl_debug_log,
"dl_find_symbol(handle=%lx, symbol=%s)\n",
(unsigned long) libhandle, symbolname));
- RETVAL = dlsym(libhandle, symbolname);
+ sym = dlsym(libhandle, symbolname);
DLDEBUG(2, PerlIO_printf(Perl_debug_log,
- " symbolref = %lx\n", (unsigned long) RETVAL));
+ " symbolref = %lx\n", (unsigned long) sym));
ST(0) = sv_newmortal() ;
- if (RETVAL == NULL)
+ if (sym == NULL)
SaveError(aTHX_ "%s",dlerror()) ;
else
- sv_setiv( ST(0), PTR2IV(RETVAL));
+ sv_setiv( ST(0), PTR2IV(sym));
void
dl_undef_symbols()
- PPCODE:
+ CODE:
diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c
index 9d88f5fdad..bb06fe4b20 100644
--- a/ext/DynaLoader/dlutils.c
+++ b/ext/DynaLoader/dlutils.c
@@ -27,7 +27,7 @@ static int dl_debug = 0; /* value copied from $DynaLoader::dl_debug */
#define DLDEBUG(level,code)
#endif
-
+#ifdef DL_UNLOAD_ALL_AT_EXIT
/* Close all dlopen'd files */
static void
dl_unload_all_files(pTHXo_ void *unused)
@@ -51,7 +51,7 @@ dl_unload_all_files(pTHXo_ void *unused)
}
}
}
-
+#endif
static void
dl_generic_private_init(pTHXo) /* called by dl_*.xs dl_private_init() */
diff --git a/ext/Encode/Encode.xs b/ext/Encode/Encode.xs
index ef21d5bd91..b9af4d61c5 100644
--- a/ext/Encode/Encode.xs
+++ b/ext/Encode/Encode.xs
@@ -1,3 +1,4 @@
+#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
@@ -8,6 +9,7 @@
#include "Symbols.h"
#define UNIMPLEMENTED(x,y) y x (SV *sv, char *encoding) { \
+ dTHX; \
Perl_croak(aTHX_ "panic_unimplemented"); \
return (y)0; /* fool picky compilers */ \
}
@@ -51,6 +53,7 @@ typedef struct
SV *
PerlIOEncode_getarg(PerlIO *f)
{
+ dTHX;
PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
SV *sv = &PL_sv_undef;
if (e->enc)
@@ -61,7 +64,7 @@ PerlIOEncode_getarg(PerlIO *f)
PUSHMARK(sp);
XPUSHs(e->enc);
PUTBACK;
- if (perl_call_method("name",G_SCALAR) == 1)
+ if (call_method("name",G_SCALAR) == 1)
{
SPAGAIN;
sv = newSVsv(POPs);
@@ -84,7 +87,7 @@ PerlIOEncode_pushed(PerlIO *f, const char *mode, SV *arg)
PUSHMARK(sp);
XPUSHs(arg);
PUTBACK;
- if (perl_call_pv("Encode::find_encoding",G_SCALAR) != 1)
+ if (call_pv("Encode::find_encoding",G_SCALAR) != 1)
{
/* should never happen */
Perl_die(aTHX_ "Encode::find_encoding did not return a value");
@@ -188,7 +191,7 @@ PerlIOEncode_fill(PerlIO *f)
XPUSHs(e->bufsv);
XPUSHs(&PL_sv_yes);
PUTBACK;
- if (perl_call_method("decode",G_SCALAR) != 1)
+ if (call_method("decode",G_SCALAR) != 1)
code = -1;
SPAGAIN;
uni = POPs;
@@ -246,7 +249,7 @@ PerlIOEncode_flush(PerlIO *f)
XPUSHs(e->bufsv);
XPUSHs(&PL_sv_yes);
PUTBACK;
- if (perl_call_method("encode",G_SCALAR) != 1)
+ if (call_method("encode",G_SCALAR) != 1)
code = -1;
SPAGAIN;
str = POPs;
diff --git a/ext/File/Glob/bsd_glob.c b/ext/File/Glob/bsd_glob.c
index a71418cf44..fa601fc81f 100644
--- a/ext/File/Glob/bsd_glob.c
+++ b/ext/File/Glob/bsd_glob.c
@@ -234,7 +234,7 @@ bsd_glob(const char *pattern, int flags,
* colon specially, so it looks for files beginning "C:" in
* the current directory. To fix this, change the pattern to
* add an explicit "./" at the start (just after the drive
- * letter and colon - ie change to "C:./*").
+ * letter and colon - ie change to "C:./").
*/
if (isalpha(pattern[0]) && pattern[1] == ':' &&
pattern[2] != BG_SEP && pattern[2] != BG_SEP2 &&
diff --git a/ext/Filter/Util/Call/Call.xs b/ext/Filter/Util/Call/Call.xs
index 94bc5da4d7..54b213bac9 100644
--- a/ext/Filter/Util/Call/Call.xs
+++ b/ext/Filter/Util/Call/Call.xs
@@ -11,6 +11,7 @@
*
*/
+#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
@@ -243,7 +244,8 @@ filter_del()
void
-unimport(...)
+unimport(package="$Package", ...)
+ char *package
PPCODE:
filter_del(filter_call);
diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs
index 1ec5ea803d..3f18a4a28c 100644
--- a/ext/GDBM_File/GDBM_File.xs
+++ b/ext/GDBM_File/GDBM_File.xs
@@ -197,6 +197,10 @@ constant(char *name, int arg)
errno = EINVAL;
return 0;
+ if (0) {
+ goto not_there; /* -Wall */
+ }
+
not_there:
errno = ENOENT;
return 0;
diff --git a/ext/List/Util/Util.xs b/ext/List/Util/Util.xs
index c5b5ebf27e..024f8755b4 100644
--- a/ext/List/Util/Util.xs
+++ b/ext/List/Util/Util.xs
@@ -293,7 +293,7 @@ CODE:
croak("weak references are not implemented in this release of perl");
#endif
-SV *
+void
isweak(sv)
SV *sv
PROTOTYPE: $
diff --git a/ext/MIME/Base64/Base64.xs b/ext/MIME/Base64/Base64.xs
index e7ffbb5535..664907948b 100644
--- a/ext/MIME/Base64/Base64.xs
+++ b/ext/MIME/Base64/Base64.xs
@@ -191,7 +191,7 @@ decode_base64(sv)
if (PL_dowarn) warn("Premature padding of base64 data");
break;
}
- /* printf("c0=%d,c1=%d,c2=%d,c3=%d\n", c[0],c[1],c[2],c[3]);/**/
+ /* printf("c0=%d,c1=%d,c2=%d,c3=%d\n", c[0],c[1],c[2],c[3]);*/
*r++ = (c[0] << 2) | ((c[1] & 0x30) >> 4);
diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index f079b7b257..fe4acda656 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -2544,6 +2544,10 @@ constant(char *name, int arg)
errno = EINVAL;
return 0;
+ if (0) {
+ not_here(""); /* -Wall */
+ }
+
not_there:
errno = ENOENT;
return 0;
@@ -3733,7 +3737,8 @@ char *
ttyname(fd)
int fd
-char *
+#XXX: use sv_getcwd()
+void
getcwd()
PPCODE:
#ifdef HAS_GETCWD
diff --git a/ext/PerlIO/Scalar/Scalar.xs b/ext/PerlIO/Scalar/Scalar.xs
index fb8b39abb6..9f991dd28c 100644
--- a/ext/PerlIO/Scalar/Scalar.xs
+++ b/ext/PerlIO/Scalar/Scalar.xs
@@ -65,7 +65,6 @@ PerlIOScalar_popped(PerlIO *f)
IV
PerlIOScalar_close(PerlIO *f)
{
- dTHX;
IV code = PerlIOBase_close(f);
PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
return code;
diff --git a/ext/PerlIO/Via/Via.xs b/ext/PerlIO/Via/Via.xs
index cdb46d448d..b2c93edf5c 100644
--- a/ext/PerlIO/Via/Via.xs
+++ b/ext/PerlIO/Via/Via.xs
@@ -409,7 +409,6 @@ PerlIOVia_get_ptr(PerlIO *f)
PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
if (s->var)
{
- dTHX;
STDCHAR *p = (STDCHAR *)(SvEND(s->var) - s->cnt);
return p;
}
diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs
index dea852b05e..db0592aac2 100644
--- a/ext/Time/HiRes/HiRes.xs
+++ b/ext/Time/HiRes/HiRes.xs
@@ -270,6 +270,9 @@ alarm(fseconds,finterval=0)
uinterval = finterval * 1000000;
RETVAL = ualarm (useconds, uinterval);
+ OUTPUT:
+ RETVAL
+
#endif
#ifdef HAS_GETTIMEOFDAY
diff --git a/ext/Time/Piece/Piece.xs b/ext/Time/Piece/Piece.xs
index a639af5d60..bae2d4c7bf 100644
--- a/ext/Time/Piece/Piece.xs
+++ b/ext/Time/Piece/Piece.xs
@@ -25,11 +25,21 @@ __strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -
int wday
int yday
int isdst
+
+ PREINIT:
+ char *buf = NULL;
+
CODE:
- {
- char *buf = my_strftime(fmt, sec, min, hour, mday, mon, year, wday, yday, isdst);
- if (buf) {
- ST(0) = sv_2mortal(newSVpv(buf, 0));
- Safefree(buf);
- }
- }
+ #XXX: an sv_strftime() that can make use of the TARG would faster
+ buf = my_strftime(fmt, sec, min, hour, mday, mon, year, wday, yday, isdst);
+ if (buf) {
+ RETVAL = buf;
+ }
+
+ OUTPUT:
+ RETVAL
+
+ CLEANUP:
+ if (buf) {
+ Safefree(buf);
+ }
diff --git a/ext/attrs/attrs.xs b/ext/attrs/attrs.xs
index 4c00cd7cb2..4914fda8f4 100644
--- a/ext/attrs/attrs.xs
+++ b/ext/attrs/attrs.xs
@@ -17,14 +17,15 @@ get_flag(char *attr)
MODULE = attrs PACKAGE = attrs
void
-import(Class, ...)
-char * Class
+import(...)
ALIAS:
unimport = 1
PREINIT:
int i;
CV *cv;
PPCODE:
+ if (items < 1)
+ Perl_croak(aTHX_ "Usage: %s(Class, ...)", GvNAME(CvGV(cv)));
if (!PL_compcv || !(cv = CvOUTSIDE(PL_compcv)))
croak("can't set attributes outside a subroutine scope");
if (ckWARN(WARN_DEPRECATED))
diff --git a/globals.c b/globals.c
index 5bf4aeabcb..b442068b06 100644
--- a/globals.c
+++ b/globals.c
@@ -73,7 +73,6 @@ CPerlObj::do_aspawn(void *vreally, void **vmark, void **vsp)
int
Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...)
{
- dTHX;
va_list(arglist);
va_start(arglist, format);
return PerlIO_vprintf(stream, format, arglist);
@@ -82,7 +81,6 @@ Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...)
int
Perl_printf_nocontext(const char *format, ...)
{
- dTHX;
va_list(arglist);
va_start(arglist, format);
return PerlIO_vprintf(PerlIO_stdout(), format, arglist);
diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index 0c91e2924f..7f71234f33 100755
--- a/lib/ExtUtils/xsubpp
+++ b/lib/ExtUtils/xsubpp
@@ -1220,6 +1220,13 @@ EOF
# Perl_croak(aTHX_ "Usage: $pname($report_args)");
EOF
+ #-Wall: if an xsub has no arguments and PPCODE is used
+ #none of ST, XSRETURN or XSprePUSH macros are used
+ #hence `ax' (setup by dXSARGS) is unused
+ print Q<<"EOF" if $PPCODE and $num_args == 0;
+# if (0) ax = ax; /* -Wall */
+EOF
+
print Q<<"EOF" if $PPCODE;
# SP -= items;
EOF
@@ -1510,10 +1517,16 @@ EOF
print Q<<"EOF";
#[[
# dXSARGS;
+EOF
+
+#-Wall: if there is no $Full_func_name there are no xsubs in this .xs
+#so `file' is unused
+print Q<<"EOF" if $Full_func_name;
# char* file = __FILE__;
-#
EOF
+print Q "#\n";
+
print Q<<"EOF" if $WantVersionChk ;
# XS_VERSION_BOOTCHECK ;
#
View Lorry Controller Status