Changeset 82094

Timestamp:

08/07/11 19:33:51 (4 years ago)

Author:

fotanus@…

Message:

Code changes thanks to Perry review

File:

• branches/gsoc11-post-destroot/base/src/port1.0/portcheckdestroot.tcl (modified) (6 diffs)

branches/gsoc11-post-destroot/base/src/port1.0/portcheckdestroot.tcl

@@ -38 +38 @@
 # escape chars in order to be usable as regexp. This function is for internal use. 
 proc portcheckdestroot::escape_chars {str} {
-        return [regsub -all {\W} $str {\\&}]
+    return [regsub -all {\W} $str {\\&}]
 }
 
@@ -79 +79 @@
     set deps {}
     if {[info exists depends_lib]} {
-        foreach dep [set depends_lib] {
+        foreach dep $depends_lib {
             set dep_portname [_get_dep_port $dep]
-            if {$dep_portname != ""} {
-                set dep_portname [_get_dep_port $dep]
-                lappend deps $dep_portname
-            }
+            lappend deps $dep_portname
         }
     }
@@ -91 +88 @@
 
 # Check for errors on port symlinks
-proc portcheckdestroot::checkdestroot_symlink {} {
+proc portcheckdestroot::checkdestroot_symlinks {} {
     global UI_PREFIX destroot prefix
-    ui_notice "$UI_PREFIX Checking for links"
+    ui_notice "$UI_PREFIX Checking symlinks"
     foreach link [links_list $destroot] {
         set points_to [file link $link]
@@ -99 +96 @@
             #This might be changed for RegExp support
             if {[regexp $destroot$prefix $points_to]} {
-                ui_debug "$link is an absolute link to a path inside destroot"
                 return -code error "$link is an absolute link to a path inside destroot"
             } else {
                 ui_debug "$link is an absolute link to a path outside destroot"
             }
-                ui_debug "Relative link path pointing to inside of destroot"
         } elseif {[file pathtype $points_to] eq {relative}} {
             if {[regexp $destroot$prefix [file normalize [file join [file dirname $link] $points_to]]]} {
                 ui_debug "$link is a relative link to a path inside destroot"
             } else {
-                ui_debug "$link is a relative link to a path outside destroot"
                 return -code error "$link is a relative link to a path outside destroot"
             }
@@ -266 +260 @@
     ui_notice "$UI_PREFIX Checking for archs"
     set archs [get_canonical_archs]
-    if { "archs" != "noarch" } {
+    if { [expr {$archs ne "noarch"}] } {
         foreach file [files_list $destroot] {
             set file_archs [list_archs $file]
-            foreach arch $file_archs {
-                if { [lsearch $arch $archs] == -1 } {
-                    return -code error "$file supports the arch $arch, and should not"
+            if { [expr {$file_archs ne {}}] } {
+                foreach arch $file_archs {
+                    if { [lsearch $arch $archs] == -1 } {
+                        return -code error "$file supports the arch $arch, and should not"
+                    }
+                }
+                foreach arch $archs {
+                    if { [lsearch $arch $file_archs] == -1 } {
+                        return -code error "$file does not suport the arch $arch, and it should"
+                    }
                 }
             }
@@ -282 +283 @@
     ui_notice "$UI_PREFIX Executing check-destroot phase"
 
-    checkdestroot_symlink
+    checkdestroot_symlinks
     checkdestroot_mtree
     checkdestroot_libs