/[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 3562 by emre, Wed Apr 3 08:37:31 2002 UTC revision 3563 by emre, Fri Apr 5 01:16:49 2002 UTC
# Line 133  Line 133 
133        else        else
134           print_fail ()           print_fail ()
135    
136    let frame_label_test label str =
137       printf "--> Test: %s\n" str;
138       let t = term_of_frame_label label in
139       let t' = frame_label_of_term t in
140          print_simple_term t;
141          if t' = label then
142             print_pass ()
143          else
144             print_fail ()
145    
146  let atom_test atom str =  let atom_test atom str =
147     printf "--> Test: %s\n" str;     printf "--> Test: %s\n" str;
148     let t = term_of_atom atom in     let t = term_of_atom atom in
# Line 276  Line 286 
286               "RawIntOfRawIntOp Int32 true Int64 false";               "RawIntOfRawIntOp Int32 true Int64 false";
287     unop_test (RawIntOfPointerOp Int16 false) "RawIntOfPointerOp Int16 false";     unop_test (RawIntOfPointerOp Int16 false) "RawIntOfPointerOp Int16 false";
288     unop_test (PointerOfRawIntOp Int32 true) "PointerOfRawIntOp Int32 true";     unop_test (PointerOfRawIntOp Int32 true) "PointerOfRawIntOp Int32 true";
289       unop_test (RawIntOfLabelOp Int64 false) "RawIntOfLabelOp Int64 false";
290    
291     (* Binary operations. *)     (* Binary operations. *)
292     binop_test (AndEnumOp 3) "AndEnumOp 3";     binop_test (AndEnumOp 3) "AndEnumOp 3";
# Line 359  Line 370 
370                sub_index = ByteIndex; sub_script = IntIndex } in                sub_index = ByteIndex; sub_script = IntIndex } in
371     subop_test op "{ BlockSub; PolySub; ByteIndex; IntIndex }";     subop_test op "{ BlockSub; PolySub; ByteIndex; IntIndex }";
372    
373       (* Fields (frame labels). *)
374       let flbl = (var1, var2, var3) in
375       frame_label_test flbl "(var1, var2, var3";
376    
377     (* Normal values. *)     (* Normal values. *)
378     atom_test (AtomNil TyInt) "AtomNil TyInt";     atom_test (AtomNil TyInt) "AtomNil TyInt";
379     atom_test (AtomInt 2) "AtomInt 2";     atom_test (AtomInt 2) "AtomInt 2";
# Line 367  Line 382 
382               "AtomRawInt (Rawint.of_string Int8 true \"23\")";               "AtomRawInt (Rawint.of_string Int8 true \"23\")";
383     atom_test (AtomFloat (Rawfloat.of_string Single "2.3"))     atom_test (AtomFloat (Rawfloat.of_string Single "2.3"))
384               "AtomFloat (Rawfloat.of_string Single \"2.3\")";               "AtomFloat (Rawfloat.of_string Single \"2.3\")";
385       atom_test (AtomLabel var1 var2 var3) "AtomLabel var1 var2 var3";
386     atom_test (AtomConst TyInt var1 3) "AtomConst TyInt var1 3";     atom_test (AtomConst TyInt var1 3) "AtomConst TyInt var1 3";
387     atom_test (AtomVar var1) "AtomVar var1";     atom_test (AtomVar var1) "AtomVar var1";
388    
# Line 381  Line 397 
397                   "AllocVArray TyInt ByteIndex (AtomInt 2) (AtomInt 3)";                   "AllocVArray TyInt ByteIndex (AtomInt 2) (AtomInt 3)";
398     alloc_op_test (AllocMalloc TyInt (AtomEnum 5 2))     alloc_op_test (AllocMalloc TyInt (AtomEnum 5 2))
399                   "AllocMalloc TyInt (AtomEnum 5 2)";                   "AllocMalloc TyInt (AtomEnum 5 2)";
400       alloc_op_test (AllocFrame var1) "AllocFrame var1";
401    
402     (* Tail calls / operations. *)     (* Tail calls / operations. *)
403     tailop_test (TailSysMigrate 2 (AtomInt 2) (AtomInt 3) var2 [])     tailop_test (TailSysMigrate 2 (AtomInt 2) (AtomInt 3) var2 [])
# Line 415  Line 432 
432                     "DebugContext (\"Hi!\", 3) []";                     "DebugContext (\"Hi!\", 3) []";
433    
434     (* Expressions. *)     (* Expressions. *)
435     exp_test (LetUnop var1 TyInt UMinusIntOp (AtomInt 2) (TailCall var1 []))     exp_test (LetUnop var1 TyInt UMinusIntOp (AtomInt 2) (TailCall var2 var1 []))
436              "LetUnop var1 TyInt UMinusIntOp (AtomInt 2) (TailCall var1 [])";              "LetUnop var1 TyInt UMinusIntOp (AtomInt 2) (TailCall var2 var1 [])";
437     exp_test (LetBinop var2 TyInt PlusIntOp (AtomInt 2) (AtomInt 3) (TailCall var1 []))     exp_test (LetBinop var2 TyInt PlusIntOp (AtomInt 2) (AtomInt 3) (TailCall var2 var1 []))
438              "LetBinop var2 TyInt PlusIntOp (AtomInt 2) (AtomInt 3) (TailCall var1 [])";              "LetBinop var2 TyInt PlusIntOp (AtomInt 2) (AtomInt 3) (TailCall var2 var1 [])";
439     exp_test (LetExt var1 TyInt "Hi!" TyInt [] (TailCall var1 []))     exp_test (LetExt var1 TyInt "Hi!" TyInt [] (TailCall var2 var1 []))
440              "LetExt var1 TyInt \"Hi!\" TyInt [] (TailCall var1 [])";              "LetExt var1 TyInt \"Hi!\" TyInt [] (TailCall var2 var1 [])";
441     exp_test (TailCall var1 [AtomInt 3]) "TailCall var1 [AtomInt 3]";     exp_test (TailCall var2 var1 [AtomInt 3]) "TailCall var2 var1 [AtomInt 3]";
442     exp_test (SpecialCall (TailAtomicRollback (AtomInt 3)))     exp_test (SpecialCall var1 (TailAtomicRollback (AtomInt 3)))
443              "SpecialCall (TailAtomicRollback (AtomInt 3))";              "SpecialCall var1 (TailAtomicRollback (AtomInt 3))";
444     exp_test (Match (AtomInt 3) [IntSet set1, TailCall var1[]])     exp_test (Match (AtomInt 3) [var1, IntSet set1, TailCall var2 var1 []])
445              "Match (AtomInt 3) [IntSet set1, TailCall var1[]]";              "Match (AtomInt 3) [var1, IntSet set1, TailCall var2 var1 []]";
446     exp_test (TypeCase (AtomInt 1) (AtomInt 2) var1 var2 (TailCall var1 []) (TailCall var1[]))     exp_test (TypeCase (AtomInt 1) (AtomInt 2) var1 var2 (TailCall var2 var1 []) (TailCall var2 var1 []))
447              "TypeCase (AtomInt 1) (AtomInt 2) var1 var2 (TailCall var1 []) (TailCall var1[])";              "TypeCase (AtomInt 1) (AtomInt 2) var1 var2 (TailCall var2 var1 []) (TailCall var2 var1 [])";
448     exp_test (LetAlloc var1 (AllocMalloc TyInt (AtomInt 3)) (TailCall var2 []))     exp_test (LetAlloc var1 (AllocMalloc TyInt (AtomInt 3)) (TailCall var1 var2 []))
449              "LetAlloc var1 (AllocMalloc TyInt (AtomInt 3)) (TailCall var2 [])";              "LetAlloc var1 (AllocMalloc TyInt (AtomInt 3)) (TailCall var1 var2 [])";
450     exp_test (LetSubscript op var1 TyInt var2 (AtomInt 2) (TailCall var3 []))     exp_test (LetSubscript op var1 TyInt var2 (AtomInt 2) (TailCall var1 var3 []))
451              "LetSubscript \"op\" var1 TyInt var2 (AtomInt 2) (TailCall var3 [])";              "LetSubscript \"op\" var1 TyInt var2 (AtomInt 2) (TailCall var1 var3 [])";
452     exp_test (SetSubscript op var1 var2 (AtomInt 2) TyInt (AtomInt 3) (TailCall var3 []))     exp_test (SetSubscript op var1 var2 (AtomInt 2) TyInt (AtomInt 3) (TailCall var1 var3 []))
453              "SetSubscript \"op\" var1 var2 (AtomInt 2) TyInt (AtomInt 3) (TailCall var3 [])";              "SetSubscript \"op\" var1 var2 (AtomInt 2) TyInt (AtomInt 3) (TailCall var1 var3 [])";
454     exp_test (SetGlobal PolySub var1 var2 TyInt (AtomInt 3) (TailCall var3 []))     exp_test (SetGlobal PolySub var1 var2 TyInt (AtomInt 3) (TailCall var1 var3 []))
455              "SetGlobal PolySub var1 var2 TyInt (AtomInt 3) (TailCall var3 [])";              "SetGlobal PolySub var1 var2 TyInt (AtomInt 3) (TailCall var1 var3 [])";
456     exp_test (Memcpy op var1 var2 (AtomInt 3) var2 (AtomInt 4) (AtomInt 60) (TailCall var3 []))     exp_test (Memcpy op var1 var2 (AtomInt 3) var2 (AtomInt 4) (AtomInt 60) (TailCall var1 var3 []))
457              "Memcpy \"op\" var1 var2 (AtomInt 3) var2 (AtomInt 4) (AtomInt 60) (TailCall var3 [])";              "Memcpy \"op\" var1 var2 (AtomInt 3) var2 (AtomInt 4) (AtomInt 60) (TailCall var1 var3 [])";
458     exp_test (Call var1 [None; Some (AtomInt 3)] (TailCall var3 []))     exp_test (Call var2 var1 [None; Some (AtomInt 3)] (TailCall var1 var3 []))
459              "Call var1 [None; Some (AtomInt 3)] (TailCall var3 [])";              "Call var2 var1 [None; Some (AtomInt 3)] (TailCall var1 var3 [])";
460     exp_test (Assert var1 (PredNop var2 IsMutable) (TailCall var3 []))     exp_test (Assert var1 (PredNop var2 IsMutable) (TailCall var1 var3 []))
461              "Assert var1 (PredNop var2 IsMutable) (TailCall var3 [])";              "Assert var1 (PredNop var2 IsMutable) (TailCall var1 var3 [])";
462     exp_test (Debug (DebugContext line []) (TailCall var3 []))     exp_test (Debug (DebugContext line []) (TailCall var1 var3 []))
463              "Debug (DebugContext \"line\" []) (TailCall var3 [])";              "Debug (DebugContext \"line\" []) (TailCall var1 var3 [])";
464    
465     (* Done. *)     (* Done. *)
466     !fail_count     !fail_count

Legend:
Removed from v.3562  
changed lines
  Added in v.3563

  ViewVC Help
Powered by ViewVC 1.1.26