/ test.scm
test.scm
1 #!/usr/bin/env -S guile --no-auto-compile 2 !# 3 (add-to-load-path (dirname (current-filename))) 4 (use-modules (srfi srfi-64) 5 (ice-9 binary-ports) 6 (system foreign) 7 (llvm module) 8 (llvm use) 9 (llvm context) 10 (llvm pass-manager) 11 (llvm block) 12 (llvm raw) 13 (llvm types) 14 (llvm type) 15 (llvm target-machine) 16 (llvm value) 17 (llvm function) 18 (llvm builder) 19 (llvm utils) 20 (llvm execution-engine) 21 (llvm error) 22 ;; (oop goops) 23 (llvm memory-buffer) 24 (llvm object) 25 (llvm bitcode) 26 ) 27 (test-with-runner (test-runner-simple) 28 (test-group "llvm-context" 29 (test-assert "current-llvm-context" (current-llvm-context)) 30 (test-assert "context-create" 31 (llvm-context? (context-create))) 32 (test-assert (module-create "hello"))) 33 (test-group "llvm-type" 34 (test-assert (int8-type)) 35 (test-assert (int16-type)) 36 (test-assert (int32-type)) 37 (test-assert (int64-type)) 38 (test-assert (int128-type)) 39 (test-assert (int-type 1)) 40 (test-assert (void-type)) 41 (test-assert (metadata-type)) 42 (test-assert (pointer-type (int128-type) 0)) 43 (test-assert (array-type (int32-type) 5)) 44 (test-assert (subtypes (struct-type 45 (list 46 (vector-type (int8-type) 30) 47 (array-type (int8-type) 30) 48 (int8-type) 49 (int32-type)) 50 #:packed? #t))) 51 (test-assert (vector-type (int8-type) 3)) 52 (test-assert (type-sized? (int8-type))) 53 (test-assert (function-type 54 #:return (int8-type) 55 #:arg-types (list (int8-type)))) 56 (test-assert "type->string" 57 (type->string (function-type 58 #:return (int8-type) 59 #:arg-types (list (int8-type))))) 60 (test-assert (struct-create-named "unkonw")) 61 (test-assert (get-type-by-name "unkonw"))) 62 63 (test-group "llvm-global-variable" 64 (let* ((module (module-create "llvm-global-variable")) 65 (x (add-global-variable module 66 (struct-type 67 (list 68 (vector-type (int8-type) 30) 69 (array-type (int8-type) 30) 70 (int8-type) 71 (int32-type)) 72 #:packed? #t) 73 "x"))) 74 75 (test-eq "first-global-variable" 76 (first-global-variable module) 77 x) 78 (test-assert "set-initializer!" 79 (set-initializer! x (const-int (int32-type) 40 #:sign-extend? #t))))) 80 (let ((module (module-create "llvm-function"))) 81 (test-group "llvm-function" 82 (let* ((func (add-function module 83 #:name "add" 84 #:arg-types (list (int32-type) 85 (int32-type)) 86 #:return (int32-type)))) 87 (test-assert func) 88 (test-assert (params func)) 89 (test-assert (type-of (car (params func)))))) 90 (test-group "llvm-block" 91 (let ((function (first-function module)) 92 (builder (builder-create))) 93 (test-assert (create-block "hello")) 94 (gc) 95 (test-assert (append-block function (create-block "hello"))) 96 (gc) 97 (test-assert (append-block function "entry")) 98 (test-assert (position-builder-at-end builder (first-block function))) 99 (test-assert (build-mul builder (param function 0) 100 (const-int (int32-type) 40 101 #:sign-extend? #t))) 102 (test-assert (build-return builder (const-int (int32-type) 40 103 #:sign-extend? #t))))) 104 (test-group "llvm-module" 105 (test-assert (module->string module))) 106 (test-group "llvm-use" 107 1)) 108 109 (test-group "llvm-target" 110 (test-assert (LLVMInitializeX86TargetInfo)) 111 (test-assert (LLVMInitializeRISCVTargetInfo)) 112 (test-assert (first-target)) 113 (test-assert (target-from-name "riscv64")) 114 (test-assert (target-description (target-from-name "riscv64"))) 115 (test-assert (host-cpu-name)) 116 (test-assert (host-cpu-features)) 117 (test-assert (host-cpu-features)) 118 (test-assert (normalize-target-triple "x86_64")) 119 (test-assert "default-target-triple" (default-target-triple)) 120 (test-assert (target-from-triple (default-target-triple)))) 121 (test-group "llvm-execution-engine" 122 (LLVMInitializeX86Target) 123 (LLVMInitializeX86TargetInfo) 124 (LLVMInitializeX86TargetMC) 125 (LLVMInitializeX86Disassembler) 126 (LLVMInitializeRISCVTargetInfo) 127 (LLVMInitializeX86AsmPrinter) 128 (LLVMInitializeX86AsmParser) 129 (let* ((module (module-create "hello")) 130 (add-func (add-function module 131 #:name "main" 132 #:return (int32-type) 133 #:arg-types (list (int32-type) 134 (int32-type)))) 135 (block (append-block add-func "entry")) 136 (builder (builder-create)) 137 (_ (position-builder-at-end builder block)) 138 (pam-0 (param add-func 0)) 139 (pam-1 (param add-func 1)) 140 (mul (build-mul builder pam-0 pam-1 #:name "mul")) 141 (add (build-add builder mul pam-1 #:name "ad")) 142 (_ (build-return builder add)) 143 (ee (create-execution-engine module)) 144 (proc (pointer->procedure 145 int64 (make-pointer 146 (function-address ee "main")) 147 (list int32 int32)))) 148 (test-equal 630 (proc 20 30)) 149 (let ((m (write-bitcode-to-memory-buffer 150 module 151 ))) 152 (test-assert (call-with-output-file "/tmp/bbbba" 153 (lambda (x) 154 (put-bytevector x 155 (pointer->bytevector 156 (LLVMGetBufferStart 157 (unwrap-llvm-memory-buffer 158 m)) 159 (LLVMGetBufferSize 160 (unwrap-llvm-memory-buffer 161 m)))))))))) 162 (test-group "llvm error" 163 (test-assert (enable-pretty-stack-trace!)) 164 (test-assert (install-fatal-error-handler! (lambda (x) (pk x)))) 165 (test-assert (reset-fatal-error-handler!))) 166 (test-group "llvm-object" 167 (call-with-memory-buffer 168 "/bin/sh" 169 (lambda (o) 170 (test-assert o) 171 (test-assert (get-type (create-binary o (current-llvm-context))))))))