Commit | Line | Data |
---|---|---|
45037e75 AW |
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) | |
48285389 | 27 | (let ((strtab (make-string-table))) |
6756d265 | 28 | (define (make-object index name bv relocs . kwargs) |
48285389 | 29 | (let ((name-idx (string-table-intern! strtab (symbol->string name)))) |
45037e75 | 30 | (make-linker-object (apply make-elf-section |
6756d265 | 31 | #:index index |
45037e75 AW |
32 | #:name name-idx |
33 | #:size (bytevector-length bv) | |
34 | kwargs) | |
35 | bv relocs | |
36 | (list (make-linker-symbol name 0))))) | |
48285389 AW |
37 | (define (make-shstrtab) |
38 | (string-table-intern! strtab ".shstrtab") | |
39 | (make-object 2 '.shstrtab (link-string-table! strtab) '() | |
45037e75 AW |
40 | #:type SHT_STRTAB #:flags 0)) |
41 | (let* ((word-size (target-word-size)) | |
42 | (endianness (target-endianness)) | |
6756d265 | 43 | (sec (make-object 1 name bytes '())) |
45037e75 AW |
44 | ;; This needs to be linked last, because linking other |
45 | ;; sections adds entries to the string table. | |
48285389 | 46 | (shstrtab (make-shstrtab))) |
45037e75 AW |
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 | ||
d4da9ba9 AW |
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)) | |
45037e75 AW |
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)))))) |