test-suite/tests/linker.test

   1 ;;;; linker.test                               -*- scheme -*-
   2 ;;;;
   3 ;;;; Copyright 2013 Free Software Foundation, Inc.
   4 ;;;;
   5 ;;;; This library is free software; you can redistribute it and/or
   6 ;;;; modify it under the terms of the GNU Lesser General Public
   7 ;;;; License as published by the Free Software Foundation; either
   8 ;;;; version 3 of the License, or (at your option) any later version.
   9 ;;;;
  10 ;;;; This library is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;;;; Lesser General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU Lesser General Public
  16 ;;;; License along with this library; if not, write to the Free Software
  17 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18
  19 (define-module (test-suite test-linker)
  20   #:use-module (test-suite lib)
  21   #:use-module (rnrs bytevectors)
  22   #:use-module (system base target)
  23   #:use-module (system vm elf)
  24   #:use-module (system vm linker))
  25
  26 (define (link-elf-with-one-main-section name bytes)
  27   (let ((strtab (make-string-table)))
  28     (define (make-object index name bv relocs . kwargs)
  29       (let ((name-idx (string-table-intern! strtab (symbol->string name))))
  30         (make-linker-object (apply make-elf-section
  31                                    #:index index
  32                                    #:name name-idx
  33                                    #:size (bytevector-length bv)
  34                                    kwargs)
  35                             bv relocs
  36                             (list (make-linker-symbol name 0)))))
  37     (define (make-shstrtab)
  38       (string-table-intern! strtab ".shstrtab")
  39       (make-object 2 '.shstrtab (link-string-table! strtab) '()
  40                    #:type SHT_STRTAB #:flags 0))
  41     (let* ((word-size (target-word-size))
  42            (endianness (target-endianness))
  43            (sec (make-object 1 name bytes '()))
  44            ;; This needs to be linked last, because linking other
  45            ;; sections adds entries to the string table.
  46            (shstrtab (make-shstrtab)))
  47       (link-elf (list sec shstrtab)
  48                 #:endianness endianness #:word-size word-size))))
  49
  50 (with-test-prefix "simple"
  51   (define foo-bytes #vu8(0 1 2 3 4 5))
  52   (define bytes #f)
  53   (define elf #f)
  54
  55   (define (bytevectors-equal? bv-a bv-b start-a start-b size)
  56     (or (zero? size)
  57         (and (equal? (bytevector-u8-ref bv-a start-a)
  58                      (bytevector-u8-ref bv-b start-b))
  59              (bytevectors-equal? bv-a bv-b (1+ start-a) (1+ start-b)
  60                                  (1- size)))))
  61
  62   (pass-if "linking succeeds"
  63     (begin
  64       (set! bytes (link-elf-with-one-main-section '.foo foo-bytes))
  65       #t))
  66
  67   (pass-if "parsing succeeds"
  68     (begin
  69       (set! elf (parse-elf bytes))
  70       (elf? elf)))
  71
  72   ;; 5 sections: the initial NULL section, .foo, .shstrtab, the initial
  73   ;; header with segment table, and the section table.
  74   (pass-if-equal 5 (elf-shnum elf))
  75
  76   (pass-if ".foo section checks out"
  77     (let ((sec (assoc-ref (elf-sections-by-name elf) ".foo")))
  78       (and sec
  79            (= (elf-section-size sec) (bytevector-length foo-bytes))
  80            (bytevectors-equal? bytes foo-bytes
  81                                (elf-section-offset sec) 0
  82                                (bytevector-length foo-bytes))))))