[24432] trunk/base/src/pextlib1.0

[source_changes at macosforge.org]

Revision: 24432
          http://trac.macosforge.org/projects/macports/changeset/24432
Author:   eridius at macports.org
Date:     2007-04-24 02:39:35 -0700 (Tue, 24 Apr 2007)

Log Message:
-----------
Add tests for failure on writing the variable.
Cleaner, more precise memory management for the variable

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	2007-04-24 09:16:31 UTC (rev 24431)
+++ trunk/base/src/pextlib1.0/fs-traverse.c	2007-04-24 09:39:35 UTC (rev 24432)
@@ -136,8 +136,14 @@
             case FTS_DP: /* directory in post-order*/
             {
                 if (!(flags & F_DEPTH) != !(ent->fts_info == FTS_D)) {
-                    Tcl_Obj *path = Tcl_NewStringObj(ent->fts_path, ent->fts_pathlen);
-                    Tcl_ObjSetVar2(interp, varname, NULL, path, 0);
+                    Tcl_Obj *rpath, *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);
+                    if (rpath == NULL && !(flags & F_IGNORE_ERRORS)) {
+                        fts_close(root_fts);
+                        return TCL_ERROR;
+                    }
                     if ((rval = Tcl_EvalObjEx(interp, body, 0)) == TCL_CONTINUE) {
                         fts_set(root_fts, ent, FTS_SKIP);
                     } else if (rval == TCL_BREAK) {
@@ -155,8 +161,14 @@
             case FTS_SLNONE: /* symbolic link with non-existant target */
             case FTS_DEFAULT: /* file type not otherwise handled (e.g., fifo) */
             {
-                Tcl_Obj *path = Tcl_NewStringObj(ent->fts_path, ent->fts_pathlen);
-                Tcl_ObjSetVar2(interp, varname, NULL, path, 0);
+                Tcl_Obj *rpath, *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);
+                if (rpath == NULL && !(flags & F_IGNORE_ERRORS)) {
+                    fts_close(root_fts);
+                    return TCL_ERROR;
+                }
                 if ((rval = Tcl_EvalObjEx(interp, body, 0)) == TCL_CONTINUE) {
                     fts_set(root_fts, ent, FTS_SKIP); /* probably useless on files/symlinks */
                 } else if (rval == TCL_BREAK) {

Modified: trunk/base/src/pextlib1.0/tests/fs-traverse.tcl
===================================================================
--- trunk/base/src/pextlib1.0/tests/fs-traverse.tcl	2007-04-24 09:16:31 UTC (rev 24431)
+++ trunk/base/src/pextlib1.0/tests/fs-traverse.tcl	2007-04-24 09:39:35 UTC (rev 24432)
@@ -94,6 +94,23 @@
             }
         }
         
+        # Test using an array variable as varname
+        # It should error out
+        if {![catch {
+            array set aryvar {}
+            fs-traverse aryvar $root {}
+        }]} {
+            error "fs-traverse did not error when setting the variable"
+        }
+        
+        # Same test with -ignoreErrors
+        if {[catch {
+            array set aryvar {}
+            fs-traverse -ignoreErrors aryvar $root {}
+        }]} {
+            error "fs-traverse errored out when setting the variable despite -ignoreErrors"
+        }
+        
         # NOTE: This should be the last test performed, as it modifies the file tree
         # Test to make sure deleting files during traversal works as expected
         set output [list]

-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.macosforge.org/pipermail/macports-changes/attachments/20070424/e23787f5/attachment.html