[65785] trunk/base/src/pextlib1.0
raimue at macports.org
raimue at macports.org
Wed Mar 31 15:25:06 PDT 2010
Revision: 65785
http://trac.macports.org/changeset/65785
Author: raimue at macports.org
Date: 2010-03-31 15:25:04 -0700 (Wed, 31 Mar 2010)
Log Message:
-----------
pextlib1.0:
fs-traverse -tails, closes #21873
Modified Paths:
--------------
trunk/base/src/pextlib1.0/fs-traverse.c
trunk/base/src/pextlib1.0/tests/fs-traverse.tcl
Modified: trunk/base/src/pextlib1.0/fs-traverse.c
===================================================================
--- trunk/base/src/pextlib1.0/fs-traverse.c 2010-03-31 21:54:44 UTC (rev 65784)
+++ trunk/base/src/pextlib1.0/fs-traverse.c 2010-03-31 22:25:04 UTC (rev 65785)
@@ -3,9 +3,10 @@
* $Id$
*
* Find files and execute arbitrary expressions on them.
- * Author: Jordan K. Hubbard, Kevin Ballard
+ * Author: Jordan K. Hubbard, Kevin Ballard, Rainer Mueller
*
* Copyright (c) 2004 Apple Computer, Inc.
+ * Copyright (c) 2010 The MacPorts Project
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
@@ -54,8 +55,9 @@
#define F_DEPTH 0x1
#define F_IGNORE_ERRORS 0x2
+#define F_TAILS 0x4
-/* fs-traverse ?-depth? ?-ignoreErrors? ?--? varname target-list body */
+/* fs-traverse ?-depth? ?-ignoreErrors? ?-tails? ?--? varname target-list body */
int
FsTraverseCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
@@ -84,6 +86,11 @@
++objv, --objc;
continue;
}
+ if (!strcmp(arg, "-tails")) {
+ flags |= F_TAILS;
+ ++objv, --objc;
+ continue;
+ }
if (!strcmp(arg, "--")) {
++objv, --objc;
break;
@@ -93,7 +100,7 @@
/* Parse remaining args */
if (objc != 3) {
- Tcl_WrongNumArgs(interp, 1, objv_orig, "?-depth? ?-ignoreErrors? ?--? varname target-list body");
+ Tcl_WrongNumArgs(interp, 1, objv_orig, "?-depth? ?-ignoreErrors? ?-tails? ?--? varname target-list body");
return TCL_ERROR;
}
@@ -106,8 +113,17 @@
body = *objv;
if ((rval = Tcl_ListObjGetElements(interp, listPtr, &lobjc, &lobjv)) == TCL_OK) {
- char **entries = calloc(lobjc+1, sizeof(char *));
- char **iter = (char **)entries;
+ char **entries;
+ char **iter;
+
+ if (flags & F_TAILS && lobjc > 1) {
+ /* result would be ambiguous with multiple paths, so we do not allow this */
+ Tcl_SetResult(interp, "-tails cannot be used with multiple paths", TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ entries = calloc(lobjc+1, sizeof(char *));
+ iter = (char **)entries;
while (lobjc > 0) {
*iter++ = Tcl_GetString(*lobjv);
--lobjc, ++lobjv;
@@ -119,6 +135,23 @@
return rval;
}
+static const char *
+extract_tail(const char *target, const char *path)
+{
+ const char *xpath = path;
+ size_t tlen = strlen(target);
+
+ if (strncmp(xpath, target, tlen) == 0) {
+ if (*(xpath + tlen) == '\0') {
+ xpath = ".";
+ } else if (*(xpath + tlen) == '/') {
+ xpath += tlen + 1;
+ }
+ }
+
+ return xpath;
+}
+
static int
do_compare(const FTSENT **a, const FTSENT **b)
{
@@ -140,7 +173,14 @@
case FTS_DP: /* directory in post-order*/
{
if (!(flags & F_DEPTH) != !(ent->fts_info == FTS_D)) {
- Tcl_Obj *rpath, *path = Tcl_NewStringObj(ent->fts_path, ent->fts_pathlen);
+ Tcl_Obj *rpath, *path;
+ if (flags & F_TAILS) {
+ /* there cannot be multiple targets */
+ const char *xpath = extract_tail(targets[0], ent->fts_path);
+ path = Tcl_NewStringObj(xpath, -1);
+ } else {
+ path = Tcl_NewStringObj(ent->fts_path, ent->fts_pathlen);
+ }
Tcl_IncrRefCount(path);
rpath = Tcl_ObjSetVar2(interp, varname, NULL, path, TCL_LEAVE_ERR_MSG);
Tcl_DecrRefCount(path);
@@ -165,7 +205,14 @@
case FTS_SLNONE: /* symbolic link with non-existant target */
case FTS_DEFAULT: /* file type not otherwise handled (e.g., fifo) */
{
- Tcl_Obj *rpath, *path = Tcl_NewStringObj(ent->fts_path, ent->fts_pathlen);
+ Tcl_Obj *rpath, *path;
+ if (flags & F_TAILS) {
+ /* there cannot be multiple targets */
+ const char *xpath = extract_tail(targets[0], ent->fts_path);
+ path = Tcl_NewStringObj(xpath, -1);
+ } else {
+ path = Tcl_NewStringObj(ent->fts_path, ent->fts_pathlen);
+ }
Tcl_IncrRefCount(path);
rpath = Tcl_ObjSetVar2(interp, varname, NULL, path, TCL_LEAVE_ERR_MSG);
Tcl_DecrRefCount(path);
Modified: trunk/base/src/pextlib1.0/tests/fs-traverse.tcl
===================================================================
--- trunk/base/src/pextlib1.0/tests/fs-traverse.tcl 2010-03-31 21:54:44 UTC (rev 65784)
+++ trunk/base/src/pextlib1.0/tests/fs-traverse.tcl 2010-03-31 22:25:04 UTC (rev 65785)
@@ -92,6 +92,28 @@
}
check_output $output $trees(5)
+ # Test -tails option
+ set output [list]
+ fs-traverse -tails file $root {
+ lappend output $file
+ }
+ check_output $output $trees(6) $root
+
+ # Test -tails option with trailing slash
+ set output [list]
+ fs-traverse -tails file $root/ {
+ lappend output $file
+ }
+ check_output $output $trees(6) $root
+
+ # Test -tails option with multiple paths
+ # It should error out
+ if {![catch {
+ fs-traverse -tails file {$root/a $root/b} {}
+ }]} {
+ error "fs-traverse did not error when using multiple paths with -tails"
+ }
+
# Test cutting the traversal short
set output [list]
fs-traverse file $root {
@@ -159,15 +181,15 @@
}
}
-proc check_output {output tree} {
+proc check_output {output tree {root ""}} {
foreach file $output {entry typelist} $tree {
set type [lindex $typelist 0]
set link [lindex $typelist 1]
if {$file ne $entry} {
error "Found `$file', expected `$entry'"
- } elseif {[file type $file] ne $type} {
+ } elseif {[file type [file join $root $file]] ne $type} {
error "File `$file' had type `[file type $file]', expected type `$type'"
- } elseif {$type eq "link" && [file readlink $file] ne $link} {
+ } elseif {$type eq "link" && [file readlink [file join $root $file]] ne $link} {
error "File `$file' linked to `[file readlink $file]', expected link to `$link'"
}
}
@@ -333,6 +355,34 @@
$root/b/c/b file
$root/b/c/c file
"
+
+ set trees(6) "
+ . directory
+ a directory
+ a/a file
+ a/b file
+ a/c directory
+ a/c/a {link ../d}
+ a/c/b file
+ a/c/c directory
+ a/c/d file
+ a/d directory
+ a/d/a file
+ a/d/b {link ../../b/a}
+ a/d/c directory
+ a/d/d file
+ a/e file
+ b directory
+ b/a directory
+ b/a/a file
+ b/a/b file
+ b/a/c file
+ b/b directory
+ b/c directory
+ b/c/a file
+ b/c/b file
+ b/c/c file
+ "
}
main $argv
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20100331/d04d4895/attachment.html>
More information about the macports-changes
mailing list