Make FAKE,READONLY optional on VMS in test 21

[perl5.git] / util.c

diff --git a/util.c b/util.c
index d253126..48cc63a 100644 (file)
--- a/util.c
+++ b/util.c
@@ -60,6 +60,7 @@ int putenv(char *);
 static char *
 S_write_no_mem(pTHX)
 {
+    dVAR;
     /* Can't use PerlIO to write as it allocates memory */
     PerlLIO_write(PerlIO_fileno(Perl_error_log),
                  PL_no_mem, strlen(PL_no_mem));
@@ -180,9 +181,10 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
 Free_t
 Perl_safesysfree(Malloc_t where)
 {
-    dVAR;
 #if defined(PERL_IMPLICIT_SYS) || defined(PERL_TRACK_MEMPOOL)
     dTHX;
+#else
+    dVAR;
 #endif
     DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) free\n",PTR2UV(where),(long)PL_an++));
     if (where) {
@@ -424,6 +426,7 @@ Analyses the string in order to make fast searches on it using fbm_instr()
 void
 Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
 {
+    dVAR;
     register const U8 *s;
     register U32 i;
     STRLEN len;
@@ -432,7 +435,7 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
 
     if (flags & FBMcf_TAIL) {
        MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : NULL;
-       sv_catpvn(sv, "\n", 1);         /* Taken into account in fbm_instr() */
+       sv_catpvs(sv, "\n");            /* Taken into account in fbm_instr() */
        if (mg && mg->mg_len >= 0)
            mg->mg_len++;
     }
@@ -691,6 +694,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
 char *
 Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift, I32 *old_posp, I32 last)
 {
+    dVAR;
     register const unsigned char *big;
     register I32 pos;
     register I32 previous;
@@ -910,11 +914,12 @@ Perl_savesvpv(pTHX_ SV *sv)
 STATIC SV *
 S_mess_alloc(pTHX)
 {
+    dVAR;
     SV *sv;
     XPVMG *any;
 
     if (!PL_dirty)
-       return sv_2mortal(newSVpvn("",0));
+       return sv_2mortal(newSVpvs(""));
 
     if (PL_mess_sv)
        return PL_mess_sv;
@@ -1011,6 +1016,7 @@ Perl_mess(pTHX_ const char *pat, ...)
 STATIC COP*
 S_closest_cop(pTHX_ COP *cop, const OP *o)
 {
+    dVAR;
     /* Look for PL_op starting from o.  cop is the last COP we've seen. */
 
     if (!o || o == PL_op)
@@ -1043,6 +1049,7 @@ S_closest_cop(pTHX_ COP *cop, const OP *o)
 SV *
 Perl_vmess(pTHX_ const char *pat, va_list *args)
 {
+    dVAR;
     SV * const sv = mess_alloc();
     static const char dgd[] = " during global destruction.\n";
 
@@ -1128,6 +1135,7 @@ Perl_write_to_stderr(pTHX_ const char* message, int msglen)
 STATIC void
 S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8)
 {
+    dVAR;
     HV *stash;
     GV *gv;
     CV *cv;
@@ -1200,6 +1208,7 @@ S_vdie_croak_common(pTHX_ const char* pat, va_list* args, STRLEN* msglen,
 OP *
 Perl_vdie(pTHX_ const char* pat, va_list *args)
 {
+    dVAR;
     const char *message;
     const int was_in_eval = PL_in_eval;
     STRLEN msglen;
@@ -1249,6 +1258,7 @@ Perl_die(pTHX_ const char* pat, ...)
 void
 Perl_vcroak(pTHX_ const char* pat, va_list *args)
 {
+    dVAR;
     const char *message;
     STRLEN msglen;
     I32 utf8 = 0;
@@ -1441,6 +1451,7 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
 bool
 Perl_ckwarn(pTHX_ U32 w)
 {
+    dVAR;
     return
        (
               isLEXWARN_on
@@ -1468,6 +1479,7 @@ Perl_ckwarn(pTHX_ U32 w)
 bool
 Perl_ckwarn_d(pTHX_ U32 w)
 {
+    dVAR;
     return
           isLEXWARN_off
        || PL_curcop->cop_warnings == pWARN_ALL
@@ -2071,6 +2083,7 @@ PerlIO *
 Perl_my_popen_list(pTHX_ char *mode, int n, SV **args)
 {
 #if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(OS2) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(MACOS_TRADITIONAL) && !defined(NETWARE)
+    dVAR;
     int p[2];
     register I32 This, that;
     register Pid_t pid;
@@ -2204,6 +2217,7 @@ Perl_my_popen_list(pTHX_ char *mode, int n, SV **args)
 PerlIO *
 Perl_my_popen(pTHX_ const char *cmd, const char *mode)
 {
+    dVAR;
     int p[2];
     register I32 This, that;
     register Pid_t pid;
@@ -2636,6 +2650,7 @@ Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save)
 I32
 Perl_my_pclose(pTHX_ PerlIO *ptr)
 {
+    dVAR;
     Sigsave_t hstat, istat, qstat;
     int status;
     SV **svp;
@@ -2692,6 +2707,7 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
 I32
 Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
 {
+    dVAR;
     I32 result = 0;
     if (!pid)
        return -1;
@@ -2877,6 +2893,7 @@ char*
 Perl_find_script(pTHX_ const char *scriptname, bool dosearch,
                 const char *const *const search_ext, I32 flags)
 {
+    dVAR;
     const char *xfound = Nullch;
     char *xfailed = Nullch;
     char tmpbuf[MAXPATHLEN];
@@ -3803,7 +3820,7 @@ int
 Perl_getcwd_sv(pTHX_ register SV *sv)
 {
 #ifndef PERL_MICRO
-
+    dVAR;
 #ifndef INCOMPLETE_TAINTS
     SvTAINTED_on(sv);
 #endif
@@ -4014,6 +4031,9 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
        pos++;
     }
 
+    if ( alpha && !saw_period )
+       Perl_croak(aTHX_ "Invalid version format (alpha without decimal)");
+
     if ( saw_period > 1 )
        qv = 1; /* force quoted version processing */
 
@@ -4131,6 +4151,7 @@ want to upgrade the SV.
 SV *
 Perl_new_version(pTHX_ SV *ver)
 {
+    dVAR;
     SV * const rv = newSV(0);
     if ( sv_derived_from(ver,"version") ) /* can just copy directly */
     {
@@ -4308,14 +4329,14 @@ Perl_vnumify(pTHX_ SV *vs)
 
     /* attempt to retrieve the version array */
     if ( !(av = (AV *)SvRV(*hv_fetch((HV*)vs, "version", 7, FALSE)) ) ) {
-       sv_catpvn(sv,"0",1);
+       sv_catpvs(sv,"0");
        return sv;
     }
 
     len = av_len(av);
     if ( len == -1 )
     {
-       sv_catpvn(sv,"0",1);
+       sv_catpvs(sv,"0");
        return sv;
     }
 
@@ -4338,12 +4359,12 @@ Perl_vnumify(pTHX_ SV *vs)
     {
        digit = SvIV(*av_fetch(av, len, 0));
        if ( alpha && width == 3 ) /* alpha version */
-           sv_catpvn(sv,"_",1);
+           sv_catpvs(sv,"_");
        Perl_sv_catpvf(aTHX_ sv, "%0*d", width, (int)digit);
     }
     else /* len == 0 */
     {
-       sv_catpvn(sv,"000",3);
+       sv_catpvs(sv, "000");
     }
     return sv;
 }
@@ -4382,7 +4403,7 @@ Perl_vnormal(pTHX_ SV *vs)
     len = av_len(av);
     if ( len == -1 )
     {
-       sv_catpvn(sv,"",0);
+       sv_catpvs(sv,"");
        return sv;
     }
     digit = SvIV(*av_fetch(av, 0, 0));
@@ -4404,7 +4425,7 @@ Perl_vnormal(pTHX_ SV *vs)
 
     if ( len <= 2 ) { /* short version, must be at least three */
        for ( len = 2 - len; len != 0; len-- )
-           sv_catpvn(sv,".0",2);
+           sv_catpvs(sv,".0");
     }
     return sv;
 }
@@ -4864,6 +4885,7 @@ Perl_parse_unicode_opts(pTHX_ const char **popt)
 U32
 Perl_seed(pTHX)
 {
+    dVAR;
     /*
      * This is really just a quick hack which grabs various garbage
      * values.  It really should be a real hash algorithm which
@@ -4945,6 +4967,7 @@ Perl_seed(pTHX)
 UV
 Perl_get_hash_seed(pTHX)
 {
+    dVAR;
      const char *s = PerlEnv_getenv("PERL_HASH_SEED");
      UV myseed = 0;
 
@@ -5209,6 +5232,7 @@ extending the interpreter's PL_my_cxt_list array */
 void *
 Perl_my_cxt_init(pTHX_ int *index, size_t size)
 {
+    dVAR;
     void *p;
     if (*index == -1) {
        /* this module hasn't been allocated an index yet */