summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTorok Edwin <edwintorok@gmail.com>2011-10-14 20:38:14 +0000
committerTorok Edwin <edwintorok@gmail.com>2011-10-14 20:38:14 +0000
commit2c4ae181c4c3d93684bb5926cd73c6b3a8370c42 (patch)
tree1a7cb71a0339d342b0e4a5574702e6bca6fd2a65
parent6b228e506f42972c003599f4873a24910f8a530a (diff)
downloadllvm-2c4ae181c4c3d93684bb5926cd73c6b3a8370c42.tar.gz
llvm-2c4ae181c4c3d93684bb5926cd73c6b3a8370c42.tar.bz2
llvm-2c4ae181c4c3d93684bb5926cd73c6b3a8370c42.tar.xz
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.ml9
-rw-r--r--test/Bindings/Ocaml/vmcore.ml10
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