This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Merge maint-5.004 branch (5.004_04) with mainline.
[perl5.git] / mg.c
diff --git a/mg.c b/mg.c
index e02a1d2..dedf381 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -357,8 +357,15 @@ MAGIC *mg;
        }
 #else
 #ifdef OS2
-       sv_setnv(sv, (double)Perl_rc);
-       sv_setpv(sv, os2error(Perl_rc));
+       if (!(_emx_env & 0x200)) {      /* Under DOS */
+           sv_setnv(sv, (double)errno);
+           sv_setpv(sv, errno ? Strerror(errno) : "");
+       } else {
+           if (errno != errno_isOS2)
+               Perl_rc = _syserrno();
+           sv_setnv(sv, (double)Perl_rc);
+           sv_setpv(sv, os2error(Perl_rc));
+       }
 #else
        sv_setnv(sv, (double)errno);
        sv_setpv(sv, errno ? Strerror(errno) : "");
@@ -384,6 +391,17 @@ MAGIC *mg;
     case '\020':               /* ^P */
        sv_setiv(sv, (IV)perldb);
        break;
+    case '\023':               /* ^S */
+       {
+           dTHR;
+           if (lex_state != LEX_NOTPARSING)
+               SvOK_off(sv);
+           else if (in_eval)
+               sv_setiv(sv, 1);
+           else
+               sv_setiv(sv, 0);
+       }
+       break;
     case '\024':               /* ^T */
 #ifdef BIG_TIME
        sv_setnv(sv, basetime);
@@ -658,6 +676,29 @@ MAGIC* mg;
 }
 
 int
+magic_set_all_env(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+#if defined(VMS)
+    die("Can't make list assignment to %%ENV on this system");
+#else
+    dTHR;
+    if (localizing) {
+       HE* entry;
+       magic_clear_all_env(sv,mg);
+       hv_iterinit((HV*)sv);
+       while (entry = hv_iternext((HV*)sv)) {
+           I32 keylen;
+           my_setenv(hv_iterkey(entry, &keylen),
+                     SvPV(hv_iterval((HV*)sv, entry), na));
+       }
+    }
+#endif
+    return 0;
+}
+
+int
 magic_clear_all_env(sv,mg)
 SV* sv;
 MAGIC* mg;
@@ -1619,16 +1660,28 @@ MAGIC* mg;
            s += strlen(s);
            /* See if all the arguments are contiguous in memory */
            for (i = 1; i < origargc; i++) {
-               if (origargv[i] == s + 1)
+               if (origargv[i] == s + 1
+#ifdef OS2
+                   || origargv[i] == s + 2
+#endif 
+                  )
                    s += strlen(++s);   /* this one is ok too */
+               else
+                   break;
            }
            /* can grab env area too? */
-           if (origenviron && origenviron[0] == s + 1) {
+           if (origenviron && (origenviron[0] == s + 1
+#ifdef OS2
+                               || (origenviron[0] == s + 9 && (s += 8))
+#endif 
+              )) {
                my_setenv("NoNe  SuCh", Nullch);
                                            /* force copy of environment */
                for (i = 0; origenviron[i]; i++)
                    if (origenviron[i] == s + 1)
                        s += strlen(++s);
+                   else
+                       break;
            }
            origalen = s - origargv[0];
        }
@@ -1636,9 +1689,11 @@ MAGIC* mg;
        i = len;
        if (i >= origalen) {
            i = origalen;
-           SvCUR_set(sv, i);
-           *SvEND(sv) = '\0';
+           /* don't allow system to limit $0 seen by script */
+           /* SvCUR_set(sv, i); *SvEND(sv) = '\0'; */
            Copy(s, origargv[0], i, char);
+           s = origargv[0]+i;
+           *s = '\0';
        }
        else {
            Copy(s, origargv[0], i, char);