From 7a825016e937bbd2291731830452433b4875bf17 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@cs.indiana.edu>
Date: Tue, 25 Nov 2014 17:53:21 -0500
Subject: [PATCH] Install, build, and test specified pkgs in DrDr.

Initially just a test pkg, with a fixed source.
---
 pkgs/plt-services/meta/drdr/pkgs          |  1 -
 pkgs/plt-services/meta/drdr/pkgs.rktd     |  5 +++
 pkgs/plt-services/meta/drdr/plt-build.rkt | 43 ++++++++++++-----------
 3 files changed, 28 insertions(+), 21 deletions(-)
 delete mode 100644 pkgs/plt-services/meta/drdr/pkgs

diff --git a/pkgs/plt-services/meta/drdr/pkgs b/pkgs/plt-services/meta/drdr/pkgs
deleted file mode 100644
index 6a452c185a..0000000000
--- a/pkgs/plt-services/meta/drdr/pkgs
+++ /dev/null
@@ -1 +0,0 @@
-()
diff --git a/pkgs/plt-services/meta/drdr/pkgs.rktd b/pkgs/plt-services/meta/drdr/pkgs.rktd
index 6a452c185a..faec618bb9 100644
--- a/pkgs/plt-services/meta/drdr/pkgs.rktd
+++ b/pkgs/plt-services/meta/drdr/pkgs.rktd
@@ -1 +1,6 @@
+<<<<<<< HEAD
 ()
+=======
+(("planet2-example" "https://github.com/jeapostrophe/planet2-example/")
+ #;("games" "git://github.com/racket/games/"))
+>>>>>>> Install, build, and test specified pkgs in DrDr.
diff --git a/pkgs/plt-services/meta/drdr/plt-build.rkt b/pkgs/plt-services/meta/drdr/plt-build.rkt
index 8e66965a95..13edb2adee 100644
--- a/pkgs/plt-services/meta/drdr/plt-build.rkt
+++ b/pkgs/plt-services/meta/drdr/plt-build.rkt
@@ -156,9 +156,13 @@
             (subprocess-kill the-process #t))))
     (thunk)))
 
-(define-runtime-path package-list "pkgs")
-(define (planet-packages)
-  (file->value package-list))
+(define (tested-packages)
+  (define tmp-file (make-temporary-file "pkgs~a.rktd" #f (current-temporary-directory)))
+  ;; Checkout the pkgs list
+  (scm-export-file (current-rev) (plt-repository) "pkgs/plt-services/meta/drdr/pkgs.rktd" tmp-file)
+  ;; Read it in
+  (define val (file->value tmp-file))
+  (delete-file tmp-file))
 
 (define (test-revision rev)
   (define rev-dir (revision-dir rev))
@@ -182,7 +186,8 @@
 
   (define pkgs-pths
     (list (build-path trunk-dir "racket" "collects")
-          (build-path trunk-dir "pkgs")))
+          (build-path trunk-dir "pkgs")
+          (build-path trunk-dir "racket" "share" "pkgs")))
   (define (test-directory dir-pth upper-sema)
     (define dir-log (build-path (trunk->log dir-pth) ".index.test"))
     (cond
@@ -290,18 +295,18 @@
           (write-cache! dir-log (current-seconds))
           (semaphore-post upper-sema)))]))
   ;; Some setup
-  (for ([pp (in-list (planet-packages))])
+  (for ([pp (in-list (tested-packages))])
+    (define (run name source)
+      (run/collect/wait/log
+       ;; XXX Give it its own timeout
+       #:timeout (current-make-install-timeout-seconds)
+       #:env (current-env)
+       (build-path log-dir "pkg" name)
+       raco-path
+       (list "pkg" "install" "--skip-installed" "-i" "--deps" "fail" "--name" name source)))
     (match pp
-      [`(,auth ,pkg ,majn ,minn ,ver)
-       (define maj (number->string majn))
-       (define min (number->string minn))
-       (run/collect/wait/log
-        ;; XXX Give it its own timeout
-        #:timeout (current-make-install-timeout-seconds)
-        #:env (current-env)
-        (build-path log-dir "planet" auth pkg maj min)
-        raco-path
-        (list "planet" "install" auth pkg maj min))]))
+      [`(,name ,source) (run name source)]
+      [(? string? name) (run name name)]))
   (run/collect/wait/log
    #:timeout (current-subprocess-timeout-seconds)
    #:env (current-env)
@@ -314,11 +319,9 @@
   (define (test-directories ps upper-sema)
     (define list-sema (make-semaphore 0))
     (define how-many 
-      (for/fold ([cnt 0]) ([p (in-list ps)])
-        (if (directory-exists? p)
-          (begin (test-directory p list-sema)
-                 (add1 cnt))
-          cnt)))
+      (for/sum ([p (in-list ps)] #:when (directory-exists? p))
+        (test-directory p list-sema)
+        1))
     (and (not (zero? how-many))
          (thread
           (lambda ()