[llvm-commits] [llvm] r141994 - in /llvm/trunk: bindings/ocaml/llvm/llvm.ml test/Bindings/Ocaml/vmcore.ml

[Torok Edwin]

Author: edwin
Date: Fri Oct 14 15:38:14 2011
New Revision: 141994

URL: http://llvm.org/viewvc/llvm-project?rev=141994&view=rev
Log:
OCaml bindings: fix infinite recursion on string_of_lltype

Modified:
    llvm/trunk/bindings/ocaml/llvm/llvm.ml
    llvm/trunk/test/Bindings/Ocaml/vmcore.ml

Modified: llvm/trunk/bindings/ocaml/llvm/llvm.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm.ml?rev=141994&r1=141993&r2=141994&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm.ml (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm.ml Fri Oct 14 15:38:14 2011
@@ -1137,7 +1137,14 @@
   (* 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)

Modified: llvm/trunk/test/Bindings/Ocaml/vmcore.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/test/Bindings/Ocaml/vmcore.ml?rev=141994&r1=141993&r2=141994&view=diff
==============================================================================
--- llvm/trunk/test/Bindings/Ocaml/vmcore.ml (original)
+++ llvm/trunk/test/Bindings/Ocaml/vmcore.ml Fri Oct 14 15:38:14 2011
@@ -337,6 +337,16 @@
       "{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