| File: | obj/gnu/usr.bin/perl/dist/PathTools/Cwd.c |
| Warning: | line 852, column 7 Value stored to 'self' during its initialization is never read |
Press '?' to see keyboard shortcuts
Keyboard shortcuts:
| 1 | /* |
| 2 | * This file was generated automatically by ExtUtils::ParseXS version 3.40 from the |
| 3 | * contents of Cwd.xs. Do not edit this file, edit Cwd.xs instead. |
| 4 | * |
| 5 | * ANY CHANGES MADE HERE WILL BE LOST! |
| 6 | * |
| 7 | */ |
| 8 | |
| 9 | #line 1 "Cwd.xs" |
| 10 | /* |
| 11 | * ex: set ts=8 sts=4 sw=4 et: |
| 12 | */ |
| 13 | |
| 14 | #define PERL_NO_GET_CONTEXT |
| 15 | |
| 16 | #include "EXTERN.h" |
| 17 | #include "perl.h" |
| 18 | #include "XSUB.h" |
| 19 | #ifndef NO_PPPORT_H1 |
| 20 | # define NEED_croak_xs_usage |
| 21 | # define NEED_sv_2pv_flags |
| 22 | # define NEED_my_strlcpy |
| 23 | # define NEED_my_strlcat |
| 24 | # include "ppport.h" |
| 25 | #endif |
| 26 | |
| 27 | #ifdef I_UNISTD |
| 28 | # include <unistd.h> |
| 29 | #endif |
| 30 | |
| 31 | /* For special handling of os390 sysplexed systems */ |
| 32 | #define SYSNAME"$SYSNAME" "$SYSNAME" |
| 33 | #define SYSNAME_LEN(sizeof("$SYSNAME") - 1) (sizeof(SYSNAME"$SYSNAME") - 1) |
| 34 | |
| 35 | /* The realpath() implementation from OpenBSD 3.9 to 4.2 (realpath.c 1.13) |
| 36 | * Renamed here to bsd_realpath() to avoid library conflicts. |
| 37 | */ |
| 38 | |
| 39 | /* See |
| 40 | * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2004-11/msg00979.html |
| 41 | * for the details of why the BSD license is compatible with the |
| 42 | * AL/GPL standard perl license. |
| 43 | */ |
| 44 | |
| 45 | /* |
| 46 | * Copyright (c) 2003 Constantin S. Svintsoff <kostik@iclub.nsu.ru> |
| 47 | * |
| 48 | * Redistribution and use in source and binary forms, with or without |
| 49 | * modification, are permitted provided that the following conditions |
| 50 | * are met: |
| 51 | * 1. Redistributions of source code must retain the above copyright |
| 52 | * notice, this list of conditions and the following disclaimer. |
| 53 | * 2. Redistributions in binary form must reproduce the above copyright |
| 54 | * notice, this list of conditions and the following disclaimer in the |
| 55 | * documentation and/or other materials provided with the distribution. |
| 56 | * 3. The names of the authors may not be used to endorse or promote |
| 57 | * products derived from this software without specific prior written |
| 58 | * permission. |
| 59 | * |
| 60 | * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS "AS IS" AND |
| 61 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
| 62 | * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
| 63 | * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE |
| 64 | * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
| 65 | * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
| 66 | * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
| 67 | * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
| 68 | * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
| 69 | * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
| 70 | * SUCH DAMAGE. |
| 71 | */ |
| 72 | |
| 73 | /* OpenBSD system #includes removed since the Perl ones should do. --jhi */ |
| 74 | |
| 75 | #ifndef MAXSYMLINKS32 |
| 76 | #define MAXSYMLINKS32 8 |
| 77 | #endif |
| 78 | |
| 79 | #ifndef VMS |
| 80 | /* |
| 81 | * char *realpath(const char *path, char resolved[MAXPATHLEN]); |
| 82 | * |
| 83 | * Find the real name of path, by removing all ".", ".." and symlink |
| 84 | * components. Returns (resolved) on success, or (NULL) on failure, |
| 85 | * in which case the path which caused trouble is left in (resolved). |
| 86 | */ |
| 87 | static |
| 88 | char * |
| 89 | bsd_realpath(const char *path, char resolved[MAXPATHLEN1024]) |
| 90 | { |
| 91 | char *p, *q, *s; |
| 92 | size_t remaining_len, resolved_len; |
| 93 | unsigned symlinks; |
| 94 | int serrno; |
| 95 | char remaining[MAXPATHLEN1024], next_token[MAXPATHLEN1024]; |
| 96 | |
| 97 | serrno = errno(*__errno()); |
| 98 | symlinks = 0; |
| 99 | if (path[0] == '/') { |
| 100 | resolved[0] = '/'; |
| 101 | resolved[1] = '\0'; |
| 102 | if (path[1] == '\0') |
| 103 | return (resolved); |
| 104 | resolved_len = 1; |
| 105 | remaining_len = my_strlcpystrlcpy(remaining, path + 1, sizeof(remaining)); |
| 106 | } else { |
| 107 | if (getcwd(resolved, MAXPATHLEN1024) == NULL((void*)0)) { |
| 108 | my_strlcpystrlcpy(resolved, ".", MAXPATHLEN1024); |
| 109 | return (NULL((void*)0)); |
| 110 | } |
| 111 | resolved_len = strlen(resolved); |
| 112 | remaining_len = my_strlcpystrlcpy(remaining, path, sizeof(remaining)); |
| 113 | } |
| 114 | if (remaining_len >= sizeof(remaining) || resolved_len >= MAXPATHLEN1024) { |
| 115 | errno(*__errno()) = ENAMETOOLONG63; |
| 116 | return (NULL((void*)0)); |
| 117 | } |
| 118 | |
| 119 | /* |
| 120 | * Iterate over path components in 'remaining'. |
| 121 | */ |
| 122 | while (remaining_len != 0) { |
| 123 | |
| 124 | /* |
| 125 | * Extract the next path component and adjust 'remaining' |
| 126 | * and its length. |
| 127 | */ |
| 128 | |
| 129 | p = strchr(remaining, '/'); |
| 130 | s = p ? p : remaining + remaining_len; |
| 131 | if ((STRLEN)(s - remaining) >= (STRLEN)sizeof(next_token)) { |
| 132 | errno(*__errno()) = ENAMETOOLONG63; |
| 133 | return (NULL((void*)0)); |
| 134 | } |
| 135 | memcpy(next_token, remaining, s - remaining); |
| 136 | next_token[s - remaining] = '\0'; |
| 137 | remaining_len -= s - remaining; |
| 138 | if (p != NULL((void*)0)) |
| 139 | memmove(remaining, s + 1, remaining_len + 1); |
| 140 | if (resolved[resolved_len - 1] != '/') { |
| 141 | if (resolved_len + 1 >= MAXPATHLEN1024) { |
| 142 | errno(*__errno()) = ENAMETOOLONG63; |
| 143 | return (NULL((void*)0)); |
| 144 | } |
| 145 | resolved[resolved_len++] = '/'; |
| 146 | resolved[resolved_len] = '\0'; |
| 147 | } |
| 148 | if (next_token[0] == '\0') |
| 149 | continue; |
| 150 | else if (strEQ(next_token, ".")(strcmp(next_token,".") == 0)) |
| 151 | continue; |
| 152 | else if (strEQ(next_token, "..")(strcmp(next_token,"..") == 0)) { |
| 153 | /* |
| 154 | * Strip the last path component except when we have |
| 155 | * single "/" |
| 156 | */ |
| 157 | if (resolved_len > 1) { |
| 158 | resolved[resolved_len - 1] = '\0'; |
| 159 | q = strrchr(resolved, '/') + 1; |
| 160 | *q = '\0'; |
| 161 | resolved_len = q - resolved; |
| 162 | } |
| 163 | continue; |
| 164 | } |
| 165 | |
| 166 | /* |
| 167 | * Append the next path component and lstat() it. If |
| 168 | * lstat() fails we still can return successfully if |
| 169 | * there are no more path components left. |
| 170 | */ |
| 171 | resolved_len = my_strlcatstrlcat(resolved, next_token, MAXPATHLEN1024); |
| 172 | if (resolved_len >= MAXPATHLEN1024) { |
| 173 | errno(*__errno()) = ENAMETOOLONG63; |
| 174 | return (NULL((void*)0)); |
| 175 | } |
| 176 | #if defined(HAS_LSTAT) && defined(HAS_READLINK) && defined(HAS_SYMLINK) |
| 177 | { |
| 178 | struct stat sb; |
| 179 | if (lstat(resolved, &sb) != 0) { |
| 180 | if (errno(*__errno()) == ENOENT2 && p == NULL((void*)0)) { |
| 181 | errno(*__errno()) = serrno; |
| 182 | return (resolved); |
| 183 | } |
| 184 | return (NULL((void*)0)); |
| 185 | } |
| 186 | if (S_ISLNK(sb.st_mode)((sb.st_mode & 0170000) == 0120000)) { |
| 187 | int slen; |
| 188 | char symlink[MAXPATHLEN1024]; |
| 189 | |
| 190 | if (symlinks++ > MAXSYMLINKS32) { |
| 191 | errno(*__errno()) = ELOOP62; |
| 192 | return (NULL((void*)0)); |
| 193 | } |
| 194 | slen = readlink(resolved, symlink, sizeof(symlink) - 1); |
| 195 | if (slen < 0) |
| 196 | return (NULL((void*)0)); |
| 197 | symlink[slen] = '\0'; |
| 198 | # ifdef EBCDIC /* XXX Probably this should be only os390 */ |
| 199 | /* Replace all instances of $SYSNAME/foo simply by /foo */ |
| 200 | if (slen > SYSNAME_LEN(sizeof("$SYSNAME") - 1) + strlen(next_token) |
| 201 | && strnEQ(symlink, SYSNAME, SYSNAME_LEN)(strncmp(symlink,"$SYSNAME",(sizeof("$SYSNAME") - 1)) == 0) |
| 202 | && *(symlink + SYSNAME_LEN(sizeof("$SYSNAME") - 1)) == '/' |
| 203 | && strEQ(symlink + SYSNAME_LEN + 1, next_token)(strcmp(symlink + (sizeof("$SYSNAME") - 1) + 1,next_token) == 0)) |
| 204 | { |
| 205 | goto not_symlink; |
| 206 | } |
| 207 | # endif |
| 208 | if (symlink[0] == '/') { |
| 209 | resolved[1] = 0; |
| 210 | resolved_len = 1; |
| 211 | } else if (resolved_len > 1) { |
| 212 | /* Strip the last path component. */ |
| 213 | resolved[resolved_len - 1] = '\0'; |
| 214 | q = strrchr(resolved, '/') + 1; |
| 215 | *q = '\0'; |
| 216 | resolved_len = q - resolved; |
| 217 | } |
| 218 | |
| 219 | /* |
| 220 | * If there are any path components left, then |
| 221 | * append them to symlink. The result is placed |
| 222 | * in 'remaining'. |
| 223 | */ |
| 224 | if (p != NULL((void*)0)) { |
| 225 | if (symlink[slen - 1] != '/') { |
| 226 | if ((STRLEN)(slen + 1) >= (STRLEN)sizeof(symlink)) { |
| 227 | errno(*__errno()) = ENAMETOOLONG63; |
| 228 | return (NULL((void*)0)); |
| 229 | } |
| 230 | symlink[slen] = '/'; |
| 231 | symlink[slen + 1] = 0; |
| 232 | } |
| 233 | remaining_len = my_strlcatstrlcat(symlink, remaining, sizeof(symlink)); |
| 234 | if (remaining_len >= sizeof(remaining)) { |
| 235 | errno(*__errno()) = ENAMETOOLONG63; |
| 236 | return (NULL((void*)0)); |
| 237 | } |
| 238 | } |
| 239 | remaining_len = my_strlcpystrlcpy(remaining, symlink, sizeof(remaining)); |
| 240 | } |
| 241 | # ifdef EBCDIC |
| 242 | not_symlink: ; |
| 243 | # endif |
| 244 | } |
| 245 | #endif |
| 246 | } |
| 247 | |
| 248 | /* |
| 249 | * Remove trailing slash except when the resolved pathname |
| 250 | * is a single "/". |
| 251 | */ |
| 252 | if (resolved_len > 1 && resolved[resolved_len - 1] == '/') |
| 253 | resolved[resolved_len - 1] = '\0'; |
| 254 | return (resolved); |
| 255 | } |
| 256 | #endif |
| 257 | |
| 258 | #ifndef SV_CWD_RETURN_UNDEFPerl_sv_setsv_flags( sv,&(PL_sv_immortals[1]),2|0); return (0) |
| 259 | #define SV_CWD_RETURN_UNDEFPerl_sv_setsv_flags( sv,&(PL_sv_immortals[1]),2|0); return (0) \Perl_sv_setsv_flags( sv,&(PL_sv_immortals[1]),2|0) |
| 260 | sv_setsv(sv, &PL_sv_undef)Perl_sv_setsv_flags( sv,&(PL_sv_immortals[1]),2|0); \ |
| 261 | return FALSE(0) |
| 262 | #endif |
| 263 | |
| 264 | #ifndef OPpENTERSUB_HASTARG0x04 |
| 265 | #define OPpENTERSUB_HASTARG0x04 32 /* Called from OP tree. */ |
| 266 | #endif |
| 267 | |
| 268 | #ifndef dXSTARGSV * const targ = ((PL_op->op_private & 0x04) ? (PL_curpad [PL_op->op_targ]) : Perl_sv_newmortal()) |
| 269 | #define dXSTARGSV * const targ = ((PL_op->op_private & 0x04) ? (PL_curpad [PL_op->op_targ]) : Perl_sv_newmortal()) SV * targ = ((PL_op->op_private & OPpENTERSUB_HASTARG0x04) \ |
| 270 | ? PAD_SV(PL_op->op_targ)(PL_curpad[PL_op->op_targ]) : sv_newmortal()Perl_sv_newmortal()) |
| 271 | #endif |
| 272 | |
| 273 | #ifndef XSprePUSH(sp = PL_stack_base + ax - 1) |
| 274 | #define XSprePUSH(sp = PL_stack_base + ax - 1) (sp = PL_stack_base + ax - 1) |
| 275 | #endif |
| 276 | |
| 277 | #ifndef SV_CWD_ISDOT |
| 278 | #define SV_CWD_ISDOT(dp)(dp->d_name[0] == '.' && (dp->d_name[1] == '\0' || (dp->d_name[1] == '.' && dp->d_name[2] == '\0' ))) \ |
| 279 | (dp->d_name[0] == '.' && (dp->d_name[1] == '\0' || \ |
| 280 | (dp->d_name[1] == '.' && dp->d_name[2] == '\0'))) |
| 281 | #endif |
| 282 | |
| 283 | #ifndef getcwd_sv |
| 284 | /* Taken from perl 5.8's util.c */ |
| 285 | #define getcwd_sv(a)Perl_getcwd_sv( a) Perl_getcwd_sv(aTHX_ a) |
| 286 | int Perl_getcwd_sv(pTHX_ SV *sv) |
| 287 | { |
| 288 | #ifndef PERL_MICRO |
| 289 | |
| 290 | SvTAINTED_on(sv)do{ if(__builtin_expect((((((__builtin_expect(((PL_tainting) ? (_Bool)1 : (_Bool)0),(0))) ? (_Bool)1 : (_Bool)0))) ? (_Bool )1 : (_Bool)0),(0))){Perl_sv_magic( (sv),((void*)0),'t',((void *)0),0);} }while (0); |
| 291 | |
| 292 | #ifdef HAS_GETCWD |
| 293 | { |
| 294 | char buf[MAXPATHLEN1024]; |
| 295 | |
| 296 | /* Some getcwd()s automatically allocate a buffer of the given |
| 297 | * size from the heap if they are given a NULL buffer pointer. |
| 298 | * The problem is that this behaviour is not portable. */ |
| 299 | if (getcwd(buf, sizeof(buf) - 1)) { |
| 300 | STRLEN len = strlen(buf); |
| 301 | sv_setpvn(sv, buf, len)Perl_sv_setpvn( sv,buf,len); |
| 302 | return TRUE(1); |
| 303 | } |
| 304 | else { |
| 305 | sv_setsv(sv, &PL_sv_undef)Perl_sv_setsv_flags( sv,&(PL_sv_immortals[1]),2|0); |
| 306 | return FALSE(0); |
| 307 | } |
| 308 | } |
| 309 | |
| 310 | #else |
| 311 | { |
| 312 | Stat_tstruct stat statbuf; |
| 313 | int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino; |
| 314 | int namelen, pathlen=0; |
| 315 | DIR *dir; |
| 316 | Direntry_tstruct dirent *dp; |
| 317 | |
| 318 | (void)SvUPGRADE(sv, SVt_PV)((void)(((svtype)((sv)->sv_flags & 0xff)) >= (SVt_PV ) || (Perl_sv_upgrade( sv,SVt_PV),1))); |
| 319 | |
| 320 | if (PerlLIO_lstat(".", &statbuf)lstat(("."), (&statbuf)) < 0) { |
| 321 | SV_CWD_RETURN_UNDEFPerl_sv_setsv_flags( sv,&(PL_sv_immortals[1]),2|0); return (0); |
| 322 | } |
| 323 | |
| 324 | orig_cdev = statbuf.st_dev; |
| 325 | orig_cino = statbuf.st_ino; |
| 326 | cdev = orig_cdev; |
| 327 | cino = orig_cino; |
| 328 | |
| 329 | for (;;) { |
| 330 | odev = cdev; |
| 331 | oino = cino; |
| 332 | |
| 333 | if (PerlDir_chdir("..")chdir(("..")) < 0) { |
| 334 | SV_CWD_RETURN_UNDEFPerl_sv_setsv_flags( sv,&(PL_sv_immortals[1]),2|0); return (0); |
| 335 | } |
| 336 | if (PerlLIO_stat(".", &statbuf)stat(((".")),((&statbuf))) < 0) { |
| 337 | SV_CWD_RETURN_UNDEFPerl_sv_setsv_flags( sv,&(PL_sv_immortals[1]),2|0); return (0); |
| 338 | } |
| 339 | |
| 340 | cdev = statbuf.st_dev; |
| 341 | cino = statbuf.st_ino; |
| 342 | |
| 343 | if (odev == cdev && oino == cino) { |
| 344 | break; |
| 345 | } |
| 346 | if (!(dir = PerlDir_open(".")opendir((".")))) { |
| 347 | SV_CWD_RETURN_UNDEFPerl_sv_setsv_flags( sv,&(PL_sv_immortals[1]),2|0); return (0); |
| 348 | } |
| 349 | |
| 350 | while ((dp = PerlDir_read(dir)readdir((dir))) != NULL((void*)0)) { |
| 351 | #ifdef DIRNAMLEN |
| 352 | namelen = dp->d_namlen; |
| 353 | #else |
| 354 | namelen = strlen(dp->d_name); |
| 355 | #endif |
| 356 | /* skip . and .. */ |
| 357 | if (SV_CWD_ISDOT(dp)(dp->d_name[0] == '.' && (dp->d_name[1] == '\0' || (dp->d_name[1] == '.' && dp->d_name[2] == '\0' )))) { |
| 358 | continue; |
| 359 | } |
| 360 | |
| 361 | if (PerlLIO_lstat(dp->d_name, &statbuf)lstat((dp->d_name), (&statbuf)) < 0) { |
| 362 | SV_CWD_RETURN_UNDEFPerl_sv_setsv_flags( sv,&(PL_sv_immortals[1]),2|0); return (0); |
| 363 | } |
| 364 | |
| 365 | tdev = statbuf.st_dev; |
| 366 | tino = statbuf.st_ino; |
| 367 | if (tino == oino && tdev == odev) { |
| 368 | break; |
| 369 | } |
| 370 | } |
| 371 | |
| 372 | if (!dp) { |
| 373 | SV_CWD_RETURN_UNDEFPerl_sv_setsv_flags( sv,&(PL_sv_immortals[1]),2|0); return (0); |
| 374 | } |
| 375 | |
| 376 | if (pathlen + namelen + 1 >= MAXPATHLEN1024) { |
| 377 | SV_CWD_RETURN_UNDEFPerl_sv_setsv_flags( sv,&(PL_sv_immortals[1]),2|0); return (0); |
| 378 | } |
| 379 | |
| 380 | SvGROW(sv, pathlen + namelen + 1)(((sv)->sv_flags & 0x10000000) || ((XPV*) (sv)->sv_any )->xpv_len_u.xpvlenu_len < (pathlen + namelen + 1) ? Perl_sv_grow ( sv,pathlen + namelen + 1) : ((sv)->sv_u.svu_pv)); |
| 381 | |
| 382 | if (pathlen) { |
| 383 | /* shift down */ |
| 384 | Move(SvPVX(sv), SvPVX(sv) + namelen + 1, pathlen, char)((void)(__builtin_expect(((((( sizeof(size_t) < sizeof(pathlen ) || sizeof(char) > ((size_t)1 << 8*(sizeof(size_t) - sizeof(pathlen)))) ? (size_t)(pathlen) : ((size_t)-1)/sizeof (char)) > ((size_t)-1)/sizeof(char))) ? (_Bool)1 : (_Bool) 0),(0)) && (Perl_croak_memory_wrap(),0)), ((void)0), ( (void)0), (void)memmove((char*)(((sv)->sv_u.svu_pv) + namelen + 1),(const char*)(((sv)->sv_u.svu_pv)), (pathlen) * sizeof (char))); |
| 385 | } |
| 386 | |
| 387 | /* prepend current directory to the front */ |
| 388 | *SvPVX(sv)((sv)->sv_u.svu_pv) = '/'; |
| 389 | Move(dp->d_name, SvPVX(sv)+1, namelen, char)((void)(__builtin_expect(((((( sizeof(size_t) < sizeof(namelen ) || sizeof(char) > ((size_t)1 << 8*(sizeof(size_t) - sizeof(namelen)))) ? (size_t)(namelen) : ((size_t)-1)/sizeof (char)) > ((size_t)-1)/sizeof(char))) ? (_Bool)1 : (_Bool) 0),(0)) && (Perl_croak_memory_wrap(),0)), ((void)0), ( (void)0), (void)memmove((char*)(((sv)->sv_u.svu_pv)+1),(const char*)(dp->d_name), (namelen) * sizeof(char))); |
| 390 | pathlen += (namelen + 1); |
| 391 | |
| 392 | #ifdef VOID_CLOSEDIR |
| 393 | PerlDir_close(dir)closedir((dir)); |
| 394 | #else |
| 395 | if (PerlDir_close(dir)closedir((dir)) < 0) { |
| 396 | SV_CWD_RETURN_UNDEFPerl_sv_setsv_flags( sv,&(PL_sv_immortals[1]),2|0); return (0); |
| 397 | } |
| 398 | #endif |
| 399 | } |
| 400 | |
| 401 | if (pathlen) { |
| 402 | SvCUR_set(sv, pathlen)do { ((void)0); ((void)0); ((void)0); (((XPV*) (sv)->sv_any )->xpv_cur = (pathlen)); } while (0); |
| 403 | *SvEND(sv)((sv)->sv_u.svu_pv + ((XPV*)(sv)->sv_any)->xpv_cur) = '\0'; |
| 404 | SvPOK_only(sv)( (sv)->sv_flags &= ~((0x00000100|0x00000200|0x00000400 |0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)| 0x80000000 |0x20000000), (sv)->sv_flags |= (0x00000400|0x00004000)); |
| 405 | |
| 406 | if (PerlDir_chdir(SvPVX(sv))chdir((((sv)->sv_u.svu_pv))) < 0) { |
| 407 | SV_CWD_RETURN_UNDEFPerl_sv_setsv_flags( sv,&(PL_sv_immortals[1]),2|0); return (0); |
| 408 | } |
| 409 | } |
| 410 | if (PerlLIO_stat(".", &statbuf)stat(((".")),((&statbuf))) < 0) { |
| 411 | SV_CWD_RETURN_UNDEFPerl_sv_setsv_flags( sv,&(PL_sv_immortals[1]),2|0); return (0); |
| 412 | } |
| 413 | |
| 414 | cdev = statbuf.st_dev; |
| 415 | cino = statbuf.st_ino; |
| 416 | |
| 417 | if (cdev != orig_cdev || cino != orig_cino) { |
| 418 | Perl_croak(aTHX_ "Unstable directory path, " |
| 419 | "current directory changed unexpectedly"); |
| 420 | } |
| 421 | |
| 422 | return TRUE(1); |
| 423 | } |
| 424 | #endif |
| 425 | |
| 426 | #else |
| 427 | return FALSE(0); |
| 428 | #endif |
| 429 | } |
| 430 | |
| 431 | #endif |
| 432 | |
| 433 | #if defined(START_MY_CXTstatic my_cxt_t my_cxt;) && defined(MY_CXT_CLONE(void)0) |
| 434 | # define USE_MY_CXT1 1 |
| 435 | #else |
| 436 | # define USE_MY_CXT1 0 |
| 437 | #endif |
| 438 | |
| 439 | #if USE_MY_CXT1 |
| 440 | # define MY_CXT_KEY"Cwd::_guts" "3.78" "Cwd::_guts" XS_VERSION"3.78" |
| 441 | typedef struct { |
| 442 | SV *empty_string_sv, *slash_string_sv; |
| 443 | } my_cxt_t; |
| 444 | START_MY_CXTstatic my_cxt_t my_cxt; |
| 445 | # define dUSE_MY_CXTstruct Perl___notused_struct dMY_CXTstruct Perl___notused_struct |
| 446 | # define EMPTY_STRING_SVmy_cxt.empty_string_sv MY_CXTmy_cxt.empty_string_sv |
| 447 | # define SLASH_STRING_SVmy_cxt.slash_string_sv MY_CXTmy_cxt.slash_string_sv |
| 448 | # define POPULATE_MY_CXTdo { my_cxt.empty_string_sv = Perl_newSVpvn( ("" "" ""), (sizeof ("")-1)); my_cxt.slash_string_sv = Perl_newSVpvn( ("" "/" "") , (sizeof("/")-1)); } while(0) do { \ |
| 449 | MY_CXTmy_cxt.empty_string_sv = newSVpvs("")Perl_newSVpvn( ("" "" ""), (sizeof("")-1)); \ |
| 450 | MY_CXTmy_cxt.slash_string_sv = newSVpvs("/")Perl_newSVpvn( ("" "/" ""), (sizeof("/")-1)); \ |
| 451 | } while(0) |
| 452 | #else |
| 453 | # define dUSE_MY_CXTstruct Perl___notused_struct dNOOPstruct Perl___notused_struct |
| 454 | # define EMPTY_STRING_SVmy_cxt.empty_string_sv sv_2mortal(newSVpvs(""))Perl_sv_2mortal( Perl_newSVpvn( ("" "" ""), (sizeof("")-1))) |
| 455 | # define SLASH_STRING_SVmy_cxt.slash_string_sv sv_2mortal(newSVpvs("/"))Perl_sv_2mortal( Perl_newSVpvn( ("" "/" ""), (sizeof("/")-1)) ) |
| 456 | #endif |
| 457 | |
| 458 | #define invocant_is_unix(i)THX_invocant_is_unix( i) THX_invocant_is_unix(aTHX_ i) |
| 459 | static |
| 460 | bool_Bool |
| 461 | THX_invocant_is_unix(pTHX_ SV *invocant) |
| 462 | { |
| 463 | /* |
| 464 | * This is used to enable optimisations that avoid method calls |
| 465 | * by knowing how they would resolve. False negatives, disabling |
| 466 | * the optimisation where it would actually behave correctly, are |
| 467 | * acceptable. |
| 468 | */ |
| 469 | return SvPOK(invocant)((invocant)->sv_flags & 0x00000400) && SvCUR(invocant)((XPV*) (invocant)->sv_any)->xpv_cur == 16 && |
| 470 | !memcmp(SvPVX(invocant)((invocant)->sv_u.svu_pv), "File::Spec::Unix", 16); |
| 471 | } |
| 472 | |
| 473 | #define unix_canonpath(p)THX_unix_canonpath( p) THX_unix_canonpath(aTHX_ p) |
| 474 | static |
| 475 | SV * |
| 476 | THX_unix_canonpath(pTHX_ SV *path) |
| 477 | { |
| 478 | SV *retval; |
| 479 | char const *p, *pe, *q; |
| 480 | STRLEN l; |
| 481 | char *o; |
| 482 | STRLEN plen; |
| 483 | SvGETMAGIC(path)((void)(__builtin_expect(((((path)->sv_flags & 0x00200000 )) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( path)) ); |
| 484 | if(!SvOK(path)((path)->sv_flags & (0x00000100|0x00000200|0x00000400| 0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000))) return &PL_sv_undef(PL_sv_immortals[1]); |
| 485 | p = SvPV_nomg(path, plen)((((path)->sv_flags & (0x00000400|0x00200000)) == 0x00000400 ) ? ((plen = ((XPV*) (path)->sv_any)->xpv_cur), ((path) ->sv_u.svu_pv)) : Perl_sv_2pv_flags( path,&plen,0)); |
| 486 | if(plen == 0) return newSVpvs("")Perl_newSVpvn( ("" "" ""), (sizeof("")-1)); |
| 487 | pe = p + plen; |
| 488 | retval = newSV(plen)Perl_newSV( plen); |
| 489 | #ifdef SvUTF8 |
| 490 | if(SvUTF8(path)((path)->sv_flags & 0x20000000)) SvUTF8_on(retval)((retval)->sv_flags |= (0x20000000)); |
| 491 | #endif |
| 492 | o = SvPVX(retval)((retval)->sv_u.svu_pv); |
| 493 | if(DOUBLE_SLASHES_SPECIAL0 && p[0] == '/' && p[1] == '/' && p[2] != '/') { |
| 494 | q = (const char *) memchr(p+2, '/', pe-(p+2)); |
| 495 | if(!q) q = pe; |
| 496 | l = q - p; |
| 497 | memcpy(o, p, l); |
| 498 | p = q; |
| 499 | o += l; |
| 500 | } |
| 501 | /* |
| 502 | * The transformations performed here are: |
| 503 | * . squeeze multiple slashes |
| 504 | * . eliminate "." segments, except one if that's all there is |
| 505 | * . eliminate leading ".." segments |
| 506 | * . eliminate trailing slash, unless it's all there is |
| 507 | */ |
| 508 | if(p[0] == '/') { |
| 509 | *o++ = '/'; |
| 510 | while(1) { |
| 511 | do { p++; } while(p[0] == '/'); |
| 512 | if(p[0] == '.' && p[1] == '.' && (p+2 == pe || p[2] == '/')) { |
| 513 | p++; |
| 514 | /* advance past second "." next time round loop */ |
| 515 | } else if(p[0] == '.' && (p+1 == pe || p[1] == '/')) { |
| 516 | /* advance past "." next time round loop */ |
| 517 | } else { |
| 518 | break; |
| 519 | } |
| 520 | } |
| 521 | } else if(p[0] == '.' && p[1] == '/') { |
| 522 | do { |
| 523 | p++; |
| 524 | do { p++; } while(p[0] == '/'); |
| 525 | } while(p[0] == '.' && p[1] == '/'); |
| 526 | if(p == pe) *o++ = '.'; |
| 527 | } |
| 528 | if(p == pe) goto end; |
| 529 | while(1) { |
| 530 | q = (const char *) memchr(p, '/', pe-p); |
| 531 | if(!q) q = pe; |
| 532 | l = q - p; |
| 533 | memcpy(o, p, l); |
| 534 | p = q; |
| 535 | o += l; |
| 536 | if(p == pe) goto end; |
| 537 | while(1) { |
| 538 | do { p++; } while(p[0] == '/'); |
| 539 | if(p == pe) goto end; |
| 540 | if(p[0] != '.') break; |
| 541 | if(p+1 == pe) goto end; |
| 542 | if(p[1] != '/') break; |
| 543 | p++; |
| 544 | } |
| 545 | *o++ = '/'; |
| 546 | } |
| 547 | end: ; |
| 548 | *o = 0; |
| 549 | SvPOK_on(retval)( (retval)->sv_flags |= (0x00000400|0x00004000)); |
| 550 | SvCUR_set(retval, o - SvPVX(retval))do { ((void)0); ((void)0); ((void)0); (((XPV*) (retval)->sv_any )->xpv_cur = (o - ((retval)->sv_u.svu_pv))); } while (0 ); |
| 551 | SvTAINT(retval)do { ((void)0); if (__builtin_expect((((((__builtin_expect((( PL_tainted) ? (_Bool)1 : (_Bool)0),(0))) ? (_Bool)1 : (_Bool) 0))) ? (_Bool)1 : (_Bool)0),(0))) do{ if(__builtin_expect(((( ((__builtin_expect(((PL_tainting) ? (_Bool)1 : (_Bool)0),(0)) ) ? (_Bool)1 : (_Bool)0))) ? (_Bool)1 : (_Bool)0),(0))){Perl_sv_magic ( (retval),((void*)0),'t',((void*)0),0);} }while (0); } while (0); |
| 552 | return retval; |
| 553 | } |
| 554 | |
| 555 | #line 556 "Cwd.c" |
| 556 | #ifndef PERL_UNUSED_VAR |
| 557 | # define PERL_UNUSED_VAR(var)((void)sizeof(var)) if (0) var = var |
| 558 | #endif |
| 559 | |
| 560 | #ifndef dVARstruct Perl___notused_struct |
| 561 | # define dVARstruct Perl___notused_struct dNOOPstruct Perl___notused_struct |
| 562 | #endif |
| 563 | |
| 564 | |
| 565 | /* This stuff is not part of the API! You have been warned. */ |
| 566 | #ifndef PERL_VERSION_DECIMAL |
| 567 | # define PERL_VERSION_DECIMAL(r,v,s)(r*1000000 + v*1000 + s) (r*1000000 + v*1000 + s) |
| 568 | #endif |
| 569 | #ifndef PERL_DECIMAL_VERSION(5*1000000 + 32*1000 + 1) |
| 570 | # define PERL_DECIMAL_VERSION(5*1000000 + 32*1000 + 1) \ |
| 571 | PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)(5*1000000 + 32*1000 + 1) |
| 572 | #endif |
| 573 | #ifndef PERL_VERSION_GE |
| 574 | # define PERL_VERSION_GE(r,v,s)((5*1000000 + 32*1000 + 1) >= (r*1000000 + v*1000 + s)) \ |
| 575 | (PERL_DECIMAL_VERSION(5*1000000 + 32*1000 + 1) >= PERL_VERSION_DECIMAL(r,v,s)(r*1000000 + v*1000 + s)) |
| 576 | #endif |
| 577 | #ifndef PERL_VERSION_LE |
| 578 | # define PERL_VERSION_LE(r,v,s)((5*1000000 + 32*1000 + 1) <= (r*1000000 + v*1000 + s)) \ |
| 579 | (PERL_DECIMAL_VERSION(5*1000000 + 32*1000 + 1) <= PERL_VERSION_DECIMAL(r,v,s)(r*1000000 + v*1000 + s)) |
| 580 | #endif |
| 581 | |
| 582 | /* XS_INTERNAL is the explicit static-linkage variant of the default |
| 583 | * XS macro. |
| 584 | * |
| 585 | * XS_EXTERNAL is the same as XS_INTERNAL except it does not include |
| 586 | * "STATIC", ie. it exports XSUB symbols. You probably don't want that |
| 587 | * for anything but the BOOT XSUB. |
| 588 | * |
| 589 | * See XSUB.h in core! |
| 590 | */ |
| 591 | |
| 592 | |
| 593 | /* TODO: This might be compatible further back than 5.10.0. */ |
| 594 | #if PERL_VERSION_GE(5, 10, 0)((5*1000000 + 32*1000 + 1) >= (5*1000000 + 10*1000 + 0)) && PERL_VERSION_LE(5, 15, 1)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 15*1000 + 1)) |
| 595 | # undef XS_EXTERNAL |
| 596 | # undef XS_INTERNAL |
| 597 | # if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING) |
| 598 | # define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) __declspec(dllexport) XSPROTO(name)void name( CV* cv __attribute__((unused))) |
| 599 | # define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) STATICstatic XSPROTO(name)void name( CV* cv __attribute__((unused))) |
| 600 | # endif |
| 601 | # if defined(__SYMBIAN32__) |
| 602 | # define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) EXPORT_C XSPROTO(name)void name( CV* cv __attribute__((unused))) |
| 603 | # define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) EXPORT_C STATICstatic XSPROTO(name)void name( CV* cv __attribute__((unused))) |
| 604 | # endif |
| 605 | # ifndef XS_EXTERNAL |
| 606 | # if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus) |
| 607 | # define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) void name(pTHX_ CV* cv __attribute__unused____attribute__((unused))) |
| 608 | # define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) STATICstatic void name(pTHX_ CV* cv __attribute__unused____attribute__((unused))) |
| 609 | # else |
| 610 | # ifdef __cplusplus |
| 611 | # define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) extern "C" XSPROTO(name)void name( CV* cv __attribute__((unused))) |
| 612 | # define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) static XSPROTO(name)void name( CV* cv __attribute__((unused))) |
| 613 | # else |
| 614 | # define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) XSPROTO(name)void name( CV* cv __attribute__((unused))) |
| 615 | # define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) STATICstatic XSPROTO(name)void name( CV* cv __attribute__((unused))) |
| 616 | # endif |
| 617 | # endif |
| 618 | # endif |
| 619 | #endif |
| 620 | |
| 621 | /* perl >= 5.10.0 && perl <= 5.15.1 */ |
| 622 | |
| 623 | |
| 624 | /* The XS_EXTERNAL macro is used for functions that must not be static |
| 625 | * like the boot XSUB of a module. If perl didn't have an XS_EXTERNAL |
| 626 | * macro defined, the best we can do is assume XS is the same. |
| 627 | * Dito for XS_INTERNAL. |
| 628 | */ |
| 629 | #ifndef XS_EXTERNAL |
| 630 | # define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) XS(name)void name( CV* cv __attribute__((unused))) |
| 631 | #endif |
| 632 | #ifndef XS_INTERNAL |
| 633 | # define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) XS(name)void name( CV* cv __attribute__((unused))) |
| 634 | #endif |
| 635 | |
| 636 | /* Now, finally, after all this mess, we want an ExtUtils::ParseXS |
| 637 | * internal macro that we're free to redefine for varying linkage due |
| 638 | * to the EXPORT_XSUB_SYMBOLS XS keyword. This is internal, use |
| 639 | * XS_EXTERNAL(name) or XS_INTERNAL(name) in your code if you need to! |
| 640 | */ |
| 641 | |
| 642 | #undef XS_EUPXS |
| 643 | #if defined(PERL_EUPXS_ALWAYS_EXPORT) |
| 644 | # define XS_EUPXS(name)static void name( CV* cv __attribute__((unused))) XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) |
| 645 | #else |
| 646 | /* default to internal */ |
| 647 | # define XS_EUPXS(name)static void name( CV* cv __attribute__((unused))) XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) |
| 648 | #endif |
| 649 | |
| 650 | #ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE((void)0); ((void)0) |
| 651 | #define PERL_ARGS_ASSERT_CROAK_XS_USAGE((void)0); ((void)0) assert(cv)((void)0); assert(params)((void)0) |
| 652 | |
| 653 | /* prototype to pass -Wmissing-prototypes */ |
| 654 | STATICstatic void |
| 655 | S_croak_xs_usage(const CV *const cv, const char *const params); |
| 656 | |
| 657 | STATICstatic void |
| 658 | S_croak_xs_usage(const CV *const cv, const char *const params) |
| 659 | { |
| 660 | const GV *const gv = CvGV(cv)Perl_CvGV( (CV *)(cv)); |
| 661 | |
| 662 | PERL_ARGS_ASSERT_CROAK_XS_USAGE((void)0); ((void)0); |
| 663 | |
| 664 | if (gv) { |
| 665 | const char *const gvname = GvNAME(gv)((((XPVGV*)(gv)->sv_any)->xiv_u.xivu_namehek))->hek_key; |
| 666 | const HV *const stash = GvSTASH(gv)(((XPVGV*)(gv)->sv_any)->xnv_u.xgv_stash); |
| 667 | const char *const hvname = stash ? HvNAME(stash)((((stash)->sv_flags & 0x02000000) && ((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV*) (stash )->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_name && ( ((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV *) (stash)->sv_any)->xhv_max+1]))->xhv_name_count ? * ((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV *) (stash)->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_names : ((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV *) (stash)->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_name )) ? (( ((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash )[((XPVHV*) (stash)->sv_any)->xhv_max+1]))->xhv_name_count ? *((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV *) (stash)->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_names : ((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV *) (stash)->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_name ))->hek_key : ((void*)0)) : NULL((void*)0); |
| 668 | |
| 669 | if (hvname) |
| 670 | Perl_croak_nocontextPerl_croak("Usage: %s::%s(%s)", hvname, gvname, params); |
| 671 | else |
| 672 | Perl_croak_nocontextPerl_croak("Usage: %s(%s)", gvname, params); |
| 673 | } else { |
| 674 | /* Pants. I don't think that it should be possible to get here. */ |
| 675 | Perl_croak_nocontextPerl_croak("Usage: CODE(0x%" UVxf"lx" ")(%s)", PTR2UV(cv)(UV)(cv), params); |
| 676 | } |
| 677 | } |
| 678 | #undef PERL_ARGS_ASSERT_CROAK_XS_USAGE((void)0); ((void)0) |
| 679 | |
| 680 | #define croak_xs_usagePerl_croak_xs_usage S_croak_xs_usage |
| 681 | |
| 682 | #endif |
| 683 | |
| 684 | /* NOTE: the prototype of newXSproto() is different in versions of perls, |
| 685 | * so we define a portable version of newXSproto() |
| 686 | */ |
| 687 | #ifdef newXS_flags |
| 688 | #define newXSproto_portable(name, c_impl, file, proto)Perl_newXS_flags( name,c_impl,file,proto,0) newXS_flags(name, c_impl, file, proto, 0)Perl_newXS_flags( name,c_impl,file,proto,0) |
| 689 | #else |
| 690 | #define newXSproto_portable(name, c_impl, file, proto)Perl_newXS_flags( name,c_impl,file,proto,0) (PL_Sv=(SV*)newXS(name, c_impl, file)Perl_newXS( name,c_impl,file), sv_setpv(PL_Sv, proto)Perl_sv_setpv( PL_Sv,proto), (CV*)PL_Sv) |
| 691 | #endif /* !defined(newXS_flags) */ |
| 692 | |
| 693 | #if PERL_VERSION_LE(5, 21, 5)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 21*1000 + 5)) |
| 694 | # define newXS_deffile(a,b)Perl_newXS_deffile( a,b) Perl_newXS(aTHX_ a,b,file) |
| 695 | #else |
| 696 | # define newXS_deffile(a,b)Perl_newXS_deffile( a,b) Perl_newXS_deffile(aTHX_ a,b) |
| 697 | #endif |
| 698 | |
| 699 | #line 700 "Cwd.c" |
| 700 | #if USE_MY_CXT1 |
| 701 | #define XSubPPtmpAAAA1 1 |
| 702 | |
| 703 | |
| 704 | XS_EUPXS(XS_Cwd_CLONE)static void XS_Cwd_CLONE( CV* cv __attribute__((unused))); /* prototype to pass -Wmissing-prototypes */ |
| 705 | XS_EUPXS(XS_Cwd_CLONE)static void XS_Cwd_CLONE( CV* cv __attribute__((unused))) |
| 706 | { |
| 707 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
| 708 | PERL_UNUSED_VAR(cv)((void)sizeof(cv)); /* -W */ |
| 709 | PERL_UNUSED_VAR(items)((void)sizeof(items)); /* -W */ |
| 710 | { |
| 711 | #line 563 "Cwd.xs" |
| 712 | PERL_UNUSED_VAR(items)((void)sizeof(items)); |
| 713 | { MY_CXT_CLONE(void)0; POPULATE_MY_CXTdo { my_cxt.empty_string_sv = Perl_newSVpvn( ("" "" ""), (sizeof ("")-1)); my_cxt.slash_string_sv = Perl_newSVpvn( ("" "/" "") , (sizeof("/")-1)); } while(0); } |
| 714 | #line 715 "Cwd.c" |
| 715 | } |
| 716 | XSRETURN_EMPTYdo { do { const IV tmpXSoff = (0); ((void)0); PL_stack_sp = PL_stack_base + ax + (tmpXSoff - 1); return; } while (0); } while (0); |
| 717 | } |
| 718 | |
| 719 | #endif |
| 720 | |
| 721 | XS_EUPXS(XS_Cwd_getcwd)static void XS_Cwd_getcwd( CV* cv __attribute__((unused))); /* prototype to pass -Wmissing-prototypes */ |
| 722 | XS_EUPXS(XS_Cwd_getcwd)static void XS_Cwd_getcwd( CV* cv __attribute__((unused))) |
| 723 | { |
| 724 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
| 725 | dXSI32I32 ix = ((XPVCV*)({ void *_p = ((cv)->sv_any); _p; }))-> xcv_start_u.xcv_xsubany.any_i32; |
| 726 | PERL_UNUSED_VAR(cv)((void)sizeof(cv)); /* -W */ |
| 727 | PERL_UNUSED_VAR(items)((void)sizeof(items)); /* -W */ |
| 728 | PERL_UNUSED_VAR(ax)((void)sizeof(ax)); /* -Wall */ |
| 729 | SPsp -= items; |
| 730 | { |
| 731 | #line 573 "Cwd.xs" |
| 732 | { |
| 733 | dXSTARGSV * const targ = ((PL_op->op_private & 0x04) ? (PL_curpad [PL_op->op_targ]) : Perl_sv_newmortal()); |
| 734 | /* fastcwd takes zero parameters: */ |
| 735 | if (ix == 1 && items != 0) |
| 736 | croak_xs_usagePerl_croak_xs_usage(cv, ""); |
| 737 | getcwd_sv(TARG)Perl_getcwd_sv( targ); |
| 738 | XSprePUSH(sp = PL_stack_base + ax - 1); PUSHTARGdo { do { if (__builtin_expect(((((targ)->sv_flags & 0x00400000 )) ? (_Bool)1 : (_Bool)0),(0))) Perl_mg_set( targ); } while ( 0); (*++sp = (targ)); } while (0); |
| 739 | SvTAINTED_on(TARG)do{ if(__builtin_expect((((((__builtin_expect(((PL_tainting) ? (_Bool)1 : (_Bool)0),(0))) ? (_Bool)1 : (_Bool)0))) ? (_Bool )1 : (_Bool)0),(0))){Perl_sv_magic( (targ),((void*)0),'t',((void *)0),0);} }while (0); |
| 740 | } |
| 741 | #line 742 "Cwd.c" |
| 742 | PUTBACKPL_stack_sp = sp; |
| 743 | return; |
| 744 | } |
| 745 | } |
| 746 | |
| 747 | |
| 748 | XS_EUPXS(XS_Cwd_abs_path)static void XS_Cwd_abs_path( CV* cv __attribute__((unused))); /* prototype to pass -Wmissing-prototypes */ |
| 749 | XS_EUPXS(XS_Cwd_abs_path)static void XS_Cwd_abs_path( CV* cv __attribute__((unused))) |
| 750 | { |
| 751 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
| 752 | if (items < 0 || items > 1) |
| 753 | croak_xs_usagePerl_croak_xs_usage(cv, "pathsv=Nullsv"); |
| 754 | PERL_UNUSED_VAR(ax)((void)sizeof(ax)); /* -Wall */ |
| 755 | SPsp -= items; |
| 756 | { |
| 757 | SV * pathsv; |
| 758 | |
| 759 | if (items < 1) |
| 760 | pathsv = Nullsv((SV*)((void*)0)); |
| 761 | else { |
| 762 | pathsv = ST(0)PL_stack_base[ax + (0)] |
| 763 | ; |
| 764 | } |
| 765 | #line 587 "Cwd.xs" |
| 766 | { |
| 767 | dXSTARGSV * const targ = ((PL_op->op_private & 0x04) ? (PL_curpad [PL_op->op_targ]) : Perl_sv_newmortal()); |
| 768 | char *const path = pathsv ? SvPV_nolen(pathsv)((((pathsv)->sv_flags & (0x00000400|0x00200000)) == 0x00000400 ) ? ((pathsv)->sv_u.svu_pv) : Perl_sv_2pv_flags( pathsv,0, 2)) : (char *)"."; |
| 769 | char buf[MAXPATHLEN1024]; |
| 770 | |
| 771 | if ( |
| 772 | #ifdef VMS |
| 773 | Perl_rmsexpand(aTHX_ path, buf, NULL((void*)0), 0) |
| 774 | #else |
| 775 | bsd_realpath(path, buf) |
| 776 | #endif |
| 777 | ) { |
| 778 | sv_setpv_mg(TARG, buf)Perl_sv_setpv_mg( targ,buf); |
| 779 | SvPOK_only(TARG)( (targ)->sv_flags &= ~((0x00000100|0x00000200|0x00000400 |0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)| 0x80000000 |0x20000000), (targ)->sv_flags |= (0x00000400|0x00004000)); |
| 780 | SvTAINTED_on(TARG)do{ if(__builtin_expect((((((__builtin_expect(((PL_tainting) ? (_Bool)1 : (_Bool)0),(0))) ? (_Bool)1 : (_Bool)0))) ? (_Bool )1 : (_Bool)0),(0))){Perl_sv_magic( (targ),((void*)0),'t',((void *)0),0);} }while (0); |
| 781 | } |
| 782 | else |
| 783 | sv_setsv(TARG, &PL_sv_undef)Perl_sv_setsv_flags( targ,&(PL_sv_immortals[1]),2|0); |
| 784 | |
| 785 | XSprePUSH(sp = PL_stack_base + ax - 1); PUSHs(TARG)(*++sp = (targ)); |
| 786 | SvTAINTED_on(TARG)do{ if(__builtin_expect((((((__builtin_expect(((PL_tainting) ? (_Bool)1 : (_Bool)0),(0))) ? (_Bool)1 : (_Bool)0))) ? (_Bool )1 : (_Bool)0),(0))){Perl_sv_magic( (targ),((void*)0),'t',((void *)0),0);} }while (0); |
| 787 | } |
| 788 | #line 789 "Cwd.c" |
| 789 | PUTBACKPL_stack_sp = sp; |
| 790 | return; |
| 791 | } |
| 792 | } |
| 793 | |
| 794 | #if defined(WIN32) && !defined(UNDER_CE) |
| 795 | #define XSubPPtmpAAAB 1 |
| 796 | |
| 797 | |
| 798 | XS_EUPXS(XS_Cwd_getdcwd)static void XS_Cwd_getdcwd( CV* cv __attribute__((unused))); /* prototype to pass -Wmissing-prototypes */ |
| 799 | XS_EUPXS(XS_Cwd_getdcwd)static void XS_Cwd_getdcwd( CV* cv __attribute__((unused))) |
| 800 | { |
| 801 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
| 802 | PERL_UNUSED_VAR(cv)((void)sizeof(cv)); /* -W */ |
| 803 | PERL_UNUSED_VAR(items)((void)sizeof(items)); /* -W */ |
| 804 | PERL_UNUSED_VAR(ax)((void)sizeof(ax)); /* -Wall */ |
| 805 | SPsp -= items; |
| 806 | { |
| 807 | #line 616 "Cwd.xs" |
| 808 | { |
| 809 | dXSTARGSV * const targ = ((PL_op->op_private & 0x04) ? (PL_curpad [PL_op->op_targ]) : Perl_sv_newmortal()); |
| 810 | int drive; |
| 811 | char *dir; |
| 812 | |
| 813 | /* Drive 0 is the current drive, 1 is A:, 2 is B:, 3 is C: and so on. */ |
| 814 | if ( items == 0 || |
| 815 | (items == 1 && (!SvOK(ST(0))((PL_stack_base[ax + (0)])->sv_flags & (0x00000100|0x00000200 |0x00000400|0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000 )) || (SvPOK(ST(0))((PL_stack_base[ax + (0)])->sv_flags & 0x00000400) && !SvCUR(ST(0))((XPV*) (PL_stack_base[ax + (0)])->sv_any)->xpv_cur)))) |
| 816 | drive = 0; |
| 817 | else if (items == 1 && SvPOK(ST(0))((PL_stack_base[ax + (0)])->sv_flags & 0x00000400) && SvCUR(ST(0))((XPV*) (PL_stack_base[ax + (0)])->sv_any)->xpv_cur && |
| 818 | isALPHA(SvPVX(ST(0))[0])( ( (sizeof((~('A' ^ 'a') & (((PL_stack_base[ax + (0)])-> sv_u.svu_pv)[0]))) == sizeof(U8)) ? ( (((U64) (((((U8) ((~('A' ^ 'a') & (((PL_stack_base[ax + (0)])->sv_u.svu_pv)[0] )))))) - ((('A')) | 0))) <= (((U64) (((('Z') - ('A'))) | 0 ))))) : (sizeof((~('A' ^ 'a') & (((PL_stack_base[ax + (0) ])->sv_u.svu_pv)[0]))) == sizeof(U32)) ? ( (((U64) (((((U32 ) ((~('A' ^ 'a') & (((PL_stack_base[ax + (0)])->sv_u.svu_pv )[0])))))) - ((('A')) | 0))) <= (((U64) (((('Z') - ('A'))) | 0))))) : ( ( (((U64) (((((U64) ((~('A' ^ 'a') & (((PL_stack_base [ax + (0)])->sv_u.svu_pv)[0])))))) - ((('A')) | 0))) <= (((U64) (((('Z') - ('A'))) | 0))))))))) |
| 819 | drive = toUPPER(SvPVX(ST(0))[0])(( ( (sizeof(((PL_stack_base[ax + (0)])->sv_u.svu_pv)[0]) == sizeof(U8)) ? ( (((U64) (((((U8) (((PL_stack_base[ax + (0)]) ->sv_u.svu_pv)[0])))) - ((('a')) | 0))) <= (((U64) (((( 'z') - ('a'))) | 0))))) : (sizeof(((PL_stack_base[ax + (0)])-> sv_u.svu_pv)[0]) == sizeof(U32)) ? ( (((U64) (((((U32) (((PL_stack_base [ax + (0)])->sv_u.svu_pv)[0])))) - ((('a')) | 0))) <= ( ((U64) (((('z') - ('a'))) | 0))))) : ( ( (((U64) (((((U64) (( (PL_stack_base[ax + (0)])->sv_u.svu_pv)[0])))) - ((('a')) | 0))) <= (((U64) (((('z') - ('a'))) | 0)))))))) ? (U8)(((( PL_stack_base[ax + (0)])->sv_u.svu_pv)[0]) - ('a' - 'A')) : (((PL_stack_base[ax + (0)])->sv_u.svu_pv)[0])) - 'A' + 1; |
| 820 | else |
| 821 | croakPerl_croak("Usage: getdcwd(DRIVE)"); |
| 822 | |
| 823 | New(0,dir,MAXPATHLEN,char)(dir = ((void)(__builtin_expect(((((( sizeof(size_t) < sizeof (1024) || sizeof(char) > ((size_t)1 << 8*(sizeof(size_t ) - sizeof(1024)))) ? (size_t)(1024) : ((size_t)-1)/sizeof(char )) > ((size_t)-1)/sizeof(char))) ? (_Bool)1 : (_Bool)0),(0 )) && (Perl_croak_memory_wrap(),0)), (char*)(Perl_safesysmalloc ((size_t)((1024)*sizeof(char)))))); |
| 824 | if (_getdcwd(drive, dir, MAXPATHLEN1024)) { |
| 825 | sv_setpv_mg(TARG, dir)Perl_sv_setpv_mg( targ,dir); |
| 826 | SvPOK_only(TARG)( (targ)->sv_flags &= ~((0x00000100|0x00000200|0x00000400 |0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)| 0x80000000 |0x20000000), (targ)->sv_flags |= (0x00000400|0x00004000)); |
| 827 | } |
| 828 | else |
| 829 | sv_setsv(TARG, &PL_sv_undef)Perl_sv_setsv_flags( targ,&(PL_sv_immortals[1]),2|0); |
| 830 | |
| 831 | Safefree(dir)Perl_safesysfree(((void *)(dir))); |
| 832 | |
| 833 | XSprePUSH(sp = PL_stack_base + ax - 1); PUSHs(TARG)(*++sp = (targ)); |
| 834 | SvTAINTED_on(TARG)do{ if(__builtin_expect((((((__builtin_expect(((PL_tainting) ? (_Bool)1 : (_Bool)0),(0))) ? (_Bool)1 : (_Bool)0))) ? (_Bool )1 : (_Bool)0),(0))){Perl_sv_magic( (targ),((void*)0),'t',((void *)0),0);} }while (0); |
| 835 | } |
| 836 | #line 837 "Cwd.c" |
| 837 | PUTBACKPL_stack_sp = sp; |
| 838 | return; |
| 839 | } |
| 840 | } |
| 841 | |
| 842 | #endif |
| 843 | |
| 844 | XS_EUPXS(XS_File__Spec__Unix_canonpath)static void XS_File__Spec__Unix_canonpath( CV* cv __attribute__ ((unused))); /* prototype to pass -Wmissing-prototypes */ |
| 845 | XS_EUPXS(XS_File__Spec__Unix_canonpath)static void XS_File__Spec__Unix_canonpath( CV* cv __attribute__ ((unused))) |
| 846 | { |
| 847 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
| 848 | if (items < 1) |
| 849 | croak_xs_usagePerl_croak_xs_usage(cv, "self, path= &PL_sv_undef, ..."); |
| 850 | { |
| 851 | SV * RETVAL; |
| 852 | SV * self = ST(0)PL_stack_base[ax + (0)] |
Value stored to 'self' during its initialization is never read | |
| 853 | ; |
| 854 | SV * path; |
| 855 | |
| 856 | if (items < 2) |
| 857 | path = &PL_sv_undef(PL_sv_immortals[1]); |
| 858 | else { |
| 859 | path = ST(1)PL_stack_base[ax + (1)] |
| 860 | ; |
| 861 | } |
| 862 | #line 652 "Cwd.xs" |
| 863 | PERL_UNUSED_VAR(self)((void)sizeof(self)); |
| 864 | RETVAL = unix_canonpath(path)THX_unix_canonpath( path); |
| 865 | #line 866 "Cwd.c" |
| 866 | RETVAL = sv_2mortal(RETVAL)Perl_sv_2mortal( RETVAL); |
| 867 | ST(0)PL_stack_base[ax + (0)] = RETVAL; |
| 868 | } |
| 869 | XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base + ax + (tmpXSoff - 1); return; } while (0); |
| 870 | } |
| 871 | |
| 872 | |
| 873 | XS_EUPXS(XS_File__Spec__Unix__fn_canonpath)static void XS_File__Spec__Unix__fn_canonpath( CV* cv __attribute__ ((unused))); /* prototype to pass -Wmissing-prototypes */ |
| 874 | XS_EUPXS(XS_File__Spec__Unix__fn_canonpath)static void XS_File__Spec__Unix__fn_canonpath( CV* cv __attribute__ ((unused))) |
| 875 | { |
| 876 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
| 877 | PERL_UNUSED_VAR(cv)((void)sizeof(cv)); /* -W */ |
| 878 | PERL_UNUSED_VAR(items)((void)sizeof(items)); /* -W */ |
| 879 | { |
| 880 | SV * RETVAL; |
| 881 | SV * path; |
| 882 | |
| 883 | if (items < 1) |
| 884 | path = &PL_sv_undef(PL_sv_immortals[1]); |
| 885 | else { |
| 886 | path = ST(0)PL_stack_base[ax + (0)] |
| 887 | ; |
| 888 | } |
| 889 | #line 660 "Cwd.xs" |
| 890 | RETVAL = unix_canonpath(path)THX_unix_canonpath( path); |
| 891 | #line 892 "Cwd.c" |
| 892 | RETVAL = sv_2mortal(RETVAL)Perl_sv_2mortal( RETVAL); |
| 893 | ST(0)PL_stack_base[ax + (0)] = RETVAL; |
| 894 | } |
| 895 | XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base + ax + (tmpXSoff - 1); return; } while (0); |
| 896 | } |
| 897 | |
| 898 | |
| 899 | XS_EUPXS(XS_File__Spec__Unix_catdir)static void XS_File__Spec__Unix_catdir( CV* cv __attribute__( (unused))); /* prototype to pass -Wmissing-prototypes */ |
| 900 | XS_EUPXS(XS_File__Spec__Unix_catdir)static void XS_File__Spec__Unix_catdir( CV* cv __attribute__( (unused))) |
| 901 | { |
| 902 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
| 903 | if (items < 1) |
| 904 | croak_xs_usagePerl_croak_xs_usage(cv, "self, ..."); |
| 905 | { |
| 906 | #line 667 "Cwd.xs" |
| 907 | dUSE_MY_CXTstruct Perl___notused_struct; |
| 908 | SV *joined; |
| 909 | #line 910 "Cwd.c" |
| 910 | SV * RETVAL; |
| 911 | SV * self = ST(0)PL_stack_base[ax + (0)] |
| 912 | ; |
| 913 | #line 670 "Cwd.xs" |
| 914 | EXTEND(SP, items+1)do { (void)0; if (__builtin_expect(((((items+1) < 0 || PL_stack_max - (sp) < (items+1))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow ( sp,sp,(sizeof(items+1) > sizeof(ssize_t) && ((ssize_t )(items+1) != (items+1)) ? -1 : (items+1))); ((void)sizeof(sp )); } } while (0); |
| 915 | ST(items)PL_stack_base[ax + (items)] = EMPTY_STRING_SVmy_cxt.empty_string_sv; |
| 916 | joined = sv_newmortal()Perl_sv_newmortal(); |
| 917 | do_join(joined, SLASH_STRING_SV, &ST(0), &ST(items))Perl_do_join( joined,my_cxt.slash_string_sv,&PL_stack_base [ax + (0)],&PL_stack_base[ax + (items)]); |
| 918 | if(invocant_is_unix(self)THX_invocant_is_unix( self)) { |
| 919 | RETVAL = unix_canonpath(joined)THX_unix_canonpath( joined); |
| 920 | } else { |
| 921 | ENTERPerl_push_scope(); |
| 922 | PUSHMARK(SP)do { I32 * mark_stack_entry; if (__builtin_expect((((mark_stack_entry = ++PL_markstack_ptr) == PL_markstack_max) ? (_Bool)1 : (_Bool )0),(0))) mark_stack_entry = Perl_markstack_grow(); *mark_stack_entry = (I32)((sp) - PL_stack_base); ; } while (0); |
| 923 | EXTEND(SP, 2)do { (void)0; if (__builtin_expect(((((2) < 0 || PL_stack_max - (sp) < (2))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow ( sp,sp,(sizeof(2) > sizeof(ssize_t) && ((ssize_t) (2) != (2)) ? -1 : (2))); ((void)sizeof(sp)); } } while (0); |
| 924 | PUSHs(self)(*++sp = (self)); |
| 925 | PUSHs(joined)(*++sp = (joined)); |
| 926 | PUTBACKPL_stack_sp = sp; |
| 927 | call_method("canonpath", G_SCALAR)Perl_call_method( "canonpath",2); |
| 928 | SPAGAINsp = PL_stack_sp; |
| 929 | RETVAL = POPs(*sp--); |
| 930 | LEAVEPerl_pop_scope(); |
| 931 | SvREFCNT_inc(RETVAL)Perl_SvREFCNT_inc(((SV *)({ void *_p = (RETVAL); _p; }))); |
| 932 | } |
| 933 | #line 934 "Cwd.c" |
| 934 | RETVAL = sv_2mortal(RETVAL)Perl_sv_2mortal( RETVAL); |
| 935 | ST(0)PL_stack_base[ax + (0)] = RETVAL; |
| 936 | } |
| 937 | XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base + ax + (tmpXSoff - 1); return; } while (0); |
| 938 | } |
| 939 | |
| 940 | |
| 941 | XS_EUPXS(XS_File__Spec__Unix__fn_catdir)static void XS_File__Spec__Unix__fn_catdir( CV* cv __attribute__ ((unused))); /* prototype to pass -Wmissing-prototypes */ |
| 942 | XS_EUPXS(XS_File__Spec__Unix__fn_catdir)static void XS_File__Spec__Unix__fn_catdir( CV* cv __attribute__ ((unused))) |
| 943 | { |
| 944 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
| 945 | PERL_UNUSED_VAR(cv)((void)sizeof(cv)); /* -W */ |
| 946 | PERL_UNUSED_VAR(items)((void)sizeof(items)); /* -W */ |
| 947 | { |
| 948 | #line 695 "Cwd.xs" |
| 949 | dUSE_MY_CXTstruct Perl___notused_struct; |
| 950 | SV *joined; |
| 951 | #line 952 "Cwd.c" |
| 952 | SV * RETVAL; |
| 953 | #line 698 "Cwd.xs" |
| 954 | EXTEND(SP, items+1)do { (void)0; if (__builtin_expect(((((items+1) < 0 || PL_stack_max - (sp) < (items+1))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow ( sp,sp,(sizeof(items+1) > sizeof(ssize_t) && ((ssize_t )(items+1) != (items+1)) ? -1 : (items+1))); ((void)sizeof(sp )); } } while (0); |
| 955 | ST(items)PL_stack_base[ax + (items)] = EMPTY_STRING_SVmy_cxt.empty_string_sv; |
| 956 | joined = sv_newmortal()Perl_sv_newmortal(); |
| 957 | do_join(joined, SLASH_STRING_SV, &ST(-1), &ST(items))Perl_do_join( joined,my_cxt.slash_string_sv,&PL_stack_base [ax + (-1)],&PL_stack_base[ax + (items)]); |
| 958 | RETVAL = unix_canonpath(joined)THX_unix_canonpath( joined); |
| 959 | #line 960 "Cwd.c" |
| 960 | RETVAL = sv_2mortal(RETVAL)Perl_sv_2mortal( RETVAL); |
| 961 | ST(0)PL_stack_base[ax + (0)] = RETVAL; |
| 962 | } |
| 963 | XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base + ax + (tmpXSoff - 1); return; } while (0); |
| 964 | } |
| 965 | |
| 966 | |
| 967 | XS_EUPXS(XS_File__Spec__Unix_catfile)static void XS_File__Spec__Unix_catfile( CV* cv __attribute__ ((unused))); /* prototype to pass -Wmissing-prototypes */ |
| 968 | XS_EUPXS(XS_File__Spec__Unix_catfile)static void XS_File__Spec__Unix_catfile( CV* cv __attribute__ ((unused))) |
| 969 | { |
| 970 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
| 971 | if (items < 1) |
| 972 | croak_xs_usagePerl_croak_xs_usage(cv, "self, ..."); |
| 973 | { |
| 974 | #line 709 "Cwd.xs" |
| 975 | dUSE_MY_CXTstruct Perl___notused_struct; |
| 976 | #line 977 "Cwd.c" |
| 977 | SV * RETVAL; |
| 978 | SV * self = ST(0)PL_stack_base[ax + (0)] |
| 979 | ; |
| 980 | #line 711 "Cwd.xs" |
| 981 | if(invocant_is_unix(self)THX_invocant_is_unix( self)) { |
| 982 | if(items == 1) { |
| 983 | RETVAL = &PL_sv_undef(PL_sv_immortals[1]); |
| 984 | } else { |
| 985 | SV *file = unix_canonpath(ST(items-1))THX_unix_canonpath( PL_stack_base[ax + (items-1)]); |
| 986 | if(items == 2) { |
| 987 | RETVAL = file; |
| 988 | } else { |
| 989 | SV *dir = sv_newmortal()Perl_sv_newmortal(); |
| 990 | sv_2mortal(file)Perl_sv_2mortal( file); |
| 991 | ST(items-1)PL_stack_base[ax + (items-1)] = EMPTY_STRING_SVmy_cxt.empty_string_sv; |
| 992 | do_join(dir, SLASH_STRING_SV, &ST(0), &ST(items-1))Perl_do_join( dir,my_cxt.slash_string_sv,&PL_stack_base[ax + (0)],&PL_stack_base[ax + (items-1)]); |
| 993 | RETVAL = unix_canonpath(dir)THX_unix_canonpath( dir); |
| 994 | if(SvCUR(RETVAL)((XPV*) (RETVAL)->sv_any)->xpv_cur == 0 || SvPVX(RETVAL)((RETVAL)->sv_u.svu_pv)[SvCUR(RETVAL)((XPV*) (RETVAL)->sv_any)->xpv_cur-1] != '/') |
| 995 | sv_catsv(RETVAL, SLASH_STRING_SV)Perl_sv_catsv_flags( RETVAL,my_cxt.slash_string_sv,2); |
| 996 | sv_catsv(RETVAL, file)Perl_sv_catsv_flags( RETVAL,file,2); |
| 997 | } |
| 998 | } |
| 999 | } else { |
| 1000 | SV *file, *dir; |
| 1001 | ENTERPerl_push_scope(); |
| 1002 | PUSHMARK(SP)do { I32 * mark_stack_entry; if (__builtin_expect((((mark_stack_entry = ++PL_markstack_ptr) == PL_markstack_max) ? (_Bool)1 : (_Bool )0),(0))) mark_stack_entry = Perl_markstack_grow(); *mark_stack_entry = (I32)((sp) - PL_stack_base); ; } while (0); |
| 1003 | EXTEND(SP, 2)do { (void)0; if (__builtin_expect(((((2) < 0 || PL_stack_max - (sp) < (2))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow ( sp,sp,(sizeof(2) > sizeof(ssize_t) && ((ssize_t) (2) != (2)) ? -1 : (2))); ((void)sizeof(sp)); } } while (0); |
| 1004 | PUSHs(self)(*++sp = (self)); |
| 1005 | PUSHs(items == 1 ? &PL_sv_undef : ST(items-1))(*++sp = (items == 1 ? &(PL_sv_immortals[1]) : PL_stack_base [ax + (items-1)])); |
| 1006 | PUTBACKPL_stack_sp = sp; |
| 1007 | call_method("canonpath", G_SCALAR)Perl_call_method( "canonpath",2); |
| 1008 | SPAGAINsp = PL_stack_sp; |
| 1009 | file = POPs(*sp--); |
| 1010 | LEAVEPerl_pop_scope(); |
| 1011 | if(items <= 2) { |
| 1012 | RETVAL = SvREFCNT_inc(file)Perl_SvREFCNT_inc(((SV *)({ void *_p = (file); _p; }))); |
| 1013 | } else { |
| 1014 | char const *pv; |
| 1015 | STRLEN len; |
| 1016 | bool_Bool need_slash; |
| 1017 | SPsp--; |
| 1018 | ENTERPerl_push_scope(); |
| 1019 | PUSHMARK(&ST(-1))do { I32 * mark_stack_entry; if (__builtin_expect((((mark_stack_entry = ++PL_markstack_ptr) == PL_markstack_max) ? (_Bool)1 : (_Bool )0),(0))) mark_stack_entry = Perl_markstack_grow(); *mark_stack_entry = (I32)((&PL_stack_base[ax + (-1)]) - PL_stack_base); ; } while (0); |
| 1020 | PUTBACKPL_stack_sp = sp; |
| 1021 | call_method("catdir", G_SCALAR)Perl_call_method( "catdir",2); |
| 1022 | SPAGAINsp = PL_stack_sp; |
| 1023 | dir = POPs(*sp--); |
| 1024 | LEAVEPerl_pop_scope(); |
| 1025 | pv = SvPV(dir, len)((((dir)->sv_flags & (0x00000400|0x00200000)) == 0x00000400 ) ? ((len = ((XPV*) (dir)->sv_any)->xpv_cur), ((dir)-> sv_u.svu_pv)) : Perl_sv_2pv_flags( dir,&len,2)); |
| 1026 | need_slash = len == 0 || pv[len-1] != '/'; |
| 1027 | RETVAL = newSVsv(dir)Perl_newSVsv_flags( (dir),2|16); |
| 1028 | if(need_slash) sv_catsv(RETVAL, SLASH_STRING_SV)Perl_sv_catsv_flags( RETVAL,my_cxt.slash_string_sv,2); |
| 1029 | sv_catsv(RETVAL, file)Perl_sv_catsv_flags( RETVAL,file,2); |
| 1030 | } |
| 1031 | } |
| 1032 | #line 1033 "Cwd.c" |
| 1033 | RETVAL = sv_2mortal(RETVAL)Perl_sv_2mortal( RETVAL); |
| 1034 | ST(0)PL_stack_base[ax + (0)] = RETVAL; |
| 1035 | } |
| 1036 | XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base + ax + (tmpXSoff - 1); return; } while (0); |
| 1037 | } |
| 1038 | |
| 1039 | |
| 1040 | XS_EUPXS(XS_File__Spec__Unix__fn_catfile)static void XS_File__Spec__Unix__fn_catfile( CV* cv __attribute__ ((unused))); /* prototype to pass -Wmissing-prototypes */ |
| 1041 | XS_EUPXS(XS_File__Spec__Unix__fn_catfile)static void XS_File__Spec__Unix__fn_catfile( CV* cv __attribute__ ((unused))) |
| 1042 | { |
| 1043 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
| 1044 | PERL_UNUSED_VAR(cv)((void)sizeof(cv)); /* -W */ |
| 1045 | PERL_UNUSED_VAR(items)((void)sizeof(items)); /* -W */ |
| 1046 | { |
| 1047 | #line 768 "Cwd.xs" |
| 1048 | dUSE_MY_CXTstruct Perl___notused_struct; |
| 1049 | #line 1050 "Cwd.c" |
| 1050 | SV * RETVAL; |
| 1051 | #line 770 "Cwd.xs" |
| 1052 | if(items == 0) { |
| 1053 | RETVAL = &PL_sv_undef(PL_sv_immortals[1]); |
| 1054 | } else { |
| 1055 | SV *file = unix_canonpath(ST(items-1))THX_unix_canonpath( PL_stack_base[ax + (items-1)]); |
| 1056 | if(items == 1) { |
| 1057 | RETVAL = file; |
| 1058 | } else { |
| 1059 | SV *dir = sv_newmortal()Perl_sv_newmortal(); |
| 1060 | sv_2mortal(file)Perl_sv_2mortal( file); |
| 1061 | ST(items-1)PL_stack_base[ax + (items-1)] = EMPTY_STRING_SVmy_cxt.empty_string_sv; |
| 1062 | do_join(dir, SLASH_STRING_SV, &ST(-1), &ST(items-1))Perl_do_join( dir,my_cxt.slash_string_sv,&PL_stack_base[ax + (-1)],&PL_stack_base[ax + (items-1)]); |
| 1063 | RETVAL = unix_canonpath(dir)THX_unix_canonpath( dir); |
| 1064 | if(SvCUR(RETVAL)((XPV*) (RETVAL)->sv_any)->xpv_cur == 0 || SvPVX(RETVAL)((RETVAL)->sv_u.svu_pv)[SvCUR(RETVAL)((XPV*) (RETVAL)->sv_any)->xpv_cur-1] != '/') |
| 1065 | sv_catsv(RETVAL, SLASH_STRING_SV)Perl_sv_catsv_flags( RETVAL,my_cxt.slash_string_sv,2); |
| 1066 | sv_catsv(RETVAL, file)Perl_sv_catsv_flags( RETVAL,file,2); |
| 1067 | } |
| 1068 | } |
| 1069 | #line 1070 "Cwd.c" |
| 1070 | RETVAL = sv_2mortal(RETVAL)Perl_sv_2mortal( RETVAL); |
| 1071 | ST(0)PL_stack_base[ax + (0)] = RETVAL; |
| 1072 | } |
| 1073 | XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base + ax + (tmpXSoff - 1); return; } while (0); |
| 1074 | } |
| 1075 | |
| 1076 | #ifdef __cplusplus |
| 1077 | extern "C" |
| 1078 | #endif |
| 1079 | XS_EXTERNAL(boot_Cwd)void boot_Cwd( CV* cv __attribute__((unused))); /* prototype to pass -Wmissing-prototypes */ |
| 1080 | XS_EXTERNAL(boot_Cwd)void boot_Cwd( CV* cv __attribute__((unused))) |
| 1081 | { |
| 1082 | #if PERL_VERSION_LE(5, 21, 5)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 21*1000 + 5)) |
| 1083 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
| 1084 | #else |
| 1085 | dVARstruct Perl___notused_struct; dXSBOOTARGSXSAPIVERCHKI32 ax = Perl_xs_handshake((((sizeof(struct PerlHandShakeInterpreter )) << 16) | ((sizeof("" "3.78" "")-1) > 0xFF ? (Perl_croak ("panic: handshake overflow"), 0xFF) : (sizeof("" "3.78" "")- 1) << 8) | ((((1)) ? (_Bool)1 : (_Bool)0) ? 0x00000020 : 0) | ((((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000080 : 0) | (((( 1)) ? (_Bool)1 : (_Bool)0) ? 0x00000040 : 0) | ((sizeof("" "v" "5" "." "32" "." "0" "")-1) > 0x0000001F ? (Perl_croak("panic: handshake overflow" ), 0x0000001F) : (sizeof("" "v" "5" "." "32" "." "0" "")-1))) , cv, "Cwd.c", "v" "5" "." "32" "." "0", "3.78"); SV **mark = PL_stack_base + ax; SV **sp = PL_stack_sp; I32 items = (I32) (sp - mark); |
| 1086 | #endif |
| 1087 | #if (PERL_REVISION5 == 5 && PERL_VERSION32 < 9) |
| 1088 | char* file = __FILE__"Cwd.c"; |
| 1089 | #else |
| 1090 | const char* file = __FILE__"Cwd.c"; |
| 1091 | #endif |
| 1092 | |
| 1093 | PERL_UNUSED_VAR(file)((void)sizeof(file)); |
| 1094 | |
| 1095 | PERL_UNUSED_VAR(cv)((void)sizeof(cv)); /* -W */ |
| 1096 | PERL_UNUSED_VAR(items)((void)sizeof(items)); /* -W */ |
| 1097 | #if PERL_VERSION_LE(5, 21, 5)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 21*1000 + 5)) |
| 1098 | XS_VERSION_BOOTCHECKPerl_xs_handshake((((sizeof(struct PerlHandShakeInterpreter)) << 16) | ((sizeof("" "3.78" "")-1) > 0xFF ? (Perl_croak ("panic: handshake overflow"), 0xFF) : (sizeof("" "3.78" "")- 1) << 8) | ((((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000020 : 0) | ((((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000080 : 0) | (((( 0)) ? (_Bool)1 : (_Bool)0) ? 0x00000040 : 0) | ((sizeof("" "" "")-1) > 0x0000001F ? (Perl_croak("panic: handshake overflow" ), 0x0000001F) : (sizeof("" "" "")-1))), cv, "Cwd.c", items, ax , "3.78"); |
| 1099 | # ifdef XS_APIVERSION_BOOTCHECKPerl_xs_handshake((((sizeof(struct PerlHandShakeInterpreter)) << 16) | ((sizeof("" "" "")-1) > 0xFF ? (Perl_croak ("panic: handshake overflow"), 0xFF) : (sizeof("" "" "")-1) << 8) | ((((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000020 : 0) | (((( 0)) ? (_Bool)1 : (_Bool)0) ? 0x00000080 : 0) | ((((0)) ? (_Bool )1 : (_Bool)0) ? 0x00000040 : 0) | ((sizeof("" "v" "5" "." "32" "." "0" "")-1) > 0x0000001F ? (Perl_croak("panic: handshake overflow" ), 0x0000001F) : (sizeof("" "v" "5" "." "32" "." "0" "")-1))) , cv, "Cwd.c", items, ax, "v" "5" "." "32" "." "0") |
| 1100 | XS_APIVERSION_BOOTCHECKPerl_xs_handshake((((sizeof(struct PerlHandShakeInterpreter)) << 16) | ((sizeof("" "" "")-1) > 0xFF ? (Perl_croak ("panic: handshake overflow"), 0xFF) : (sizeof("" "" "")-1) << 8) | ((((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000020 : 0) | (((( 0)) ? (_Bool)1 : (_Bool)0) ? 0x00000080 : 0) | ((((0)) ? (_Bool )1 : (_Bool)0) ? 0x00000040 : 0) | ((sizeof("" "v" "5" "." "32" "." "0" "")-1) > 0x0000001F ? (Perl_croak("panic: handshake overflow" ), 0x0000001F) : (sizeof("" "v" "5" "." "32" "." "0" "")-1))) , cv, "Cwd.c", items, ax, "v" "5" "." "32" "." "0"); |
| 1101 | # endif |
| 1102 | #endif |
| 1103 | |
| 1104 | #if XSubPPtmpAAAA1 |
| 1105 | newXS_deffile("Cwd::CLONE", XS_Cwd_CLONE)Perl_newXS_deffile( "Cwd::CLONE",XS_Cwd_CLONE); |
| 1106 | #endif |
| 1107 | cv = newXS_deffile("Cwd::fastcwd", XS_Cwd_getcwd)Perl_newXS_deffile( "Cwd::fastcwd",XS_Cwd_getcwd); |
| 1108 | XSANY((XPVCV*)({ void *_p = ((cv)->sv_any); _p; }))->xcv_start_u .xcv_xsubany.any_i32 = 1; |
| 1109 | cv = newXS_deffile("Cwd::getcwd", XS_Cwd_getcwd)Perl_newXS_deffile( "Cwd::getcwd",XS_Cwd_getcwd); |
| 1110 | XSANY((XPVCV*)({ void *_p = ((cv)->sv_any); _p; }))->xcv_start_u .xcv_xsubany.any_i32 = 0; |
| 1111 | newXS_deffile("Cwd::abs_path", XS_Cwd_abs_path)Perl_newXS_deffile( "Cwd::abs_path",XS_Cwd_abs_path); |
| 1112 | #if XSubPPtmpAAAB |
| 1113 | (void)newXSproto_portable("Cwd::getdcwd", XS_Cwd_getdcwd, file, ";@")Perl_newXS_flags( "Cwd::getdcwd",XS_Cwd_getdcwd,file,";@",0); |
| 1114 | #endif |
| 1115 | newXS_deffile("File::Spec::Unix::canonpath", XS_File__Spec__Unix_canonpath)Perl_newXS_deffile( "File::Spec::Unix::canonpath",XS_File__Spec__Unix_canonpath ); |
| 1116 | newXS_deffile("File::Spec::Unix::_fn_canonpath", XS_File__Spec__Unix__fn_canonpath)Perl_newXS_deffile( "File::Spec::Unix::_fn_canonpath",XS_File__Spec__Unix__fn_canonpath ); |
| 1117 | newXS_deffile("File::Spec::Unix::catdir", XS_File__Spec__Unix_catdir)Perl_newXS_deffile( "File::Spec::Unix::catdir",XS_File__Spec__Unix_catdir ); |
| 1118 | newXS_deffile("File::Spec::Unix::_fn_catdir", XS_File__Spec__Unix__fn_catdir)Perl_newXS_deffile( "File::Spec::Unix::_fn_catdir",XS_File__Spec__Unix__fn_catdir ); |
| 1119 | newXS_deffile("File::Spec::Unix::catfile", XS_File__Spec__Unix_catfile)Perl_newXS_deffile( "File::Spec::Unix::catfile",XS_File__Spec__Unix_catfile ); |
| 1120 | newXS_deffile("File::Spec::Unix::_fn_catfile", XS_File__Spec__Unix__fn_catfile)Perl_newXS_deffile( "File::Spec::Unix::_fn_catfile",XS_File__Spec__Unix__fn_catfile ); |
| 1121 | |
| 1122 | /* Initialisation Section */ |
| 1123 | |
| 1124 | #line 551 "Cwd.xs" |
| 1125 | #if USE_MY_CXT1 |
| 1126 | { |
| 1127 | MY_CXT_INIT(void)0; |
| 1128 | POPULATE_MY_CXTdo { my_cxt.empty_string_sv = Perl_newSVpvn( ("" "" ""), (sizeof ("")-1)); my_cxt.slash_string_sv = Perl_newSVpvn( ("" "/" "") , (sizeof("/")-1)); } while(0); |
| 1129 | } |
| 1130 | #endif |
| 1131 | |
| 1132 | #if XSubPPtmpAAAA1 |
| 1133 | #endif |
| 1134 | #if XSubPPtmpAAAB |
| 1135 | #endif |
| 1136 | #line 1137 "Cwd.c" |
| 1137 | |
| 1138 | /* End of Initialisation Section */ |
| 1139 | |
| 1140 | #if PERL_VERSION_LE(5, 21, 5)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 21*1000 + 5)) |
| 1141 | # if PERL_VERSION_GE(5, 9, 0)((5*1000000 + 32*1000 + 1) >= (5*1000000 + 9*1000 + 0)) |
| 1142 | if (PL_unitcheckav) |
| 1143 | call_list(PL_scopestack_ix, PL_unitcheckav)Perl_call_list( PL_scopestack_ix,PL_unitcheckav); |
| 1144 | # endif |
| 1145 | XSRETURN_YESdo { (PL_stack_base[ax + (0)] = &(PL_sv_immortals[0]) ); do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base + ax + (tmpXSoff - 1); return; } while (0); } while (0); |
| 1146 | #else |
| 1147 | Perl_xs_boot_epilog(aTHX_ ax); |
| 1148 | #endif |
| 1149 | } |
| 1150 |