/[mojave]/metaprl/theories/mc/tests/mp_mc_test_connect_exp.ml
ViewVC logotype

Diff of /metaprl/theories/mc/tests/mp_mc_test_connect_exp.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 3579 by emre, Fri Apr 5 01:16:49 2002 UTC revision 3580 by emre, Fri Apr 19 08:09:21 2002 UTC
# Line 83  Line 83 
83        else        else
84           print_fail ()           print_fail ()
85    
 let sub_block_test sub_block str =  
    printf "--> Test: %s\n" str;  
    let t = term_of_sub_block sub_block in  
    let t' = sub_block_of_term t in  
       print_simple_term t;  
       if t' = sub_block then  
          print_pass ()  
       else  
          print_fail ()  
   
 let sub_value_test sub_value str =  
    printf "--> Test: %s\n" str;  
    let t = term_of_sub_value sub_value in  
    let t' = sub_value_of_term t in  
       print_simple_term t;  
       if t' = sub_value then  
          print_pass ()  
       else  
          print_fail ()  
   
 let sub_index_test sub_index str =  
    printf "--> Test: %s\n" str;  
    let t = term_of_sub_index sub_index in  
    let t' = sub_index_of_term t in  
       print_simple_term t;  
       if t' = sub_index then  
          print_pass ()  
       else  
          print_fail ()  
   
 let sub_script_test sub_script str =  
    printf "--> Test: %s\n" str;  
    let t = term_of_sub_script sub_script in  
    let t' = sub_script_of_term t in  
       print_simple_term t;  
       if t' = sub_script then  
          print_pass ()  
       else  
          print_fail ()  
   
 let subop_test subop str =  
    printf "--> Test: %s\n" str;  
    let t = term_of_subop subop in  
    let t' = subop_of_term t in  
       print_simple_term t;  
       if t' = subop then  
          print_pass ()  
       else  
          print_fail ()  
   
86  let frame_label_test label str =  let frame_label_test label str =
87     printf "--> Test: %s\n" str;     printf "--> Test: %s\n" str;
88     let t = term_of_frame_label label in     let t = term_of_frame_label label in
# Line 173  Line 123 
123        else        else
124           print_fail ()           print_fail ()
125    
 let pred_nop_test pred_nop str =  
    printf "--> Test: %s\n" str;  
    let t = term_of_pred_nop pred_nop in  
    let t' = pred_nop_of_term t in  
       print_simple_term t;  
       if t' = pred_nop then  
          print_pass ()  
       else  
          print_fail ()  
   
 let pred_unop_test pred_unop str =  
    printf "--> Test: %s\n" str;  
    let t = term_of_pred_unop pred_unop in  
    let t' = pred_unop_of_term t in  
       print_simple_term t;  
       if t' = pred_unop then  
          print_pass ()  
       else  
          print_fail ()  
   
 let pred_binop_test pred_binop str =  
    printf "--> Test: %s\n" str;  
    let t = term_of_pred_binop pred_binop in  
    let t' = pred_binop_of_term t in  
       print_simple_term t;  
       if t' = pred_binop then  
          print_pass ()  
       else  
          print_fail ()  
   
126  let pred_test pred str =  let pred_test pred str =
127     printf "--> Test: %s\n" str;     printf "--> Test: %s\n" str;
128     let t = term_of_pred pred in     let t = term_of_pred pred in
# Line 286  Line 206 
206               "RawIntOfRawIntOp Int32 true Int64 false";               "RawIntOfRawIntOp Int32 true Int64 false";
207     unop_test (RawIntOfPointerOp Int16 false) "RawIntOfPointerOp Int16 false";     unop_test (RawIntOfPointerOp Int16 false) "RawIntOfPointerOp Int16 false";
208     unop_test (PointerOfRawIntOp Int32 true) "PointerOfRawIntOp Int32 true";     unop_test (PointerOfRawIntOp Int32 true) "PointerOfRawIntOp Int32 true";
209     unop_test (RawIntOfLabelOp Int64 false) "RawIntOfLabelOp Int64 false";     unop_test (PointerOfBlockOp BlockSub) "PointerOfBlockOp BlockSub";
210    
211     (* Binary operations. *)     (* Binary operations. *)
212     binop_test (AndEnumOp 3) "AndEnumOp 3";     binop_test (AndEnumOp 3) "AndEnumOp 3";
# Line 350  Line 270 
270     binop_test (Atan2Op Single) "Atan2Op Single";     binop_test (Atan2Op Single) "Atan2Op Single";
271     binop_test EqEqOp "EqEqOp";     binop_test EqEqOp "EqEqOp";
272     binop_test NeqEqOp "NeqEqOp";     binop_test NeqEqOp "NeqEqOp";
273     binop_test (PlusPointerOp Int8 false) "PlusPointerOp Int8 false";     binop_test (PlusPointerOp BlockSub Int8 false)
274                  "PlusPointerOp BlockSub Int8 false";
275    
276     (* Subscript operators. *)     (* Subscript operators. *)
    sub_block_test BlockSub "BlockSub";  
    sub_block_test RawDataSub "RawDataSub";  
    sub_block_test TupleSub "TupleSub";  
    sub_block_test RawTupleSub "RawTupleSub";  
    sub_value_test PolySub "PolySub";  
    sub_value_test (RawIntSub Int8 false) "RawIntSub Int8 false";  
    sub_value_test (RawFloatSub Single) "RawFloatSub Single";  
    sub_value_test PointerSub "PointerSub";  
    sub_value_test FunctionSub "FunctionSub";  
    sub_index_test ByteIndex "ByteIndex";  
    sub_index_test WordIndex "WordIndex";  
    sub_script_test IntIndex "IntIndex";  
    sub_script_test (RawIntIndex Int8 true) "RawIntIndex Int8 true";  
