summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2003-05-10 10:55:49 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2003-05-10 10:55:49 +0000
commit210e727c30fedfe36428f457a5e2f9e6176680c4 (patch)
tree57f4ec70b5bd13df03599ce313c8fdca3d07cbd3
parentb32dd47ebda3152d7d120c264c8f3b0b6bab01b0 (diff)
downloadperl-210e727c30fedfe36428f457a5e2f9e6176680c4.tar.gz
Try to plug more potential PerlIO NULL method
dereferences; try to document the matter. p4raw-id: //depot/perl@19472
-rw-r--r--perlio.c47
-rw-r--r--pod/perliol.pod42
2 files changed, 72 insertions, 17 deletions
diff --git a/perlio.c b/perlio.c
index 69a2d34844..24927c71a2 100644
--- a/perlio.c
+++ b/perlio.c
@@ -524,15 +524,15 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
{
if (PerlIOValid(f)) {
PerlIO_funcs *tab = PerlIOBase(f)->tab;
- PerlIO *new;
PerlIO_debug("fdupopen f=%p param=%p\n",(void*)f,(void*)param);
- new = (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX),f,param, flags);
- return new;
- }
- else {
- SETERRNO(EBADF, SS_IVCHAN);
- return NULL;
+ if (tab && tab->Dup)
+ return (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX), f, param, flags);
+ SETERRNO(EINVAL, LIB_INVARG);
}
+ else
+ SETERRNO(EBADF, SS_IVCHAN);
+
+ return NULL;
}
void
@@ -1153,7 +1153,8 @@ PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
*f = l;
PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name,
(mode) ? mode : "(Null)", (void*)arg);
- if ((*l->tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
+ if (*l->tab->Pushed &&
+ (*l->tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
PerlIO_pop(aTHX_ f);
return NULL;
}
@@ -1163,8 +1164,9 @@ PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
/* Pseudo-layer where push does its own stack adjust */
PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name,
(mode) ? mode : "(Null)", (void*)arg);
- if ((*tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
- return NULL;
+ if (tab->Pushed &&
+ (*tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
+ return NULL;
}
}
return f;
@@ -1526,8 +1528,13 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
PerlIO_debug("openn(%s,'%s','%s',%d,%x,%o,%p,%d,%p)\n",
tab->name, layers, mode, fd, imode, perm,
(void*)f, narg, (void*)args);
- f = (*tab->Open) (aTHX_ tab, layera, n, mode, fd, imode, perm,
- f, narg, args);
+ if (tab->Open)
+ f = (*tab->Open) (aTHX_ tab, layera, n, mode, fd, imode, perm,
+ f, narg, args);
+ else {
+ SETERRNO(EINVAL, LIB_INVARG);
+ f = NULL;
+ }
if (f) {
if (n + 1 < layera->cur) {
/*
@@ -1862,8 +1869,11 @@ PerlIORaw_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
PerlIO *old, int narg, SV **args)
{
PerlIO_funcs *tab = PerlIO_default_btm();
- return (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
- old, narg, args);
+ if (tab && tab->Open)
+ return (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
+ old, narg, args);
+ SETERRNO(EINVAL, LIB_INVARG);
+ return NULL;
}
PerlIO_funcs PerlIO_raw = {
@@ -2139,12 +2149,15 @@ PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
}
if (f) {
PerlIO_funcs *self = PerlIOBase(o)->tab;
- SV *arg = Nullsv;
+ SV *arg;
char buf[8];
PerlIO_debug("PerlIOBase_dup %s f=%p o=%p param=%p\n",
self->name, (void*)f, (void*)o, (void*)param);
- if (self->Getarg) {
- arg = (*self->Getarg)(aTHX_ o,param,flags);
+ if (self->Getarg)
+ arg = (*self->Getarg)(aTHX_ o, param, flags);
+ else {
+ arg = Nullsv;
+ SETERRNO(EINVAL, LIB_INVARG);
}
f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg);
if (arg) {
diff --git a/pod/perliol.pod b/pod/perliol.pod
index 6a40570271..5a9dda5d66 100644
--- a/pod/perliol.pod
+++ b/pod/perliol.pod
@@ -675,6 +675,48 @@ The application (or layer above) must ensure they are consistent.
=back
+=head2 Implementing PerlIO Layers
+
+If you are creating a PerlIO layer, you may want to be lazy, in other
+words, implement only the methods that interest you. The other methods
+you can either replace with the "blank" methods
+
+ PerlIOBase_noop_ok
+ PerlIOBase_noop_fail
+
+(which do nothing, and return zero and -1, respectively) or for
+certain methods you may assume a default behaviour by using a NULL
+method. The default behaviour is either to use the corresponding
+PerlIOBase method, or silently return success (return zero), or to
+fail (set errno and return -1 or NULL). The following table
+summarizes the behaviour:
+
+ method behaviour with NULL
+
+ Clearerr PerlIOBase_clearerr
+ Close PerlIOBase_close
+ Dup FAILURE
+ Eof PerlIOBase_eof
+ Error PerlIOBase_error
+ Fileno PerlIOBase_fileno
+ Fill FAILURE
+ Flush SUCCESS
+ Getarg FAILURE
+ Get_base FAILURE
+ Get_bufsiz FAILURE
+ Get_cnt FAILURE
+ Get_ptr FAILURE
+ Open FAILURE
+ Popped SUCCESS
+ Pushed SUCCESS
+ Read PerlIOBase_read
+ Seek FAILURE
+ Set_cnt FAILURE
+ Set_ptrcnt FAILURE
+ Setlinebuf PerlIOBase_setlinebuf
+ Tell FAILURE
+ Unread PerlIOBase_unread
+ Write FAILURE
=head2 Core Layers