6502/llvm-6502
1
0
Fork 0
mirror of https://github.com/c64scene-ar/llvm-6502.git synced 2024-12-26 21:32:10 +00:00
Code Issues Projects Releases Wiki Activity

OCaml bindings: fix infinite recursion on string_of_lltype

Browse Source 
git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@141994 91177308-0d34-0410-b5e6-96231b3b80d8
This commit is contained in:
Torok Edwin 2011-10-14 20:38:14 +00:00
parent 6b228e506f
commit 2c4ae181c4
2 changed files with 18 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
bindings/ocaml/llvm/llvm.ml
View File

@ -1137,7 +1137,14 @@ let rec string_of_lltype ty =
(* FIXME: stop infinite recursion! :) *)
match classify_type ty with
TypeKind.Integer -> "i" ^ string_of_int (integer_bitwidth ty)
| TypeKind.Pointer -> (string_of_lltype (element_type ty)) ^ "*"
| TypeKind.Pointer ->
(let ety = element_type ty in
match classify_type ety with
| TypeKind.Struct ->
(match struct_name ety with
| None -> (string_of_lltype ety)
| Some s -> s) ^ "*"
| _ -> (string_of_lltype (element_type ty)) ^ "*")
| TypeKind.Struct ->
let s = "{ " ^ (concat2 ", " (
Array.map string_of_lltype (struct_element_types ty)

10
test/Bindings/Ocaml/vmcore.ml
View File

@ -337,6 +337,16 @@ let test_constants () =
"{cx},{ax},{di},~{dirflag},~{fpsr},~{flags},~{edi},~{ecx}"
true
false)
end;
group "recursive struct"; begin
let nsty = named_struct_type context "rec" in
let pty = pointer_type nsty in
struct_set_body nsty [| i32_type; pty |] false;
let elts = [| const_int i32_type 4; const_pointer_null pty |] in
let grec_init = const_named_struct nsty elts in
ignore (define_global "grec" grec_init m);
ignore (string_of_lltype nsty);
end