From 0afb26cc71109fd7068a8048980443848fcbad15 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 8 Nov 2013 14:54:38 +0100 Subject: [PATCH] Move useful parts of asm-to-bytecode.test to cross-compilation.test * test-suite/tests/cross-compilation.test: Rename from asm-to-bytecode, and remove the bits testing assembly->bytecode but keep the cross-compilation things. * test-suite/Makefile.am: Adapt. --- test-suite/Makefile.am | 2 +- test-suite/tests/asm-to-bytecode.test | 217 ------------------------ test-suite/tests/cross-compilation.test | 90 ++++++++++ 3 files changed, 91 insertions(+), 218 deletions(-) delete mode 100644 test-suite/tests/asm-to-bytecode.test create mode 100644 test-suite/tests/cross-compilation.test diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 19789db86..3ab34d6d8 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -28,7 +28,6 @@ SCM_TESTS = tests/00-initial-env.test \ tests/and-let-star.test \ tests/arbiters.test \ tests/arrays.test \ - tests/asm-to-bytecode.test \ tests/bit-operations.test \ tests/bitvectors.test \ tests/brainfuck.test \ @@ -40,6 +39,7 @@ SCM_TESTS = tests/00-initial-env.test \ tests/control.test \ tests/continuations.test \ tests/coverage.test \ + tests/cross-compilation.test \ tests/cse.test \ tests/curried-definitions.test \ tests/dwarf.test \ diff --git a/test-suite/tests/asm-to-bytecode.test b/test-suite/tests/asm-to-bytecode.test deleted file mode 100644 index 688e7524a..000000000 --- a/test-suite/tests/asm-to-bytecode.test +++ /dev/null @@ -1,217 +0,0 @@ -;;;; Assembly to bytecode compilation -*- mode: scheme; coding: utf-8; -*- -;;;; -;;;; Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc. -;;;; -;;;; This library is free software; you can redistribute it and/or -;;;; modify it under the terms of the GNU Lesser General Public -;;;; License as published by the Free Software Foundation; either -;;;; version 3 of the License, or (at your option) any later version. -;;;; -;;;; This library is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;;; Lesser General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU Lesser General Public -;;;; License along with this library; if not, write to the Free Software -;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - -(define-module (tests asm-to-bytecode) - #:use-module (rnrs bytevectors) - #:use-module ((rnrs io ports) #:select (open-bytevector-output-port)) - #:use-module (test-suite lib) - #:use-module (system vm instruction) - #:use-module (system vm objcode) - #:use-module (system vm elf) - #:use-module (system base target) - #:use-module (language objcode elf) - #:use-module (language assembly) - #:use-module (language assembly compile-bytecode)) - -(define (->u8-list sym val) - (let ((entry (assq-ref `((uint16 2 ,bytevector-u16-native-set!) - (uint32 4 ,bytevector-u32-native-set!)) - sym))) - (or entry (error "unknown sym" sym)) - (let ((bv (make-bytevector (car entry)))) - ((cadr entry) bv 0 val) - (bytevector->u8-list bv)))) - -(define (munge-bytecode v) - (let lp ((i 0) (out '())) - (if (= i (vector-length v)) - (u8-list->bytevector (reverse out)) - (let ((x (vector-ref v i))) - (cond - ((symbol? x) - (lp (1+ i) (cons (instruction->opcode x) out))) - ((integer? x) - (lp (1+ i) (cons x out))) - ((pair? x) - (lp (1+ i) (append (reverse (apply ->u8-list x)) out))) - (else (error "bad test bytecode" x))))))) - -(define (comp-test x y) - (let* ((y (munge-bytecode y)) - (len (bytevector-length y)) - (v #f)) - - (run-test `(length ,x) #t - (lambda () - (let* ((wrapped `(load-program () ,(byte-length x) #f ,x)) - (bv (compile-bytecode wrapped '()))) - (set! v (make-bytevector (- (bytevector-length bv) 8))) - (bytevector-copy! bv 8 v 0 (bytevector-length v)) - (= (bytevector-length v) len)))) - (run-test `(compile-equal? ,x ,y) #t - (lambda () - (equal? v y))))) - - -(with-test-prefix "compiler" - (with-test-prefix "asm-to-bytecode" - - (comp-test '(make-int8 3) - #(make-int8 3)) - - (comp-test '(load-number "3.14") - (vector 'load-number 0 0 4 (char->integer #\3) (char->integer #\.) - (char->integer #\1) (char->integer #\4))) - - (comp-test '(load-string "foo") - (vector 'load-string 0 0 3 (char->integer #\f) (char->integer #\o) - (char->integer #\o))) - - (comp-test '(load-symbol "foo") - (vector 'load-symbol 0 0 3 (char->integer #\f) (char->integer #\o) - (char->integer #\o))) - - (comp-test '(load-string "æ") ;; a non-ASCII Latin-1 string - (vector 'load-string 0 0 1 230)) - - (comp-test '(load-wide-string "λ") - (apply vector 'load-wide-string 0 0 4 - (if (eq? (native-endianness) (endianness little)) - '(187 3 0 0) - '(0 0 3 187)))) - - (comp-test '(load-program () 3 #f (make-int8 3) (return)) - #(load-program - (uint32 3) ;; len - (uint32 0) ;; metalen - make-int8 3 - return)) - - ;; the nops are to pad meta to an 8-byte alignment. not strictly - ;; necessary for this test, but representative of the common case. - (comp-test '(load-program () 8 - (load-program () 3 - #f - (make-int8 3) (return)) - (make-int8 3) (return) - (nop) (nop) (nop) (nop) (nop)) - #(load-program - (uint32 8) ;; len - (uint32 11) ;; metalen - make-int8 3 - return - nop nop nop nop nop - (uint32 3) ;; len - (uint32 0) ;; metalen - make-int8 3 - return)))) - - -(define (test-triplet cpu vendor os) - (let ((triplet (string-append cpu "-" vendor "-" os))) - (pass-if (format #f "triplet ~a" triplet) - (with-target triplet - (lambda () - (and (string=? (target-cpu) cpu) - (string=? (target-vendor) vendor) - (string=? (target-os) os))))))) - -(define (native-cpu) - (with-target %host-type target-cpu)) - -(define (native-os) - (with-target %host-type target-os)) - -(define (native-word-size) - ((@ (system foreign) sizeof) '*)) - -(define %objcode-cookie-size - (string-length "GOOF----LE-8")) - -(define (test-target triplet endian word-size) - (pass-if (format #f "target `~a' honored" triplet) - (call-with-values (lambda () - (open-bytevector-output-port)) - (lambda (p get-objcode) - (with-target triplet - (lambda () - (let ((word-size - ;; When the target is the native CPU, rather trust - ;; the native CPU's word size. This is because - ;; Debian's `sparc64-linux-gnu' port, for instance, - ;; actually has a 32-bit user-land, for instance (see - ;; - ;; for details.) - (if (and (string=? (native-cpu) (target-cpu)) - (string=? (native-os) (target-os))) - (native-word-size) - word-size)) - (b (compile-bytecode - '(load-program () 16 #f - (assert-nargs-ee/locals 1) - (make-int8 77) - (toplevel-ref 1) - (local-ref 0) - (mul) - (add) - (return) - (nop) (nop) (nop) - (nop) (nop)) - #f))) - (write-objcode (bytecode->objcode b (target-endianness)) p) - (let* ((bv (get-objcode))) - (and=> (parse-elf bv) - (lambda (elf) - (and (equal? (elf-byte-order elf) endian) - (equal? (elf-word-size elf) word-size)))))))))))) - -(with-test-prefix "cross-compilation" - - (test-triplet "i586" "pc" "gnu0.3") - (test-triplet "x86_64" "unknown" "linux-gnu") - (test-triplet "x86_64" "unknown" "kfreebsd-gnu") - - (test-target "i586-pc-gnu0.3" (endianness little) 4) - (test-target "x86_64-pc-linux-gnu" (endianness little) 8) - (test-target "powerpc-unknown-linux-gnu" (endianness big) 4) - (test-target "sparc64-unknown-freebsd8.2" (endianness big) 8) - - (test-target "mips64el-unknown-linux-gnu" ; n32 or o32 ABI - (endianness little) 4) - (test-target "mips64el-unknown-linux-gnuabi64" ; n64 ABI (Debian tuplet) - (endianness little) 8) - (test-target "x86_64-unknown-linux-gnux32" ; x32 ABI (Debian tuplet) - (endianness little) 4) - - (pass-if-exception "unknown target" - exception:miscellaneous-error - (call-with-values (lambda () - (open-bytevector-output-port)) - (lambda (p get-objcode) - (let* ((b (compile-bytecode '(load-program () 3 #f - (make-int8 77) - (return)) - #f)) - (o (bytecode->objcode b (target-endianness)))) - (with-target "fcpu-unknown-gnu1.0" - (lambda () - (write-objcode o p)))))))) - -;; Local Variables: -;; eval: (put 'with-target 'scheme-indent-function 1) -;; End: diff --git a/test-suite/tests/cross-compilation.test b/test-suite/tests/cross-compilation.test new file mode 100644 index 000000000..78d9c8083 --- /dev/null +++ b/test-suite/tests/cross-compilation.test @@ -0,0 +1,90 @@ +;;;; Cross compilation -*- mode: scheme; coding: utf-8; -*- +;;;; +;;;; Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(define-module (tests cross-compilation) + #:use-module (test-suite lib) + #:use-module (rnrs bytevectors) + #:use-module (system vm elf) + #:use-module (system base compile) + #:use-module (system base target)) + +(define (test-triplet cpu vendor os) + (let ((triplet (string-append cpu "-" vendor "-" os))) + (pass-if (format #f "triplet ~a" triplet) + (with-target triplet + (lambda () + (and (string=? (target-cpu) cpu) + (string=? (target-vendor) vendor) + (string=? (target-os) os))))))) + +(define (native-cpu) + (with-target %host-type target-cpu)) + +(define (native-os) + (with-target %host-type target-os)) + +(define (native-word-size) + ((@ (system foreign) sizeof) '*)) + +(define (test-target triplet endian word-size) + (pass-if (format #f "target `~a' honored" triplet) + (with-target triplet + (lambda () + (let ((word-size + ;; When the target is the native CPU, rather trust + ;; the native CPU's word size. This is because + ;; Debian's `sparc64-linux-gnu' port, for instance, + ;; actually has a 32-bit user-land, for instance (see + ;; + ;; for details.) + (if (and (string=? (native-cpu) (target-cpu)) + (string=? (native-os) (target-os))) + (native-word-size) + word-size)) + (bv (compile '(hello-world) #:to 'rtl))) + (and=> (parse-elf bv) + (lambda (elf) + (and (equal? (elf-byte-order elf) endian) + (equal? (elf-word-size elf) word-size))))))))) + +(with-test-prefix "cross-compilation" + + (test-triplet "i586" "pc" "gnu0.3") + (test-triplet "x86_64" "unknown" "linux-gnu") + (test-triplet "x86_64" "unknown" "kfreebsd-gnu") + + (test-target "i586-pc-gnu0.3" (endianness little) 4) + (test-target "x86_64-pc-linux-gnu" (endianness little) 8) + (test-target "powerpc-unknown-linux-gnu" (endianness big) 4) + (test-target "sparc64-unknown-freebsd8.2" (endianness big) 8) + + (test-target "mips64el-unknown-linux-gnu" ; n32 or o32 ABI + (endianness little) 4) + (test-target "mips64el-unknown-linux-gnuabi64" ; n64 ABI (Debian tuplet) + (endianness little) 8) + (test-target "x86_64-unknown-linux-gnux32" ; x32 ABI (Debian tuplet) + (endianness little) 4) + + (pass-if-exception "unknown target" exception:miscellaneous-error + (with-target "fcpu-unknown-gnu1.0" + (lambda () + (compile '(ohai) #:to 'rtl))))) + +;; Local Variables: +;; eval: (put 'with-target 'scheme-indent-function 1) +;; End: -- 2.20.1