[108657] branches/gsoc13-tests/src/port1.0/tests/portdistcheck.test

[marius at macports.org]

Revision: 108657
          https://trac.macports.org/changeset/108657
Author:   marius at macports.org
Date:     2013-07-29 12:03:35 -0700 (Mon, 29 Jul 2013)
Log Message:
-----------
portdistcheck.test: added partial test case

Added Paths:
-----------
    branches/gsoc13-tests/src/port1.0/tests/portdistcheck.test

Added: branches/gsoc13-tests/src/port1.0/tests/portdistcheck.test
===================================================================
--- branches/gsoc13-tests/src/port1.0/tests/portdistcheck.test	                        (rev 0)
+++ branches/gsoc13-tests/src/port1.0/tests/portdistcheck.test	2013-07-29 19:03:35 UTC (rev 108657)
@@ -0,0 +1,93 @@
+package require tcltest 2
+namespace import tcltest::*
+
+set pwd [file normalize $argv0]
+set pwd [eval file join {*}[lrange [file split $pwd] 0 end-1]]
+
+package require macports 1.0
+mportinit
+
+source ../portdistcheck.tcl
+
+proc getdefaultportresourcepath {{path ""}} {
+    global macports::sources_default
+
+    set default_source_url [lindex ${sources_default} 0]
+    if {[getprotocol $default_source_url] == "file"} {
+        set proposedpath [getportdir $default_source_url]
+    } else {
+        set proposedpath [getsourcepath $default_source_url]
+    }
+
+    # append requested path
+    set proposedpath [file join $proposedpath _resources $path]
+
+    return $proposedpath
+}
+
+proc getprotocol {url} {
+    if {[regexp {(?x)([^:]+)://.+} $url match protocol] == 1} {
+        return ${protocol}
+    } else {
+        return -code error "Can't parse url $url"
+    }
+}
+
+proc getsourcepath {url} {
+    global macports::portdbpath
+
+    set source_path [split $url ://]
+
+    if {[_source_is_snapshot $url]} {
+        # daily snapshot tarball
+        return [file join $portdbpath sources [join [lrange $source_path 3 end-1] /] ports]
+    }
+
+    return [file join $portdbpath sources [lindex $source_path 3] [lindex $source_path 4] [lindex $source_path 5]]
+}
+
+proc getportresourcepath {url {path ""} {fallback yes}} {
+    global macports::sources_default
+
+    set protocol [getprotocol $url]
+
+    switch -- ${protocol} {
+        file {
+            set proposedpath [file normalize [file join [getportdir $url] .. ..]]
+        }
+        default {
+            set proposedpath [getsourcepath $url]
+        }
+    }
+
+    # append requested path
+    set proposedpath [file join $proposedpath _resources $path]
+
+    if {$fallback == "yes" && ![file exists $proposedpath]} {
+        return [getdefaultportresourcepath $path]
+    }
+
+    return $proposedpath
+}
+
+
+test distcheck_main {
+    Distcheck main unit test.
+} -body {
+    set portpath $pwd
+    set filespath $pwd/files
+
+    set name fondu
+    set subport fondu
+    set distname fondu_src-060102
+    set porturl "http://fondu.sourceforge.net/"
+    set master_sites "http://fondu.sourceforge.net/"
+
+    set res [portdistcheck::distcheck_main]
+    puts $res
+
+    return "Distcheck main successful."
+} -result "Distcheck main successful."
+
+
+cleanupTests
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20130729/944d2889/attachment.html>