diff options
author | Torok Edwin <edwintorok@gmail.com> | 2011-10-14 20:38:14 +0000 |
---|---|---|
committer | Torok Edwin <edwintorok@gmail.com> | 2011-10-14 20:38:14 +0000 |
commit | 2c4ae181c4c3d93684bb5926cd73c6b3a8370c42 (patch) | |
tree | 1a7cb71a0339d342b0e4a5574702e6bca6fd2a65 | |
parent | 6b228e506f42972c003599f4873a24910f8a530a (diff) |
OCaml bindings: fix infinite recursion on string_of_lltype
git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@141994 91177308-0d34-0410-b5e6-96231b3b80d8
-rw-r--r-- | bindings/ocaml/llvm/llvm.ml | 9 | ||||
-rw-r--r-- | test/Bindings/Ocaml/vmcore.ml | 10 |
2 files changed, 18 insertions, 1 deletions
diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml index 19ad672b54..168c21ccc8 100644 --- a/bindings/ocaml/llvm/llvm.ml +++ b/bindings/ocaml/llvm/llvm.ml @@ -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) diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml index 01b22508bc..34a7338682 100644 --- a/test/Bindings/Ocaml/vmcore.ml +++ b/test/Bindings/Ocaml/vmcore.ml @@ -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 |