1 (** Unit tests for {!Exercise}, authored against the exercise.mli contract. *) 2 3 let get id = 4 match Exercise.find_id id with 5 | Some e -> e 6 | None -> Alcotest.failf "catalog is missing %S" id 7 8 let dumbbell_flyes = 9 { 10 Exercise.equipment = Exercise.Dumbbell; 11 movement = Exercise.Fly; 12 variation = Exercise.Standard; 13 } 14 15 let lookup_tests = 16 [ 17 ( "a structured key locates the curated exercise", 18 `Quick, 19 fun () -> 20 match Exercise.find dumbbell_flyes with 21 | Some exercise -> 22 Alcotest.(check string) 23 "name" "Dumbbell Flyes" (Exercise.name exercise); 24 Alcotest.(check bool) 25 "key round-trips" true 26 (Exercise.key exercise = dumbbell_flyes); 27 Alcotest.(check string) 28 "stable id" "dumbbell-flyes" 29 (Exercise.id exercise :> string) 30 | None -> Alcotest.fail "Dumbbell Flyes key is absent" ); 31 ( "an absent structured key is rejected", 32 `Quick, 33 fun () -> 34 Alcotest.(check bool) 35 "no dumbbell press in HD1 catalog" true 36 (Option.is_none 37 (Exercise.find 38 { 39 Exercise.equipment = Exercise.Dumbbell; 40 movement = Exercise.Press; 41 variation = Exercise.Standard; 42 })) ); 43 ( "a stable identifier remains an external lookup boundary", 44 `Quick, 45 fun () -> 46 Alcotest.(check bool) 47 "stable id" true 48 (Option.is_some (Exercise.find_id "dumbbell-flyes")); 49 Alcotest.(check bool) 50 "unknown id" true 51 (Option.is_none (Exercise.find_id "jefferson-curl")) ); 52 ] 53 54 let pre_exhaust_tests = 55 [ 56 ( "accepts HD1's pec pairing", 57 `Quick, 58 fun () -> 59 Alcotest.(check bool) 60 "flyes then incline press" true 61 (Exercise.may_pre_exhaust ~isolation:(get "dumbbell-flyes") 62 ~compound:(get "incline-press")) ); 63 ( "accepts HD1's triceps pairing, where dips serves a second muscle", 64 `Quick, 65 fun () -> 66 Alcotest.(check bool) 67 "french press then dips" true 68 (Exercise.may_pre_exhaust ~isolation:(get "lying-french-press") 69 ~compound:(get "dips")); 70 Alcotest.(check bool) 71 "flyes then dips" true 72 (Exercise.may_pre_exhaust ~isolation:(get "dumbbell-flyes") 73 ~compound:(get "dips")) ); 74 ( "accepts HD1's lat and leg pairings", 75 `Quick, 76 fun () -> 77 Alcotest.(check bool) 78 "pullovers then pulldowns" true 79 (Exercise.may_pre_exhaust ~isolation:(get "pullovers") 80 ~compound:(get "close-grip-pulldowns")); 81 Alcotest.(check bool) 82 "leg extensions then leg presses" true 83 (Exercise.may_pre_exhaust ~isolation:(get "leg-extensions") 84 ~compound:(get "leg-presses")) ); 85 ( "rejects invalid pairings", 86 `Quick, 87 fun () -> 88 Alcotest.(check bool) 89 "compound then compound" false 90 (Exercise.may_pre_exhaust ~isolation:(get "dips") 91 ~compound:(get "incline-press")); 92 Alcotest.(check bool) 93 "isolation then isolation" false 94 (Exercise.may_pre_exhaust ~isolation:(get "dumbbell-flyes") 95 ~compound:(get "pec-deck")); 96 Alcotest.(check bool) 97 "unrelated targets" false 98 (Exercise.may_pre_exhaust ~isolation:(get "dumbbell-flyes") 99 ~compound:(get "squats")) ); 100 ] 101 102 let substitution_tests = 103 [ 104 ( "HD1's alternatives are substitutable", 105 `Quick, 106 fun () -> 107 Alcotest.(check bool) 108 "flyes for pec deck" true 109 (Exercise.may_substitute ~original:(get "dumbbell-flyes") 110 ~candidate:(get "pec-deck")); 111 Alcotest.(check bool) 112 "leg press for squat" true 113 (Exercise.may_substitute ~original:(get "leg-presses") 114 ~candidate:(get "squats")) ); 115 ( "substitution is symmetric but excludes the original and unrelated \ 116 movements", 117 `Quick, 118 fun () -> 119 let flyes = get "dumbbell-flyes" in 120 let pec_deck = get "pec-deck" in 121 Alcotest.(check bool) 122 "pec deck for flyes" true 123 (Exercise.may_substitute ~original:pec_deck ~candidate:flyes); 124 Alcotest.(check bool) 125 "not self" false 126 (Exercise.may_substitute ~original:flyes ~candidate:flyes); 127 Alcotest.(check bool) 128 "curls for squats" false 129 (Exercise.may_substitute ~original:(get "curls") 130 ~candidate:(get "squats")) ); 131 ] 132 133 let suite = 134 [ 135 ("exercise.lookup", lookup_tests); 136 ("exercise.pre_exhaust", pre_exhaust_tests); 137 ("exercise.substitution", substitution_tests); 138 ] 139