Ver código fonte

gcc: Support dependencies in `run-test'.

* gcc-plugin/tests/run-test.in (compile/match): Look for `dependencies'
  in the `instructions' directive; recurse on all dependencies and
  succeed when all of them succeeded.
Ludovic Courtès 14 anos atrás
pai
commit
09c9dc965a
1 arquivos alterados com 121 adições e 97 exclusões
  1. 121 97
      gcc-plugin/tests/run-test.in

+ 121 - 97
gcc-plugin/tests/run-test.in

@@ -276,6 +276,10 @@ otherwise."
   (define exe
     (executable-file file))
 
+  (define (c->o c-file)
+    (string-append (substring c-file 0 (- (string-length c-file) 2))
+                   ".o"))
+
   (log "~a directives found in `~a'" (length directives) file)
 
   (let*-values (((error-expected?)
@@ -293,103 +297,123 @@ otherwise."
                               (_ #f)))
                           directives)
                      '(run)))
-                ((goal)
-                 (if error-expected?
-                     'compile
-                     (car instructions)))
-                ((cflags)
-                 `(,@cflags
-                   ,@(or (and=> (assq-ref (cdr instructions) 'cflags) cadr)
-                         '())
-                   ,@(if (memq goal '(link run))
-                         `("-o" ,exe)
-                         '("-c"))))
-                ((ldflags)
-                 `(,@ldflags
-                   ,@(or (assq-ref (cdr instructions) 'ldflags)
-                         '())))
-                ((directives)
-                 (remove (lambda (l+d)
-                           (match l+d
-                             (((? location?) 'instructions _ ...)
-                              #t)
-                             (_ #f)))
-                         directives))
-                ((status diagnostics unsatisfied)
-                 (compile/match* file directives cc cflags ldflags))
-                ((unmatched)
-                 ;; Consider unmatched only diagnostics that have a kind, to
-                 ;; avoid taking into account messages like "In file included
-                 ;; from", "In function 'main'", etc.
-                 (filter diagnostic-kind diagnostics)))
-
-    (or (null? unmatched)
-        (begin
-          (format (current-error-port)
-                  "error: ~a unmatched GCC diagnostics:~%"
-                  (length unmatched))
-          (for-each (lambda (d)
-                      (format (current-error-port)
-                              "  ~a:~a:~a: ~a: ~a~%"
-                              (and=> (diagnostic-location d)
-                                     location-file)
-                              (and=> (diagnostic-location d)
-                                     location-line)
-                              (and=> (diagnostic-location d)
-                                     location-column)
-                              (diagnostic-kind d)
-                              (diagnostic-message d)))
-                    unmatched)
-          #f))
-
-    (if (null? unsatisfied)
-        (or (null? directives)
-            (log "~a directives satisfied" (length directives)))
-        (begin
-          (format (current-error-port) "error: ~a unsatisfied directives:~%"
-                  (length unsatisfied))
-          (for-each (lambda (l+d)
-                      (let ((loc (car l+d))
-                            (dir (cdr l+d)))
-                        (format (current-error-port)
-                                "  ~a:~a:~a: ~a: ~s~%"
-                                (location-file loc)
-                                (location-line loc)
-                                (location-column loc)
-                                (car dir)
-                                (cadr dir))))
-                    unsatisfied)
-          #f))
-
-    (if error-expected?
-        (if (= 0 status)
-            (format (current-error-port) "error: compilation succeeded~%"))
-        (if (= 0 status)
-            (or (eq? goal 'compile)
-                (file-exists? exe)
-                (begin
-                  (format (current-error-port)
-                          "error: executable file `~a' not found~%" exe)
-                  #f))
-            (format (current-error-port)
-                    "error: compilation failed (compiler exit code ~a)~%~{  ~a~%~}"
-                    status
-                    (map diagnostic-message diagnostics))))
-
-    (and (null? unmatched)
-         (null? unsatisfied)
-         (if error-expected?
-             (not (= 0 status))
-             (and (= 0 status)
-                  (or (eq? goal 'compile) (file-exists? exe))
-                  (or (not (eq? goal 'run))
-                      (let ((status (run-starpu-code exe)))
-                        (or (= 0 status)
-                            (begin
-                              (format (current-error-port)
-                                      "error: program `~a' failed (exit code ~a)~%"
-                                      exe status)
-                              #f)))))))))
+                ((options)
+                 (match instructions
+                   ((_ options ...)
+                    options)
+                   (_ '())))
+                ((dependencies)
+                 (or (assq-ref options 'dependencies)
+                     '())))
+
+    (or (null? dependencies)
+        (format (current-output-port) "~s has ~a dependencies: ~{~s ~}~%"
+                file (length dependencies) dependencies))
+
+    (and (every (cut compile/match <> cc cflags ldflags)
+                dependencies)
+         (let*-values (((goal)
+                        (if error-expected?
+                            'compile
+                            (car instructions)))
+                       ((cflags)
+                        `(,@cflags
+                          ,@(or (and=> (assq-ref options 'cflags) cadr)
+                                '())
+                          ,@(if (memq goal '(link run))
+                                `("-o" ,exe)
+                                '("-c"))))
+                       ((ldflags)
+                        `(,@(map c->o dependencies)
+                          ,@ldflags
+                          ,@(or (assq-ref options 'ldflags)
+                                '())))
+                       ((directives)
+                        (remove (lambda (l+d)
+                                  (match l+d
+                                    (((? location?) 'instructions _ ...)
+                                     #t)
+                                    (_ #f)))
+                                directives))
+                       ((status diagnostics unsatisfied)
+                        (compile/match* file directives cc cflags ldflags))
+                       ((unmatched)
+                        ;; Consider unmatched only diagnostics that have a
+                        ;; kind, to avoid taking into account messages like
+                        ;; "In file included from", "In function 'main'",
+                        ;; etc.
+                        (filter diagnostic-kind diagnostics)))
+
+           (or (null? unmatched)
+               (begin
+                 (format (current-error-port)
+                         "error: ~a unmatched GCC diagnostics:~%"
+                         (length unmatched))
+                 (for-each (lambda (d)
+                             (format (current-error-port)
+                                     "  ~a:~a:~a: ~a: ~a~%"
+                                     (and=> (diagnostic-location d)
+                                            location-file)
+                                     (and=> (diagnostic-location d)
+                                            location-line)
+                                     (and=> (diagnostic-location d)
+                                            location-column)
+                                     (diagnostic-kind d)
+                                     (diagnostic-message d)))
+                           unmatched)
+                 #f))
+
+           (if (null? unsatisfied)
+               (or (null? directives)
+                   (log "~a directives satisfied" (length directives)))
+               (begin
+                 (format (current-error-port)
+                         "error: ~a unsatisfied directives:~%"
+                         (length unsatisfied))
+                 (for-each (lambda (l+d)
+                             (let ((loc (car l+d))
+                                   (dir (cdr l+d)))
+                               (format (current-error-port)
+                                       "  ~a:~a:~a: ~a: ~s~%"
+                                       (location-file loc)
+                                       (location-line loc)
+                                       (location-column loc)
+                                       (car dir)
+                                       (cadr dir))))
+                           unsatisfied)
+                 #f))
+
+           (if error-expected?
+               (if (= 0 status)
+                   (format (current-error-port)
+                           "error: compilation succeeded~%"))
+               (if (= 0 status)
+                   (or (eq? goal 'compile)
+                       (file-exists? exe)
+                       (begin
+                         (format (current-error-port)
+                                 "error: executable file `~a' not found~%" exe)
+                         #f))
+                   (format (current-error-port)
+                           "error: compilation failed (compiler exit code ~a)~%~{  ~a~%~}"
+                           status
+                           (map diagnostic-message diagnostics))))
+
+           (and (null? unmatched)
+                (null? unsatisfied)
+                (if error-expected?
+                    (not (= 0 status))
+                    (and (= 0 status)
+                         (or (eq? goal 'compile) (file-exists? exe))
+                         (or (not (eq? goal 'run))
+                             (let ((status (run-starpu-code exe)))
+                               (or (= 0 status)
+                                   (begin
+                                     (format (current-error-port)
+                                             "error: program `~a' failed \
+(exit code ~a)~%"
+                                             exe status)
+                                     #f)))))))))))
 
 
 ;;;