277     let op = { sub_block = BlockSub;  sub_value = PolySub;     let op = { sub_block = BlockSub;  sub_value = PolySub;
278                sub_index = ByteIndex; sub_script = IntIndex } in                sub_index = ByteIndex; sub_script = IntIndex } in
    subop_test op "{ BlockSub; PolySub; ByteIndex; IntIndex }";  
279    
280     (* Fields (frame labels). *)     (* Fields (frame labels). *)
281     let flbl = (var1, var2, var3) in     let flbl = (var1, var2, var3) in
282     frame_label_test flbl "(var1, var2, var3";     frame_label_test flbl "(var1, var2, var3)";
283    
284     (* Normal values. *)     (* Normal values. *)
285     atom_test (AtomNil TyInt) "AtomNil TyInt";     atom_test (AtomNil TyInt) "AtomNil TyInt";
# Line 382  Line 289 
289               "AtomRawInt (Rawint.of_string Int8 true \"23\")";               "AtomRawInt (Rawint.of_string Int8 true \"23\")";
290     atom_test (AtomFloat (Rawfloat.of_string Single "2.3"))     atom_test (AtomFloat (Rawfloat.of_string Single "2.3"))
291               "AtomFloat (Rawfloat.of_string Single \"2.3\")";               "AtomFloat (Rawfloat.of_string Single \"2.3\")";
292     atom_test (AtomLabel var1 var2 var3) "AtomLabel var1 var2 var3";     atom_test (AtomLabel flbl (Rawint.of_string Int8 true "23"))
293                 "AtomLabel (var1 var2 var3) (Rawint.of_string Int8 true \"23\")";
294       atom_test  (AtomSizeof [] (Rawint.of_string Int8 true "23"))
295                  "AtomSizeof [] (Rawint.of_string Int8 true \"23\")";
296     atom_test (AtomConst TyInt var1 3) "AtomConst TyInt var1 3";     atom_test (AtomConst TyInt var1 3) "AtomConst TyInt var1 3";
297     atom_test (AtomVar var1) "AtomVar var1";     atom_test (AtomVar var1) "AtomVar var1";
298    
# Line 409  Line 319 
319     tailop_test (TailAtomicCommit var2 []) "TailAtomicCommit var2 []";     tailop_test (TailAtomicCommit var2 []) "TailAtomicCommit var2 []";
320    
321     (* Predicates and assertions. *)     (* Predicates and assertions. *)
322     pred_nop_test IsMutable "IsMutable";     pred_test (IsMutable var1) "IsMutable var1";
323     pred_unop_test Reserve "Reserve";     pred_test (Reserve (AtomNil TyInt) (AtomInt 3))
324     pred_unop_test BoundsCheckLower "BoundsCheckLower";               "Reserve (AtomNil TyInt) (AtomInt 3";
325     pred_unop_test BoundsCheckUpper "BoundsCheckUpper";     pred_test (BoundsCheck op var1 (AtomNil TyInt) (AtomInt 3))
326     pred_unop_test PolyCheck "PolyCheck";               "BoundsCheck op var1 (AtomNil TyInt) (AtomInt 3)";
327     pred_unop_test PointerCheck "PointerCheck";     pred_test (ElementCheck TyInt op var1 (AtomInt 3))
328     pred_unop_test FunctionCheck "FunctionCheck";               "ElementCheck TyInt op var1 (AtomInt 3)";
    pred_binop_test BoundsCheck "BoundsCheck";  
    pred_test (PredNop var1 IsMutable) "PredNop var1 IsMutable";  
    pred_test (PredUnop var2 Reserve (AtomVar var1))  
              "PredUnop var2 Reserve (AtomVar var1)";  
    pred_test (PredBinop var1 BoundsCheck (AtomInt 2) (AtomInt 3))  
              "PredBinop var1 BoundsCheck (AtomInt 2) (AtomInt 3)";  
329    
330     (* Debugging info. *)     (* Debugging info. *)
331     debug_line_test ("Help!", 3) "\"Help!\" 3";     debug_line_test ("Help!", 3) "\"Help!\" 3";
# Line 457  Line 361 
361              "Memcpy \"op\" var1 var2 (AtomInt 3) var2 (AtomInt 4) (AtomInt 60) (TailCall var1 var3 [])";              "Memcpy \"op\" var1 var2 (AtomInt 3) var2 (AtomInt 4) (AtomInt 60) (TailCall var1 var3 [])";
362     exp_test (Call var2 var1 [None; Some (AtomInt 3)] (TailCall var1 var3 []))     exp_test (Call var2 var1 [None; Some (AtomInt 3)] (TailCall var1 var3 []))
363              "Call var2 var1 [None; Some (AtomInt 3)] (TailCall var1 var3 [])";              "Call var2 var1 [None; Some (AtomInt 3)] (TailCall var1 var3 [])";
364     exp_test (Assert var1 (PredNop var2 IsMutable) (TailCall var1 var3 []))     exp_test (Assert var1 (IsMutable var2) (TailCall var1 var3 []))
365              "Assert var1 (PredNop var2 IsMutable) (TailCall var1 var3 [])";              "Assert var1 (IsMutable var2) (TailCall var1 var3 [])";
366     exp_test (Debug (DebugContext line []) (TailCall var1 var3 []))     exp_test (Debug (DebugContext line []) (TailCall var1 var3 []))
367              "Debug (DebugContext \"line\" []) (TailCall var1 var3 [])";              "Debug (DebugContext \"line\" []) (TailCall var1 var3 [])";
368    

Legend:
Removed from v.3579  
changed lines
  Added in v.3580

  ViewVC Help
Powered by ViewVC 1.1.26