CHT:ARM: update tests for result types

Author: sipma

CodeHawk/CHT/CHB_tests/bchlibarm32_tests/tbchlibarm32/tCHBchlibarm32Assertion.ml

@@ -28,6 +28,7 @@
 
 (* chutil *)
 open CHPrettyUtil
+open CHTraceResult
 
 (* xprlib *)
 open XprToPretty
@@ -37,6 +38,7 @@ open XprTypes
 open BCHARMTypes
 
 module A = TCHAssertion
+module TR = CHTraceResult
 
 
 let x2s x = pretty_to_string (xpr_formatter#pr_expr x)
@@ -105,16 +107,21 @@ let equal_arm_conditional_expr
 let equal_instrxdata_conditionxprs
       ?(msg="")
       ~(expected: string)
-      ~(received: xpr_t list)
+      ~(received: xpr_t traceresult list)
       ~(index: int)
       () =
+  let xtr2s (x_r: xpr_t traceresult): string =
+    TR.tfold
+      ~ok:x2s
+      ~error:(fun e -> String.concat "; " e)
+      x_r in
   match received with
   | [] -> A.fail expected "empty list" msg
   | _ when (List.length received) > index ->
-     A.equal_string ~msg expected (x2s (List.nth received index))
+     A.equal_string ~msg expected (xtr2s (List.nth received index))
   | _ ->
      let receivedlen = string_of_int (List.length received) in
-     let xprs = String.concat ", " (List.map x2s received) in
+     let xprs = String.concat ", " (List.map xtr2s received) in
      A.fail
        expected
        ("Index: "

CodeHawk/CHT/CHB_tests/bchlibarm32_tests/tbchlibarm32/tCHBchlibarm32Assertion.mli

@@ -26,6 +26,9 @@
    SOFTWARE.
    ============================================================================= *)
 
+(* chutil *)
+open CHTraceResult
+
 (* xprlib *)
 open XprTypes
 
@@ -68,7 +71,7 @@ val equal_arm_conditional_expr:
 val equal_instrxdata_conditionxprs:
   ?msg: string
   -> expected:string
-  -> received:xpr_t list
+  -> received:xpr_t traceresult list
   -> index:int
   -> unit
   -> unit

CodeHawk/CHT/CHB_tests/bchlibarm32_tests/tbchlibarm32/tCHBchlibarm32Utils.ml

@@ -26,6 +26,12 @@
    SOFTWARE.
    ============================================================================= *)
 
+(* chutil *)
+open CHTraceResult
+
+(* xprlib *)
+open XprTypes
+
 (* bchlib *)
 open BCHByteUtilities
 open BCHDoubleword
@@ -130,8 +136,9 @@ let thumb_function_setup
   end
 
 
-(* To be updated to properly deal with the xpr_t traceresult *)
-let get_instrxdata_xprs (faddr: doubleword_int) (iaddr: doubleword_int) =
+let get_instrxdata_xprs
+      (faddr: doubleword_int)
+      (iaddr: doubleword_int): xpr_t traceresult list =
   let _ = testsupport#request_instrx_data in
   let finfo = get_function_info faddr in
   let fn = get_arm_assembly_function faddr in
@@ -146,7 +153,7 @@ let get_instrxdata_xprs (faddr: doubleword_int) (iaddr: doubleword_int) =
             ignore (id#index_instr instr floc))) in
   let (_, xprs) =
     TR.tget_ok (testsupport#retrieve_instrx_data iaddr#to_hex_string) in
-  List.map TR.tget_ok xprs
+  xprs
 
 
 let get_instrxdata_tags (faddr: doubleword_int) (iaddr: doubleword_int) =

CodeHawk/CHT/CHB_tests/bchlibarm32_tests/tbchlibarm32/tCHBchlibarm32Utils.mli

@@ -26,6 +26,9 @@
    SOFTWARE.
    ============================================================================= *)
 
+(* chutil *)
+open CHTraceResult
+
 (* xprlib *)
 open XprTypes
 
@@ -48,7 +51,8 @@ val arm_function_setup: doubleword_int -> string -> arm_assembly_function_int
 val thumb_function_setup: doubleword_int -> string -> arm_assembly_function_int
 
 
-val get_instrxdata_xprs: doubleword_int -> doubleword_int -> xpr_t list
+val get_instrxdata_xprs:
+  doubleword_int -> doubleword_int -> xpr_t traceresult list
 
 
 val get_instrxdata_tags: doubleword_int -> doubleword_int -> string list

CodeHawk/CHT/CHB_tests/bchlibarm32_tests/txbchlibarm32/bCHTranslateARMToCHIFTest.ml

@@ -5,7 +5,7 @@
    ------------------------------------------------------------------------------
    The MIT License (MIT)
 
-   Copyright (c) 2022-2024  Aarno Labs LLC
+   Copyright (c) 2022-20245 Aarno Labs LLC
 
    Permission is hereby granted, free of charge, to any person obtaining a copy
    of this software and associated documentation files (the "Software"), to deal
@@ -62,7 +62,7 @@ open BCHAnalyzeApp
 
 
 let testname = "bCHTranslateARMToCHIFTest"
-let lastupdated = "2024-08-27"
+let lastupdated = "2025-01-06"
 
 let make_dw (s: string) = TR.tget_ok (string_to_doubleword s)
 
@@ -86,7 +86,7 @@ let translate_store () =
        [("arg_0004", "R4_in"); ("arg_0008", "LR_in")]);
       ("STR", "0x1b4bc", "08608de500", [("arg_0008", "R6_in")]);
       ("STRBwb", "0x10208", "015062e500",
-       [("R2_in[-1]", "sv__13__sv"); ("R2", "sv__3__sv")]);
+       [("R2_in[-1]", "R5_in"); ("R2", "sv__3__sv")]);
       ("STRwb", "0x10568", "08402de500",
        [("var_0008", "R4_in"); ("SP", "sv__3__sv")]);
       ("STRDwb1", "0x1b4bc", "f0416de100",
@@ -97,7 +97,7 @@ let translate_store () =
        [("var_0012", "R4_in");
         ("var_0008", "R5_in");
         ("SP", "sv__3__sv")]);
-      ("STRH", "0x1b4bc", "b031cde100", [("arg_0016", "sv__25__sv")])
+      ("STRH", "0x1b4bc", "b031cde100", [("arg_0016", "R3_in")])
     ] in
   begin
     TS.new_testsuite (testname ^ "_translate_store") lastupdated;
@@ -146,7 +146,7 @@ let thumb_chif_conditionxprs () =
        "0x4f12",
        "44f6251393f87094b9f1910ff94602d8a9f6e1594847a9f6e769484700",
        3,
-       "((lsb gvb_0x4d95_in) <= 145)")
+       "(gv_0x4d95_in <= 145)")
     ] in
   begin
     TS.new_testsuite (testname ^ "_thumb_chif_conditionxprs") lastupdated;
@@ -200,13 +200,14 @@ let thumb_instrxdata_conditionxprs () =
        "0x4f12",
        "44f6251393f87094b9f1910ff94602d8a9f6e1594847a9f6e769484700",
        3,
-       "((lsb gvb_0x4d95_in) <= 145)")
+       "(gv_0x4d95_in <= 145)")
     ] in
   begin
     TS.new_testsuite (testname ^ "_thumb_instrxdata_conditionxprs") lastupdated;
 
     system_info#set_elf_is_code_address wordzero codemax;
     ARMU.arm_instructions_setup (make_dw "0x4000") 0x10000;
+
     List.iter (fun (title, cfaddr, ccaddr, bytes, iterations, expectedcond) ->
 
         TS.add_simple_test