[shell changes from patch from perl5.003_19 to perl5.003_20]
authorChip Salzenberg <chip@atlantic.net>
Tue, 7 Jan 1997 23:52:00 +0000 (11:52 +1200)
committerChip Salzenberg <chip@atlantic.net>
Tue, 7 Jan 1997 23:52:00 +0000 (11:52 +1200)
Change from running these commands:

 # this file is obsolete
 rm -f ext/DynaLoader/dl_os2.xs

 # this file was renamed
 if test -f t/pragma/warn-global
 then
     mv t/pragma/warn-global t/pragma/warn-1global
 fi

 # new (and nearly new) tests must be executable
 touch t/comp/proto.t
 chmod +x t/comp/proto.t t/comp/use.t t/harness

 # ready to patch
 exit 0

ext/DynaLoader/dl_os2.xs [deleted file]
t/comp/proto.t [new file with mode: 0755]
t/harness [changed mode: 0644->0755]
t/pragma/warn-1global [new file with mode: 0644]
t/pragma/warn-global [deleted file]

diff --git a/ext/DynaLoader/dl_os2.xs b/ext/DynaLoader/dl_os2.xs
deleted file mode 100644 (file)
index 3042a00..0000000
+++ /dev/null
@@ -1,188 +0,0 @@
-/* dl_os2.xs
- * 
- * Platform:   OS/2.
- * Author:     Andreas Kaiser (ak@ananke.s.bawue.de)
- * Created:    08th December 1994
- */
-
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-
-#define INCL_BASE
-#include <os2.h>
-
-#include "dlutils.c"   /* SaveError() etc      */
-
-static ULONG retcode;
-
-static void *
-dlopen(char *path, int mode)
-{
-       HMODULE handle;
-       char tmp[260], *beg, *dot;
-       char fail[300];
-       ULONG rc;
-
-       if ((rc = DosLoadModule(fail, sizeof fail, path, &handle)) == 0)
-               return (void *)handle;
-
-       retcode = rc;
-
-       /* Not found. Check for non-FAT name and try truncated name. */
-       /* Don't know if this helps though... */
-       for (beg = dot = path + strlen(path);
-            beg > path && !strchr(":/\\", *(beg-1));
-            beg--)
-               if (*beg == '.')
-                       dot = beg;
-       if (dot - beg > 8) {
-               int n = beg+8-path;
-               memmove(tmp, path, n);
-               memmove(tmp+n, dot, strlen(dot)+1);
-               if (DosLoadModule(fail, sizeof fail, tmp, &handle) == 0)
-                       return (void *)handle;
-       }
-
-       return NULL;
-}
-
-static void *
-dlsym(void *handle, char *symbol)
-{
-       ULONG rc, type;
-       PFN addr;
-
-       rc = DosQueryProcAddr((HMODULE)handle, 0, symbol, &addr);
-       if (rc == 0) {
-               rc = DosQueryProcType((HMODULE)handle, 0, symbol, &type);
-               if (rc == 0 && type == PT_32BIT)
-                       return (void *)addr;
-               rc = ERROR_CALL_NOT_IMPLEMENTED;
-       }
-       retcode = rc;
-       return NULL;
-}
-
-static char *
-dlerror(void)
-{
-       static char buf[300];
-       ULONG len;
-
-       if (retcode == 0)
-               return NULL;
-       if (DosGetMessage(NULL, 0, buf, sizeof buf - 1, retcode, "OSO001.MSG", &len))
-               sprintf(buf, "OS/2 system error code %d", retcode);
-       else
-               buf[len] = '\0';
-       retcode = 0;
-       return buf;
-}
-
-
-static void
-dl_private_init()
-{
-    (void)dl_generic_private_init();
-}
-
-static char *
-mod2fname(sv)
-     SV   *sv;
-{
-    static char fname[9];
-    int pos = 7;
-    int len;
-    AV  *av;
-    SV  *svp;
-    char *s;
-
-    if (!SvROK(sv)) croak("Not a reference given to mod2fname");
-    sv = SvRV(sv);
-    if (SvTYPE(sv) != SVt_PVAV) 
-      croak("Not array reference given to mod2fname");
-    if (av_len((AV*)sv) < 0) 
-      croak("Empty array reference given to mod2fname");
-    s = SvPV(*av_fetch((AV*)sv, av_len((AV*)sv), FALSE), na);
-    strncpy(fname, s, 8);
-    if ((len=strlen(s)) < 7) pos = len;
-    fname[pos] = '_';
-    fname[pos + 1] = '\0';
-    return (char *)fname;
-}
-
-MODULE = DynaLoader    PACKAGE = DynaLoader
-
-BOOT:
-    (void)dl_private_init();
-
-
-void *
-dl_load_file(filename)
-    char *             filename
-    CODE:
-    int mode = 1;     /* Solaris 1 */
-#ifdef RTLD_LAZY
-    mode = RTLD_LAZY; /* Solaris 2 */
-#endif
-    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s):\n", filename));
-    RETVAL = dlopen(filename, mode) ;
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL));
-    ST(0) = sv_newmortal() ;
-    if (RETVAL == NULL)
-       SaveError("%s",dlerror()) ;
-    else
-       sv_setiv( ST(0), (IV)RETVAL);
-
-
-void *
-dl_find_symbol(libhandle, symbolname)
-    void *     libhandle
-    char *     symbolname
-    CODE:
-#ifdef DLSYM_NEEDS_UNDERSCORE
-    char symbolname_buf[1024];
-    symbolname = dl_add_underscore(symbolname, symbolname_buf);
-#endif
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_find_symbol(handle=%x, symbol=%s)\n",
-       libhandle, symbolname));
-    RETVAL = dlsym(libhandle, symbolname);
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "  symbolref = %x\n", RETVAL));
-    ST(0) = sv_newmortal() ;
-    if (RETVAL == NULL)
-       SaveError("%s",dlerror()) ;
-    else
-       sv_setiv( ST(0), (IV)RETVAL);
-
-
-void
-dl_undef_symbols()
-    PPCODE:
-
-char *
-mod2fname(sv)
-     SV   *sv;
-
-
-# These functions should not need changing on any platform:
-
-void
-dl_install_xsub(perl_name, symref, filename="$Package")
-    char *             perl_name
-    void *             symref 
-    char *             filename
-    CODE:
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
-               perl_name, symref));
-    ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
-
-
-char *
-dl_error()
-    CODE:
-    RETVAL = LastError ;
-    OUTPUT:
-    RETVAL
-
-# end.
diff --git a/t/comp/proto.t b/t/comp/proto.t
new file mode 100755 (executable)
index 0000000..e69de29
old mode 100644 (file)
new mode 100755 (executable)
diff --git a/t/pragma/warn-1global b/t/pragma/warn-1global
new file mode 100644 (file)
index 0000000..3325273
--- /dev/null
@@ -0,0 +1,146 @@
+Check existing $^W functionality
+
+__END__
+
+# warnable code, warnings disabled
+$a =+ 3 ;
+EXPECT
+
+########
+-w
+# warnable code, warnings enabled via command line switch
+$a =+ 3 ;
+EXPECT
+Reversed += operator at - line 3.
+########
+#! perl -w
+# warnable code, warnings enabled via #! line
+$a =+ 3 ;
+EXPECT
+Reversed += operator at - line 3.
+########
+
+# warnable code, warnings enabled via compile time $^W
+BEGIN { $^W = 1 }
+$a =+ 3 ;
+EXPECT
+Reversed += operator at - line 4.
+########
+
+# compile-time warnable code, warnings enabled via runtime $^W
+# so no warning printed.
+$^W = 1 ;
+$a =+ 3 ;
+EXPECT
+
+########
+
+# warnable code, warnings enabled via runtime $^W
+$^W = 1 ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value at - line 4.
+########
+
+# warnings enabled at compile time, disabled at run time
+BEGIN { $^W = 1 }
+$^W = 0 ;
+my $b ; chop $b ;
+EXPECT
+
+########
+
+# warnings disabled at compile time, enabled at run time
+BEGIN { $^W = 0 }
+$^W = 1 ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value at - line 5.
+########
+-w
+--FILE-- abcd
+my $b ; chop $b ;
+1 ;
+--FILE-- 
+require "./abcd";
+EXPECT
+Use of uninitialized value at ./abcd line 1.
+########
+
+--FILE-- abcd
+my $b ; chop $b ;
+1 ;
+--FILE-- 
+#! perl -w
+require "./abcd";
+EXPECT
+Use of uninitialized value at ./abcd line 1.
+########
+
+--FILE-- abcd
+my $b ; chop $b ;
+1 ;
+--FILE-- 
+$^W =1 ;
+require "./abcd";
+EXPECT
+Use of uninitialized value at ./abcd line 1.
+########
+
+--FILE-- abcd
+$^W = 0;
+my $b ; chop $b ;
+1 ;
+--FILE-- 
+$^W =1 ;
+require "./abcd";
+EXPECT
+
+########
+
+--FILE-- abcd
+$^W = 1;
+1 ;
+--FILE-- 
+$^W =0 ;
+require "./abcd";
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value at - line 3.
+########
+
+$^W = 1;
+eval "my $b ; chop $b ;" ;
+EXPECT
+Use of uninitialized value at - line 3.
+Use of uninitialized value at - line 3.
+########
+
+eval "$^W = 1;" ;
+my $b ; chop $b ;
+EXPECT
+
+########
+
+eval {$^W = 1;} ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value at - line 3.
+########
+
+{
+    local ($^W) = 1;
+}
+my $b ; chop $b ;
+EXPECT
+
+########
+
+my $a ; chop $a ;
+{
+    local ($^W) = 1;
+    my $b ; chop $b ;
+}
+my $c ; chop $c ;
+EXPECT
+Use of uninitialized value at - line 5.
diff --git a/t/pragma/warn-global b/t/pragma/warn-global
deleted file mode 100644 (file)
index 3325273..0000000
+++ /dev/null
@@ -1,146 +0,0 @@
-Check existing $^W functionality
-
-__END__
-
-# warnable code, warnings disabled
-$a =+ 3 ;
-EXPECT
-
-########
--w
-# warnable code, warnings enabled via command line switch
-$a =+ 3 ;
-EXPECT
-Reversed += operator at - line 3.
-########
-#! perl -w
-# warnable code, warnings enabled via #! line
-$a =+ 3 ;
-EXPECT
-Reversed += operator at - line 3.
-########
-
-# warnable code, warnings enabled via compile time $^W
-BEGIN { $^W = 1 }
-$a =+ 3 ;
-EXPECT
-Reversed += operator at - line 4.
-########
-
-# compile-time warnable code, warnings enabled via runtime $^W
-# so no warning printed.
-$^W = 1 ;
-$a =+ 3 ;
-EXPECT
-
-########
-
-# warnable code, warnings enabled via runtime $^W
-$^W = 1 ;
-my $b ; chop $b ;
-EXPECT
-Use of uninitialized value at - line 4.
-########
-
-# warnings enabled at compile time, disabled at run time
-BEGIN { $^W = 1 }
-$^W = 0 ;
-my $b ; chop $b ;
-EXPECT
-
-########
-
-# warnings disabled at compile time, enabled at run time
-BEGIN { $^W = 0 }
-$^W = 1 ;
-my $b ; chop $b ;
-EXPECT
-Use of uninitialized value at - line 5.
-########
--w
---FILE-- abcd
-my $b ; chop $b ;
-1 ;
---FILE-- 
-require "./abcd";
-EXPECT
-Use of uninitialized value at ./abcd line 1.
-########
-
---FILE-- abcd
-my $b ; chop $b ;
-1 ;
---FILE-- 
-#! perl -w
-require "./abcd";
-EXPECT
-Use of uninitialized value at ./abcd line 1.
-########
-
---FILE-- abcd
-my $b ; chop $b ;
-1 ;
---FILE-- 
-$^W =1 ;
-require "./abcd";
-EXPECT
-Use of uninitialized value at ./abcd line 1.
-########
-
---FILE-- abcd
-$^W = 0;
-my $b ; chop $b ;
-1 ;
---FILE-- 
-$^W =1 ;
-require "./abcd";
-EXPECT
-
-########
-
---FILE-- abcd
-$^W = 1;
-1 ;
---FILE-- 
-$^W =0 ;
-require "./abcd";
-my $b ; chop $b ;
-EXPECT
-Use of uninitialized value at - line 3.
-########
-
-$^W = 1;
-eval "my $b ; chop $b ;" ;
-EXPECT
-Use of uninitialized value at - line 3.
-Use of uninitialized value at - line 3.
-########
-
-eval "$^W = 1;" ;
-my $b ; chop $b ;
-EXPECT
-
-########
-
-eval {$^W = 1;} ;
-my $b ; chop $b ;
-EXPECT
-Use of uninitialized value at - line 3.
-########
-
-{
-    local ($^W) = 1;
-}
-my $b ; chop $b ;
-EXPECT
-
-########
-
-my $a ; chop $a ;
-{
-    local ($^W) = 1;
-    my $b ; chop $b ;
-}
-my $c ; chop $c ;
-EXPECT
-Use of uninitialized value at - line 5.