flambda-backend: Port value_kind changes to testsuite/tools to fix pa…

…rsecmm.mly (ocaml-flambda#1060) failure in github CI with 32-bit tests
ccasin · Jan 11, 2023 · 7b1779a · 7b1779a
1 parent 49505d1
commit 7b1779a
Show file tree

Hide file tree

Showing 3 changed files with 17 additions and 6 deletions.
diff --git a/testsuite/tools/parsecmm.mly b/testsuite/tools/parsecmm.mly
@@ -43,7 +43,7 @@ let make_switch n selector caselist =
     List.iter (fun pos -> index.(pos) <- i) posl;
     actv.(i) <- (e, dbg)
   done;
-  Cswitch(selector, index, actv, dbg)
+  Cswitch(selector, index, actv, dbg, value_kind ())
 
 let access_array base numelt size =
   match numelt with
@@ -228,7 +228,8 @@ expr:
   | LPAREN binaryop expr expr RPAREN { Cop($2, [$3; $4], debuginfo ()) }
   | LPAREN SEQ sequence RPAREN { $3 }
   | LPAREN IF expr expr expr RPAREN
-      { Cifthenelse($3, debuginfo (), $4, debuginfo (), $5, debuginfo ()) }
+      { Cifthenelse($3, debuginfo (), $4, debuginfo (), $5, debuginfo (),
+                   value_kind ()) }
   | LPAREN SWITCH INTCONST expr caselist RPAREN { make_switch $3 $4 $5 }
   | LPAREN WHILE expr sequence RPAREN
       {
@@ -239,21 +240,21 @@ expr:
             Cconst_int (x, _) when x <> 0 -> $4
           | _ -> Cifthenelse($3, debuginfo (), $4, debuginfo (),
                              (Cexit(lbl0,[])),
-                             debuginfo ()) in
+                             debuginfo (), value_kind ()) in
         Ccatch(Nonrecursive, [lbl0, [], Ctuple [], debuginfo ()],
           Ccatch(Recursive,
             [lbl1, [], Csequence(body, Cexit(lbl1, [])), debuginfo ()],
-            Cexit(lbl1, []))) }
+            Cexit(lbl1, []), value_kind ()), value_kind ()) }
   | LPAREN EXIT IDENT exprlist RPAREN
     { Cexit(find_label $3, List.rev $4) }
   | LPAREN CATCH sequence WITH catch_handlers RPAREN
     { let handlers = $5 in
       List.iter (fun (_, l, _, _) ->
         List.iter (fun (x, _) -> unbind_ident x) l) handlers;
-      Ccatch(Recursive, handlers, $3) }
+      Ccatch(Recursive, handlers, $3, value_kind ()) }
   | EXIT        { Cexit(0,[]) }
   | LPAREN TRY sequence WITH bind_ident sequence RPAREN
-                { unbind_ident $5; Ctrywith($3, $5, $6, debuginfo ()) }
+                { unbind_ident $5; Ctrywith($3, $5, $6, debuginfo (), value_kind ()) }
   | LPAREN VAL expr expr RPAREN
       { let open Asttypes in
         Cop(Cload (Word_val, Mutable), [access_array $3 $4 Arch.size_addr],

diff --git a/testsuite/tools/parsecmmaux.ml b/testsuite/tools/parsecmmaux.ml
@@ -60,3 +60,11 @@ let debuginfo ?(loc=Location.symbol_rloc ()) () =
                   ~scopes:Scoped_location.empty_scopes loc
                )
             )
+
+let value_kind () =
+  (* CR-someday poechsel: As the value_kind is only used when building cmm
+     for the first time, its precise value is not important afterward.
+     For now we can say that the cmm code read by parsecmm will only contain
+     Pgenval and it should make no difference, but this should probably be
+     fixed. *)
+  Cmm.Vval Lambda.Pgenval
diff --git a/testsuite/tools/parsecmmaux.mli b/testsuite/tools/parsecmmaux.mli
@@ -29,3 +29,5 @@ type error =
 exception Error of error
 
 val report_error: error -> unit
+
+val value_kind : unit -> Cmm.value_kind
Original file line number	Diff line number	Diff line change
Expand Up		@@ -29,3 +29,5 @@ type error =
		exception Error of error

		val report_error: error -> unit

		val value_kind : unit -> Cmm.value_kind