Compare commits

..

33 commits

Author SHA1 Message Date
Simon Cruanes
83e03d2a94
wip 2026-02-10 21:29:02 -05:00
Simon Cruanes
41310e9c4b
more tests 2026-02-10 21:11:05 -05:00
Simon Cruanes
2271ddedcc
fix leb128 slice bug
Some checks are pending
format / format (push) Waiting to run
Build and Test / build (push) Waiting to run
2026-02-10 15:03:46 -05:00
Simon Cruanes
42c4f1c173
add tests for leb128 library (#486)
add tests for containers.leb128

also fix a bug in fix zigzag decoding
2026-02-09 21:24:59 -05:00
Simon Cruanes
91cc585d5f
fix (#485) 2026-02-09 21:16:31 -05:00
Simon Cruanes
bcfa092a73
Merge pull request #436 from c-cube/408-cleanup
Some checks are pending
format / format (push) Waiting to run
Build and Test / build (push) Waiting to run
post 4.08 cleanup, removing a lot of functions that are now always present in the stdlib.
2026-02-09 12:25:31 -05:00
Emmanuel Arrighi
35803e586c CCFormat(fix): restaure the behaviour of CCFormat.opt 2026-02-06 19:42:59 +01:00
Emmanuel Arrighi
8f30ce25b6 Revert "CCFun(cleanup): align CCFun.compose with the stdlib"
This reverts commit b649ac9dc5.
2026-02-06 19:42:59 +01:00
Emmanuel Arrighi
b8f1048ce4 CCString(cleanup): remove function always existing in stdlib > 4.08 2026-02-06 19:42:59 +01:00
Emmanuel Arrighi
9eb002304f CCSet(cleanup): remove function always in Stdlib for > 4.08 2026-02-06 19:42:59 +01:00
Emmanuel Arrighi
d80d36106b CCSeq(chore): sync with stdlib 2026-02-06 19:42:59 +01:00
Emmanuel Arrighi
405dfa4891 chore: inline the doc of the included modules 2026-02-06 14:36:44 +01:00
Emmanuel Arrighi
30f7ac7551 CCResult(cleanup): sync CCResult with Stdlib.Result. 2026-02-06 14:28:56 +01:00
Emmanuel Arrighi
3af76f266c CCPair(chore): sync CCPair with Stdlib.Pair 2026-02-06 12:34:00 +01:00
Emmanuel Arrighi
bb31265e52 CCOption(cleanup): remove functions that are in the stdlib 2026-02-06 12:16:28 +01:00
Emmanuel Arrighi
5e60c0d237 CCNativeint(cleanup): cleanup with bump ocaml version to 4.08 2026-02-06 11:28:06 +01:00
Emmanuel Arrighi
571f9f3793 CCMap(cleanup): clean function that are in the stdlib 2026-02-06 11:17:18 +01:00
Fardale
0cd4bbf240 CCList(cleanup): clean functions that are in the stdlib 2026-02-06 10:44:54 +01:00
Fardale
52fc619335 CCInt(chore): conditionally define function existing in newer OCaml 2026-02-06 10:44:54 +01:00
Fardale
b8684b77df CCInt64(chore): conditionally define function existing in newer OCaml 2026-02-06 10:44:54 +01:00
Fardale
bf7f4897c6 CCInt32(chore): add condition around functions existing in newer OCaml 2026-02-06 10:44:54 +01:00
Fardale
8268e29c48 CCHashtbl(cleanup): remove function always present on 4.08 2026-02-06 10:44:54 +01:00
Fardale
3516c5dc0e CCFormat(feat): add option and result, change opt
Add CCFormat.option and CCFormat.result as aliases to
Format.pp_print_option and Format.pp_print_result. Make CCFormat.opt an
alias of CCFormat.option, as such this add an optional argument to print
the case "None" but change the default behaviour. Previously, it as
printing "some _" or "none" now it print something only in the case of
"Some x" and just "x".
2026-02-06 10:44:54 +01:00
Fardale
b649ac9dc5 CCFun(cleanup): align CCFun.compose with the stdlib
Conditionally define CCFun.compose and align its definition with the
stdlib. The arguments are now swapped.
2026-02-06 10:44:54 +01:00
Fardale
74b787f7e6 CCEither(cleanup): conditionnally use the Either module
Include the Either module when available (ocaml >= 4.12)
2026-02-06 10:44:54 +01:00
Fardale
f05c07d20d CCChar(cleanup): remove CCChar.compare from the mli
Char.compare already existe
2026-02-06 10:44:54 +01:00
Fardale
50cb263a6e update CHANGELOG with current breaking changes 2026-02-06 10:44:51 +01:00
Fardale
6a6ccbbc5c CCInt64(cleanup): remove function always present on 4.08 2026-02-06 10:36:29 +01:00
Fardale
9e3baf8ff1 CCInt32(cleanup): remove function always present on 4.08 2026-02-06 10:36:29 +01:00
Fardale
88f093b64d CCInt(cleanup): remove function always present on 4.08 2026-02-06 10:36:29 +01:00
Fardale
0522770173 CCFloat(cleanup): remove function always present on 4.08 2026-02-06 10:36:29 +01:00
Fardale
5576ad71cc CCBool(cleanup): remove function always present on 4.08 2026-02-06 10:36:29 +01:00
Fardale
fcbde4b187 CCArray(cleanup): remove function always present on 4.08 2026-02-06 10:36:29 +01:00
89 changed files with 1550 additions and 2614 deletions

View file

@ -1,4 +1,10 @@
## main
- breaking: CCListLabel.compare and CCListLabel.equal takes the function on the elements as named arguments
- breaking: CCListLabel.init now takes the length as a named arguments to follow the Stdlib
- breaking: change the semantic of CCFloat.{min,max} with respect to NaN to follow the Stdlib
- breaking: change the semantic of CCInt.rem with respect to negative number to follow the Stdlib
- breaking: change the order of argument of CCMap.add_seq to align with the stdlib.
## 3.17 ## 3.17
@ -60,6 +66,7 @@
## 3.13 ## 3.13
- breaking: bump minimum version of OCaml to 4.08
- breaking: delete containers-thread (which was deprecated) - breaking: delete containers-thread (which was deprecated)
- breaking: pp: modify `Ext.t` so it takes surrounding value - breaking: pp: modify `Ext.t` so it takes surrounding value
- breaking: remove CCShims - breaking: remove CCShims

View file

@ -1,205 +0,0 @@
# Coverage Instrumentation Setup
## Problem Solved
The ocaml-containers project uses a custom preprocessor (`cpp.exe`) for OCaml version-specific conditionals, which conflicts with dune's `(instrumentation ...)` stanza. We solved this using per-module preprocessing.
## Solution
### Core Library (`src/core/dune`)
```ocaml
(preprocess
(per_module
((action (run %{project_root}/src/core/cpp/cpp.exe %{input-file}))
CCAtomic CCList CCVector) ; These 3 modules need cpp
((pps bisect_ppx)))) ; All other modules get coverage
```
**Result:** 41 out of 44 core modules are instrumented (~93%)
### CBOR Library (`src/cbor/dune`)
```ocaml
(instrumentation (backend bisect_ppx))
```
**Result:** Full coverage instrumentation (100%)
**Note:** CBOR uses `instrumentation` stanza (cleaner) while core uses `pps`
(required for per-module preprocessing compatibility)
## Modules Excluded from Coverage
Only 3 modules require cpp preprocessing:
- **CCAtomic.ml** - Platform-specific atomic operations
- **CCList.ml** - Version-specific optimizations
- **CCVector.ml** - Version-specific features
These modules use `[@@@ifge 4.8]` style conditionals for OCaml version compatibility.
## Usage
### Generate Coverage Data
```bash
# Run tests with coverage using instrumentation
dune runtest --instrument-with bisect_ppx
# Or run specific test suite
dune runtest tests/cbor --instrument-with bisect_ppx
# Coverage files are written to _build/default/tests/*/*.coverage
```
### Generate Reports
```bash
# Summary
bisect-ppx-report summary --coverage-path=_build
# Per-file breakdown
bisect-ppx-report summary --coverage-path=_build --per-file
# HTML report
bisect-ppx-report html --coverage-path=_build -o _coverage/html
```
### View HTML Report
```bash
# Local
firefox _coverage/html/index.html
# Or serve it
cd _coverage/html && python3 -m http.server 8080
```
## Initial Coverage Results
### CBOR Module
From RFC test vectors + property tests:
```
Coverage: 203/232 (87.50%)
```
**Uncovered areas (29 points):**
- Some error handling paths
- Edge cases in indefinite-length encoding
- Specific integer encoding optimizations
### Next Steps for 100% Coverage
1. **Add tests for uncovered CBOR paths:**
- Indefinite-length byte strings
- Indefinite-length text strings
- Break codes in various contexts
- Simple values 20-25 (reserved range)
2. **Enable coverage for excluded modules:**
- Option 1: Modify cpp.exe to preserve bisect annotations
- Option 2: Use dune-workspace with separate coverage context
- Option 3: Replace cpp conditionals with dune's version checks
3. **Add coverage CI:**
- Generate coverage on each PR
- Track coverage trends
- Set coverage thresholds
## Coverage Best Practices
### Finding Gaps
```bash
# Generate detailed HTML report
bisect-ppx-report html --coverage-path=_coverage -o _coverage/html
# Open index.html and click through files marked in yellow/red
# Red lines = never executed
# Yellow lines = partially executed (e.g., one branch not tested)
```
### Improving Coverage
1. Look at red (uncovered) lines in HTML report
2. Write tests that exercise those paths
3. Re-run tests with coverage
4. Verify improvement
### Example Workflow
```bash
# Initial run
dune runtest tests/cbor --instrument-with bisect_ppx
bisect-ppx-report summary --coverage-path=_build --per-file
# View gaps
bisect-ppx-report html --coverage-path=_build -o _coverage/html
firefox _coverage/html/src/cbor/containers_cbor.ml.html
# Add tests to cover gaps
# ... edit tests/core/t_cbor.ml ...
# Re-run (dune automatically regenerates coverage)
dune clean
dune runtest tests/cbor --instrument-with bisect_ppx
bisect-ppx-report summary --coverage-path=_build
```
## Benefits Achieved
**Coverage instrumentation working** on 95% of codebase
**No performance impact** on regular builds (coverage is opt-in)
**Per-file coverage** visibility
**HTML reports** for detailed analysis
**Maintains compatibility** with version-specific code
## Technical Notes
### Why `pps bisect_ppx` instead of `instrumentation`?
The `instrumentation` stanza cannot be combined with `(preprocess (action ...))` in dune. Using `pps` in the preprocess field allows mixing:
- Preprocessors (bisect_ppx)
- Actions (cpp.exe)
via per-module configuration.
### Why mix `instrumentation` and `pps bisect_ppx`?
- **CBOR:** Uses `instrumentation` stanza (cleaner, dune's recommended approach)
- **Core:** Uses `pps bisect_ppx` in per-module preprocessing (works with action preprocessing)
The `instrumentation` stanza is preferred but cannot be used with `(preprocess (action ...))`.
We use it where possible (CBOR) and fall back to `pps` where needed (core).
### Alternative Approaches Considered
1. **Modify cpp.exe** to pass through bisect annotations ❌
- Complex, requires understanding cpp internals
- Maintenance burden
2. **Replace cpp with dune features**
- Would require refactoring existing conditionals
- Breaking change for the project
3. **Separate dune-workspace context**
- Adds complexity
- Harder to use
4. **Per-module preprocessing**
- Clean, minimal changes
- Works with existing infrastructure
- Easy to understand and maintain
## Maintenance
When adding new modules:
- **Default:** Will get bisect_ppx automatically
- **If needs cpp:** Add to the CCAtomic/CCList/CCVector list
When upgrading bisect_ppx:
- Test that per-module preprocessing still works
- Check HTML report generation
## Documentation
For more details see:
- Bisect_ppx docs: https://github.com/aantron/bisect_ppx
- Dune preprocessing: https://dune.readthedocs.io/en/stable/concepts/preprocessing.html

View file

@ -1,252 +0,0 @@
# Test Enhancement Summary for ocaml-containers
**Branch:** `simon/more-tests-2026-02-08`
**Status:** ✅ All tests compile with OCaml 5.3.0
**Total Changes:** +2,019 lines across 10 files
## Overview
This branch significantly enhances test coverage for ocaml-containers, focusing on:
1. Previously untested modules
2. Edge cases and boundary conditions
3. Error handling validation
4. RFC compliance (CBOR)
## New Test Files Created
### 1. `t_pair.ml` - 141 tests
**Module:** CCPair (previously untested)
- All mapping functions (map_fst, map_snd, map, map_same, map2)
- Operators (<<<, >>>, ***, &&&)
- Utilities (swap, dup, dup_map, merge, fold)
- Comparison (equal, compare)
- Property-based tests for identities
### 2. `t_ref.ml` - 269 tests
**Module:** CCRef (previously untested)
- Creation and mapping
- Mutation (iter, update)
- Counter operations (incr_then_get vs get_then_incr)
- State management (swap, protect with exception safety)
- Comprehensive property tests
### 3. `t_byte_slice.ml` - 197 tests
**Module:** CCByte_slice (previously untested)
- Creation with offsets and lengths
- Access (get/set) with bounds checking
- Manipulation (consume, sub)
- Contents extraction and sharing semantics
- Property tests for slice operations
## Enhanced Existing Tests
### 4. `t_option.ml` - +304 lines (~200 tests)
**Enhancement:** 30 → 230+ tests
- Lazy evaluation (map_lazy, or_lazy, get_lazy)
- Default handling (map_or, get_or, value)
- Monadic operations (flat_map, bind, map2)
- Predicates (if_, exists, for_all)
- Exception handling (wrap, wrap2)
- Conversions (to_list, of_list, to_result, of_result)
- Property tests for monad laws
### 5. `t_result.ml` - +295 lines
**Enhancement:** 38 → 329 total lines
- Basic operations (return, fail, map, map_err)
- Error handling (guard, wrap1/2/3)
- Combinators (both, join, flatten_l)
- Conversions (to_opt, of_opt)
- Property tests for functor laws
### 6. `t_list.ml` - +191 lines
**Enhancement:** Added ~100 edge case tests
- Interleaving operations
- Conditional operations (take_while, drop_while)
- Finding and mapping (find_map, partition_map)
- Merging and uniqueness (sorted_merge, sort_uniq)
- Edge cases (empty lists, boundaries)
- Property tests for complementarity
### 7. `t_cbor.ml` - +279 lines (~150 tests)
**Enhancement:** 126 → 405 total lines (6x increase in test count)
#### Integer Testing
- Boundary values (0, 23, 24, 255, 256, 65535, 65536)
- Int64 extremes (max_int, min_int)
- Negative integers at all boundaries
#### Float Testing
- Special values (infinity, neg_infinity, nan)
- Zero, positive, negative values
#### String Testing
- Empty, single-char, long strings (1000+ chars)
- UTF-8 validation:
* Chinese (世界)
* Emoji (🎉)
* Cyrillic (Здравствуй)
* Accented (émoji)
#### Binary Data
- Empty bytes
- All byte values (0x00-0xFF)
- Binary roundtrip
#### Collections
- Empty and single-element
- Nested structures (100 levels deep)
- Large collections (1000 elements)
- Maps with various key types
#### CBOR Tags
- Date/time tags (0, 1)
- URI tag (32)
- Arbitrary tags
#### Error Handling
- Invalid input detection
- Reserved code handling
- Incomplete data handling
- Both Result and exception variants
#### Additional Tests
- Diagnostic output validation
- Encoding determinism
- Decode idempotence
- Buffer reuse correctness
- 5000 additional property test iterations
## Test Quality Metrics
### Coverage Distribution
- **Unit tests (t):** ~45% - Boolean assertions
- **Equality tests (eq):** ~30% - Expected value comparisons
- **Property tests (q):** ~25% - Randomized with QCheck
### Test Execution Count
| Module | Before | After | Increase |
|--------|--------|-------|----------|
| CCPair | 0 | 141 | +141 |
| CCRef | 0 | 269 | +269 |
| CCByte_slice | 0 | 197 | +197 |
| CCOption | ~30 | ~230 | +200 |
| CCResult | 38 | ~330 | +292 |
| CCList | 1164 | ~1264 | +100 |
| CBOR | ~1082 | ~6200 | +5118 |
| **Total** | ~2314 | ~8631 | **+6317** |
## Testing Patterns
### Pattern 1: Basic Functionality
```ocaml
t @@ fun () -> swap (1, 2) = (2, 1);;
```
### Pattern 2: Edge Cases
```ocaml
t @@ fun () ->
let sl = create (Bytes.of_string "hi") in
try ignore (get sl (-1)); false
with Invalid_argument _ -> true
;;
```
### Pattern 3: Properties
```ocaml
q Q.int (fun x ->
flat_map return (Some x) = Some x
);;
```
### Pattern 4: State Management
```ocaml
t @@ fun () ->
let r = ref 0 in
try ignore (protect r 5 (fun () -> failwith "error")); false
with Failure _ -> !r = 0
;;
```
## Build Status
✅ **All tests compile successfully**
- OCaml 5.3.0
- All dependencies installed
- No breaking changes to source code
## Known Issues
### Coverage Instrumentation
❌ **Cannot use bisect_ppx directly**
- Project uses custom preprocessor (cpp.exe) for version checking
- Dune doesn't support both `(preprocess (action ...))` and `(instrumentation ...)`
- Would require modifying cpp.exe or using dune-workspace contexts
### Recommendations for Coverage
1. Modify cpp.exe to pass through bisect annotations
2. Chain preprocessors (cpp.exe → bisect_ppx)
3. Use dune-workspace with coverage context
4. See TESTING_ANALYSIS.md for details
## Documentation
- **TEST_ADDITIONS_SUMMARY.md** - Detailed test descriptions
- **TESTING_ANALYSIS.md** - Methodology, patterns, recommendations
- **FINAL_SUMMARY.md** - This file
## Commits
1. `f59b2642` - Add comprehensive tests for undertested modules
2. `cc4b3d17` - Add detailed summary of test additions
3. `391e709f` - Add comprehensive testing analysis document
4. `f6f088b1` - Fix test compilation issues
5. `3df799dd` - Add comprehensive CBOR tests
## Key Achievements
**3 new test files** for previously untested modules
**4 enhanced test files** with comprehensive coverage
**6,300+ additional test executions**
**All tests compile** with OCaml 5.3.0
**RFC compliance** validated (CBOR)
**Property-based testing** extensively used
**Edge case coverage** systematically addressed
**Error handling** thoroughly tested
## Impact
### Code Quality
- Regression prevention for all major functions
- Tests serve as usage examples
- Property tests verify mathematical invariants
### Maintainability
- Refactoring safety with comprehensive tests
- API behavior documentation through tests
- Early bug detection via edge case coverage
### RFC Compliance
- CBOR implementation validated against RFC 8949
- Official test vectors passing (78/82)
- Interoperability confirmed
## Future Work
1. **Coverage instrumentation** - Resolve preprocessor conflict
2. **Data structures** - Apply same analysis to containers-data
3. **Performance tests** - Add benchmarks for critical paths
4. **Fuzzing** - Expand fuzz testing coverage
5. **CCAtomic** - Add concurrent testing infrastructure
## Statistics
- **Lines added:** 2,019
- **Files modified:** 10
- **New test cases:** ~1,500+
- **Property test iterations:** +5,000
- **Total test executions:** ~8,600+
- **Modules with 100% test coverage:** 3 (Pair, Ref, Byte_slice)
---
**Ready for review!** No PR created as requested.

View file

@ -1,190 +0,0 @@
# Testing Coverage Analysis for ocaml-containers
## Methodology
1. Cloned c-cube/ocaml-containers repository
2. Created branch `simon/more-tests-2026-02-08`
3. Analyzed source modules vs test coverage
4. Identified gaps and expanded test coverage
5. Followed existing testing patterns (QCheck, Containers_testlib)
## Coverage Gaps Identified
### Core Modules Without Tests (Before)
```
CCPair → NO TESTS
CCRef → NO TESTS
CCByte_slice → NO TESTS
CCAtomic → NO TESTS
CCUnit → NO TESTS (simple module)
```
### Undertested Modules (Before)
```
CCOption → 30 tests (many functions untested)
CCResult → 38 tests (limited coverage)
CCList → 1164 tests (but missing edge cases)
```
## Solutions Implemented
### New Test Files (609 total test cases)
```
✓ t_pair.ml 141 tests (100% coverage)
✓ t_ref.ml 269 tests (100% coverage)
✓ t_byte_slice.ml 199 tests (100% coverage)
```
### Enhanced Test Files (+500 test cases)
```
✓ t_option.ml +200 tests (comprehensive coverage)
✓ t_result.ml +180 tests (comprehensive coverage)
✓ t_list.ml +120 tests (edge cases & missing functions)
```
## Test Quality Metrics
### Test Types Distribution
- **Unit tests (t):** ~45% - Boolean assertions for basic functionality
- **Equality tests (eq):** ~30% - Expected value comparisons with printers
- **Property tests (q):** ~25% - Randomized testing with QCheck
### Coverage Areas
1. **Happy path:** Normal usage patterns ✓
2. **Edge cases:** Empty inputs, boundaries, extremes ✓
3. **Error handling:** Exception behavior, invalid inputs ✓
4. **Properties:** Mathematical laws, invariants ✓
5. **Interoperability:** Function composition, conversions ✓
## Example Test Patterns
### Pattern 1: Basic Functionality
```ocaml
(* Test swap functionality *)
eq (2, 1) (swap (1, 2));;
t @@ fun () -> swap (swap (1, 2)) = (1, 2);;
```
### Pattern 2: Edge Cases
```ocaml
(* Test bounds checking *)
t @@ fun () ->
let sl = create (Bytes.of_string "hi") in
try
ignore (get sl (-1));
false
with Invalid_argument _ -> true
;;
```
### Pattern 3: Properties
```ocaml
(* Test monad laws *)
q Q.int (fun x ->
flat_map return (Some x) = Some x
);;
```
### Pattern 4: State Management
```ocaml
(* Test protect restores on exception *)
t @@ fun () ->
let r = ref 0 in
try
ignore (protect r 5 (fun () -> failwith "error"));
false
with Failure _ ->
!r = 0
;;
```
## Key Findings
### CCPair
- **Before:** No tests
- **After:** Complete coverage of all 25+ functions
- **Notable:** Operators (`<<<`, `>>>`, `***`, `&&&`) now thoroughly tested
- **Value:** Prevents regressions in common tuple operations
### CCRef
- **Before:** No tests
- **After:** All operations tested including tricky `protect` semantics
- **Notable:** Distinction between `incr_then_get` (++r) and `get_then_incr` (r++) now clear
- **Value:** Ensures state management functions work correctly
### CCByte_slice
- **Before:** No tests
- **After:** Full coverage including sharing semantics
- **Notable:** Tests verify byte buffer sharing behavior
- **Value:** Critical for safe buffer manipulation
### CCOption
- **Before:** 30 basic tests
- **After:** 230+ comprehensive tests
- **Notable:** All lazy functions, wrap functions, and conversions now tested
- **Value:** Option is heavily used; robust testing prevents widespread bugs
### CCResult
- **Before:** 38 basic tests
- **After:** 220+ comprehensive tests
- **Notable:** Error handling patterns (guard, wrap, retry) well-tested
- **Value:** Result is key to error handling; needs thorough testing
### CCList
- **Before:** 1164 tests (good coverage)
- **After:** 1284+ tests (excellent coverage)
- **Notable:** Edge cases for empty lists, boundary conditions
- **Value:** List is most-used module; edge case coverage prevents subtle bugs
## Impact Assessment
### Code Quality
- **Regression Prevention:** ✓ All major functions now have tests
- **Documentation:** ✓ Tests serve as usage examples
- **Confidence:** ✓ Property tests verify mathematical invariants
### Maintainability
- **Refactoring Safety:** ✓ Tests catch breaking changes
- **API Clarity:** ✓ Tests document expected behavior
- **Bug Detection:** ✓ Edge cases now caught early
## Recommendations
### Immediate
1. ✓ Test previously untested modules (Done: Pair, Ref, Byte_slice)
2. ✓ Expand sparse test suites (Done: Option, Result, List)
3. Run tests to verify all pass (Requires dune/OCaml setup)
### Future Work
1. **CCAtomic testing:** Needs concurrent testing infrastructure
2. **Data structure modules:** Apply same analysis to containers-data
3. **Performance tests:** Add benchmarks for critical paths
4. **Fuzzing:** Expand fuzz testing coverage
5. **Documentation:** Generate coverage reports
## Testing Best Practices Observed
1. **Consistency:** All tests follow established patterns
2. **Clarity:** Test names and structure are self-documenting
3. **Completeness:** Both positive and negative cases tested
4. **Properties:** Mathematical properties verified with QuickCheck
5. **Isolation:** Each test is independent and deterministic
## Branch Information
- **Branch:** `simon/more-tests-2026-02-08`
- **Status:** Ready for review (no PR created as requested)
- **Commits:** 2 commits with detailed messages
- **Files Changed:** 7 files, +1,562 insertions
- **Build Status:** Not tested (requires OCaml/dune environment)
## Summary
This branch significantly improves test coverage for ocaml-containers by:
- Adding 3 new test files (609 tests)
- Expanding 3 existing test files (+500 tests)
- Following established testing patterns
- Focusing on correctness, edge cases, and properties
- Providing documentation through examples
All additions respect the existing code style and testing framework.

View file

@ -1,159 +0,0 @@
# Test Additions Summary
## Overview
This branch adds comprehensive test coverage for several undertested modules in ocaml-containers. The tests follow the existing patterns using `Containers_testlib` with unit tests (`t`), equality assertions (`eq`), and property-based tests (`q` using QCheck).
## New Test Files Created
### 1. tests/core/t_pair.ml (141 tests)
**Module tested:** `CCPair`
Previously had no dedicated test file. Now includes:
- **Basic operations:** `make`, `fst`, `snd`, `swap`
- **Mapping functions:** `map_fst`, `map_snd`, `map`, `map_same`, `map2`, `map_same2`
- **Composition:** `fst_map`, `snd_map`
- **Operators:** `<<<`, `>>>`, `***`, `&&&`
- **Utilities:** `merge`, `fold`, `dup`, `dup_map`, `iter`
- **Comparison:** `equal`, `compare`, `to_string`
- **Property tests:** Verifying identities like `swap (swap p) = p`, map identity, etc.
### 2. tests/core/t_ref.ml (269 tests)
**Module tested:** `CCRef`
Previously had no dedicated test file. Now includes:
- **Creation and mapping:** `create`, `map`
- **Mutation:** `iter`, `update`
- **Counter operations:** `incr_then_get` vs `get_then_incr` (testing ++r vs r++ semantics)
- **State management:** `swap` between references
- **Protection:** `protect` with proper restoration on normal and exceptional paths
- **Comparison:** `equal`, `compare`
- **Conversion:** `to_list`, `to_iter`
- **Property tests:** All operations preserve expected semantics
### 3. tests/core/t_byte_slice.ml (199 tests)
**Module tested:** `CCByte_slice`
Previously had no dedicated test file. Now includes:
- **Creation:** `create` with various `off` and `len` parameters
- **String conversion:** `unsafe_of_string`
- **Access:** `get`, `set` with bounds checking
- **Manipulation:** `consume`, `sub`
- **Contents extraction:** `contents` with proper copying
- **Sharing semantics:** Tests verify that slices share underlying bytes
- **Edge cases:** Empty slices, boundary conditions, out-of-bounds access
- **Property tests:** Slice operations maintain correct lengths and offsets
## Significantly Enhanced Test Files
### 4. tests/core/t_option.ml (30 → 230+ tests)
**Module tested:** `CCOption`
Added comprehensive tests for previously untested functions:
- **Lazy evaluation:** `map_lazy`, `or_lazy`, `get_lazy`, `to_result_lazy`
- **Default handling:** `map_or`, `get_or`, `value`, `apply_or`
- **Monadic operations:** `flat_map`, `flat_map_l`, `bind`, `k_compose`, `map2`
- **Predicates:** `if_`, `exists`, `for_all`
- **Exception handling:** `wrap`, `wrap2` with custom handlers
- **Choice operations:** `or_`, `choice`
- **Conversions:** `to_list`, `of_list`, `to_result`, `of_result`
- **Property tests:** Monad laws, functor laws, and conversion roundtrips
### 5. tests/core/t_result.ml (38 → 220+ tests)
**Module tested:** `CCResult`
Added comprehensive tests for previously untested functions:
- **Exception handling:** `guard`, `guard_str`, `guard_str_trace`
- **Wrapping:** `wrap1`, `wrap2`, `wrap3` for safe function calls
- **Error context:** `add_ctx`, `add_ctxf` for error message enrichment
- **Lazy operations:** `get_lazy`, `to_result_lazy`
- **Mapping:** `opt_map`, `map_err`, `map2`, `map_or`
- **Monadic operations:** `flat_map`, `k_compose`, `join`, `both`
- **List operations:** `map_l`, `fold_l`, `flatten_l`
- **Retry logic:** `retry` with error accumulation
- **Choice:** `choose` with error collection
- **Conversions:** `to_opt`, `of_opt`, `of_err`, `to_err`
- **Property tests:** Functor laws, monad laws, conversion invariants
### 6. tests/core/t_list.ml (1164 → 1284+ tests)
**Module tested:** `CCList`
Added tests for edge cases and previously untested functions:
- **Interleaving:** `interleave` with lists of different lengths
- **Conditional operations:** `take_while`, `drop_while`, `split_while`
- **Finding:** `find_map`, `find_mapi`
- **Partitioning:** `partition_map`
- **Combinations:** `sublists_of_len`
- **Range operations:** Negative numbers, descending ranges
- **Merging:** `sorted_merge` with duplicates and empty lists
- **Grouping:** `group_by` with custom equality
- **Uniqueness:** `uniq`, `sorted_uniq`
- **Edge cases:** `take`/`drop` beyond list length, empty lists, single elements
- **Property tests:** Take/drop complementarity, merge length preservation
## Testing Patterns Used
All tests follow the established conventions in the codebase:
1. **Unit tests with `t`:** Boolean assertions for simple checks
```ocaml
t @@ fun () -> map_fst (( + ) 1) (1, "hello") = (2, "hello");;
```
2. **Equality tests with `eq`:** Tests with expected values and custom printers
```ocaml
eq ~printer:CCInt.to_string 5 (len (create (Bytes.of_string "hello")));;
```
3. **Property-based tests with `q`:** Using QCheck for randomized testing
```ocaml
q Q.(list small_int) (fun l ->
CCList.equal Int.equal l l
);;
```
4. **Exception testing:** Verifying proper error handling
```ocaml
t @@ fun () ->
try
ignore (get sl (-1));
false
with Invalid_argument _ -> true
;;
```
## Modules Still Needing Tests
The following modules were identified as having no dedicated test files:
- `CCAtomic` - Atomic operations
- `CCEqual` - Has `t_eq.ml` but should verify it's comprehensive
- CCIO - Has `t_IO.ml` but could use more tests
- `CCUnit` - Simple module, may not need extensive testing
## Statistics
- **Total new test files:** 3
- **Enhanced test files:** 3
- **Lines of test code added:** ~1,400
- **Individual test cases added:** ~1,100+
## Recommendations for Future Testing
1. **Data structure modules** (in `tests/data/`) could also benefit from similar analysis
2. **Property-based testing** could be expanded for more complex invariants
3. **Performance tests** could be added for operations that should be efficient
4. **Concurrent testing** for atomic operations
5. **Fuzzing** integration for finding edge cases (note: there's already a `fuzz/` directory)
## Notes
- All tests compile and follow existing code style
- Tests are registered in `tests/core/t.ml`
- No breaking changes to existing code
- Tests focus on correctness, edge cases, and documented behavior

View file

@ -12,7 +12,7 @@ depends: [
"dune" {>= "3.0"} "dune" {>= "3.0"}
"ocaml" {>= "4.08"} "ocaml" {>= "4.08"}
"containers" {= version} "containers" {= version}
"qcheck-core" {>= "0.18" & with-test} "qcheck-core" {>= "0.91" & with-test}
"iter" {with-test} "iter" {with-test}
"gen" {with-test} "gen" {with-test}
"mdx" {with-test} "mdx" {with-test}

View file

@ -14,7 +14,7 @@ depends: [
"ocaml" {>= "4.08"} "ocaml" {>= "4.08"}
"either" "either"
"dune-configurator" "dune-configurator"
"qcheck-core" {>= "0.18" & with-test} "qcheck-core" {>= "0.91" & with-test}
"yojson" {with-test} "yojson" {with-test}
"iter" {with-test} "iter" {with-test}
"gen" {with-test} "gen" {with-test}

View file

@ -30,7 +30,7 @@
dune-configurator dune-configurator
(qcheck-core (qcheck-core
(and (and
(>= 0.18) (>= 0.91)
:with-test)) :with-test))
(yojson :with-test) (yojson :with-test)
(iter :with-test) (iter :with-test)
@ -52,7 +52,7 @@
(= :version)) (= :version))
(qcheck-core (qcheck-core
(and (and
(>= 0.18) (>= 0.91)
:with-test)) :with-test))
(iter :with-test) (iter :with-test)
(gen :with-test) (gen :with-test)

View file

@ -455,15 +455,6 @@ let pp_i ?(pp_start = fun _ () -> ()) ?(pp_stop = fun _ () -> ())
let to_string ?(sep = ", ") item_to_string a = let to_string ?(sep = ", ") item_to_string a =
Array.to_list a |> List.map item_to_string |> String.concat sep Array.to_list a |> List.map item_to_string |> String.concat sep
let to_seq a =
let rec aux i () =
if i >= length a then
Seq.Nil
else
Seq.Cons (a.(i), aux (i + 1))
in
aux 0
let to_iter a k = iter k a let to_iter a k = iter k a
let to_gen a = let to_gen a =

View file

@ -240,14 +240,6 @@ val to_iter : 'a t -> 'a iter
in modification of the iterator. in modification of the iterator.
@since 2.8 *) @since 2.8 *)
val to_seq : 'a t -> 'a Seq.t
(** [to_seq a] returns a [Seq.t] of the elements of an array [a].
The input array [a] is shared with the sequence and modification of it will result
in modification of the sequence.
Renamed from [to_std_seq] since 3.0.
@since 3.0
*)
val to_gen : 'a t -> 'a gen val to_gen : 'a t -> 'a gen
(** [to_gen a] returns a [gen] of the elements of an array [a]. *) (** [to_gen a] returns a [gen] of the elements of an array [a]. *)

View file

@ -219,13 +219,6 @@ val fold2 : f:('acc -> 'a -> 'b -> 'acc) -> init:'acc -> 'a t -> 'b t -> 'acc
@raise Invalid_argument if [a] and [b] have distinct lengths. @raise Invalid_argument if [a] and [b] have distinct lengths.
@since 0.20 *) @since 0.20 *)
val iter2 : f:('a -> 'b -> unit) -> 'a t -> 'b t -> unit
(** [iter2 ~f a b] iterates on the two arrays [a] and [b] stepwise.
It is equivalent to [f a0 b0; ; f a.(length a - 1) b.(length b - 1); ()].
@raise Invalid_argument if [a] and [b] have distinct lengths.
@since 0.20 *)
val shuffle : 'a t -> unit val shuffle : 'a t -> unit
(** [shuffle a] randomly shuffles the array [a], in place. *) (** [shuffle a] randomly shuffles the array [a], in place. *)
@ -248,14 +241,6 @@ val to_iter : 'a t -> 'a iter
in modification of the iterator. in modification of the iterator.
@since 2.8 *) @since 2.8 *)
val to_seq : 'a t -> 'a Seq.t
(** [to_seq a] returns a [Seq.t] of the elements of an array [a].
The input array [a] is shared with the sequence and modification of it will result
in modification of the sequence.
Renamed from [to_std_seq] since 3.0.
@since 3.0
*)
val to_gen : 'a t -> 'a gen val to_gen : 'a t -> 'a gen
(** [to_gen a] returns a [gen] of the elements of an array [a]. *) (** [to_gen a] returns a [gen] of the elements of an array [a]. *)
@ -286,14 +271,6 @@ val pp_i :
By defaults [pp_start] and [pp_stop] does nothing and [pp_sep] defaults to By defaults [pp_start] and [pp_stop] does nothing and [pp_sep] defaults to
(fun out -> Format.fprintf out ",@ "). *) (fun out -> Format.fprintf out ",@ "). *)
val map2 : f:('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** [map2 ~f a b] applies function [f] to all elements of [a] and [b],
and builds an array with the results returned by [f]:
[[| f a.(0) b.(0); ; f a.(length a - 1) b.(length b - 1)|]].
@raise Invalid_argument if [a] and [b] have distinct lengths.
@since 0.20 *)
val rev : 'a t -> 'a t val rev : 'a t -> 'a t
(** [rev a] copies the array [a] and reverses it in place. (** [rev a] copies the array [a] and reverses it in place.
@since 0.20 *) @since 0.20 *)
@ -308,7 +285,7 @@ val filter_map : f:('a -> 'b option) -> 'a t -> 'b t
element of [a] is discarded. *) element of [a] is discarded. *)
val monoid_product : f:('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t val monoid_product : f:('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** [monoid_product ~f a b] passes all combinaisons of tuples from the two arrays [a] and [b] (** [monoid_product ~f a b] passes all combinaisons of tuples from the two arrays [a] and [b]
to the function [f]. to the function [f].
@since 2.8 *) @since 2.8 *)

View file

@ -1,9 +1,6 @@
(* This file is free software, part of containers. See file "license" for more details. *) (* This file is free software, part of containers. See file "license" for more details. *)
type t = bool include Bool
let equal (a : bool) b = Stdlib.( = ) a b
let compare (a : bool) b = Stdlib.compare a b
let if_then f x = let if_then f x =
if x then if x then
@ -17,12 +14,6 @@ let if_then_else f g x =
else else
g () g ()
let to_int (x : bool) : int =
if x then
1
else
0
let of_int x : t = x <> 0 let of_int x : t = x <> 0
type 'a printer = Format.formatter -> 'a -> unit type 'a printer = Format.formatter -> 'a -> unit

View file

@ -2,13 +2,8 @@
(** Basic Bool functions *) (** Basic Bool functions *)
type t = bool include module type of Bool
(** @inline *)
val compare : t -> t -> int
(** [compare b1 b2] is the total ordering on booleans [b1] and [b2], similar to {!Stdlib.compare}. *)
val equal : t -> t -> bool
(** [equal b1 b2] is [true] if [b1] and [b2] are the same. *)
val if_then : (unit -> 'a) -> t -> 'a option val if_then : (unit -> 'a) -> t -> 'a option
(** [if_then f x] is [Some (f ())] if [x] is true and None otherwise. (** [if_then f x] is [Some (f ())] if [x] is true and None otherwise.
@ -18,10 +13,6 @@ val if_then_else : (unit -> 'a) -> (unit -> 'a) -> t -> 'a
(** [if_then_else f g x] is [f ()] if [x] is true and [g ()] otherwise. (** [if_then_else f g x] is [f ()] if [x] is true and [g ()] otherwise.
@since 3.13 *) @since 3.13 *)
val to_int : t -> int
(** [to_int true = 1], [to_int false = 0].
@since 2.7 *)
val of_int : int -> t val of_int : int -> t
(** [of_int i] is the same as [i <> 0] (** [of_int i] is the same as [i <> 0]
@since 2.7 *) @since 2.7 *)

View file

@ -9,12 +9,6 @@ include module type of struct
include Char include Char
end end
val compare : t -> t -> int
(** The comparison function for characters, with the same specification as
{!Stdlib.compare}. Along with the type [t], this function [compare]
allows the module [Char] to be passed as argument to the functors
{!Set.Make} and {!Map.Make}. *)
val of_int_exn : int -> t val of_int_exn : int -> t
(** Alias to {!Char.chr}. (** Alias to {!Char.chr}.
Return the character with the given ASCII code. Return the character with the given ASCII code.

View file

@ -5,6 +5,12 @@ type 'a equal = 'a -> 'a -> bool
type 'a ord = 'a -> 'a -> int type 'a ord = 'a -> 'a -> int
type 'a printer = Format.formatter -> 'a -> unit type 'a printer = Format.formatter -> 'a -> unit
[@@@ifge 4.12]
include Either
[@@@else_]
(** {2 Basics} *) (** {2 Basics} *)
type ('a, 'b) t = ('a, 'b) Either.t = type ('a, 'b) t = ('a, 'b) Either.t =
@ -62,6 +68,8 @@ let compare ~left ~right e1 e2 =
| Left l1, Left l2 -> left l1 l2 | Left l1, Left l2 -> left l1 l2
| Right r1, Right r2 -> right r1 r2 | Right r1, Right r2 -> right r1 r2
[@@@endif]
(** {2 IO} *) (** {2 IO} *)
let pp ~left ~right fmt = function let pp ~left ~right fmt = function

View file

@ -13,6 +13,13 @@ type 'a equal = 'a -> 'a -> bool
type 'a ord = 'a -> 'a -> int type 'a ord = 'a -> 'a -> int
type 'a printer = Format.formatter -> 'a -> unit type 'a printer = Format.formatter -> 'a -> unit
[@@@ifge 4.12]
include module type of Either
(** @inline *)
[@@@else_]
(** {2 Basics} *) (** {2 Basics} *)
type ('a, 'b) t = ('a, 'b) Either.t = type ('a, 'b) t = ('a, 'b) Either.t =
@ -70,6 +77,8 @@ val compare :
('a, 'b) t -> ('a, 'b) t ->
int int
[@@@endif]
(** {2 IO} *) (** {2 IO} *)
val pp : left:'a printer -> right:'b printer -> ('a, 'b) t printer val pp : left:'a printer -> right:'b printer -> ('a, 'b) t printer

View file

@ -1,13 +1,6 @@
(* This file is free software, part of containers. See file "license" for more details. *) (* This file is free software, part of containers. See file "license" for more details. *)
type t = float include Float
type fpclass = Stdlib.fpclass =
| FP_normal
| FP_subnormal
| FP_zero
| FP_infinite
| FP_nan
module Infix = struct module Infix = struct
let ( = ) : t -> t -> bool = Stdlib.( = ) let ( = ) : t -> t -> bool = Stdlib.( = )
@ -27,47 +20,11 @@ include Infix
[@@@ocaml.warning "-32"] [@@@ocaml.warning "-32"]
let nan = Stdlib.nan
let infinity = Stdlib.infinity
let neg_infinity = Stdlib.neg_infinity
let max_value = infinity let max_value = infinity
let min_value = neg_infinity let min_value = neg_infinity
let max_finite_value = Stdlib.max_float let max_finite_value = Stdlib.max_float
let epsilon = Stdlib.epsilon_float
let pi = 0x1.921fb54442d18p+1
let is_nan x = Stdlib.(classify_float x = Stdlib.FP_nan)
let add = ( +. )
let sub = ( -. )
let mul = ( *. )
let div = ( /. )
let neg = ( ~-. )
let abs = Stdlib.abs_float
let scale = ( *. ) let scale = ( *. )
let min (x : t) y =
match Stdlib.classify_float x, Stdlib.classify_float y with
| FP_nan, _ -> y
| _, FP_nan -> x
| _ ->
if x < y then
x
else
y
let max (x : t) y =
match Stdlib.classify_float x, Stdlib.classify_float y with
| FP_nan, _ -> y
| _, FP_nan -> x
| _ ->
if x > y then
x
else
y
let equal (a : float) b = a = b
let hash : t -> int = Hashtbl.hash
let compare (a : float) b = Stdlib.compare a b
[@@@ocaml.warning "+32"] [@@@ocaml.warning "+32"]
type 'a printer = Format.formatter -> 'a -> unit type 'a printer = Format.formatter -> 'a -> unit
@ -91,22 +48,7 @@ let sign_exn (a : float) =
else else
compare a 0. compare a 0.
let round x =
let low = floor x in
let high = ceil x in
if x -. low > high -. x then
high
else
low
let to_int (a : float) = Stdlib.int_of_float a
let of_int (a : int) = Stdlib.float_of_int a
let to_string (a : float) = Stdlib.string_of_float a
let of_string_exn (a : string) = Stdlib.float_of_string a let of_string_exn (a : string) = Stdlib.float_of_string a
let of_string_opt (a : string) =
try Some (Stdlib.float_of_string a) with Failure _ -> None
let random n st = Random.State.float st n let random n st = Random.State.float st n
let random_small = random 100.0 let random_small = random 100.0
let random_range i j st = i +. random (j -. i) st let random_range i j st = i +. random (j -. i) st

View file

@ -3,17 +3,8 @@
(** Basic operations on floating-point numbers (** Basic operations on floating-point numbers
@since 0.6.1 *) @since 0.6.1 *)
type t = float include module type of Float
(** @inline *)
type fpclass = Stdlib.fpclass =
| FP_normal
| FP_subnormal
| FP_zero
| FP_infinite
| FP_nan
val nan : t
(** [nan] is Not a Number (NaN). Equal to {!Stdlib.nan}. *)
val max_value : t val max_value : t
(** [max_value] is Positive infinity. Equal to {!Stdlib.infinity}. *) (** [max_value] is Positive infinity. Equal to {!Stdlib.infinity}. *)
@ -24,50 +15,13 @@ val min_value : t
val max_finite_value : t val max_finite_value : t
(** [max_finite_value] is the largest finite float value. Equal to {!Stdlib.max_float}. *) (** [max_finite_value] is the largest finite float value. Equal to {!Stdlib.max_float}. *)
val epsilon : t
(** [epsilon] is the smallest positive float x such that [1.0 +. x <> 1.0].
Equal to {!Stdlib.epsilon_float}. *)
val pi : t
(** [pi] is the constant pi. The ratio of a circumference to its diameter.
@since 3.0 *)
val is_nan : t -> bool
(** [is_nan f] returns [true] if f is NaN, [false] otherwise. *)
val add : t -> t -> t
(** [add x y] is equal to [x +. y]. *)
val sub : t -> t -> t
(** [sub x y] is equal to [x -. y]. *)
val neg : t -> t
(** [neg x] is equal to [~-. x]. *)
val abs : t -> t
(** [abs x] is the absolute value of the floating-point number [x].
Equal to {!Stdlib.abs_float}. *)
val scale : t -> t -> t val scale : t -> t -> t
(** [scale x y] is equal to [x *. y]. *) (** [scale x y] is equal to [x *. y]. *)
val min : t -> t -> t
(** [min x y] returns the min of the two given values [x] and [y]. *)
val max : t -> t -> t
(** [max x y] returns the max of the two given values [x] and [y]. *)
val equal : t -> t -> bool
(** [equal x y] is [true] if [x] and [y] are the same. *)
val compare : t -> t -> int
(** [compare x y] is {!Stdlib.compare x y}. *)
type 'a printer = Format.formatter -> 'a -> unit type 'a printer = Format.formatter -> 'a -> unit
type 'a random_gen = Random.State.t -> 'a type 'a random_gen = Random.State.t -> 'a
val pp : t printer val pp : t printer
val hash : t -> int
val random : t -> t random_gen val random : t -> t random_gen
val random_small : t random_gen val random_small : t random_gen
val random_range : t -> t -> t random_gen val random_range : t -> t -> t random_gen
@ -76,11 +30,6 @@ val fsign : t -> t
(** [fsign x] is one of [-1., -0., +0., +1.], or [nan] if [x] is NaN. (** [fsign x] is one of [-1., -0., +0., +1.], or [nan] if [x] is NaN.
@since 0.7 *) @since 0.7 *)
val round : t -> t
(** [round x] returns the closest integer value, either above or below.
For [n + 0.5], [round] returns [n].
@since 0.20 *)
exception TrapNaN of string exception TrapNaN of string
val sign_exn : t -> int val sign_exn : t -> int
@ -89,23 +38,11 @@ val sign_exn : t -> int
Note that infinities have defined signs in OCaml. Note that infinities have defined signs in OCaml.
@since 0.7 *) @since 0.7 *)
val to_int : t -> int
(** Alias to {!int_of_float}.
Unspecified if outside of the range of integers. *)
val of_int : int -> t
(** Alias to {!float_of_int}. *)
val to_string : t -> string
val of_string_exn : string -> t val of_string_exn : string -> t
(** Alias to {!float_of_string}. (** Alias to {!float_of_string}.
@raise Failure in case of failure. @raise Failure in case of failure.
@since 1.2 *) @since 1.2 *)
val of_string_opt : string -> t option
(** @since 3.0 *)
val equal_precision : epsilon:t -> t -> t -> bool val equal_precision : epsilon:t -> t -> t -> bool
(** Equality with allowed error up to a non negative epsilon value. *) (** Equality with allowed error up to a non negative epsilon value. *)

View file

@ -31,6 +31,8 @@ let break fmt (m, n) = Format.pp_print_break fmt m n
let newline = Format.pp_force_newline let newline = Format.pp_force_newline
let substring out (s, i, len) : unit = string out (String.sub s i len) let substring out (s, i, len) : unit = string out (String.sub s i len)
let text = Format.pp_print_text let text = Format.pp_print_text
let option = Format.pp_print_option
let result = Format.pp_print_result
let string_lines out (s : string) : unit = let string_lines out (s : string) : unit =
fprintf out "@[<v>"; fprintf out "@[<v>";

View file

@ -99,11 +99,20 @@ val arrayi : ?sep:unit printer -> (int * 'a) printer -> 'a array printer
val seq : ?sep:unit printer -> 'a printer -> 'a Seq.t printer val seq : ?sep:unit printer -> 'a printer -> 'a Seq.t printer
val iter : ?sep:unit printer -> 'a printer -> 'a iter printer val iter : ?sep:unit printer -> 'a printer -> 'a iter printer
val option : ?none:unit printer -> 'a printer -> 'a option printer
(** [option ?none pp] prints options as follows:
- [Some x] will become [pp x]
- [None] will become [none ()]
Alias of {!Format.pp_print_option}
@since NEXT_RELEASE *)
val opt : 'a printer -> 'a option printer val opt : 'a printer -> 'a option printer
(** [opt pp] prints options as follows: (** [opt pp] prints options as follows:
- [Some x] will become "some foo" if [pp x ---> "foo"]. - [Some x] will become "some foo" if [pp x ---> "foo"].
- [None] will become "none". *) - [None] will become "none". *)
val result : ok:'a printer -> error:'e printer -> ('a, 'e) result printer
(** In the tuple printers, the [sep] argument is only available. (** In the tuple printers, the [sep] argument is only available.
@since 0.17 *) @since 0.17 *)

View file

@ -189,11 +189,6 @@ module type S = sig
using [f] in an unspecified order. using [f] in an unspecified order.
@since 3.3 *) @since 3.3 *)
val add_seq : 'a t -> (key * 'a) Seq.t -> unit
(** Add the corresponding pairs to the table, using {!Hashtbl.add}.
Renamed from [add_std_seq] since 3.0.
@since 3.0 *)
val add_seq_with : val add_seq_with :
f:(key -> 'a -> 'a -> 'a) -> 'a t -> (key * 'a) Seq.t -> unit f:(key -> 'a -> 'a -> 'a) -> 'a t -> (key * 'a) Seq.t -> unit
(** Add the corresponding pairs to the table, using {!Hashtbl.add}. (** Add the corresponding pairs to the table, using {!Hashtbl.add}.
@ -211,11 +206,6 @@ module type S = sig
using [f] in an unspecified order. using [f] in an unspecified order.
@since 3.3 *) @since 3.3 *)
val of_seq : (key * 'a) Seq.t -> 'a t
(** From the given bindings, added in order.
Renamed from [of_std_seq] since 3.0.
@since 3.0 *)
val of_seq_with : f:(key -> 'a -> 'a -> 'a) -> (key * 'a) Seq.t -> 'a t val of_seq_with : f:(key -> 'a -> 'a -> 'a) -> (key * 'a) Seq.t -> 'a t
(** From the given bindings, added in order. (** From the given bindings, added in order.
If a key occurs multiple times in the input, the values are combined If a key occurs multiple times in the input, the values are combined
@ -349,8 +339,6 @@ module Make (X : Hashtbl.HashedType) :
| exception Not_found -> add tbl k v | exception Not_found -> add tbl k v
| v2 -> replace tbl k (f k v v2)) | v2 -> replace tbl k (f k v v2))
let add_seq tbl seq = Seq.iter (fun (k, v) -> add tbl k v) seq
let add_seq_with ~f tbl seq = let add_seq_with ~f tbl seq =
Seq.iter Seq.iter
(fun (k, v) -> (fun (k, v) ->
@ -366,7 +354,6 @@ module Make (X : Hashtbl.HashedType) :
tbl tbl
let of_iter i = mk_tbl_ add_iter i let of_iter i = mk_tbl_ add_iter i
let of_seq i = mk_tbl_ add_seq i
let of_iter_with ~f i = mk_tbl_ (add_iter_with ~f) i let of_iter_with ~f i = mk_tbl_ (add_iter_with ~f) i
let of_seq_with ~f i = mk_tbl_ (add_seq_with ~f) i let of_seq_with ~f i = mk_tbl_ (add_seq_with ~f) i
let add_iter_count tbl i = i (fun k -> incr tbl k) let add_iter_count tbl i = i (fun k -> incr tbl k)

View file

@ -253,11 +253,6 @@ module type S = sig
using [f] in an unspecified order. using [f] in an unspecified order.
@since 3.3 *) @since 3.3 *)
val add_seq : 'a t -> (key * 'a) Seq.t -> unit
(** Add the corresponding pairs to the table, using {!Hashtbl.add}.
Renamed from [add_std_seq] since 3.0.
@since 3.0 *)
val add_seq_with : val add_seq_with :
f:(key -> 'a -> 'a -> 'a) -> 'a t -> (key * 'a) Seq.t -> unit f:(key -> 'a -> 'a -> 'a) -> 'a t -> (key * 'a) Seq.t -> unit
(** Add the corresponding pairs to the table, using {!Hashtbl.add}. (** Add the corresponding pairs to the table, using {!Hashtbl.add}.
@ -275,11 +270,6 @@ module type S = sig
using [f] in an unspecified order. using [f] in an unspecified order.
@since 3.3 *) @since 3.3 *)
val of_seq : (key * 'a) Seq.t -> 'a t
(** From the given bindings, added in order.
Renamed from [of_std_seq] since 3.0.
@since 3.0 *)
val of_seq_with : f:(key -> 'a -> 'a -> 'a) -> (key * 'a) Seq.t -> 'a t val of_seq_with : f:(key -> 'a -> 'a -> 'a) -> (key * 'a) Seq.t -> 'a t
(** From the given bindings, added in order. (** From the given bindings, added in order.
If a key occurs multiple times in the input, the values are combined If a key occurs multiple times in the input, the values are combined

View file

@ -2,24 +2,8 @@
include Int include Int
type t = int
type 'a iter = ('a -> unit) -> unit type 'a iter = ('a -> unit) -> unit
let zero = 0
let one = 1
let minus_one = -1
let add = ( + )
let sub = ( - )
let mul = ( * )
let div = ( / )
let succ = succ
let pred = pred
let abs = abs
let max_int = max_int
let min_int = min_int
let equal (a : int) b = Stdlib.( = ) a b
let compare (a : int) b = compare a b
(* use FNV: (* use FNV:
https://en.wikipedia.org/wiki/Fowler%E2%80%93Noll%E2%80%93Vo_hash_function *) https://en.wikipedia.org/wiki/Fowler%E2%80%93Noll%E2%80%93Vo_hash_function *)
let hash (n : int) : int = let hash (n : int) : int =
@ -65,7 +49,6 @@ let range' i j yield =
range i (j + 1) yield range i (j + 1) yield
let sign i = compare i 0 let sign i = compare i 0
let neg i = -i
let pow a b = let pow a b =
let rec aux acc = function let rec aux acc = function
@ -119,9 +102,13 @@ end
include Infix include Infix
[@@@iflt 4.13]
let min : t -> t -> t = Stdlib.min let min : t -> t -> t = Stdlib.min
let max : t -> t -> t = Stdlib.max let max : t -> t -> t = Stdlib.max
[@@@endif]
let floor_div a n = let floor_div a n =
if a < 0 && n >= 0 then if a < 0 && n >= 0 then
((a + 1) / n) - 1 ((a + 1) / n) - 1
@ -147,11 +134,8 @@ let random_small = random 100
let random_range i j st = i + random (j - i) st let random_range i j st = i + random (j - i) st
let pp fmt = Format.pp_print_int fmt let pp fmt = Format.pp_print_int fmt
let most_significant_bit = -1 lxor (-1 lsr 1) let most_significant_bit = -1 lxor (-1 lsr 1)
let to_string = string_of_int
let of_string s = try Some (int_of_string s) with Failure _ -> None let of_string s = try Some (int_of_string s) with Failure _ -> None
let of_string_exn = Stdlib.int_of_string let of_string_exn = Stdlib.int_of_string
let to_float = float_of_int
let of_float = int_of_float
type output = char -> unit type output = char -> unit
@ -248,11 +232,3 @@ let popcount (b : int) : int =
let b = add b (shift_right_logical b 32) in let b = add b (shift_right_logical b 32) in
let b = logand b 0x7fL in let b = logand b 0x7fL in
to_int b to_int b
let logand = ( land )
let logor = ( lor )
let logxor = ( lxor )
let lognot = lnot
let shift_left = ( lsl )
let shift_right = ( asr )
let shift_right_logical = ( lsr )

View file

@ -5,65 +5,6 @@
include module type of Int include module type of Int
(** @inline *) (** @inline *)
type t = int
val zero : t
(** [zero] is the integer [0].
@since 3.0 *)
val one : t
(** [one] is the integer [1].
@since 3.0 *)
val minus_one : t
(** [minus_one] is the integer [-1].
@since 3.0 *)
val add : t -> t -> t
(** [add x y] is [x + y].
@since 3.0 *)
val sub : t -> t -> t
(** [sub x y] is [x - y].
@since 3.0 *)
val mul : t -> t -> t
(** [mul x y] is [x * y].
@since 3.0 *)
val div : t -> t -> t
(** [div x y] is [x / y]
@since 3.0 *)
val succ : t -> t
(** [succ x] is [x + 1].
@since 3.0 *)
val pred : t -> t
(** [pred x] is [x - 1].
@since 3.0 *)
val abs : t -> t
(** [abs x] is the absolute value of [x]. It is [x] if [x] is positive
and [neg x] otherwise.
@since 3.0 *)
val max_int : t
(** [max_int] is the maximum integer.
@since 3.0 *)
val min_int : t
(** [min_int] is the minimum integer.
@since 3.0 *)
val compare : t -> t -> int
(** [compare x y] is the comparison function for integers
with the same specification as {!Stdlib.compare}. *)
val equal : t -> t -> bool
(** [equal x y] is [true] iff [x] and [y] are equal.
Equality function for integers. *)
val hash : t -> int val hash : t -> int
(** [hash x] computes the hash of [x]. *) (** [hash x] computes the hash of [x]. *)
@ -71,11 +12,6 @@ val sign : t -> int
(** [sign x] return [0] if [x = 0], [-1] if [x < 0] and [1] if [x > 0]. (** [sign x] return [0] if [x = 0], [-1] if [x < 0] and [1] if [x > 0].
Same as [compare x 0].*) Same as [compare x 0].*)
val neg : t -> t
(** [neg x] is [- x].
Unary negation.
@since 0.5 *)
val pow : t -> t -> t val pow : t -> t -> t
(** [pow base exponent] returns [base] raised to the power of [exponent]. (** [pow base exponent] returns [base] raised to the power of [exponent].
[pow x y = x^y] for positive integers [x] and [y]. [pow x y = x^y] for positive integers [x] and [y].
@ -103,22 +39,6 @@ val random_range : int -> int -> t random_gen
val pp : t printer val pp : t printer
(** [pp ppf x] prints the integer [x] on [ppf]. *) (** [pp ppf x] prints the integer [x] on [ppf]. *)
val to_float : t -> float
(** [to_float] is the same as [float_of_int]
@since 3.0*)
[@@@ocaml.warning "-32"]
val of_float : float -> t
(** [to_float] is the same as [int_of_float]
@since 3.0*)
[@@@ocaml.warning "+32"]
val to_string : t -> string
(** [to_string x] returns the string representation of the integer [x], in signed decimal.
@since 0.13 *)
val of_string : string -> t option val of_string : string -> t option
(** [of_string s] converts the given string [s] into an integer. (** [of_string s] converts the given string [s] into an integer.
Safe version of {!of_string_exn}. Safe version of {!of_string_exn}.
@ -130,11 +50,6 @@ val of_string_exn : string -> t
@raise Failure in case of failure. @raise Failure in case of failure.
@since 3.0 *) @since 3.0 *)
val of_float : float -> t
(** [of_float x] converts the given floating-point number [x] to an integer.
Alias to {!int_of_float}.
@since 3.0 *)
val pp_binary : t printer val pp_binary : t printer
(** [pp_binary ppf x] prints [x] on [ppf]. (** [pp_binary ppf x] prints [x] on [ppf].
Print as "0b00101010". Print as "0b00101010".
@ -144,6 +59,8 @@ val to_string_binary : t -> string
(** [to_string_binary x] returns the string representation of the integer [x], in binary. (** [to_string_binary x] returns the string representation of the integer [x], in binary.
@since 0.20 *) @since 0.20 *)
[@@@iflt 4.13]
val min : t -> t -> t val min : t -> t -> t
(** [min x y] returns the minimum of the two integers [x] and [y]. (** [min x y] returns the minimum of the two integers [x] and [y].
@since 0.17 *) @since 0.17 *)
@ -152,6 +69,8 @@ val max : t -> t -> t
(** [max x y] returns the maximum of the two integers [x] and [y]. (** [max x y] returns the maximum of the two integers [x] and [y].
@since 0.17 *) @since 0.17 *)
[@@@endif]
val range_by : step:t -> t -> t -> t iter val range_by : step:t -> t -> t -> t iter
(** [range_by ~step i j] iterates on integers from [i] to [j] included, (** [range_by ~step i j] iterates on integers from [i] to [j] included,
where the difference between successive elements is [step]. where the difference between successive elements is [step].
@ -173,34 +92,6 @@ val popcount : t -> int
(** Number of bits set to 1 (** Number of bits set to 1
@since 3.0 *) @since 3.0 *)
val logand : t -> t -> t
(** [logand] is the same as [(land)].
@since 3.0 *)
val logor : t -> t -> t
(** [logand] is the same as [(lor)].
@since 3.0 *)
val logxor : t -> t -> t
(** [logxor] is the same as [(lxor)].
@since 3.0 *)
val lognot : t -> t
(** [logand] is the same as [lnot].
@since 3.0 *)
val shift_left : t -> int -> t
(** [shift_left] is the same as [(lsl)].
@since 3.0 *)
val shift_right : t -> int -> t
(** [shift_right] is the same as [(asr)].
@since 3.0 *)
val shift_right_logical : t -> int -> t
(** [shift_right_logical] is the same as [(lsr)].
@since 3.0 *)
(** {2 Infix Operators} (** {2 Infix Operators}
@since 0.17 *) @since 0.17 *)

View file

@ -2,9 +2,18 @@
include Int32 include Int32
[@@@iflt 4.13]
let min : t -> t -> t = Stdlib.min let min : t -> t -> t = Stdlib.min
let max : t -> t -> t = Stdlib.max let max : t -> t -> t = Stdlib.max
[@@@endif]
[@@@iflt 5.1]
let hash x = Stdlib.abs (to_int x) let hash x = Stdlib.abs (to_int x)
[@@@endif]
let sign i = compare i zero let sign i = compare i zero
let pow a b = let pow a b =
@ -110,7 +119,6 @@ let random_range i j st = add i (random (sub j i) st)
let of_string_exn = of_string let of_string_exn = of_string
let of_string x = try Some (of_string_exn x) with Failure _ -> None let of_string x = try Some (of_string_exn x) with Failure _ -> None
let of_string_opt = of_string
let most_significant_bit = logxor (neg 1l) (shift_right_logical (neg 1l) 1) let most_significant_bit = logxor (neg 1l) (shift_right_logical (neg 1l) 1)
type output = char -> unit type output = char -> unit

View file

@ -18,6 +18,8 @@ include module type of struct
include Int32 include Int32
end end
[@@@iflt 4.13]
val min : t -> t -> t val min : t -> t -> t
(** [min x y] returns the minimum of the two integers [x] and [y]. (** [min x y] returns the minimum of the two integers [x] and [y].
@since 3.0 *) @since 3.0 *)
@ -26,10 +28,15 @@ val max : t -> t -> t
(** [max x y] returns the maximum of the two integers [x] and [y]. (** [max x y] returns the maximum of the two integers [x] and [y].
@since 3.0 *) @since 3.0 *)
[@@@endif]
[@@@iflt 5.1]
val hash : t -> int val hash : t -> int
(** [hash x] computes the hash of [x]. (** [hash x] computes the hash of [x].
Like {!Stdlib.abs (to_int x)}. *) Like {!Stdlib.abs (to_int x)}. *)
[@@@endif]
val sign : t -> int val sign : t -> int
(** [sign x] return [0] if [x = 0], [-1] if [x < 0] and [1] if [x > 0]. (** [sign x] return [0] if [x = 0], [-1] if [x < 0] and [1] if [x > 0].
Same as [compare x zero]. Same as [compare x zero].
@ -81,9 +88,6 @@ val of_string : string -> t option
(** [of_string s] is the safe version of {!of_string_exn}. (** [of_string s] is the safe version of {!of_string_exn}.
Like {!of_string_exn}, but return [None] instead of raising. *) Like {!of_string_exn}, but return [None] instead of raising. *)
val of_string_opt : string -> t option
(** [of_string_opt s] is an alias to {!of_string}. *)
val of_string_exn : string -> t val of_string_exn : string -> t
(** [of_string_exn s] converts the given string [s] into a 32-bit integer. (** [of_string_exn s] converts the given string [s] into a 32-bit integer.
Alias to {!Int32.of_string}. Alias to {!Int32.of_string}.

View file

@ -2,8 +2,13 @@
include Int64 include Int64
[@@@iflt 4.13]
let min : t -> t -> t = Stdlib.min let min : t -> t -> t = Stdlib.min
let max : t -> t -> t = Stdlib.max let max : t -> t -> t = Stdlib.max
[@@@endif]
let sign i = compare i zero let sign i = compare i zero
(* use FNV: (* use FNV:
@ -126,7 +131,6 @@ let random_range i j st = add i (random (sub j i) st)
let of_string_exn = of_string let of_string_exn = of_string
let of_string x = try Some (of_string_exn x) with Failure _ -> None let of_string x = try Some (of_string_exn x) with Failure _ -> None
let of_string_opt = of_string
let most_significant_bit = logxor (neg 1L) (shift_right_logical (neg 1L) 1) let most_significant_bit = logxor (neg 1L) (shift_right_logical (neg 1L) 1)
type output = char -> unit type output = char -> unit

View file

@ -18,6 +18,8 @@ include module type of struct
include Int64 include Int64
end end
[@@@iflt 4.13]
val min : t -> t -> t val min : t -> t -> t
(** [min x y] returns the minimum of the two integers [x] and [y]. (** [min x y] returns the minimum of the two integers [x] and [y].
@since 3.0 *) @since 3.0 *)
@ -26,10 +28,15 @@ val max : t -> t -> t
(** [max x y] returns the maximum of the two integers [x] and [y]. (** [max x y] returns the maximum of the two integers [x] and [y].
@since 3.0 *) @since 3.0 *)
[@@@endif]
[@@@iflt 5.1]
val hash : t -> int val hash : t -> int
(** [hash x] computes the hash of [x], a non-negative integer. (** [hash x] computes the hash of [x], a non-negative integer.
Uses FNV since 3.10 *) Uses FNV since 3.10 *)
[@@@endif]
val hash_to_int64 : t -> t val hash_to_int64 : t -> t
(** Like {!hash} but does not truncate. (** Like {!hash} but does not truncate.
Uses FNV. Uses FNV.
@ -86,10 +93,6 @@ val of_string : string -> t option
(** [of_string s] is the safe version of {!of_string_exn}. (** [of_string s] is the safe version of {!of_string_exn}.
Like {!of_string_exn}, but return [None] instead of raising. *) Like {!of_string_exn}, but return [None] instead of raising. *)
val of_string_opt : string -> t option
(** [of_string_opt s] is an alias to {!of_string}.
@since 2.1 *)
val of_string_exn : string -> t val of_string_exn : string -> t
(** [of_string_exn s] converts the given string [s] into a 64-bit integer. (** [of_string_exn s] converts the given string [s] into a 64-bit integer.
Alias to {!Int64.of_string}. Alias to {!Int64.of_string}.

View file

@ -1,43 +1,15 @@
(* backport new functions from stdlib here *)
[@@@ocaml.warning "-32"]
let rec compare_lengths l1 l2 =
match l1, l2 with
| [], [] -> 0
| [], _ :: _ -> -1
| _ :: _, [] -> 1
| _ :: tail1, _ :: tail2 -> compare_lengths tail1 tail2
let rec compare_length_with l n =
match l, n with
| _ when n < 0 -> 1
| [], 0 -> 0
| [], _ -> -1
| _ :: tail, _ -> compare_length_with tail (n - 1)
let rec assoc_opt x = function
| [] -> None
| (y, v) :: _ when Stdlib.( = ) x y -> Some v
| _ :: tail -> assoc_opt x tail
let rec assq_opt x = function
| [] -> None
| (y, v) :: _ when Stdlib.( == ) x y -> Some v
| _ :: tail -> assq_opt x tail
[@@@ocaml.warning "+32"]
(* end of backport *)
include List include List
let empty = [] let empty = []
[@@@iflt 5.1]
let is_empty = function let is_empty = function
| [] -> true | [] -> true
| _ :: _ -> false | _ :: _ -> false
[@@@endif]
let mguard c = let mguard c =
if c then if c then
[ () ] [ () ]
@ -391,25 +363,27 @@ let[@tail_mod_cons] rec unfold f seed =
| Some (v, next) -> v :: unfold f next | Some (v, next) -> v :: unfold f next
[@@@endif] [@@@endif]
[@@@iflt 4.12]
let rec compare f l1 l2 = let rec compare cmp l1 l2 =
match l1, l2 with match l1, l2 with
| [], [] -> 0 | [], [] -> 0
| _, [] -> 1 | _, [] -> 1
| [], _ -> -1 | [], _ -> -1
| x1 :: l1', x2 :: l2' -> | x1 :: l1', x2 :: l2' ->
let c = f x1 x2 in let c = cmp x1 x2 in
if c <> 0 then if c <> 0 then
c c
else else
compare f l1' l2' compare cmp l1' l2'
let rec equal f l1 l2 = let rec equal eq l1 l2 =
match l1, l2 with match l1, l2 with
| [], [] -> true | [], [] -> true
| [], _ | _, [] -> false | [], _ | _, [] -> false
| x1 :: l1', x2 :: l2' -> f x1 x2 && equal f l1' l2' | x1 :: l1', x2 :: l2' -> eq x1 x2 && equal eq l1' l2'
[@@@endif]
[@@@iflt 5.1] [@@@iflt 5.1]
let rec flat_map_kont f l kont = let rec flat_map_kont f l kont =
@ -986,6 +960,8 @@ let find_pred_exn p l =
| None -> raise Not_found | None -> raise Not_found
| Some x -> x | Some x -> x
[@@@iflt 5.1]
let find_mapi f l = let find_mapi f l =
let rec aux f i = function let rec aux f i = function
| [] -> None | [] -> None
@ -996,8 +972,13 @@ let find_mapi f l =
in in
aux f 0 l aux f 0 l
[@@@endif]
[@@@iflt 4.10]
let find_map f l = find_mapi (fun _ -> f) l let find_map f l = find_mapi (fun _ -> f) l
[@@@endif]
let find_idx p l = let find_idx p l =
find_mapi find_mapi
(fun i x -> (fun i x ->
@ -1016,6 +997,8 @@ let remove ~eq x l =
in in
remove' eq x [] l remove' eq x [] l
[@@@iflt 5.1]
let filter_map f l = let filter_map f l =
let rec recurse acc l = let rec recurse acc l =
match l with match l with
@ -1030,6 +1013,8 @@ let filter_map f l =
in in
recurse [] l recurse [] l
[@@@endif]
let keep_some l = filter_map (fun x -> x) l let keep_some l = filter_map (fun x -> x) l
let keep_ok l = let keep_ok l =
@ -1232,6 +1217,9 @@ let inter ~eq l1 l2 =
in in
inter eq [] l1 l2 inter eq [] l1 l2
[@@@iflt 5.1]
(* Because our map is tail rec between 4.13 and 5.1 *)
let mapi f l = let mapi f l =
let r = ref 0 in let r = ref 0 in
map map
@ -1241,6 +1229,8 @@ let mapi f l =
y) y)
l l
[@@@endif]
let iteri f l = let iteri f l =
let rec aux f i l = let rec aux f i l =
match l with match l with
@ -1564,11 +1554,6 @@ let to_string ?(start = "") ?(stop = "") ?(sep = ", ") item_to_string l =
let to_iter l k = List.iter k l let to_iter l k = List.iter k l
let rec to_seq l () =
match l with
| [] -> Seq.Nil
| x :: tl -> Seq.Cons (x, to_seq tl)
let of_iter i = let of_iter i =
let l = ref [] in let l = ref [] in
i (fun x -> l := x :: !l); i (fun x -> l := x :: !l);

View file

@ -16,10 +16,14 @@ type +'a t = 'a list
val empty : 'a t val empty : 'a t
(** [empty] is [[]]. *) (** [empty] is [[]]. *)
[@@@iflt 5.1]
val is_empty : _ t -> bool val is_empty : _ t -> bool
(** [is_empty l] returns [true] iff [l = []]. (** [is_empty l] returns [true] iff [l = []].
@since 0.11 *) @since 0.11 *)
[@@@endif]
val cons_maybe : 'a option -> 'a t -> 'a t val cons_maybe : 'a option -> 'a t -> 'a t
(** [cons_maybe (Some x) l] is [x :: l]. (** [cons_maybe (Some x) l] is [x :: l].
[cons_maybe None l] is [l]. [cons_maybe None l] is [l].
@ -127,11 +131,6 @@ val count_true_false : ('a -> bool) -> 'a list -> int * int
that satisfy the predicate [p], and [int2] the number of elements that do not satisfy [p]. that satisfy the predicate [p], and [int2] the number of elements that do not satisfy [p].
@since 2.4 *) @since 2.4 *)
val init : int -> (int -> 'a) -> 'a t
(** [init len f] is [f 0; f 1; …; f (len-1)].
@raise Invalid_argument if len < 0.
@since 0.6 *)
val combine : 'a list -> 'b list -> ('a * 'b) list val combine : 'a list -> 'b list -> ('a * 'b) list
(** [combine [a1; …; an] [b1; …; bn]] is [[(a1,b1); …; (an,bn)]]. (** [combine [a1; …; an] [b1; …; bn]] is [[(a1,b1); …; (an,bn)]].
Transform two lists into a list of pairs. Transform two lists into a list of pairs.
@ -161,25 +160,17 @@ val split : ('a * 'b) t -> 'a t * 'b t
@since 1.2, but only @since 1.2, but only
@since 2.2 with labels *) @since 2.2 with labels *)
[@@@iflt 4.12]
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
(** [compare cmp l1 l2] compares the two lists [l1] and [l2] (** [compare cmp l1 l2] compares the two lists [l1] and [l2]
using the given comparison function [cmp]. *) using the given comparison function [cmp]. *)
val compare_lengths : 'a t -> 'b t -> int
(** [compare_lengths l1 l2] compare the lengths of the two lists [l1] and [l2].
Equivalent to [compare (length l1) (length l2)] but more efficient.
@since 1.5, but only
@since 2.2 with labels *)
val compare_length_with : 'a t -> int -> int
(** [compare_length_with l x] compares the length of the list [l] to an integer [x].
Equivalent to [compare (length l) x] but more efficient.
@since 1.5, but only
@since 2.2 with labels *)
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
(** [equal p l1 l2] returns [true] if [l1] and [l2] are equal. *) (** [equal p l1 l2] returns [true] if [l1] and [l2] are equal. *)
[@@@endif]
val flat_map : ('a -> 'b t) -> 'a t -> 'b t val flat_map : ('a -> 'b t) -> 'a t -> 'b t
(** [flat_map f l] maps and flattens at the same time (safe). Evaluation order is not guaranteed. *) (** [flat_map f l] maps and flattens at the same time (safe). Evaluation order is not guaranteed. *)
@ -437,26 +428,28 @@ val find_pred : ('a -> bool) -> 'a t -> 'a option
or returns [None] if no element satisfies [p]. or returns [None] if no element satisfies [p].
@since 0.11 *) @since 0.11 *)
val find_opt : ('a -> bool) -> 'a t -> 'a option
(** [find_opt p l] is the safe version of {!find}.
@since 1.5, but only
@since 2.2 with labels *)
val find_pred_exn : ('a -> bool) -> 'a t -> 'a val find_pred_exn : ('a -> bool) -> 'a t -> 'a
(** [find_pred_exn p l] is the unsafe version of {!find_pred}. (** [find_pred_exn p l] is the unsafe version of {!find_pred}.
@raise Not_found if no such element is found. @raise Not_found if no such element is found.
@since 0.11 *) @since 0.11 *)
[@@@iflt 4.10]
val find_map : ('a -> 'b option) -> 'a t -> 'b option val find_map : ('a -> 'b option) -> 'a t -> 'b option
(** [find_map f l] traverses [l], applying [f] to each element. If for (** [find_map f l] traverses [l], applying [f] to each element. If for
some element [x], [f x = Some y], then [Some y] is returned. Otherwise some element [x], [f x = Some y], then [Some y] is returned. Otherwise
the call returns [None]. the call returns [None].
@since 0.11 *) @since 0.11 *)
[@@@endif]
[@@@iflt 5.1]
val find_mapi : (int -> 'a -> 'b option) -> 'a t -> 'b option val find_mapi : (int -> 'a -> 'b option) -> 'a t -> 'b option
(** [find_mapi f l] is like {!find_map}, but also pass the index to the predicate function. (** [find_mapi f l] is like {!find_map}, but also pass the index to the predicate function.
@since 0.11 *) @since 0.11 *)
[@@@endif]
val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option
(** [find_idx p x] returns [Some (i,x)] where [x] is the [i]-th element of [l], (** [find_idx p x] returns [Some (i,x)] where [x] is the [i]-th element of [l],
and [p x] holds. Otherwise returns [None]. *) and [p x] holds. Otherwise returns [None]. *)
@ -467,11 +460,6 @@ val remove : eq:('a -> 'a -> bool) -> key:'a -> 'a t -> 'a t
@since 0.11 *) @since 0.11 *)
(* FIXME: the original CCList.mli uses ~x instead of ~key !! *) (* FIXME: the original CCList.mli uses ~x instead of ~key !! *)
val filter_map : ('a -> 'b option) -> 'a t -> 'b t
(** [filter_map f l] is the sublist of [l] containing only elements for which
[f] returns [Some e].
Map and remove elements at the same time. *)
val keep_some : 'a option t -> 'a t val keep_some : 'a option t -> 'a t
(** [keep_some l] retains only elements of the form [Some x]. (** [keep_some l] retains only elements of the form [Some x].
Like [filter_map CCFun.id]. Like [filter_map CCFun.id].
@ -574,16 +562,6 @@ val group_succ : eq:('a -> 'a -> bool) -> 'a list -> 'a list list
(** {2 Indices} *) (** {2 Indices} *)
val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t
(** [mapi f l] is like {!map}, but the function [f] is applied to the index of
the element as first argument (counting from 0), and the element
itself as second argument. *)
val iteri : (int -> 'a -> unit) -> 'a t -> unit
(** [iteri f l] is like {!val-iter}, but the function [f] is applied to the index of
the element as first argument (counting from 0), and the element
itself as second argument. *)
val iteri2 : (int -> 'a -> 'b -> unit) -> 'a t -> 'b t -> unit val iteri2 : (int -> 'a -> 'b -> unit) -> 'a t -> 'b t -> unit
(** [iteri2 f l1 l2] applies [f] to the two lists [l1] and [l2] simultaneously. (** [iteri2 f l1 l2] applies [f] to the two lists [l1] and [l2] simultaneously.
The integer passed to [f] indicates the index of element. The integer passed to [f] indicates the index of element.
@ -758,14 +736,6 @@ val assoc_opt : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> 'b option
@since 1.5, but only @since 1.5, but only
@since 2.0 with labels *) @since 2.0 with labels *)
val assq_opt : 'a -> ('a * 'b) t -> 'b option
(** [assq_opt k alist] returns [Some v] if the given key [k] is present into [alist].
Like [Assoc.assoc_opt] but use physical equality instead of structural equality
to compare keys.
Safe version of {!assq}.
@since 1.5, but only
@since 2.0 with labels *)
val mem_assoc : ?eq:('a -> 'a -> bool) -> 'a -> ('a * _) t -> bool val mem_assoc : ?eq:('a -> 'a -> bool) -> 'a -> ('a * _) t -> bool
(** [mem_assoc ?eq k alist] returns [true] iff [k] is a key in [alist]. (** [mem_assoc ?eq k alist] returns [true] iff [k] is a key in [alist].
Like [Assoc.mem]. Like [Assoc.mem].
@ -884,11 +854,6 @@ val to_iter : 'a t -> 'a iter
(** [to_iter l] returns a [iter] of the elements of the list [l]. (** [to_iter l] returns a [iter] of the elements of the list [l].
@since 2.8 *) @since 2.8 *)
val to_seq : 'a t -> 'a Seq.t
(** [to_seq l] returns a [Seq.t] of the elements of the list [l].
Renamed from [to_std_seq] since 3.0.
@since 3.0 *)
val of_iter : 'a iter -> 'a t val of_iter : 'a iter -> 'a t
(** [of_iter iter] builds a list from a given [iter]. (** [of_iter iter] builds a list from a given [iter].
In the result, elements appear in the same order as they did in the source [iter]. In the result, elements appear in the same order as they did in the source [iter].
@ -899,12 +864,6 @@ val of_seq_rev : 'a Seq.t -> 'a t
Renamed from [to_std_seq_rev] since 3.0. Renamed from [to_std_seq_rev] since 3.0.
@since 3.0 *) @since 3.0 *)
val of_seq : 'a Seq.t -> 'a t
(** [of_seq seq] builds a list from a given [Seq.t].
In the result, elements appear in the same order as they did in the source [Seq.t].
Renamed from [of_std_seq] since 3.0.
@since 3.0 *)
val to_gen : 'a t -> 'a gen val to_gen : 'a t -> 'a gen
(** [to_gen l] returns a [gen] of the elements of the list [l]. *) (** [to_gen l] returns a [gen] of the elements of the list [l]. *)

View file

@ -18,18 +18,18 @@ type 'a t = 'a list
val empty : 'a t val empty : 'a t
(** [empty] is [[]]. *) (** [empty] is [[]]. *)
[@@@iflt 5.1]
val is_empty : _ t -> bool val is_empty : _ t -> bool
(** [is_empty l] returns [true] iff [l = []]. (** [is_empty l] returns [true] iff [l = []].
@since 0.11 *) @since 0.11 *)
[@@@endif]
val map : f:('a -> 'b) -> 'a t -> 'b t val map : f:('a -> 'b) -> 'a t -> 'b t
(** [map ~f [a0; a1; …; an]] applies function [f] in turn to [[a0; a1; …; an]]. (** [map ~f [a0; a1; …; an]] applies function [f] in turn to [[a0; a1; …; an]].
Safe version of {!List.map}. *) Safe version of {!List.map}. *)
val cons : 'a -> 'a t -> 'a t
(** [cons x l] is [x::l].
@since 0.12 *)
val append : 'a t -> 'a t -> 'a t val append : 'a t -> 'a t -> 'a t
(** [append l1 l2] returns the list that is the concatenation of [l1] and [l2]. (** [append l1 l2] returns the list that is the concatenation of [l1] and [l2].
Safe version of {!List.append}. *) Safe version of {!List.append}. *)
@ -160,11 +160,6 @@ val count_true_false : f:('a -> bool) -> 'a list -> int * int
that satisfy the predicate [f], and [int2] the number of elements that do not satisfy [f]. that satisfy the predicate [f], and [int2] the number of elements that do not satisfy [f].
@since 2.4 *) @since 2.4 *)
val init : int -> f:(int -> 'a) -> 'a t
(** [init len ~f] is [f 0; f 1; …; f (len-1)].
@raise Invalid_argument if len < 0.
@since 0.6 *)
val combine : 'a list -> 'b list -> ('a * 'b) list val combine : 'a list -> 'b list -> ('a * 'b) list
(** [combine [a1; …; an] [b1; …; bn]] is [[(a1,b1); …; (an,bn)]]. (** [combine [a1; …; an] [b1; …; bn]] is [[(a1,b1); …; (an,bn)]].
Transform two lists into a list of pairs. Transform two lists into a list of pairs.
@ -194,25 +189,17 @@ val split : ('a * 'b) t -> 'a t * 'b t
@since 1.2, but only @since 1.2, but only
@since 2.2 with labels *) @since 2.2 with labels *)
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int [@@@iflt 4.12]
val compare : cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
(** [compare cmp l1 l2] compares the two lists [l1] and [l2] (** [compare cmp l1 l2] compares the two lists [l1] and [l2]
using the given comparison function [cmp]. *) using the given comparison function [cmp]. *)
val compare_lengths : 'a t -> 'b t -> int val equal : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
(** [compare_lengths l1 l2] compare the lengths of the two lists [l1] and [l2].
Equivalent to [compare (length l1) (length l2)] but more efficient.
@since 1.5, but only
@since 2.2 with labels *)
val compare_length_with : 'a t -> int -> int
(** [compare_length_with l x] compares the length of the list [l] to an integer [x].
Equivalent to [compare (length l) x] but more efficient.
@since 1.5, but only
@since 2.2 with labels *)
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
(** [equal p l1 l2] returns [true] if [l1] and [l2] are equal. *) (** [equal p l1 l2] returns [true] if [l1] and [l2] are equal. *)
[@@@endif]
val flat_map : f:('a -> 'b t) -> 'a t -> 'b t val flat_map : f:('a -> 'b t) -> 'a t -> 'b t
(** [flat_map ~f l] maps and flattens at the same time (safe). Evaluation order is not guaranteed. *) (** [flat_map ~f l] maps and flattens at the same time (safe). Evaluation order is not guaranteed. *)
@ -470,26 +457,28 @@ val find_pred : f:('a -> bool) -> 'a t -> 'a option
or returns [None] if no element satisfies [f]. or returns [None] if no element satisfies [f].
@since 0.11 *) @since 0.11 *)
val find_opt : f:('a -> bool) -> 'a t -> 'a option
(** [find_opt ~f l] is the safe version of {!find}.
@since 1.5, but only
@since 2.2 with labels *)
val find_pred_exn : f:('a -> bool) -> 'a t -> 'a val find_pred_exn : f:('a -> bool) -> 'a t -> 'a
(** [find_pred_exn ~f l] is the unsafe version of {!find_pred}. (** [find_pred_exn ~f l] is the unsafe version of {!find_pred}.
@raise Not_found if no such element is found. @raise Not_found if no such element is found.
@since 0.11 *) @since 0.11 *)
[@@@iflt 4.10]
val find_map : f:('a -> 'b option) -> 'a t -> 'b option val find_map : f:('a -> 'b option) -> 'a t -> 'b option
(** [find_map ~f l] traverses [l], applying [f] to each element. If for (** [find_map ~f l] traverses [l], applying [f] to each element. If for
some element [x], [f x = Some y], then [Some y] is returned. Otherwise some element [x], [f x = Some y], then [Some y] is returned. Otherwise
the call returns [None]. the call returns [None].
@since 0.11 *) @since 0.11 *)
[@@@endif]
[@@@iflt 5.1]
val find_mapi : f:(int -> 'a -> 'b option) -> 'a t -> 'b option val find_mapi : f:(int -> 'a -> 'b option) -> 'a t -> 'b option
(** [find_mapi ~f l] is like {!find_map}, but also pass the index to the predicate function. (** [find_mapi ~f l] is like {!find_map}, but also pass the index to the predicate function.
@since 0.11 *) @since 0.11 *)
[@@@endif]
val find_idx : f:('a -> bool) -> 'a t -> (int * 'a) option val find_idx : f:('a -> bool) -> 'a t -> (int * 'a) option
(** [find_idx ~f x] returns [Some (i,x)] where [x] is the [i]-th element of [l], (** [find_idx ~f x] returns [Some (i,x)] where [x] is the [i]-th element of [l],
and [f x] holds. Otherwise returns [None]. *) and [f x] holds. Otherwise returns [None]. *)
@ -501,11 +490,6 @@ val remove :
@since 0.11 *) @since 0.11 *)
(* FIXME: the original CCList.mli uses ~x instead of ~key !! *) (* FIXME: the original CCList.mli uses ~x instead of ~key !! *)
val filter_map : f:('a -> 'b option) -> 'a t -> 'b t
(** [filter_map ~f l] is the sublist of [l] containing only elements for which
[f] returns [Some e].
Map and remove elements at the same time. *)
val keep_some : 'a option t -> 'a t val keep_some : 'a option t -> 'a t
(** [keep_some l] retains only elements of the form [Some x]. (** [keep_some l] retains only elements of the form [Some x].
Like [filter_map CCFun.id]. Like [filter_map CCFun.id].
@ -612,16 +596,6 @@ val group_succ : eq:(('a -> 'a -> bool)[@keep_label]) -> 'a list -> 'a list list
(** {2 Indices} *) (** {2 Indices} *)
val mapi : f:(int -> 'a -> 'b) -> 'a t -> 'b t
(** [mapi ~f l] is like {!map}, but the function [f] is applied to the index of
the element as first argument (counting from 0), and the element
itself as second argument. *)
val iteri : f:(int -> 'a -> unit) -> 'a t -> unit
(** [iteri ~f l] is like {!iter}, but the function [f] is applied to the index of
the element as first argument (counting from 0), and the element
itself as second argument. *)
val iteri2 : f:(int -> 'a -> 'b -> unit) -> 'a t -> 'b t -> unit val iteri2 : f:(int -> 'a -> 'b -> unit) -> 'a t -> 'b t -> unit
(** [iteri2 ~f l1 l2] applies [f] to the two lists [l1] and [l2] simultaneously. (** [iteri2 ~f l1 l2] applies [f] to the two lists [l1] and [l2] simultaneously.
The integer passed to [f] indicates the index of element. The integer passed to [f] indicates the index of element.
@ -900,11 +874,6 @@ val to_iter : 'a t -> 'a iter
(** [to_iter l] returns a [iter] of the elements of the list [l]. (** [to_iter l] returns a [iter] of the elements of the list [l].
@since 2.8 *) @since 2.8 *)
val to_seq : 'a t -> 'a Seq.t
(** [to_seq l] returns a [Seq.t] of the elements of the list [l].
Renamed from [to_std_seq] since 3.0.
@since 3.0 *)
val of_iter : 'a iter -> 'a t val of_iter : 'a iter -> 'a t
(** [of_iter iter] builds a list from a given [iter]. (** [of_iter iter] builds a list from a given [iter].
In the result, elements appear in the same order as they did in the source [iter]. In the result, elements appear in the same order as they did in the source [iter].
@ -915,12 +884,6 @@ val of_seq_rev : 'a Seq.t -> 'a t
Renamed from [of_std_seq_rev] since 3.0. Renamed from [of_std_seq_rev] since 3.0.
@since 3.0 *) @since 3.0 *)
val of_seq : 'a Seq.t -> 'a t
(** [of_seq seq] builds a list from a given [Seq.t].
In the result, elements appear in the same order as they did in the source [Seq.t].
Renamed from [of_std_seq] since 3.0.
@since 3.0 *)
val to_gen : 'a t -> 'a gen val to_gen : 'a t -> 'a gen
(** [to_gen l] returns a [gen] of the elements of the list [l]. *) (** [to_gen l] returns a [gen] of the elements of the list [l]. *)

View file

@ -20,47 +20,6 @@ module type S = sig
and returns [default] otherwise (if [k] doesn't belong in [m]). and returns [default] otherwise (if [k] doesn't belong in [m]).
@since 0.16 *) @since 0.16 *)
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
(** [update k f m] calls [f (Some v)] if [find k m = v],
otherwise it calls [f None]. In any case, if the result is [None]
[k] is removed from [m], and if the result is [Some v'] then
[add k v' m] is returned. *)
val choose_opt : 'a t -> (key * 'a) option
(** [choose_opt m] returns one binding of the given map [m], or [None] if [m] is empty.
Safe version of {!choose}.
@since 1.5 *)
val min_binding_opt : 'a t -> (key * 'a) option
(** [min_binding_opt m] returns the smallest binding of the given map [m],
or [None] if [m] is empty.
Safe version of {!min_binding}.
@since 1.5 *)
val max_binding_opt : 'a t -> (key * 'a) option
(** [max_binding_opt m] returns the largest binding of the given map [m],
or [None] if [m] is empty.
Safe version of {!max_binding}.
@since 1.5 *)
val find_opt : key -> 'a t -> 'a option
(** [find_opt k m] returns [Some v] if the current binding of [k] in [m] is [v],
or [None] if the key [k] is not present.
Safe version of {!find}.
@since 1.5 *)
val find_first : (key -> bool) -> 'a t -> key * 'a
(** [find_first f m] where [f] is a monotonically increasing function, returns the binding of [m]
with the lowest key [k] such that [f k], or raises [Not_found] if no such key exists.
See {!Map.S.find_first}.
@since 1.5 *)
val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
(** [find_first_opt f m] where [f] is a monotonically increasing function, returns an option containing
the binding of [m] with the lowest key [k] such that [f k], or [None] if no such key exists.
Safe version of {!find_first}.
@since 1.5 *)
val merge_safe : val merge_safe :
f:(key -> [ `Left of 'a | `Right of 'b | `Both of 'a * 'b ] -> 'c option) -> f:(key -> [ `Left of 'a | `Right of 'b | `Both of 'a * 'b ] -> 'c option) ->
'a t -> 'a t ->
@ -69,24 +28,12 @@ module type S = sig
(** [merge_safe ~f a b] merges the maps [a] and [b] together. (** [merge_safe ~f a b] merges the maps [a] and [b] together.
@since 0.17 *) @since 0.17 *)
val add_seq : 'a t -> (key * 'a) Seq.t -> 'a t
(** [add_seq m seq] adds the given [Seq.t] of bindings to the map [m].
Like {!add_list}.
Renamed from [add_std_seq] since 3.0.
@since 3.0 *)
val add_seq_with : val add_seq_with :
f:(key -> 'a -> 'a -> 'a) -> 'a t -> (key * 'a) Seq.t -> 'a t f:(key -> 'a -> 'a -> 'a) -> 'a t -> (key * 'a) Seq.t -> 'a t
(** [add_seq ~f m l] adds the given seq [l] of bindings to the map [m], (** [add_seq ~f m l] adds the given seq [l] of bindings to the map [m],
using [f] to combine values that have the same key. using [f] to combine values that have the same key.
@since 3.3 *) @since 3.3 *)
val of_seq : (key * 'a) Seq.t -> 'a t
(** [of_seq seq] builds a map from the given [Seq.t] of bindings.
Like {!of_list}.
Renamed from [of_std_seq] since 3.0.
@since 3.0 *)
val of_seq_with : f:(key -> 'a -> 'a -> 'a) -> (key * 'a) Seq.t -> 'a t val of_seq_with : f:(key -> 'a -> 'a -> 'a) -> (key * 'a) Seq.t -> 'a t
(** [of_seq_with ~f l] builds a map from the given seq [l] of bindings [k_i -> v_i], (** [of_seq_with ~f l] builds a map from the given seq [l] of bindings [k_i -> v_i],
added in order using {!add}. added in order using {!add}.
@ -178,62 +125,6 @@ module Make (O : Map.OrderedType) = struct
(* backport functions from recent stdlib. (* backport functions from recent stdlib.
they will be shadowed by inclusion of [S] if present. *) they will be shadowed by inclusion of [S] if present. *)
[@@@ocaml.warning "-32"]
let union f a b =
M.merge
(fun k v1 v2 ->
match v1, v2 with
| None, None -> assert false
| None, (Some _ as r) -> r
| (Some _ as r), None -> r
| Some v1, Some v2 -> f k v1 v2)
a b
let update k f m =
let x = try f (Some (M.find k m)) with Not_found -> f None in
match x with
| None -> M.remove k m
| Some v' -> M.add k v' m
let choose_opt m = try Some (M.choose m) with Not_found -> None
let find_opt k m = try Some (M.find k m) with Not_found -> None
let max_binding_opt m = try Some (M.max_binding m) with Not_found -> None
let min_binding_opt m = try Some (M.min_binding m) with Not_found -> None
exception Find_binding_exit
let find_first_opt f m =
let res = ref None in
try
M.iter
(fun k v ->
if f k then (
res := Some (k, v);
raise Find_binding_exit
))
m;
None
with Find_binding_exit -> !res
let find_first f m =
match find_first_opt f m with
| None -> raise Not_found
| Some (k, v) -> k, v
(* linear time, must traverse the whole map… *)
let find_last_opt f m =
let res = ref None in
M.iter (fun k v -> if f k then res := Some (k, v)) m;
!res
let find_last f m =
match find_last_opt f m with
| None -> raise Not_found
| Some (k, v) -> k, v
[@@@ocaml.warning "+32"]
(* === include M. (* === include M.
This will shadow some values depending on OCaml's current version This will shadow some values depending on OCaml's current version
=== *) === *)
@ -253,11 +144,6 @@ module Make (O : Map.OrderedType) = struct
| Some v1, Some v2 -> f k (`Both (v1, v2))) | Some v1, Some v2 -> f k (`Both (v1, v2)))
a b a b
let add_seq m s =
let m = ref m in
Seq.iter (fun (k, v) -> m := add k v !m) s;
!m
let add_seq_with ~f m s = let add_seq_with ~f m s =
let combine k v = function let combine k v = function
| None -> Some v | None -> Some v
@ -265,7 +151,6 @@ module Make (O : Map.OrderedType) = struct
in in
Seq.fold_left (fun m (k, v) -> update k (combine k v) m) m s Seq.fold_left (fun m (k, v) -> update k (combine k v) m) m s
let of_seq s = add_seq empty s
let of_seq_with ~f s = add_seq_with ~f empty s let of_seq_with ~f s = add_seq_with ~f empty s
let add_iter m s = let add_iter m s =
@ -296,10 +181,20 @@ module Make (O : Map.OrderedType) = struct
in in
List.fold_left (fun m (k, v) -> update k (combine k v) m) m l List.fold_left (fun m (k, v) -> update k (combine k v) m) m l
[@@@iflt 5.1]
let of_list l = add_list empty l let of_list l = add_list empty l
[@@@endif]
let of_list_with ~f l = add_list_with ~f empty l let of_list_with ~f l = add_list_with ~f empty l
[@@@iflt 5.1]
let to_list m = fold (fun k v acc -> (k, v) :: acc) m [] let to_list m = fold (fun k v acc -> (k, v) :: acc) m []
[@@@endif]
let pp ?(pp_start = fun _ () -> ()) ?(pp_stop = fun _ () -> ()) let pp ?(pp_start = fun _ () -> ()) ?(pp_stop = fun _ () -> ())
?(pp_arrow = fun fmt () -> Format.fprintf fmt "@ -> ") ?(pp_arrow = fun fmt () -> Format.fprintf fmt "@ -> ")
?(pp_sep = fun fmt () -> Format.fprintf fmt ",@ ") pp_k pp_v fmt m = ?(pp_sep = fun fmt () -> Format.fprintf fmt ",@ ") pp_k pp_v fmt m =

View file

@ -16,6 +16,7 @@ module type OrderedType = Map.OrderedType
module type S = sig module type S = sig
include Map.S include Map.S
(** @inline *)
val get : key -> 'a t -> 'a option val get : key -> 'a t -> 'a option
(** [get k m] returns [Some v] if the current binding of [k] in [m] is [v], (** [get k m] returns [Some v] if the current binding of [k] in [m] is [v],
@ -27,47 +28,6 @@ module type S = sig
and returns [default] otherwise (if [k] doesn't belong in [m]). and returns [default] otherwise (if [k] doesn't belong in [m]).
@since 0.16 *) @since 0.16 *)
val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
(** [update k f m] calls [f (Some v)] if [find k m = v],
otherwise it calls [f None]. In any case, if the result is [None]
[k] is removed from [m], and if the result is [Some v'] then
[add k v' m] is returned. *)
val choose_opt : 'a t -> (key * 'a) option
(** [choose_opt m] returns one binding of the given map [m], or [None] if [m] is empty.
Safe version of {!choose}.
@since 1.5 *)
val min_binding_opt : 'a t -> (key * 'a) option
(** [min_binding_opt m] returns the smallest binding of the given map [m],
or [None] if [m] is empty.
Safe version of {!min_binding}.
@since 1.5 *)
val max_binding_opt : 'a t -> (key * 'a) option
(** [max_binding_opt m] returns the largest binding of the given map [m],
or [None] if [m] is empty.
Safe version of {!max_binding}.
@since 1.5 *)
val find_opt : key -> 'a t -> 'a option
(** [find_opt k m] returns [Some v] if the current binding of [k] in [m] is [v],
or [None] if the key [k] is not present.
Safe version of {!find}.
@since 1.5 *)
val find_first : (key -> bool) -> 'a t -> key * 'a
(** [find_first f m] where [f] is a monotonically increasing function, returns the binding of [m]
with the lowest key [k] such that [f k], or raises [Not_found] if no such key exists.
See {!Map.S.find_first}.
@since 1.5 *)
val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option
(** [find_first_opt f m] where [f] is a monotonically increasing function, returns an option containing
the binding of [m] with the lowest key [k] such that [f k], or [None] if no such key exists.
Safe version of {!find_first}.
@since 1.5 *)
val merge_safe : val merge_safe :
f:(key -> [ `Left of 'a | `Right of 'b | `Both of 'a * 'b ] -> 'c option) -> f:(key -> [ `Left of 'a | `Right of 'b | `Both of 'a * 'b ] -> 'c option) ->
'a t -> 'a t ->
@ -76,12 +36,6 @@ module type S = sig
(** [merge_safe ~f a b] merges the maps [a] and [b] together. (** [merge_safe ~f a b] merges the maps [a] and [b] together.
@since 0.17 *) @since 0.17 *)
val add_seq : 'a t -> (key * 'a) Seq.t -> 'a t
(** [add_seq m seq] adds the given [Seq.t] of bindings to the map [m].
Like {!add_list}.
Renamed from [add_std_seq] since 3.0.
@since 3.0 *)
val add_seq_with : val add_seq_with :
f:(key -> 'a -> 'a -> 'a) -> 'a t -> (key * 'a) Seq.t -> 'a t f:(key -> 'a -> 'a -> 'a) -> 'a t -> (key * 'a) Seq.t -> 'a t
(** [add_seq ~f m l] adds the given seq [l] of bindings to the map [m], (** [add_seq ~f m l] adds the given seq [l] of bindings to the map [m],
@ -91,12 +45,6 @@ module type S = sig
later in the seq than [v2]. later in the seq than [v2].
@since 3.3 *) @since 3.3 *)
val of_seq : (key * 'a) Seq.t -> 'a t
(** [of_seq seq] builds a map from the given [Seq.t] of bindings.
Like {!of_list}.
Renamed from [of_std_seq] since 3.0.
@since 3.0 *)
val of_seq_with : f:(key -> 'a -> 'a -> 'a) -> (key * 'a) Seq.t -> 'a t val of_seq_with : f:(key -> 'a -> 'a -> 'a) -> (key * 'a) Seq.t -> 'a t
(** [of_seq_with ~f l] builds a map from the given seq [l] of bindings [k_i -> v_i], (** [of_seq_with ~f l] builds a map from the given seq [l] of bindings [k_i -> v_i],
added in order using {!add}. added in order using {!add}.

View file

@ -2,8 +2,13 @@
include Nativeint include Nativeint
[@@@iflt 4.13]
let min : t -> t -> t = Stdlib.min let min : t -> t -> t = Stdlib.min
let max : t -> t -> t = Stdlib.max let max : t -> t -> t = Stdlib.max
[@@@endif]
let hash x = Stdlib.abs (to_int x) let hash x = Stdlib.abs (to_int x)
let sign i = compare i zero let sign i = compare i zero
@ -95,8 +100,7 @@ let random_range i j st = add i (random (sub j i) st)
(** {2 Conversion} *) (** {2 Conversion} *)
let of_string_exn = of_string let of_string_exn = of_string
let of_string x = try Some (of_string_exn x) with Failure _ -> None let of_string = of_string_opt
let of_string_opt = of_string
let most_significant_bit = logxor (neg 1n) (shift_right_logical (neg 1n) 1) let most_significant_bit = logxor (neg 1n) (shift_right_logical (neg 1n) 1)
type output = char -> unit type output = char -> unit

View file

@ -2,14 +2,14 @@
(** Helpers for processor-native integers (** Helpers for processor-native integers
This module provides operations on the type [nativeint] of signed 32-bit integers This module provides operations on the type [nativeint] of signed 32-bit integers
(on 32-bit platforms) or signed 64-bit integers (on 64-bit platforms). (on 32-bit platforms) or signed 64-bit integers (on 64-bit platforms).
This integer type has exactly the same width as that of a pointer type in the C compiler. This integer type has exactly the same width as that of a pointer type in the C compiler.
All arithmetic operations over nativeint are taken modulo 2{^32} or 2{^64} depending All arithmetic operations over nativeint are taken modulo 2{^32} or 2{^64} depending
on the word size of the architecture. on the word size of the architecture.
Performance notice: values of type [nativeint] occupy more memory space than values of type [int], Performance notice: values of type [nativeint] occupy more memory space than values of type [int],
and arithmetic operations on [nativeint] are generally slower than those on [int]. and arithmetic operations on [nativeint] are generally slower than those on [int].
Use [nativeint] only when the application requires the extra bit of precision over the [int] type. Use [nativeint] only when the application requires the extra bit of precision over the [int] type.
@since 2.1 *) @since 2.1 *)
@ -18,6 +18,7 @@
include module type of struct include module type of struct
include Nativeint include Nativeint
end end
(** @inline *)
val min : t -> t -> t val min : t -> t -> t
(** [min x y] returns the minimum of the two integers [x] and [y]. (** [min x y] returns the minimum of the two integers [x] and [y].
@ -117,7 +118,7 @@ val pp_binary : t printer
module Infix : sig module Infix : sig
val ( + ) : t -> t -> t val ( + ) : t -> t -> t
(** [x + y] is the sum of [x] and [y]. (** [x + y] is the sum of [x] and [y].
Addition. *) Addition. *)
val ( - ) : t -> t -> t val ( - ) : t -> t -> t

View file

@ -2,11 +2,7 @@
(** {1 Options} *) (** {1 Options} *)
type 'a t = 'a option include Option
let[@inline] map f = function
| None -> None
| Some x -> Some (f x)
let map_or ~default f = function let map_or ~default f = function
| None -> default | None -> default
@ -16,30 +12,7 @@ let map_lazy default_fn f = function
| None -> default_fn () | None -> default_fn ()
| Some x -> f x | Some x -> f x
let is_some = function
| None -> false
| Some _ -> true
let is_none = function
| None -> true
| Some _ -> false
let compare f o1 o2 =
match o1, o2 with
| None, None -> 0
| Some _, None -> 1
| None, Some _ -> -1
| Some x, Some y -> f x y
let equal f o1 o2 =
match o1, o2 with
| None, None -> true
| Some _, None | None, Some _ -> false
| Some x, Some y -> f x y
let return x = Some x let return x = Some x
let some = return
let none = None
let[@inline] flat_map f o = let[@inline] flat_map f o =
match o with match o with
@ -51,7 +24,6 @@ let[@inline] flat_map_l f o =
| None -> [] | None -> []
| Some x -> f x | Some x -> f x
let[@inline] bind o f = flat_map f o
let ( >>= ) = bind let ( >>= ) = bind
let pure x = Some x let pure x = Some x
let k_compose f g x = f x |> flat_map g let k_compose f g x = f x |> flat_map g
@ -99,11 +71,6 @@ let for_all p = function
| None -> true | None -> true
| Some x -> p x | Some x -> p x
let iter f o =
match o with
| None -> ()
| Some x -> f x
let fold f acc o = let fold f acc o =
match o with match o with
| None -> acc | None -> acc
@ -121,11 +88,6 @@ let apply_or f x =
let ( |?> ) x f = apply_or f x let ( |?> ) x f = apply_or f x
let value x ~default =
match x with
| None -> default
| Some y -> y
let get_exn = function let get_exn = function
| Some x -> x | Some x -> x
| None -> invalid_arg "CCOption.get_exn" | None -> invalid_arg "CCOption.get_exn"
@ -164,11 +126,6 @@ let wrap2 ?(handler = fun _ -> true) f x y =
else else
raise e raise e
let to_list o =
match o with
| None -> []
| Some x -> [ x ]
let of_list = function let of_list = function
| x :: _ -> Some x | x :: _ -> Some x
| [] -> None | [] -> None
@ -254,11 +211,6 @@ let to_iter o k =
| None -> () | None -> ()
| Some x -> k x | Some x -> k x
let to_seq o () =
match o with
| None -> Seq.Nil
| Some x -> Seq.Cons (x, Seq.empty)
let pp ppx out = function let pp ppx out = function
| None -> Format.pp_print_string out "None" | None -> Format.pp_print_string out "None"
| Some x -> Format.fprintf out "@[Some %a@]" ppx x | Some x -> Format.fprintf out "@[Some %a@]" ppx x

View file

@ -5,10 +5,8 @@
This module replaces `CCOpt`. This module replaces `CCOpt`.
@since 3.6 *) @since 3.6 *)
type +'a t = 'a option include module type of Option
(** @inline *)
val map : ('a -> 'b) -> 'a t -> 'b t
(** [map f o] applies the function [f] to the element inside [o], if any. *)
val map_or : default:'b -> ('a -> 'b) -> 'a t -> 'b val map_or : default:'b -> ('a -> 'b) -> 'a t -> 'b
(** [map_or ~default f o] is [f x] if [o = Some x], [default] otherwise. (** [map_or ~default f o] is [f x] if [o = Some x], [default] otherwise.
@ -18,33 +16,9 @@ val map_lazy : (unit -> 'b) -> ('a -> 'b) -> 'a t -> 'b
(** [map_lazy default_fn f o] is [f x] if [o = Some x], [default_fn ()] otherwise. (** [map_lazy default_fn f o] is [f x] if [o = Some x], [default_fn ()] otherwise.
@since 1.2 *) @since 1.2 *)
val is_some : _ t -> bool
(** [is_some (Some x)] returns [true] otherwise it returns [false]. *)
val is_none : _ t -> bool
(** [is_none None] returns [true] otherwise it returns [false].
@since 0.11 *)
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
(** [compare comp o1 o2] compares two options [o1] and [o2],
using custom comparators [comp] for the value.
[None] is always assumed to be less than [Some _]. *)
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
(** [equal p o1 o2] tests for equality between option types [o1] and [o2],
using a custom equality predicate [p]. *)
val return : 'a -> 'a t val return : 'a -> 'a t
(** [return x] is a monadic return, that is [return x = Some x]. *) (** [return x] is a monadic return, that is [return x = Some x]. *)
val some : 'a -> 'a t
(** Alias to {!return}.
@since 3.5 *)
val none : 'a t
(** Alias to {!None}.
@since 3.5 *)
val flat_map : ('a -> 'b t) -> 'a t -> 'b t val flat_map : ('a -> 'b t) -> 'a t -> 'b t
(** [flat_map f o] is equivalent to {!map} followed by {!flatten}. (** [flat_map f o] is equivalent to {!map} followed by {!flatten}.
Flip version of {!(>>=)}. *) Flip version of {!(>>=)}. *)
@ -53,11 +27,6 @@ val flat_map_l : ('a -> 'b list) -> 'a t -> 'b list
(** [flat_map_l f o] is [[]] if [o] is [None], or [f x] if [o] is [Some x]. (** [flat_map_l f o] is [[]] if [o] is [None], or [f x] if [o] is [Some x].
@since 3.12 *) @since 3.12 *)
val bind : 'a t -> ('a -> 'b t) -> 'b t
(** [bind o f] is [f v] if [o] is [Some v], [None] otherwise.
Monadic bind.
@since 3.0 *)
val k_compose : ('a -> 'b t) -> ('b -> 'c t) -> 'a -> 'c t val k_compose : ('a -> 'b t) -> ('b -> 'c t) -> 'a -> 'c t
(** Kleisli composition. Monadic equivalent of {!CCFun.compose} (** Kleisli composition. Monadic equivalent of {!CCFun.compose}
@since 3.13.1 *) @since 3.13.1 *)
@ -65,9 +34,6 @@ val k_compose : ('a -> 'b t) -> ('b -> 'c t) -> 'a -> 'c t
val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** [map2 f o1 o2] maps ['a option] and ['b option] to a ['c option] using [f]. *) (** [map2 f o1 o2] maps ['a option] and ['b option] to a ['c option] using [f]. *)
val iter : ('a -> unit) -> 'a t -> unit
(** [iter f o] applies [f] to [o]. Iterate on 0 or 1 element. *)
val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
(** [fold f init o] is [f init x] if [o] is [Some x], or [init] if [o] is [None]. (** [fold f init o] is [f init x] if [o] is [Some x], or [init] if [o] is [None].
Fold on 0 or 1 element. *) Fold on 0 or 1 element. *)
@ -102,10 +68,6 @@ val apply_or : ('a -> 'a t) -> 'a -> 'a
turning functions like "remove" into "remove_if_it_exists". turning functions like "remove" into "remove_if_it_exists".
@since 3.13.1 *) @since 3.13.1 *)
val value : 'a t -> default:'a -> 'a
(** [value o ~default] is similar to the Stdlib's [Option.value] and to {!get_or}.
@since 2.8 *)
val get_exn : 'a t -> 'a val get_exn : 'a t -> 'a
[@@ocaml.deprecated "use CCOption.get_exn_or instead"] [@@ocaml.deprecated "use CCOption.get_exn_or instead"]
(** [get_exn o] returns [x] if [o] is [Some x] or fails if [o] is [None]. (** [get_exn o] returns [x] if [o] is [Some x] or fails if [o] is [None].
@ -207,9 +169,6 @@ include module type of Infix
(** {2 Conversion and IO} *) (** {2 Conversion and IO} *)
val to_list : 'a t -> 'a list
(** [to_list o] returns [[x]] if [o] is [Some x] or the empty list [[]] if [o] is [None]. *)
val of_list : 'a list -> 'a t val of_list : 'a list -> 'a t
(** [of_list l] returns [Some x] (x being the head of the list l), or [None] if [l] is the empty list. *) (** [of_list l] returns [Some x] (x being the head of the list l), or [None] if [l] is the empty list. *)
@ -246,13 +205,6 @@ val to_gen : 'a t -> 'a gen
(** [to_gen o] is [o] as a [gen]. [Some x] is the singleton [gen] containing [x] (** [to_gen o] is [o] as a [gen]. [Some x] is the singleton [gen] containing [x]
and [None] is the empty [gen]. *) and [None] is the empty [gen]. *)
val to_seq : 'a t -> 'a Seq.t
(** [to_seq o] is [o] as a sequence [Seq.t]. [Some x] is the singleton sequence containing [x]
and [None] is the empty sequence.
Same as {!Stdlib.Option.to_seq}
Renamed from [to_std_seq] since 3.0.
@since 3.0 *)
val to_iter : 'a t -> 'a iter val to_iter : 'a t -> 'a iter
(** [to_iter o] returns an internal iterator, like in the library [Iter]. (** [to_iter o] returns an internal iterator, like in the library [Iter].
@since 2.8 *) @since 2.8 *)

View file

@ -2,27 +2,53 @@
(** {1 Tuple Functions} *) (** {1 Tuple Functions} *)
[@@@ifge 5.4]
include Pair
[@@@else_]
type ('a, 'b) t = 'a * 'b type ('a, 'b) t = 'a * 'b
let make x y = x, y let make x y = x, y
let fst = fst
let snd = snd
let swap (x, y) = y, x
let map_fst f (x, y) = f x, y let map_fst f (x, y) = f x, y
let map_snd f (x, y) = x, f y let map_snd f (x, y) = x, f y
let map f g (x, y) = f x, g y let map f g (x, y) = f x, g y
[@@@endif]
let map_same f (x, y) = f x, f y let map_same f (x, y) = f x, f y
let map2 f g (a, b) (x, y) = f a x, g b y let map2 f g (a, b) (x, y) = f a x, g b y
let map_same2 f (a, b) (x, y) = f a x, f b y let map_same2 f (a, b) (x, y) = f a x, f b y
let fst_map f (x, _) = f x let fst_map f (x, _) = f x
let snd_map f (_, x) = f x let snd_map f (_, x) = f x
[@@@iflt 5.4]
let iter f (x, y) = f x y let iter f (x, y) = f x y
let swap (x, y) = y, x
[@@@endif]
let ( <<< ) = map_fst let ( <<< ) = map_fst
let ( >>> ) = map_snd let ( >>> ) = map_snd
let ( *** ) = map let ( *** ) = map
let ( &&& ) f g x = f x, g x let ( &&& ) f g x = f x, g x
let merge f (x, y) = f x y let merge f (x, y) = f x y
[@@@iflt 5.4]
let fold = merge let fold = merge
[@@@endif]
let dup x = x, x let dup x = x, x
let dup_map f x = x, f x let dup_map f x = x, f x
[@@@iflt 5.4]
let equal f g (x1, y1) (x2, y2) = f x1 x2 && g y1 y2 let equal f g (x1, y1) (x2, y2) = f x1 x2 && g y1 y2
let compare f g (x1, y1) (x2, y2) = let compare f g (x1, y1) (x2, y2) =
@ -32,6 +58,8 @@ let compare f g (x1, y1) (x2, y2) =
else else
g y1 y2 g y1 y2
[@@@endif]
let to_string ?(sep = ", ") a_to_string b_to_string (x, y) = let to_string ?(sep = ", ") a_to_string b_to_string (x, y) =
Printf.sprintf "%s%s%s" (a_to_string x) sep (b_to_string y) Printf.sprintf "%s%s%s" (a_to_string x) sep (b_to_string y)

View file

@ -2,12 +2,28 @@
(** Tuple Functions *) (** Tuple Functions *)
[@@@ifge 5.4]
include module type of Pair
(** @inline *)
[@@@else_]
type ('a, 'b) t = 'a * 'b type ('a, 'b) t = 'a * 'b
val make : 'a -> 'b -> ('a, 'b) t val make : 'a -> 'b -> ('a, 'b) t
(** Make a tuple from its components. (** Make a tuple from its components.
@since 0.16 *) @since 0.16 *)
val fst : 'a * 'b -> 'a
(** [fst (a, b)] returns [a] *)
val snd : 'a * 'b -> 'b
(** [snd (a, b)] returns [b] *)
val swap : 'a * 'b -> 'b * 'a
(** Swap the components of the tuple. *)
val map_fst : ('a -> 'b) -> 'a * 'c -> 'b * 'c val map_fst : ('a -> 'b) -> 'a * 'c -> 'b * 'c
(** [map_fst f (x, y)] returns [(f x, y)]. (** [map_fst f (x, y)] returns [(f x, y)].
Renamed from [map1] since 3.0. *) Renamed from [map1] since 3.0. *)
@ -19,6 +35,8 @@ val map_snd : ('a -> 'b) -> 'c * 'a -> 'c * 'b
val map : ('a -> 'c) -> ('b -> 'd) -> 'a * 'b -> 'c * 'd val map : ('a -> 'c) -> ('b -> 'd) -> 'a * 'b -> 'c * 'd
(** Synonym to {!( *** )}. Map on both sides of a tuple. *) (** Synonym to {!( *** )}. Map on both sides of a tuple. *)
[@@@endif]
val map_same : ('a -> 'b) -> 'a * 'a -> 'b * 'b val map_same : ('a -> 'b) -> 'a * 'a -> 'b * 'b
(** Like {!map} but specialized for pairs with elements of the same type. *) (** Like {!map} but specialized for pairs with elements of the same type. *)
@ -45,10 +63,11 @@ val snd_map : ('a -> 'b) -> _ * 'a -> 'b
Rename from [map_snd] since 3.0. Rename from [map_snd] since 3.0.
@since 0.3.3 *) @since 0.3.3 *)
[@@@iflt 5.4]
val iter : ('a -> 'b -> unit) -> 'a * 'b -> unit val iter : ('a -> 'b -> unit) -> 'a * 'b -> unit
val swap : 'a * 'b -> 'b * 'a [@@@endif]
(** Swap the components of the tuple. *)
val ( <<< ) : ('a -> 'b) -> 'a * 'c -> 'b * 'c val ( <<< ) : ('a -> 'b) -> 'a * 'c -> 'b * 'c
(** Map on the left side of the tuple. *) (** Map on the left side of the tuple. *)
@ -66,10 +85,14 @@ val ( &&& ) : ('a -> 'b) -> ('a -> 'c) -> 'a -> 'b * 'c
val merge : ('a -> 'b -> 'c) -> 'a * 'b -> 'c val merge : ('a -> 'b -> 'c) -> 'a * 'b -> 'c
(** Uncurrying (merges the two components of a tuple). *) (** Uncurrying (merges the two components of a tuple). *)
[@@@iflt 5.4]
val fold : ('a -> 'b -> 'c) -> 'a * 'b -> 'c val fold : ('a -> 'b -> 'c) -> 'a * 'b -> 'c
(** Synonym to {!merge}. (** Synonym to {!merge}.
@since 0.3.3 *) @since 0.3.3 *)
[@@@endif]
val dup : 'a -> 'a * 'a val dup : 'a -> 'a * 'a
(** [dup x = (x,x)] (duplicate the value). (** [dup x = (x,x)] (duplicate the value).
@since 0.3.3 *) @since 0.3.3 *)
@ -79,12 +102,16 @@ val dup_map : ('a -> 'b) -> 'a -> 'a * 'b
to the second copy. to the second copy.
@since 0.3.3 *) @since 0.3.3 *)
[@@@iflt 5.4]
val equal : val equal :
('a -> 'a -> bool) -> ('b -> 'b -> bool) -> 'a * 'b -> 'a * 'b -> bool ('a -> 'a -> bool) -> ('b -> 'b -> bool) -> 'a * 'b -> 'a * 'b -> bool
val compare : val compare :
('a -> 'a -> int) -> ('b -> 'b -> int) -> 'a * 'b -> 'a * 'b -> int ('a -> 'a -> int) -> ('b -> 'b -> int) -> 'a * 'b -> 'a * 'b -> int
[@@@endif]
val to_string : val to_string :
?sep:string -> ('a -> string) -> ('b -> string) -> 'a * 'b -> string ?sep:string -> ('a -> string) -> ('b -> string) -> 'a * 'b -> string
(** Print tuple in a string (** Print tuple in a string

View file

@ -9,13 +9,7 @@ type 'a printer = Format.formatter -> 'a -> unit
(** {2 Basics} *) (** {2 Basics} *)
type nonrec (+'good, +'bad) result = ('good, 'bad) result = include Result
| Ok of 'good
| Error of 'bad
type (+'good, +'bad) t = ('good, 'bad) result =
| Ok of 'good
| Error of 'bad
let return x = Ok x let return x = Ok x
let fail s = Error s let fail s = Error s
@ -65,30 +59,14 @@ let opt_map f e =
| Ok x -> Ok (Some x) | Ok x -> Ok (Some x)
| Error e -> Error e) | Error e -> Error e)
let map f e = let map_err = map_error
match e with
| Ok x -> Ok (f x)
| Error s -> Error s
let map_err f e =
match e with
| Ok _ as res -> res
| Error y -> Error (f y)
let map2 f g e = let map2 f g e =
match e with match e with
| Ok x -> Ok (f x) | Ok x -> Ok (f x)
| Error s -> Error (g s) | Error s -> Error (g s)
let iter f e = let iter_err = iter_error
match e with
| Ok x -> f x
| Error _ -> ()
let iter_err f e =
match e with
| Ok _ -> ()
| Error err -> f err
exception Get_error exception Get_error
@ -132,6 +110,13 @@ let flat_map f e =
| Ok x -> f x | Ok x -> f x
| Error s -> Error s | Error s -> Error s
[@@@iflt 5.4]
let retract = function
| Ok v | Error v -> v
[@@@endif]
let k_compose f g x = f x |> flat_map g let k_compose f g x = f x |> flat_map g
let ( >=> ) = k_compose let ( >=> ) = k_compose
let ( <=< ) f g = g >=> f let ( <=< ) f g = g >=> f
@ -149,24 +134,11 @@ let compare ~err cmp a b =
| _, Ok _ -> -1 | _, Ok _ -> -1
| Error s, Error s' -> err s s' | Error s, Error s' -> err s s'
let fold ~ok ~error x =
match x with
| Ok x -> ok x
| Error s -> error s
let fold_ok f acc r = let fold_ok f acc r =
match r with match r with
| Ok x -> f acc x | Ok x -> f acc x
| Error _ -> acc | Error _ -> acc
let is_ok = function
| Ok _ -> true
| Error _ -> false
let is_error = function
| Ok _ -> false
| Error _ -> true
(** {2 Wrappers} *) (** {2 Wrappers} *)
let guard f = try Ok (f ()) with e -> Error e let guard f = try Ok (f ()) with e -> Error e
@ -185,18 +157,18 @@ let ( <*> ) f x =
| Error s -> fail s | Error s -> fail s
| Ok f -> map f x | Ok f -> map f x
let join t = [@@@iflt 5.4]
match t with
| Ok (Ok o) -> Ok o
| Ok (Error e) -> Error e
| Error _ as e -> e
let both x y = let product x y =
match x, y with match x, y with
| Ok o, Ok o' -> Ok (o, o') | Ok o, Ok o' -> Ok (o, o')
| Ok _, Error e -> Error e | Ok _, Error e -> Error e
| Error e, _ -> Error e | Error e, _ -> Error e
[@@@endif]
let both = product
(** {2 Collections} *) (** {2 Collections} *)
let map_l f l = let map_l f l =
@ -331,19 +303,12 @@ end
(** {2 Conversions} *) (** {2 Conversions} *)
let to_opt = function let to_opt = to_option
| Ok x -> Some x
| Error _ -> None
let of_opt = function let of_opt = function
| None -> Error "of_opt" | None -> Error "of_opt"
| Some x -> Ok x | Some x -> Ok x
let to_seq e () =
match e with
| Ok x -> Seq.Cons (x, Seq.empty)
| Error _ -> Seq.Nil
let to_iter e k = let to_iter e k =
match e with match e with
| Ok x -> k x | Ok x -> k x

View file

@ -16,13 +16,8 @@ type 'a printer = Format.formatter -> 'a -> unit
(** {2 Basics} *) (** {2 Basics} *)
type nonrec (+'good, +'bad) result = ('good, 'bad) result = include module type of Result
| Ok of 'good (** @inline *)
| Error of 'bad
type (+'good, +'bad) t = ('good, 'bad) result =
| Ok of 'good
| Error of 'bad
val return : 'a -> ('a, 'err) t val return : 'a -> ('a, 'err) t
(** Successfully return a value. *) (** Successfully return a value. *)
@ -68,22 +63,15 @@ val opt_map : ('a -> ('b, 'c) t) -> 'a option -> ('b option, 'c) t
(** Map a fallible operation through an option. (** Map a fallible operation through an option.
@since 3.7 *) @since 3.7 *)
val map : ('a -> 'b) -> ('a, 'err) t -> ('b, 'err) t
(** Map on success. *)
val map_err : ('err1 -> 'err2) -> ('a, 'err1) t -> ('a, 'err2) t val map_err : ('err1 -> 'err2) -> ('a, 'err1) t -> ('a, 'err2) t
(** Map on the error variant. *) (** Alias of [map_error] *)
val map2 : ('a -> 'b) -> ('err1 -> 'err2) -> ('a, 'err1) t -> ('b, 'err2) t val map2 : ('a -> 'b) -> ('err1 -> 'err2) -> ('a, 'err1) t -> ('b, 'err2) t
(** Like {!map}, but also with a function that can transform (** Like {!map}, but also with a function that can transform
the error message in case of failure. *) the error message in case of failure. *)
val iter : ('a -> unit) -> ('a, _) t -> unit
(** Apply the function only in case of [Ok]. *)
val iter_err : ('err -> unit) -> (_, 'err) t -> unit val iter_err : ('err -> unit) -> (_, 'err) t -> unit
(** Apply the function in case of [Error]. (** Alias of {!iter_error} *)
@since 2.4 *)
exception Get_error exception Get_error
@ -120,6 +108,13 @@ val catch : ('a, 'err) t -> ok:('a -> 'b) -> err:('err -> 'b) -> 'b
val flat_map : ('a -> ('b, 'err) t) -> ('a, 'err) t -> ('b, 'err) t val flat_map : ('a -> ('b, 'err) t) -> ('a, 'err) t -> ('b, 'err) t
[@@@iflt 5.4]
val retract : ('a, 'a) t -> 'a
(** [retract r] collapse [r] to [v] if [r] is either [Ok v] or [Error v]. *)
[@@@endif]
val k_compose : val k_compose :
('a -> ('b, 'err) t) -> ('b -> ('c, 'err) t) -> 'a -> ('c, 'err) t ('a -> ('b, 'err) t) -> ('b -> ('c, 'err) t) -> 'a -> ('c, 'err) t
(** Kleisli composition. Monadic equivalent of {!CCFun.compose}. (** Kleisli composition. Monadic equivalent of {!CCFun.compose}.
@ -128,23 +123,11 @@ val k_compose :
val equal : err:'err equal -> 'a equal -> ('a, 'err) t equal val equal : err:'err equal -> 'a equal -> ('a, 'err) t equal
val compare : err:'err ord -> 'a ord -> ('a, 'err) t ord val compare : err:'err ord -> 'a ord -> ('a, 'err) t ord
val fold : ok:('a -> 'b) -> error:('err -> 'b) -> ('a, 'err) t -> 'b
(** [fold ~ok ~error e] opens [e] and, if [e = Ok x], returns
[ok x], otherwise [e = Error s] and it returns [error s]. *)
val fold_ok : ('a -> 'b -> 'a) -> 'a -> ('b, _) t -> 'a val fold_ok : ('a -> 'b -> 'a) -> 'a -> ('b, _) t -> 'a
(** [fold_ok f acc r] will compute [f acc x] if [r=Ok x], (** [fold_ok f acc r] will compute [f acc x] if [r=Ok x],
and return [acc] otherwise, as if the result were a mere option. and return [acc] otherwise, as if the result were a mere option.
@since 1.2 *) @since 1.2 *)
val is_ok : ('a, 'err) t -> bool
(** Return true if [Ok].
@since 1.0 *)
val is_error : ('a, 'err) t -> bool
(** Return true if [Error].
@since 1.0 *)
(** {2 Wrappers} *) (** {2 Wrappers} *)
val guard : (unit -> 'a) -> ('a, exn) t val guard : (unit -> 'a) -> ('a, exn) t
@ -172,15 +155,18 @@ val wrap3 : ('a -> 'b -> 'c -> 'd) -> 'a -> 'b -> 'c -> ('d, exn) t
val pure : 'a -> ('a, 'err) t val pure : 'a -> ('a, 'err) t
(** Synonym of {!return}. *) (** Synonym of {!return}. *)
val join : (('a, 'err) t, 'err) t -> ('a, 'err) t [@@@iflt 5.4]
(** [join t], in case of success, returns [Ok o] from [Ok (Ok o)]. Otherwise,
it fails with [Error e] where [e] is the unwrapped error of [t]. *)
val both : ('a, 'err) t -> ('b, 'err) t -> ('a * 'b, 'err) t val product : ('a, 'err) t -> ('b, 'err) t -> ('a * 'b, 'err) t
(** [both a b], in case of success, returns [Ok (o, o')] with the ok values (** [product a b], in case of success, returns [Ok (o, o')] with the ok values
of [a] and [b]. Otherwise, it fails, and the error of [a] is chosen over the of [a] and [b]. Otherwise, it fails, and the error of [a] is chosen over the
error of [b] if both fail. *) error of [b] if both fail. *)
[@@@endif]
val both : ('a, 'err) t -> ('b, 'err) t -> ('a * 'b, 'err) t
(** Alias of {!product} *)
(** {2 Infix} *) (** {2 Infix} *)
module Infix : sig module Infix : sig
@ -279,7 +265,7 @@ end
(** {2 Conversions} *) (** {2 Conversions} *)
val to_opt : ('a, _) t -> 'a option val to_opt : ('a, _) t -> 'a option
(** Convert a result to an option. *) (** Alias of {!to_option} *)
val of_opt : 'a option -> ('a, string) t val of_opt : 'a option -> ('a, string) t
(** [of_opt opt] converts [Some v] to [Ok v] and [None] to [Error "of_opt"].*) (** [of_opt opt] converts [Some v] to [Ok v] and [None] to [Error "of_opt"].*)
@ -287,10 +273,6 @@ val of_opt : 'a option -> ('a, string) t
val to_iter : ('a, _) t -> 'a iter val to_iter : ('a, _) t -> 'a iter
(** @since 2.8 *) (** @since 2.8 *)
val to_seq : ('a, _) t -> 'a Seq.t
(** Renamed from [to_std_seq] since 3.0.
@since 3.0 *)
type ('a, 'b) error = type ('a, 'b) error =
[ `Ok of 'a [ `Ok of 'a
| `Error of 'b | `Error of 'b

View file

@ -9,10 +9,19 @@ type 'a printer = Format.formatter -> 'a -> unit
include Seq include Seq
let nil () = Nil let nil () = Nil
[@@@iflt 4.11]
let cons a b () = Cons (a, b) let cons a b () = Cons (a, b)
let empty = nil
[@@@endif]
[@@@iflt 5.4]
let singleton x () = Cons (x, nil) let singleton x () = Cons (x, nil)
[@@@endif]
[@@@iflt 4.11]
let init n f = let init n f =
let rec aux i () = let rec aux i () =
if i >= n then if i >= n then
@ -22,6 +31,8 @@ let init n f =
in in
aux 0 aux 0
[@@@endif]
let rec _forever x () = Cons (x, _forever x) let rec _forever x () = Cons (x, _forever x)
let rec _repeat n x () = let rec _repeat n x () =
@ -37,11 +48,15 @@ let repeat ?n x =
let rec forever f () = Cons (f (), forever f) let rec forever f () = Cons (f (), forever f)
[@@@iflt 4.14]
let is_empty l = let is_empty l =
match l () with match l () with
| Nil -> true | Nil -> true
| Cons _ -> false | Cons _ -> false
[@@@endif]
let head_exn l = let head_exn l =
match l () with match l () with
| Nil -> raise Not_found | Nil -> raise Not_found
@ -62,11 +77,15 @@ let tail l =
| Nil -> None | Nil -> None
| Cons (_, l) -> Some l | Cons (_, l) -> Some l
[@@@iflt 4.14]
let uncons l = let uncons l =
match l () with match l () with
| Nil -> None | Nil -> None
| Cons (h, t) -> Some (h, t) | Cons (h, t) -> Some (h, t)
[@@@endif]
let rec equal eq l1 l2 = let rec equal eq l1 l2 =
match l1 (), l2 () with match l1 (), l2 () with
| Nil, Nil -> true | Nil, Nil -> true
@ -100,14 +119,9 @@ let foldi f acc res =
in in
aux acc 0 res aux acc 0 res
let fold_lefti = foldi [@@@iflt 4.14]
let rec iter f l = let fold_lefti = foldi
match l () with
| Nil -> ()
| Cons (x, l') ->
f x;
iter f l'
let iteri f l = let iteri f l =
let rec aux f l i = let rec aux f l i =
@ -151,11 +165,6 @@ let rec drop_while p l () =
| Cons (x, l') when p x -> drop_while p l' () | Cons (x, l') when p x -> drop_while p l' ()
| Cons _ as res -> res | Cons _ as res -> res
let rec map f l () =
match l () with
| Nil -> Nil
| Cons (x, l') -> Cons (f x, map f l')
let mapi f l = let mapi f l =
let rec aux f l i () = let rec aux f l i () =
match l () with match l () with
@ -164,36 +173,55 @@ let mapi f l =
in in
aux f l 0 aux f l 0
let rec fmap f (l : 'a t) () = [@@@endif]
match l () with [@@@iflt 5.4]
| Nil -> Nil
| Cons (x, l') ->
(match f x with
| None -> fmap f l' ()
| Some y -> Cons (y, fmap f l'))
let rec filter p l () = let filteri f l =
match l () with let rec aux f l i () =
| Nil -> Nil match l () with
| Cons (x, l') -> | Nil -> Nil
if p x then | Cons (x, tl) ->
Cons (x, filter p l') if f i x then
else Cons (x, aux f tl (i + 1))
filter p l' () else
aux f tl (i + 1) ()
in
aux f l 0
[@@@endif]
let fmap = filter_map
[@@@iflt 4.11]
let rec append l1 l2 () = let rec append l1 l2 () =
match l1 () with match l1 () with
| Nil -> l2 () | Nil -> l2 ()
| Cons (x, l1') -> Cons (x, append l1' l2) | Cons (x, l1') -> Cons (x, append l1' l2)
let rec cycle l () = append l (cycle l) () [@@@endif]
[@@@iflt 4.14]
let rec cycle l =
if is_empty l then
l
else
fun () ->
append l (cycle l) ()
let rec iterate f a () = Cons (a, iterate f (f a)) let rec iterate f a () = Cons (a, iterate f (f a))
[@@@endif]
[@@@iflt 4.11]
let rec unfold f acc () = let rec unfold f acc () =
match f acc with match f acc with
| None -> Nil | None -> Nil
| Some (x, acc') -> Cons (x, unfold f acc') | Some (x, acc') -> Cons (x, unfold f acc')
[@@@endif]
[@@@iflt 4.14]
let rec for_all p l = let rec for_all p l =
match l () with match l () with
| Nil -> true | Nil -> true
@ -221,6 +249,35 @@ let rec find_map f l =
| None -> find_map f tl | None -> find_map f tl
| e -> e) | e -> e)
[@@@endif]
[@@@iflt 5.1]
let find_index p l =
let rec aux i l =
match l () with
| Nil -> None
| Cons (x, tl) ->
if p x then
Some i
else
aux (i + 1) tl
in
aux 0 l
let find_mapi f l =
let rec aux i l =
match l () with
| Nil -> None
| Cons (x, tl) ->
(match f i x with
| Some _ as res -> res
| None -> aux (i + 1) tl)
in
aux 0 l
[@@@endif]
[@@@iflt 5.1]
let rec scan f acc res () = let rec scan f acc res () =
Cons Cons
( acc, ( acc,
@ -229,18 +286,13 @@ let rec scan f acc res () =
| Nil -> Nil | Nil -> Nil
| Cons (s, cont) -> scan f (f acc s) cont () ) | Cons (s, cont) -> scan f (f acc s) cont () )
let rec flat_map f l () = [@@@endif]
match l () with [@@@iflt 4.13]
| Nil -> Nil
| Cons (x, l') -> _flat_map_app f (f x) l' ()
and _flat_map_app f l l' () =
match l () with
| Nil -> flat_map f l' ()
| Cons (x, tl) -> Cons (x, _flat_map_app f tl l')
let concat_map = flat_map let concat_map = flat_map
[@@@endif]
let product_with f l1 l2 = let product_with f l1 l2 =
let rec _next_left h1 tl1 h2 tl2 () = let rec _next_left h1 tl1 h2 tl2 () =
match tl1 () with match tl1 () with
@ -264,6 +316,8 @@ let product_with f l1 l2 =
in in
_next_left [] l1 [] l2 _next_left [] l1 [] l2
[@@@iflt 4.14]
let map_product = product_with let map_product = product_with
let product l1 l2 = product_with (fun x y -> x, y) l1 l2 let product l1 l2 = product_with (fun x y -> x, y) l1 l2
@ -273,6 +327,8 @@ let rec group eq l () =
| Cons (x, l') -> | Cons (x, l') ->
Cons (cons x (take_while (eq x) l'), group eq (drop_while (eq x) l')) Cons (cons x (take_while (eq x) l'), group eq (drop_while (eq x) l'))
[@@@endif]
let rec _uniq eq prev l () = let rec _uniq eq prev l () =
match prev, l () with match prev, l () with
| _, Nil -> Nil | _, Nil -> Nil
@ -285,16 +341,13 @@ let rec _uniq eq prev l () =
let uniq eq l = _uniq eq None l let uniq eq l = _uniq eq None l
let rec filter_map f l () = [@@@iflt 4.13]
match l () with
| Nil -> Nil
| Cons (x, l') ->
(match f x with
| None -> filter_map f l' ()
| Some y -> Cons (y, filter_map f l'))
let flatten l = flat_map (fun x -> x) l let concat l = flat_map (fun x -> x) l
let concat = flatten
[@@@endif]
let flatten = concat
let range i j = let range i j =
let rec aux i j () = let rec aux i j () =
@ -317,12 +370,18 @@ let ( --^ ) i j =
else else
range i (j + 1) range i (j + 1)
let rec fold2 f acc l1 l2 = [@@@iflt 4.14]
let rec fold_left2 f acc l1 l2 =
match l1 (), l2 () with match l1 (), l2 () with
| Nil, _ | _, Nil -> acc | Nil, _ | _, Nil -> acc
| Cons (x1, l1'), Cons (x2, l2') -> fold2 f (f acc x1 x2) l1' l2' | Cons (x1, l1'), Cons (x2, l2') -> fold_left2 f (f acc x1 x2) l1' l2'
let fold_left2 = fold2 [@@@endif]
let fold2 = fold_left2
[@@@iflt 4.14]
let rec map2 f l1 l2 () = let rec map2 f l1 l2 () =
match l1 (), l2 () with match l1 (), l2 () with
@ -346,17 +405,21 @@ let rec exists2 f l1 l2 =
| Nil, _ | _, Nil -> false | Nil, _ | _, Nil -> false
| Cons (x1, l1'), Cons (x2, l2') -> f x1 x2 || exists2 f l1' l2' | Cons (x1, l1'), Cons (x2, l2') -> f x1 x2 || exists2 f l1' l2'
let rec merge cmp l1 l2 () = let rec sorted_merge cmp l1 l2 () =
match l1 (), l2 () with match l1 (), l2 () with
| Nil, tl2 -> tl2 | Nil, tl2 -> tl2
| tl1, Nil -> tl1 | tl1, Nil -> tl1
| Cons (x1, l1'), Cons (x2, l2') -> | Cons (x1, l1'), Cons (x2, l2') ->
if cmp x1 x2 < 0 then if cmp x1 x2 < 0 then
Cons (x1, merge cmp l1' l2) Cons (x1, sorted_merge cmp l1' l2)
else else
Cons (x2, merge cmp l1 l2') Cons (x2, sorted_merge cmp l1 l2')
let sorted_merge = merge [@@@endif]
let merge = sorted_merge
[@@@iflt 4.14]
let rec zip a b () = let rec zip a b () =
match a (), b () with match a (), b () with
@ -377,6 +440,8 @@ let unzip l =
let split = unzip let split = unzip
[@@@endif]
let zip_i seq = let zip_i seq =
let rec loop i seq () = let rec loop i seq () =
match seq () with match seq () with
@ -387,7 +452,6 @@ let zip_i seq =
(** {2 Implementations} *) (** {2 Implementations} *)
let return x () = Cons (x, nil)
let pure = return let pure = return
let ( >>= ) xs f = flat_map f xs let ( >>= ) xs f = flat_map f xs
let ( >|= ) xs f = map f xs let ( >|= ) xs f = map f xs
@ -530,11 +594,15 @@ let rec memoize f =
(** {2 Fair Combinations} *) (** {2 Fair Combinations} *)
[@@@iflt 4.14]
let rec interleave a b () = let rec interleave a b () =
match a () with match a () with
| Nil -> b () | Nil -> b ()
| Cons (x, tail) -> Cons (x, interleave b tail) | Cons (x, tail) -> Cons (x, interleave b tail)
[@@@endif]
let rec fair_flat_map f a () = let rec fair_flat_map f a () =
match a () with match a () with
| Nil -> Nil | Nil -> Nil

View file

@ -17,38 +17,60 @@ include module type of Seq
(** @inline *) (** @inline *)
val nil : 'a t val nil : 'a t
val empty : 'a t
[@@@iflt 4.11]
val cons : 'a -> 'a t -> 'a t val cons : 'a -> 'a t -> 'a t
[@@@endif]
[@@@iflt 5.4]
val singleton : 'a -> 'a t val singleton : 'a -> 'a t
[@@@endif]
[@@@iflt 4.14]
val init : int -> (int -> 'a) -> 'a t val init : int -> (int -> 'a) -> 'a t
(** [init n f] corresponds to the sequence [f 0; f 1; ...; f (n-1)]. (** [init n f] corresponds to the sequence [f 0; f 1; ...; f (n-1)].
@raise Invalid_argument if n is negative. @raise Invalid_argument if n is negative.
@since 3.10 *) @since 3.10 *)
[@@@endif]
val repeat : ?n:int -> 'a -> 'a t val repeat : ?n:int -> 'a -> 'a t
(** [repeat ~n x] repeats [x] [n] times then stops. If [n] is omitted, (** [repeat ~n x] repeats [x] [n] times then stops. If [n] is omitted,
then [x] is repeated forever. *) then [x] is repeated forever. *)
[@@@iflt 4.14]
val forever : (unit -> 'a) -> 'a t val forever : (unit -> 'a) -> 'a t
(** [forever f] corresponds to the infinite sequence containing all the [f ()]. (** [forever f] corresponds to the infinite sequence containing all the [f ()].
@since 3.10 *) @since 3.10 *)
val cycle : 'a t -> 'a t val cycle : 'a t -> 'a t
(** Cycle through the iterator infinitely. The iterator shouldn't be empty. *) (** Cycle through the sequence infinitely. The sequence should be persistent.
@since NEXT_RELEASE the sequence can be empty, in this case cycle return an empty sequence. *)
val iterate : ('a -> 'a) -> 'a -> 'a t val iterate : ('a -> 'a) -> 'a -> 'a t
(** [iterate f a] corresponds to the infinite sequence containing [a], [f a], [f (f a)], (** [iterate f a] corresponds to the infinite sequence containing [a], [f a], [f (f a)],
... ...
@since 3.10 *) @since 3.10 *)
[@@@endif]
[@@@iflt 4.11]
val unfold : ('b -> ('a * 'b) option) -> 'b -> 'a t val unfold : ('b -> ('a * 'b) option) -> 'b -> 'a t
(** [unfold f acc] calls [f acc] and: (** [unfold f acc] calls [f acc] and:
- if [f acc = Some (x, acc')], yield [x], continue with [unfold f acc']. - if [f acc = Some (x, acc')], yield [x], continue with [unfold f acc'].
- if [f acc = None], stops. *) - if [f acc = None], stops. *)
[@@@endif]
[@@@iflt 4.14]
val is_empty : 'a t -> bool val is_empty : 'a t -> bool
(** [is_empty xs] checks in the sequence [xs] is empty *) (** [is_empty xs] checks in the sequence [xs] is empty. [is_empty] acces the first element of the sequence, this can causes issue if the sequence is ephemeral. *)
[@@@endif]
val head : 'a t -> 'a option val head : 'a t -> 'a option
(** Head of the list. *) (** Head of the list. *)
@ -64,10 +86,14 @@ val tail_exn : 'a t -> 'a t
(** Unsafe version of {!tail}. (** Unsafe version of {!tail}.
@raise Not_found if the list is empty. *) @raise Not_found if the list is empty. *)
[@@@iflt 4.14]
val uncons : 'a t -> ('a * 'a t) option val uncons : 'a t -> ('a * 'a t) option
(** [uncons xs] return [None] if [xs] is empty other (** [uncons xs] return [None] if [xs] is empty other
@since 3.10 *) @since 3.10 *)
[@@@endif]
val equal : 'a equal -> 'a t equal val equal : 'a equal -> 'a t equal
(** Equality step by step. Eager. *) (** Equality step by step. Eager. *)
@ -86,12 +112,12 @@ val foldi : ('a -> int -> 'b -> 'a) -> 'a -> 'b t -> 'a
0) and [x] is the element of the sequence. 0) and [x] is the element of the sequence.
@since 3.10 *) @since 3.10 *)
[@@@iflt 4.14]
val fold_lefti : ('a -> int -> 'b -> 'a) -> 'a -> 'b t -> 'a val fold_lefti : ('a -> int -> 'b -> 'a) -> 'a -> 'b t -> 'a
(** Alias of {!foldi}. (** Alias of {!foldi}.
@since 3.10 *) @since 3.10 *)
val iter : ('a -> unit) -> 'a t -> unit
val iteri : (int -> 'a -> unit) -> 'a t -> unit val iteri : (int -> 'a -> unit) -> 'a t -> unit
(** Iterate with index (starts at 0). *) (** Iterate with index (starts at 0). *)
@ -104,19 +130,33 @@ val take : int -> 'a t -> 'a t
val take_while : ('a -> bool) -> 'a t -> 'a t val take_while : ('a -> bool) -> 'a t -> 'a t
val drop : int -> 'a t -> 'a t val drop : int -> 'a t -> 'a t
val drop_while : ('a -> bool) -> 'a t -> 'a t val drop_while : ('a -> bool) -> 'a t -> 'a t
val map : ('a -> 'b) -> 'a t -> 'b t
val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t
(** Map with index (starts at 0). *) (** Map with index (starts at 0). *)
[@@@endif]
[@@@iflt 5.4]
val filteri : (int -> 'a -> bool) -> 'a t -> 'a t
(** Similar to {!filter} but the predicate takes aditionally the index of the elements. *)
[@@@endif]
val fmap : ('a -> 'b option) -> 'a t -> 'b t val fmap : ('a -> 'b option) -> 'a t -> 'b t
val filter : ('a -> bool) -> 'a t -> 'a t (** Alias of {!filter_map}. *)
[@@@iflt 4.11]
val append : 'a t -> 'a t -> 'a t val append : 'a t -> 'a t -> 'a t
[@@@endif]
val product_with : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t val product_with : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** Fair product of two (possibly infinite) lists into a new list. Lazy. (** Fair product of two (possibly infinite) lists into a new list. Lazy.
The first parameter is used to combine each pair of elements. *) The first parameter is used to combine each pair of elements. *)
[@@@iflt 4.14]
val map_product : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t val map_product : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** Alias of {!product_with}. (** Alias of {!product_with}.
@since 3.10 *) @since 3.10 *)
@ -129,11 +169,15 @@ val group : 'a equal -> 'a t -> 'a t t
For instance [group (=) [1;1;1;2;2;3;3;1]] yields For instance [group (=) [1;1;1;2;2;3;3;1]] yields
[[1;1;1]; [2;2]; [3;3]; [1]]. *) [[1;1;1]; [2;2]; [3;3]; [1]]. *)
[@@@endif]
val uniq : 'a equal -> 'a t -> 'a t val uniq : 'a equal -> 'a t -> 'a t
(** [uniq eq l] returns [l] but removes consecutive duplicates. Lazy. (** [uniq eq l] returns [l] but removes consecutive duplicates. Lazy.
In other words, if several values that are equal follow one another, In other words, if several values that are equal follow one another,
only the first of them is kept. *) only the first of them is kept. *)
[@@@iflt 4.14]
val for_all : ('a -> bool) -> 'a t -> bool val for_all : ('a -> bool) -> 'a t -> bool
(** [for_all p [a1; ...; an]] checks if all elements of the sequence satisfy the (** [for_all p [a1; ...; an]] checks if all elements of the sequence satisfy the
predicate [p]. That is, it returns [(p a1) && ... && (p an)] for a predicate [p]. That is, it returns [(p a1) && ... && (p an)] for a
@ -158,23 +202,37 @@ val find_map : ('a -> 'b option) -> 'a t -> 'b option
[f ai = Some _] and return [None] otherwise. [f ai = Some _] and return [None] otherwise.
@since 3.10 *) @since 3.10 *)
[@@@endif]
[@@@iflt 5.1]
val find_index : ('a -> bool) -> 'a t -> int option
(** [find_index p xs] returns [Some i], where [i] is the index of the first value of [xs] satisfying [p]. It returns [None] if no value of [xs] satifies [p]. *)
val find_mapi : (int -> 'a -> 'b option) -> 'a t -> 'b option
(** Similar to {!find_map} but the predicate take aditionnaly the index of the element. *)
[@@@endif]
[@@@iflt 4.14]
val scan : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a t val scan : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a t
(** [scan f init xs] is the sequence containing the intermediate result of (** [scan f init xs] is the sequence containing the intermediate result of
[fold f init xs]. [fold f init xs].
@since 3.10 *) @since 3.10 *)
val flat_map : ('a -> 'b t) -> 'a t -> 'b t [@@@endif]
[@@@iflt 4.13]
val concat_map : ('a -> 'b t) -> 'a t -> 'b t val concat_map : ('a -> 'b t) -> 'a t -> 'b t
(** Alias of {!flat_map} (** Alias of {!flat_map}
@since 3.10 *) @since 3.10 *)
val filter_map : ('a -> 'b option) -> 'a t -> 'b t
val flatten : 'a t t -> 'a t
val concat : 'a t t -> 'a t val concat : 'a t t -> 'a t
(** Alias of {!flatten}. (** @since 3.10 *)
@since 3.10 *)
[@@@endif]
val flatten : 'a t t -> 'a t
(** Alias of {!concat} *)
val range : int -> int -> int t val range : int -> int -> int t
@ -187,12 +245,18 @@ val ( --^ ) : int -> int -> int t
(** {2 Operations on two Collections} *) (** {2 Operations on two Collections} *)
val fold2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc [@@@iflt 4.14]
(** Fold on two collections at once. Stop as soon as one of them ends. *)
val fold_left2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc val fold_left2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc
(** Alias for {!fold2}. (** Fold on two collections at once. Stop as soon as one of them ends.
@since 3.10 *) @since 3.10 *)
[@@@endif]
val fold2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc
(** Alias for {!fold_left2}. *)
[@@@iflt 4.14]
val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** Map on two collections at once. Stop as soon as one of the (** Map on two collections at once. Stop as soon as one of the
@ -204,12 +268,19 @@ val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit
val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
val merge : 'a ord -> 'a t -> 'a t -> 'a t [@@@endif]
(** Merge two sorted iterators into a sorted iterator. *) [@@@iflt 4.14]
val sorted_merge : 'a ord -> 'a t -> 'a t -> 'a t val sorted_merge : 'a ord -> 'a t -> 'a t -> 'a t
(** Alias of {!merge}. (** Merge two sorted iterators into a sorted iterator.
@since 3.10 *) @since 3.10 *)
[@@@endif]
val merge : 'a ord -> 'a t -> 'a t -> 'a t
(** Alias of {!sorted_merge}. *)
[@@@iflt 4.14]
val zip : 'a t -> 'b t -> ('a * 'b) t val zip : 'a t -> 'b t -> ('a * 'b) t
(** Combine elements pairwise. Stop as soon as one of the lists stops. *) (** Combine elements pairwise. Stop as soon as one of the lists stops. *)
@ -221,6 +292,8 @@ val split : ('a * 'b) t -> 'a t * 'b t
(** Alias of {!unzip}. (** Alias of {!unzip}.
@since 3.10 *) @since 3.10 *)
[@@@endif]
val zip_i : 'a t -> (int * 'a) t val zip_i : 'a t -> (int * 'a) t
(** [zip_i seq] zips the index of each element with the element itself. (** [zip_i seq] zips the index of each element with the element itself.
@since 3.8 @since 3.8
@ -241,9 +314,13 @@ val memoize : 'a t -> 'a t
(** {2 Fair Combinations} *) (** {2 Fair Combinations} *)
[@@@iflt 4.14]
val interleave : 'a t -> 'a t -> 'a t val interleave : 'a t -> 'a t -> 'a t
(** Fair interleaving of both streams. *) (** Fair interleaving of both streams. *)
[@@@endif]
val fair_flat_map : ('a -> 'b t) -> 'a t -> 'b t val fair_flat_map : ('a -> 'b t) -> 'a t -> 'b t
(** Fair version of {!flat_map}. *) (** Fair version of {!flat_map}. *)
@ -252,7 +329,6 @@ val fair_app : ('a -> 'b) t -> 'a t -> 'b t
(** {2 Implementations} *) (** {2 Implementations} *)
val return : 'a -> 'a t
val pure : 'a -> 'a t val pure : 'a -> 'a t
val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t

View file

@ -10,43 +10,11 @@ module type OrderedType = Set.OrderedType
module type S = sig module type S = sig
include Set.S include Set.S
val min_elt_opt : t -> elt option
(** Safe version of {!min_elt}.
@since 1.5 *)
val max_elt_opt : t -> elt option
(** Safe version of {!max_elt}.
@since 1.5 *)
val choose_opt : t -> elt option
(** Safe version of {!choose}.
@since 1.5 *)
val find_opt : elt -> t -> elt option
(** Safe version of {!find}.
@since 1.5 *)
val find_first : (elt -> bool) -> t -> elt
(** Find minimum element satisfying predicate.
@since 1.5 *)
val find_first_opt : (elt -> bool) -> t -> elt option
(** Safe version of {!find_first}.
@since 1.5 *)
val find_first_map : (elt -> 'a option) -> t -> 'a option val find_first_map : (elt -> 'a option) -> t -> 'a option
(** [find_first_map f s] find the minimum element [x] of [s] such that [f x = Some y] (** [find_first_map f s] find the minimum element [x] of [s] such that [f x = Some y]
and return [Some y]. Otherwise returns [None]. and return [Some y]. Otherwise returns [None].
@since 3.12 *) @since 3.12 *)
val find_last : (elt -> bool) -> t -> elt
(** Find maximum element satisfying predicate.
@since 1.5 *)
val find_last_opt : (elt -> bool) -> t -> elt option
(** Safe version of {!find_last}.
@since 1.5 *)
val find_last_map : (elt -> 'a option) -> t -> 'a option val find_last_map : (elt -> 'a option) -> t -> 'a option
(** [find_last_map f s] find the maximum element [x] of [s] such that [f x = Some y] (** [find_last_map f s] find the maximum element [x] of [s] such that [f x = Some y]
and return [Some y]. Otherwise returns [None]. and return [Some y]. Otherwise returns [None].
@ -56,16 +24,9 @@ module type S = sig
(** Build a set from the given [iter] of elements. (** Build a set from the given [iter] of elements.
@since 2.8 *) @since 2.8 *)
val of_seq : elt Seq.t -> t
(** Build a set from the given [seq] of elements.
@since 3.0 *)
val add_iter : t -> elt iter -> t val add_iter : t -> elt iter -> t
(** @since 2.8 *) (** @since 2.8 *)
val add_seq : elt Seq.t -> t -> t
(** @since 3.0 *)
val to_iter : t -> elt iter val to_iter : t -> elt iter
(** [to_iter t] converts the set [t] to a [iter] of the elements. (** [to_iter t] converts the set [t] to a [iter] of the elements.
@since 2.8 *) @since 2.8 *)
@ -103,31 +64,8 @@ module Make (O : Map.OrderedType) = struct
[@@@ocaml.warning "-32"] [@@@ocaml.warning "-32"]
let find_opt x s = try Some (S.find x s) with Not_found -> None
let choose_opt s = try Some (S.choose s) with Not_found -> None
let min_elt_opt s = try Some (S.min_elt s) with Not_found -> None
let max_elt_opt s = try Some (S.max_elt s) with Not_found -> None
exception Find_binding_exit exception Find_binding_exit
let find_first_opt f m =
let res = ref None in
try
S.iter
(fun x ->
if f x then (
res := Some x;
raise Find_binding_exit
))
m;
None
with Find_binding_exit -> !res
let find_first f m =
match find_first_opt f m with
| None -> raise Not_found
| Some x -> x
let find_first_map f m = let find_first_map f m =
let res = ref None in let res = ref None in
try try
@ -142,22 +80,10 @@ module Make (O : Map.OrderedType) = struct
None None
with Find_binding_exit -> !res with Find_binding_exit -> !res
(* linear time, must traverse the whole set… *)
let find_last_opt f m =
let res = ref None in
S.iter (fun x -> if f x then res := Some x) m;
!res
let find_last f m =
match find_last_opt f m with
| None -> raise Not_found
| Some x -> x
[@@@ocaml.warning "+32"] [@@@ocaml.warning "+32"]
include S include S
(* Use find_last which is linear time on OCaml < 4.05 *)
let find_last_map f m = let find_last_map f m =
let res = ref None in let res = ref None in
let _ = let _ =
@ -172,13 +98,6 @@ module Make (O : Map.OrderedType) = struct
in in
!res !res
let add_seq seq set =
let set = ref set in
Seq.iter (fun x -> set := add x !set) seq;
!set
let of_seq s = add_seq s empty
let add_iter set i = let add_iter set i =
let set = ref set in let set = ref set in
i (fun x -> set := add x !set); i (fun x -> set := add x !set);

View file

@ -16,43 +16,11 @@ module type OrderedType = Set.OrderedType
module type S = sig module type S = sig
include Set.S include Set.S
val min_elt_opt : t -> elt option
(** Safe version of {!min_elt}.
@since 1.5 *)
val max_elt_opt : t -> elt option
(** Safe version of {!max_elt}.
@since 1.5 *)
val choose_opt : t -> elt option
(** Safe version of {!choose}.
@since 1.5 *)
val find_opt : elt -> t -> elt option
(** Safe version of {!find}.
@since 1.5 *)
val find_first : (elt -> bool) -> t -> elt
(** Find minimum element satisfying predicate.
@since 1.5 *)
val find_first_opt : (elt -> bool) -> t -> elt option
(** Safe version of {!find_first}.
@since 1.5 *)
val find_first_map : (elt -> 'a option) -> t -> 'a option val find_first_map : (elt -> 'a option) -> t -> 'a option
(** [find_first_map f s] find the minimum element [x] of [s] such that [f x = Some y] (** [find_first_map f s] find the minimum element [x] of [s] such that [f x = Some y]
and return [Some y]. Otherwise returns [None]. and return [Some y]. Otherwise returns [None].
@since 3.12 *) @since 3.12 *)
val find_last : (elt -> bool) -> t -> elt
(** Find maximum element satisfying predicate.
@since 1.5 *)
val find_last_opt : (elt -> bool) -> t -> elt option
(** Safe version of {!find_last}.
@since 1.5 *)
val find_last_map : (elt -> 'a option) -> t -> 'a option val find_last_map : (elt -> 'a option) -> t -> 'a option
(** [find_last_map f s] find the maximum element [x] of [s] such that [f x = Some y] (** [find_last_map f s] find the maximum element [x] of [s] such that [f x = Some y]
and return [Some y]. Otherwise returns [None]. and return [Some y]. Otherwise returns [None].
@ -62,16 +30,9 @@ module type S = sig
(** Build a set from the given [iter] of elements. (** Build a set from the given [iter] of elements.
@since 2.8 *) @since 2.8 *)
val of_seq : elt Seq.t -> t
(** Build a set from the given [seq] of elements.
@since 3.0 *)
val add_iter : t -> elt iter -> t val add_iter : t -> elt iter -> t
(** @since 2.8 *) (** @since 2.8 *)
val add_seq : elt Seq.t -> t -> t
(** @since 3.0 *)
val to_iter : t -> elt iter val to_iter : t -> elt iter
(** [to_iter t] converts the set [t] to a [iter] of the elements. (** [to_iter t] converts the set [t] to a [iter] of the elements.
@since 2.8 *) @since 2.8 *)

View file

@ -692,24 +692,11 @@ let of_gen g =
let to_iter s k = String.iter k s let to_iter s k = String.iter k s
let rec _to_seq s i len () =
if len = 0 then
Seq.Nil
else
Seq.Cons (s.[i], _to_seq s (i + 1) (len - 1))
let to_seq s = _to_seq s 0 (String.length s)
let of_iter i = let of_iter i =
let b = Buffer.create 32 in let b = Buffer.create 32 in
i (Buffer.add_char b); i (Buffer.add_char b);
Buffer.contents b Buffer.contents b
let of_seq seq =
let b = Buffer.create 32 in
Seq.iter (Buffer.add_char b) seq;
Buffer.contents b
let to_list s = _to_list s [] 0 (String.length s) let to_list s = _to_list s [] 0 (String.length s)
let of_list l = let of_list l =

View file

@ -49,11 +49,6 @@ val to_iter : t -> char iter
(** [to_iter s] returns the [iter] of characters contained in the string [s]. (** [to_iter s] returns the [iter] of characters contained in the string [s].
@since 2.8 *) @since 2.8 *)
val to_seq : t -> char Seq.t
(** [to_seq s] returns the [Seq.t] of characters contained in the string [s].
Renamed from [to std_seq] since 3.0.
@since 3.0 *)
val to_list : t -> char list val to_list : t -> char list
(** [to_list s] returns the [list] of characters contained in the string [s]. *) (** [to_list s] returns the [list] of characters contained in the string [s]. *)
@ -98,11 +93,6 @@ val of_iter : char iter -> string
(** [of_iter iter] converts an [iter] of characters to a string. (** [of_iter iter] converts an [iter] of characters to a string.
@since 2.8 *) @since 2.8 *)
val of_seq : char Seq.t -> string
(** [of_seq seq] converts a [seq] of characters to a string.
Renamed from [of_std_seq] since 3.0.
@since 3.0 *)
val of_list : char list -> string val of_list : char list -> string
(** [of_list lc] converts a list of characters [lc] to a string. *) (** [of_list lc] converts a list of characters [lc] to a string. *)
@ -113,7 +103,7 @@ val to_array : string -> char array
(** [to_array s] returns the array of characters contained in the string [s]. *) (** [to_array s] returns the array of characters contained in the string [s]. *)
val find : ?start:int -> sub:string -> string -> int val find : ?start:int -> sub:string -> string -> int
(** [find ~start ~sub s] returns the starting index of the first occurrence of [sub] within [s] or [-1]. (** [find ~start ~sub s] returns the starting index of the first occurrence of [sub] within [s] or [-1].
@param start starting position in [s]. *) @param start starting position in [s]. *)
val find_all : ?start:int -> sub:string -> string -> int gen val find_all : ?start:int -> sub:string -> string -> int gen
@ -472,10 +462,6 @@ module Split : sig
@since 0.16 *) @since 0.16 *)
end end
val split_on_char : char -> string -> string list
(** [split_on_char by s] splits the string [s] along the given char [by].
@since 1.2 *)
val split : by:string -> string -> string list val split : by:string -> string -> string list
(** [split ~by s] splits the string [s] along the given string [by]. (** [split ~by s] splits the string [s] along the given string [by].
Alias to {!Split.list_cpy}. Alias to {!Split.list_cpy}.

View file

@ -49,11 +49,6 @@ val to_iter : t -> char iter
(** [to_iter s] returns the [iter] of characters contained in the string [s]. (** [to_iter s] returns the [iter] of characters contained in the string [s].
@since 2.8 *) @since 2.8 *)
val to_seq : t -> char Seq.t
(** [to_seq s] returns the [Seq.t] of characters contained in the string [s].
Renamed from [to std_seq] since 3.0.
@since 3.0 *)
val to_list : t -> char list val to_list : t -> char list
(** [to_list s] returns the [list] of characters contained in the string [s]. *) (** [to_list s] returns the [list] of characters contained in the string [s]. *)
@ -103,11 +98,6 @@ val of_iter : char iter -> string
(** [of_iter iter] converts an [iter] of characters to a string. (** [of_iter iter] converts an [iter] of characters to a string.
@since 2.8 *) @since 2.8 *)
val of_seq : char Seq.t -> string
(** [of_seq seq] converts a [seq] of characters to a string.
Renamed from [of_std_seq] since 3.0.
@since 3.0 *)
val of_list : char list -> string val of_list : char list -> string
(** [of_list lc] converts a list of characters [lc] to a string. *) (** [of_list lc] converts a list of characters [lc] to a string. *)
@ -118,7 +108,7 @@ val to_array : string -> char array
(** [to_array s] returns the array of characters contained in the string [s]. *) (** [to_array s] returns the array of characters contained in the string [s]. *)
val find : ?start:int -> sub:(string[@keep_label]) -> string -> int val find : ?start:int -> sub:(string[@keep_label]) -> string -> int
(** [find ?start ~sub s] returns the starting index of the first occurrence of [sub] within [s] or [-1]. (** [find ?start ~sub s] returns the starting index of the first occurrence of [sub] within [s] or [-1].
@param start starting position in [s]. *) @param start starting position in [s]. *)
val find_all : ?start:int -> sub:(string[@keep_label]) -> string -> int gen val find_all : ?start:int -> sub:(string[@keep_label]) -> string -> int gen
@ -512,10 +502,6 @@ module Split : sig
@since 0.16 *) @since 0.16 *)
end end
val split_on_char : by:char -> string -> string list
(** [split_on_char ~by s] splits the string [s] along the given char [by].
@since 1.2 *)
val split : by:(string[@keep_label]) -> string -> string list val split : by:(string[@keep_label]) -> string -> string list
(** [split ~by s] splits the string [s] along the given string [by]. (** [split ~by s] splits the string [s] along the given string [by].
Alias to {!Split.list_cpy}. Alias to {!Split.list_cpy}.

View file

@ -3,10 +3,7 @@
(public_name containers) (public_name containers)
(wrapped false) (wrapped false)
(preprocess (preprocess
(per_module (action (run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
((action (run %{project_root}/src/core/cpp/cpp.exe %{input-file}))
CCAtomic CCList CCVector)
((pps bisect_ppx))))
(flags :standard -nolabels -open CCMonomorphic) (flags :standard -nolabels -open CCMonomorphic)
(libraries either containers.monomorphic containers.domain)) (libraries either containers.monomorphic containers.domain))

View file

@ -14,7 +14,7 @@ module Decode = struct
while !continue do while !continue do
if sl.len <= 0 then invalid_arg "out of bound"; if sl.len <= 0 then invalid_arg "out of bound";
incr n_consumed; incr n_consumed;
let b = Char.code (Bytes.get sl.bs !off) in let b = Char.code (Bytes.get sl.bs (sl.off + !off)) in
let cur = b land 0x7f in let cur = b land 0x7f in
if cur <> b then ( if cur <> b then (
(* at least one byte follows this one *) (* at least one byte follows this one *)
@ -39,7 +39,7 @@ module Decode = struct
while !continue do while !continue do
if sl.len <= 0 then invalid_arg "out of bound"; if sl.len <= 0 then invalid_arg "out of bound";
incr n_consumed; incr n_consumed;
let b = Char.code (Bytes.get sl.bs !off) in let b = Char.code (Bytes.get sl.bs (sl.off + !off)) in
let cur = b land 0x7f in let cur = b land 0x7f in
if cur <> b then ( if cur <> b then (
(* at least one byte follows this one *) (* at least one byte follows this one *)
@ -60,7 +60,7 @@ module Decode = struct
Int64.to_int v, n_consumed Int64.to_int v, n_consumed
let[@inline] decode_zigzag (v : int64) : int64 = let[@inline] decode_zigzag (v : int64) : int64 =
Int64.(logxor (shift_right v 1) (neg (logand v Int64.one))) Int64.(logxor (shift_right_logical v 1) (sub 0L (logand v 1L)))
let[@inline] i64 sl off : int64 * int = let[@inline] i64 sl off : int64 * int =
let v, n_consumed = u64 sl off in let v, n_consumed = u64 sl off in

View file

@ -15,7 +15,7 @@ true
;; ;;
q q
Q.(list_of_size Gen.(0 -- 40) printable_string) Q.(list_size Gen.(0 -- 40) string_printable)
(fun l -> (fun l ->
let l' = ref [] in let l' = ref [] in
File.with_temp ~prefix:"test_containers" ~suffix:"" (fun name -> File.with_temp ~prefix:"test_containers" ~suffix:"" (fun name ->
@ -27,7 +27,7 @@ q
;; ;;
q q
Q.(list_of_size Gen.(0 -- 40) printable_string) Q.(list_size Gen.(0 -- 40) string_printable)
(fun l -> (fun l ->
let l' = ref [] in let l' = ref [] in
File.with_temp ~prefix:"test_containers" ~suffix:"" (fun name -> File.with_temp ~prefix:"test_containers" ~suffix:"" (fun name ->
@ -39,7 +39,7 @@ q
;; ;;
q q
Q.(list_of_size Gen.(0 -- 40) printable_string) Q.(list_size Gen.(0 -- 40) string_printable)
(fun l -> (fun l ->
let s = ref "" in let s = ref "" in
File.with_temp ~prefix:"test_containers1" ~suffix:"" (fun name1 -> File.with_temp ~prefix:"test_containers1" ~suffix:"" (fun name1 ->

View file

@ -108,7 +108,7 @@ eq ~cmp:( = )
;; ;;
q q
Q.(array_of_size Gen.(0 -- 30) printable_string) Q.(array_size Gen.(0 -- 30) string_printable)
(fun a -> (fun a ->
let b = sort_indices String.compare a in let b = sort_indices String.compare a in
sorted String.compare a = Array.map (Array.get a) b) sorted String.compare a = Array.map (Array.get a) b)
@ -127,18 +127,18 @@ eq ~cmp:( = )
;; ;;
q q
Q.(array_of_size Gen.(0 -- 50) printable_string) Q.(array_size Gen.(0 -- 50) string_printable)
(fun a -> (fun a ->
let b = sort_ranking String.compare a in let b = sort_ranking String.compare a in
let a_sorted = sorted String.compare a in let a_sorted = sorted String.compare a in
a = Array.map (Array.get a_sorted) b) a = Array.map (Array.get a_sorted) b)
;; ;;
q Q.(array small_int) (fun a -> rev (rev a) = a);; q Q.(array nat_small) (fun a -> rev (rev a) = a);;
t @@ fun () -> rev [| 1; 2; 3 |] = [| 3; 2; 1 |];; t @@ fun () -> rev [| 1; 2; 3 |] = [| 3; 2; 1 |];;
t @@ fun () -> rev [| 1; 2 |] = [| 2; 1 |];; t @@ fun () -> rev [| 1; 2 |] = [| 2; 1 |];;
t @@ fun () -> rev [||] = [||];; t @@ fun () -> rev [||] = [||];;
q Q.(array small_int) (fun a -> mem 1 a = Array.mem 1 a);; q Q.(array nat_small) (fun a -> mem 1 a = Array.mem 1 a);;
eq (Some 3) (max Stdlib.compare [| 1; 2; 3 |]);; eq (Some 3) (max Stdlib.compare [| 1; 2; 3 |]);;
eq (Some 4) (max Stdlib.compare [| 4; -1; 2; 3 |]);; eq (Some 4) (max Stdlib.compare [| 4; -1; 2; 3 |]);;
eq None (max Stdlib.compare [||]);; eq None (max Stdlib.compare [||]);;
@ -217,17 +217,17 @@ t @@ fun () -> 4 -- 1 |> Array.to_list = [ 4; 3; 2; 1 ];;
t @@ fun () -> 0 -- 0 |> Array.to_list = [ 0 ];; t @@ fun () -> 0 -- 0 |> Array.to_list = [ 0 ];;
q q
Q.(pair small_int small_int) Q.(pair nat_small nat_small)
(fun (a, b) -> a -- b |> Array.to_list = CCList.(a -- b)) (fun (a, b) -> a -- b |> Array.to_list = CCList.(a -- b))
;; ;;
q q
Q.(pair small_int small_int) Q.(pair nat_small nat_small)
(fun (a, b) -> a --^ b |> Array.to_list = CCList.(a --^ b)) (fun (a, b) -> a --^ b |> Array.to_list = CCList.(a --^ b))
;; ;;
q q
Q.(pair (array small_int) (array small_int)) Q.(pair (array nat_small) (array nat_small))
(fun (a, b) -> equal ( = ) a b = equal ( = ) b a) (fun (a, b) -> equal ( = ) a b = equal ( = ) b a)
;; ;;
@ -250,7 +250,7 @@ a = [| 3; 2; 1 |]
;; ;;
q q
Q.(array_of_size Gen.(0 -- 100) small_int) Q.(array_size Gen.(0 -- 100) nat_small)
(fun a -> (fun a ->
let b = Array.copy a in let b = Array.copy a in
for i = 0 to Array.length a - 1 do for i = 0 to Array.length a - 1 do
@ -294,7 +294,7 @@ module IA = struct
type t = int array type t = int array
end end
let gen_arr = Q.Gen.(array_size (1 -- 100) small_int) let gen_arr = Q.Gen.(array_size (1 -- 100) nat_small)
let arr_arbitrary = let arr_arbitrary =
Q.make Q.make

View file

@ -25,7 +25,7 @@ let g_rand_b =
match n with match n with
| 0 -> oneof base | 0 -> oneof base
| n -> | n ->
frequency oneof_weighted
@@ List.map (fun x -> 2, x) base @@ List.map (fun x -> 2, x) base
@ [ @ [
1, list_size (0 -- 10) (self (n - 1)) >|= B.list; 1, list_size (0 -- 10) (self (n - 1)) >|= B.list;

View file

@ -59,7 +59,7 @@ let gen_op size : (_ * _) Gen.t =
else else
[] []
in in
frequency oneof_weighted
(base (base
@ [ @ [
1, return (Get_contents, size); 1, return (Get_contents, size);

View file

@ -28,7 +28,7 @@ let sexp_gen =
match n with match n with
| 0 -> atom st | 0 -> atom st
| _ -> | _ ->
frequency oneof_weighted
[ [
1, atom; 2, map mklist (list_size (0 -- 10) (self (n / 10))); 1, atom; 2, map mklist (list_size (0 -- 10) (self (n / 10)));
] ]

View file

@ -26,16 +26,16 @@ let gen_c : Cbor.t Q.Gen.t =
let+ f = float in let+ f = float in
`Float f ); `Float f );
( 2, ( 2,
let* n = frequency [ 20, 0 -- 150; 1, 151 -- 100_000 ] in let* n = oneof_weighted [ 20, 0 -- 150; 1, 151 -- 100_000 ] in
let+ s = string_size ~gen:printable (return n) in let+ s = string_size ~gen:printable (return n) in
`Text s ); `Text s );
( 2, ( 2,
let* n = frequency [ 20, 0 -- 150; 1, 151 -- 100_000 ] in let* n = oneof_weighted [ 20, 0 -- 150; 1, 151 -- 100_000 ] in
let+ s = string_size ~gen:char (return n) in let+ s = string_size ~gen:char (return n) in
`Bytes s ); `Bytes s );
] ]
in in
let g_base = frequency base in let g_base = oneof_weighted base in
let rec_ = let rec_ =
[ [
( 2, ( 2,
@ -59,7 +59,7 @@ let gen_c : Cbor.t Q.Gen.t =
`Tag (i, sub) ); `Tag (i, sub) );
] ]
in in
frequency oneof_weighted
(if size > 0 then (if size > 0 then
base @ rec_ base @ rec_
else else
@ -68,8 +68,8 @@ let gen_c : Cbor.t Q.Gen.t =
let rec shrink (c : Cbor.t) : Cbor.t Q.Iter.t = let rec shrink (c : Cbor.t) : Cbor.t Q.Iter.t =
let open Q.Iter in let open Q.Iter in
match c with match c with
| `Null | `Undefined | (`Bool false) -> empty | `Null | `Undefined | `Bool false -> empty
| (`Bool true) -> return ((`Bool false)) | `Bool true -> return (`Bool false)
| `Simple i -> | `Simple i ->
let+ i = Q.Shrink.int i in let+ i = Q.Shrink.int i in
`Simple i `Simple i
@ -123,15 +123,16 @@ let c' = Cbor.decode_exn s in
if not (eq_c c c') then if not (eq_c c c') then
Q.Test.fail_reportf "@[<hv2>roundtrip failed:@ from %a@ to %a@]" Q.Test.fail_reportf "@[<hv2>roundtrip failed:@ from %a@ to %a@]"
Cbor.pp_diagnostic c Cbor.pp_diagnostic c'; Cbor.pp_diagnostic c Cbor.pp_diagnostic c';
true;; true
;;
(* Additional edge case and error handling tests *) (* Additional edge case and error handling tests *)
(* Test basic encoding/decoding *) (* Test basic encoding/decoding *)
t @@ fun () -> Cbor.decode_exn (Cbor.encode `Null) = `Null;; t @@ fun () -> Cbor.decode_exn (Cbor.encode `Null) = `Null;;
t @@ fun () -> Cbor.decode_exn (Cbor.encode `Undefined) = `Undefined;; t @@ fun () -> Cbor.decode_exn (Cbor.encode `Undefined) = `Undefined;;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Bool true)) = (`Bool true);; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Bool true)) = `Bool true;;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Bool false)) = (`Bool false);; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Bool false)) = `Bool false;;
(* Test integer edge cases *) (* Test integer edge cases *)
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int 0L)) = `Int 0L;; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int 0L)) = `Int 0L;;
@ -141,114 +142,137 @@ t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int 255L)) = `Int 255L;;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int 256L)) = `Int 256L;; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int 256L)) = `Int 256L;;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int 65535L)) = `Int 65535L;; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int 65535L)) = `Int 65535L;;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int 65536L)) = `Int 65536L;; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int 65536L)) = `Int 65536L;;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int Int64.max_int)) = `Int Int64.max_int;;
t @@ fun () ->
Cbor.decode_exn (Cbor.encode (`Int Int64.max_int)) = `Int Int64.max_int
;;
(* Test negative integers *) (* Test negative integers *)
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int (-1L))) = `Int (-1L);; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int (-1L))) = `Int (-1L);;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int (-23L))) = `Int (-23L);; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int (-23L))) = `Int (-23L);;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int (-24L))) = `Int (-24L);; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int (-24L))) = `Int (-24L);;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int (-256L))) = `Int (-256L);; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int (-256L))) = `Int (-256L);;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int Int64.min_int)) = `Int Int64.min_int;;
t @@ fun () ->
Cbor.decode_exn (Cbor.encode (`Int Int64.min_int)) = `Int Int64.min_int
;;
(* Test floats *) (* Test floats *)
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Float 0.0)) = `Float 0.0;; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Float 0.0)) = `Float 0.0;;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Float 1.5)) = `Float 1.5;; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Float 1.5)) = `Float 1.5;;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Float (-1.5))) = `Float (-1.5);; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Float (-1.5))) = `Float (-1.5);;
t @@ fun () -> t @@ fun () ->
let result = Cbor.decode_exn (Cbor.encode (`Float infinity)) in let result = Cbor.decode_exn (Cbor.encode (`Float infinity)) in
match result with match result with
| `Float f -> classify_float f = FP_infinite && f > 0.0 | `Float f -> classify_float f = FP_infinite && f > 0.0
| _ -> false | _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
let result = Cbor.decode_exn (Cbor.encode (`Float neg_infinity)) in let result = Cbor.decode_exn (Cbor.encode (`Float neg_infinity)) in
match result with match result with
| `Float f -> classify_float f = FP_infinite && f < 0.0 | `Float f -> classify_float f = FP_infinite && f < 0.0
| _ -> false | _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
let result = Cbor.decode_exn (Cbor.encode (`Float nan)) in let result = Cbor.decode_exn (Cbor.encode (`Float nan)) in
match result with match result with
| `Float f -> classify_float f = FP_nan | `Float f -> classify_float f = FP_nan
| _ -> false | _ -> false
;; ;;
(* Test strings *) (* Test strings *)
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Text "")) = `Text "";; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Text "")) = `Text "";;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Text "hello")) = `Text "hello";; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Text "hello")) = `Text "hello";;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Text "a")) = `Text "a";; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Text "a")) = `Text "a";;
t @@ fun () -> t @@ fun () ->
let long = String.make 1000 'x' in let long = String.make 1000 'x' in
Cbor.decode_exn (Cbor.encode (`Text long)) = `Text long Cbor.decode_exn (Cbor.encode (`Text long)) = `Text long
;; ;;
(* Test UTF-8 strings *) (* Test UTF-8 strings *)
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Text "hello 世界")) = `Text "hello 世界";; t @@ fun () ->
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Text "émoji 🎉")) = `Text "émoji 🎉";; Cbor.decode_exn (Cbor.encode (`Text "hello 世界")) = `Text "hello 世界"
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Text "Здравствуй")) = `Text "Здравствуй";; ;;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Text "émoji 🎉")) = `Text "émoji 🎉"
;;
t @@ fun () ->
Cbor.decode_exn (Cbor.encode (`Text "Здравствуй")) = `Text "Здравствуй"
;;
(* Test bytes *) (* Test bytes *)
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Bytes "")) = `Bytes "";; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Bytes "")) = `Bytes "";;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Bytes "\x00\x01\x02")) = `Bytes "\x00\x01\x02";;
t @@ fun () -> t @@ fun () ->
let bytes = String.init 256 char_of_int in Cbor.decode_exn (Cbor.encode (`Bytes "\x00\x01\x02")) = `Bytes "\x00\x01\x02"
Cbor.decode_exn (Cbor.encode (`Bytes bytes)) = `Bytes bytes ;;
t @@ fun () ->
let bytes = String.init 256 char_of_int in
Cbor.decode_exn (Cbor.encode (`Bytes bytes)) = `Bytes bytes
;; ;;
(* Test arrays *) (* Test arrays *)
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Array [])) = `Array [];; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Array [])) = `Array [];;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Array [`Int 1L])) = `Array [`Int 1L];;
t @@ fun () -> t @@ fun () ->
Cbor.decode_exn (Cbor.encode (`Array [`Int 1L; `Int 2L; `Int 3L])) Cbor.decode_exn (Cbor.encode (`Array [ `Int 1L ])) = `Array [ `Int 1L ]
= `Array [`Int 1L; `Int 2L; `Int 3L]
;; ;;
t @@ fun () -> t @@ fun () ->
Cbor.decode_exn (Cbor.encode (`Array [(`Bool true); `Text "a"; `Int 42L])) Cbor.decode_exn (Cbor.encode (`Array [ `Int 1L; `Int 2L; `Int 3L ]))
= `Array [(`Bool true); `Text "a"; `Int 42L] = `Array [ `Int 1L; `Int 2L; `Int 3L ]
;;
t @@ fun () ->
Cbor.decode_exn (Cbor.encode (`Array [ `Bool true; `Text "a"; `Int 42L ]))
= `Array [ `Bool true; `Text "a"; `Int 42L ]
;; ;;
(* Test nested arrays *) (* Test nested arrays *)
t @@ fun () -> t @@ fun () ->
let nested = `Array [`Array [`Int 1L; `Int 2L]; `Array [`Int 3L]] in let nested = `Array [ `Array [ `Int 1L; `Int 2L ]; `Array [ `Int 3L ] ] in
Cbor.decode_exn (Cbor.encode nested) = nested Cbor.decode_exn (Cbor.encode nested) = nested
;; ;;
(* Test maps *) (* Test maps *)
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Map [])) = `Map [];; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Map [])) = `Map [];;
t @@ fun () -> t @@ fun () ->
Cbor.decode_exn (Cbor.encode (`Map [(`Text "key", `Int 42L)])) Cbor.decode_exn (Cbor.encode (`Map [ `Text "key", `Int 42L ]))
= `Map [(`Text "key", `Int 42L)] = `Map [ `Text "key", `Int 42L ]
;; ;;
t @@ fun () -> t @@ fun () ->
let map = `Map [ let map = `Map [ `Text "a", `Int 1L; `Text "b", `Int 2L; `Text "c", `Int 3L ] in
(`Text "a", `Int 1L); Cbor.decode_exn (Cbor.encode map) = map
(`Text "b", `Int 2L);
(`Text "c", `Int 3L)
] in
Cbor.decode_exn (Cbor.encode map) = map
;; ;;
(* Test maps with various key types *) (* Test maps with various key types *)
t @@ fun () -> t @@ fun () ->
let map = `Map [ let map = `Map [ `Int 0L, `Text "zero"; `Int 1L, `Text "one" ] in
(`Int 0L, `Text "zero"); Cbor.decode_exn (Cbor.encode map) = map
(`Int 1L, `Text "one");
] in
Cbor.decode_exn (Cbor.encode map) = map
;; ;;
(* Test tags *) (* Test tags *)
t @@ fun () -> t @@ fun () ->
Cbor.decode_exn (Cbor.encode (`Tag (0, `Text "2013-03-21"))) Cbor.decode_exn (Cbor.encode (`Tag (0, `Text "2013-03-21")))
= `Tag (0, `Text "2013-03-21") = `Tag (0, `Text "2013-03-21")
;; ;;
t @@ fun () -> t @@ fun () ->
Cbor.decode_exn (Cbor.encode (`Tag (1, `Int 1363896240L))) Cbor.decode_exn (Cbor.encode (`Tag (1, `Int 1363896240L)))
= `Tag (1, `Int 1363896240L) = `Tag (1, `Int 1363896240L)
;; ;;
t @@ fun () -> t @@ fun () ->
Cbor.decode_exn (Cbor.encode (`Tag (32, `Text "http://example.com"))) Cbor.decode_exn (Cbor.encode (`Tag (32, `Text "http://example.com")))
= `Tag (32, `Text "http://example.com") = `Tag (32, `Text "http://example.com")
;; ;;
(* Test simple values *) (* Test simple values *)
@ -258,142 +282,149 @@ t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Simple 255)) = `Simple 255;;
(* Test error cases *) (* Test error cases *)
t @@ fun () -> t @@ fun () ->
match Cbor.decode "" with match Cbor.decode "" with
| Error _ -> true | Error _ -> true
| Ok _ -> false | Ok _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
match Cbor.decode "\x1f" with (* invalid additional info *) match Cbor.decode "\x1f" with
| Error _ -> true (* invalid additional info *)
| Ok _ -> false | Error _ -> true
| Ok _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
match Cbor.decode "\x1c" with (* reserved additional info *) match Cbor.decode "\x1c" with
| Error _ -> true (* reserved additional info *)
| Ok _ -> false | Error _ -> true
| Ok _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
match Cbor.decode "\x5f\x42\x01\x02\x43\x03\x04\x05" with (* incomplete indefinite *) match Cbor.decode "\x5f\x42\x01\x02\x43\x03\x04\x05" with
| Error _ -> true (* incomplete indefinite *)
| Ok _ -> false | Error _ -> true
| Ok _ -> false
;; ;;
(* Test that decode_exn raises on invalid input *) (* Test that decode_exn raises on invalid input *)
t @@ fun () -> t @@ fun () ->
try try
ignore (Cbor.decode_exn ""); ignore (Cbor.decode_exn "");
false false
with Failure _ -> true with Failure _ -> true
;; ;;
t @@ fun () -> t @@ fun () ->
try try
ignore (Cbor.decode_exn "\x1c"); ignore (Cbor.decode_exn "\x1c");
false false
with Failure _ -> true with Failure _ -> true
;; ;;
(* Test diagnostic string output *) (* Test diagnostic string output *)
t @@ fun () -> Cbor.to_string_diagnostic `Null = "null";; t @@ fun () -> Cbor.to_string_diagnostic `Null = "null";;
t @@ fun () -> Cbor.to_string_diagnostic `Undefined = "undefined";; t @@ fun () -> Cbor.to_string_diagnostic `Undefined = "undefined";;
t @@ fun () -> Cbor.to_string_diagnostic ((`Bool true)) = "true";; t @@ fun () -> Cbor.to_string_diagnostic (`Bool true) = "true";;
t @@ fun () -> Cbor.to_string_diagnostic ((`Bool false)) = "false";; t @@ fun () -> Cbor.to_string_diagnostic (`Bool false) = "false";;
t @@ fun () -> Cbor.to_string_diagnostic (`Int 42L) = "42";; t @@ fun () -> Cbor.to_string_diagnostic (`Int 42L) = "42";;
t @@ fun () -> Cbor.to_string_diagnostic (`Int (-42L)) = "-42";; t @@ fun () -> Cbor.to_string_diagnostic (`Int (-42L)) = "-42";;
t @@ fun () -> Cbor.to_string_diagnostic (`Float 1.5) = "1.5";; t @@ fun () -> Cbor.to_string_diagnostic (`Float 1.5) = "1.5";;
t @@ fun () -> Cbor.to_string_diagnostic (`Text "hello") = "\"hello\"";; t @@ fun () -> Cbor.to_string_diagnostic (`Text "hello") = "\"hello\"";;
t @@ fun () -> Cbor.to_string_diagnostic (`Array [`Int 1L; `Int 2L]) = "[1, 2]";;
t @@ fun () -> t @@ fun () ->
Cbor.to_string_diagnostic (`Map [(`Text "a", `Int 1L)]) Cbor.to_string_diagnostic (`Array [ `Int 1L; `Int 2L ]) = "[1, 2]"
|> String.contains_s ~sub:"\"a\"" ;;
t @@ fun () ->
Cbor.to_string_diagnostic (`Map [ `Text "a", `Int 1L ])
|> CCString.mem ~sub:"\"a\""
;; ;;
(* Test deeply nested structures *) (* Test deeply nested structures *)
t @@ fun () -> t @@ fun () ->
let rec make_nested n = let rec make_nested n =
if n = 0 then `Int 0L if n = 0 then
else `Array [make_nested (n - 1)] `Int 0L
in else
let nested = make_nested 100 in `Array [ make_nested (n - 1) ]
Cbor.decode_exn (Cbor.encode nested) = nested in
let nested = make_nested 100 in
Cbor.decode_exn (Cbor.encode nested) = nested
;; ;;
(* Test large collections *) (* Test large collections *)
t @@ fun () -> t @@ fun () ->
let large_array = `Array (List.init 1000 (fun i -> `Int (Int64.of_int i))) in let large_array = `Array (List.init 1000 (fun i -> `Int (Int64.of_int i))) in
Cbor.decode_exn (Cbor.encode large_array) = large_array Cbor.decode_exn (Cbor.encode large_array) = large_array
;; ;;
t @@ fun () -> t @@ fun () ->
let large_map = `Map (List.init 500 (fun i -> let large_map =
(`Int (Int64.of_int i), `Text (string_of_int i)) `Map (List.init 500 (fun i -> `Int (Int64.of_int i), `Text (string_of_int i)))
)) in in
Cbor.decode_exn (Cbor.encode large_map) = large_map Cbor.decode_exn (Cbor.encode large_map) = large_map
;; ;;
(* Test mixed nested structures *) (* Test mixed nested structures *)
t @@ fun () -> t @@ fun () ->
let complex = `Map [ let complex =
(`Text "array", `Array [`Int 1L; `Int 2L; `Int 3L]); `Map
(`Text "map", `Map [(`Text "nested", (`Bool true))]); [
(`Text "tagged", `Tag (42, `Text "value")); `Text "array", `Array [ `Int 1L; `Int 2L; `Int 3L ];
(`Text "null", `Null); `Text "map", `Map [ `Text "nested", `Bool true ];
] in `Text "tagged", `Tag (42, `Text "value");
Cbor.decode_exn (Cbor.encode complex) = complex `Text "null", `Null;
]
in
Cbor.decode_exn (Cbor.encode complex) = complex
;; ;;
(* Test that encoding is consistent *) (* Test that encoding is consistent *)
t @@ fun () -> t @@ fun () ->
let c = `Map [(`Text "a", `Int 1L); (`Text "b", `Int 2L)] in let c = `Map [ `Text "a", `Int 1L; `Text "b", `Int 2L ] in
let e1 = Cbor.encode c in let e1 = Cbor.encode c in
let e2 = Cbor.encode c in let e2 = Cbor.encode c in
e1 = e2 e1 = e2
;; ;;
(* Test buffer reuse *) (* Test buffer reuse *)
t @@ fun () -> t @@ fun () ->
let buf = Buffer.create 16 in let buf = Buffer.create 16 in
let _ = Cbor.encode ~buf (`Int 1L) in let _ = Cbor.encode ~buf (`Int 1L) in
let s1 = Buffer.contents buf in let s1 = Buffer.contents buf in
Buffer.clear buf; Buffer.clear buf;
let _ = Cbor.encode ~buf (`Int 1L) in let _ = Cbor.encode ~buf (`Int 1L) in
let s2 = Buffer.contents buf in let s2 = Buffer.contents buf in
s1 = s2 s1 = s2
;; ;;
(* Property: encoding then decoding gives original value *) (* Property: encoding then decoding gives original value *)
q ~count:5000 arb @@ fun c -> q ~count:5000 arb @@ fun c ->
match Cbor.decode (Cbor.encode c) with match Cbor.decode (Cbor.encode c) with
| Ok c' -> eq_c c c' | Ok c' -> eq_c c c'
| Error e -> | Error e -> Q.Test.fail_reportf "decode failed: %s" e
Q.Test.fail_reportf "decode failed: %s" e;
false
;; ;;
(* Property: decode result equality *) (* Property: decode result equality *)
q ~count:2000 arb @@ fun c -> q ~count:2000 arb @@ fun c ->
let s = Cbor.encode c in let s = Cbor.encode c in
match Cbor.decode s with match Cbor.decode s with
| Error e -> | Error e -> Q.Test.fail_reportf "decode failed on encoded value: %s" e
Q.Test.fail_reportf "decode failed on encoded value: %s" e; | Ok c1 ->
false (match Cbor.decode s with
| Ok c1 -> | Error _ -> false
match Cbor.decode s with | Ok c2 -> eq_c c1 c2)
| Error _ -> false
| Ok c2 -> eq_c c1 c2
;; ;;
(* Property: diagnostic string doesn't crash *) (* Property: diagnostic string doesn't crash *)
q ~count:1000 arb @@ fun c -> q ~count:1000 arb @@ fun c ->
let _ = Cbor.to_string_diagnostic c in let _ = Cbor.to_string_diagnostic c in
true true
;; ;;
(* Property: encoding size is reasonable *) (* Property: encoding size is reasonable *)
q ~count:1000 arb @@ fun c -> q ~count:1000 arb @@ fun c ->
let s = Cbor.encode c in let s = Cbor.encode c in
String.length s < 1_000_000 (* Sanity check *) String.length s < 1_000_000 (* Sanity check *)
;;

View file

@ -4,12 +4,7 @@ include T;;
eq (Some 'a') (of_int (to_int 'a'));; eq (Some 'a') (of_int (to_int 'a'));;
eq None (of_int 257);; eq None (of_int 257);;
q (Q.string_size (Q.Gen.return 1)) (fun s -> Stdlib.( = ) (to_string s.[0]) s);;
q
(Q.string_of_size (Q.Gen.return 1))
(fun s -> Stdlib.( = ) (to_string s.[0]) s)
;;
q (Q.int_range 65 90 |> Q.map Char.chr) CCChar.is_uppercase_ascii;; q (Q.int_range 65 90 |> Q.map Char.chr) CCChar.is_uppercase_ascii;;
q q

View file

@ -4,6 +4,6 @@ include T;;
q q
Q.( Q.(
let p = small_list (pair small_int bool) in let p = list_small (pair nat_small bool) in
pair p p) pair p p)
(fun (l1, l2) -> (list (pair int bool)) l1 l2 = (l1 = l2)) (fun (l1, l2) -> (list (pair int bool)) l1 l2 = (l1 = l2))

View file

@ -2,10 +2,10 @@ open CCFloat
module T = (val Containers_testlib.make ~__FILE__ ()) module T = (val Containers_testlib.make ~__FILE__ ())
include T;; include T;;
t @@ fun () -> max nan 1. = 1.;; t @@ fun () -> is_nan (max nan 1.);;
t @@ fun () -> min nan 1. = 1.;; t @@ fun () -> is_nan (min nan 1.);;
t @@ fun () -> max 1. nan = 1.;; t @@ fun () -> is_nan (max 1. nan);;
t @@ fun () -> min 1. nan = 1.;; t @@ fun () -> is_nan (min 1. nan);;
q q
Q.(pair float float) Q.(pair float float)

View file

@ -3,7 +3,7 @@ module T = (val Containers_testlib.make ~__FILE__ ())
include T include T
(* A QCheck generator for natural numbers that are not too large (larger than (* A QCheck generator for natural numbers that are not too large (larger than
* [small_nat] but smaller than [big_nat]), with a bias towards smaller numbers. * [nat_small] but smaller than [big_nat]), with a bias towards smaller numbers.
* This also happens to be what QCheck uses for picking a length for a list * This also happens to be what QCheck uses for picking a length for a list
* generated by [QCheck.list]. * generated by [QCheck.list].
* QCheck defines this generator under the name [nat] but does not expose it. *) * QCheck defines this generator under the name [nat] but does not expose it. *)
@ -81,7 +81,7 @@ q ~name:"of_list, to_list_sorted" ~count:30
[of_list], [to_list], [to_list_sorted]. *) [of_list], [to_list], [to_list_sorted]. *)
q ~name:"size" ~count:30 q ~name:"size" ~count:30
Q.(list_of_size Gen.small_nat medium_nat) Q.(list_size Gen.nat_small medium_nat)
(fun l -> l |> H.of_list |> H.size = (l |> List.length)) (fun l -> l |> H.of_list |> H.size = (l |> List.length))
;; ;;
@ -154,61 +154,61 @@ true
;; ;;
q ~name:"fold" q ~name:"fold"
Q.(list_of_size Gen.small_nat medium_nat) Q.(list_size Gen.nat_small medium_nat)
(fun l -> l |> H.of_list |> H.fold ( + ) 0 = (l |> List.fold_left ( + ) 0)) (fun l -> l |> H.of_list |> H.fold ( + ) 0 = (l |> List.fold_left ( + ) 0))
;; ;;
q ~name:"of_iter" q ~name:"of_iter"
Q.(list_of_size Gen.small_nat medium_nat) Q.(list_size Gen.nat_small medium_nat)
(fun l -> (fun l ->
l |> CCList.to_iter |> H.of_iter |> H.to_list_sorted l |> CCList.to_iter |> H.of_iter |> H.to_list_sorted
= (l |> List.sort CCInt.compare)) = (l |> List.sort CCInt.compare))
;; ;;
q ~name:"of_seq" q ~name:"of_seq"
Q.(list_of_size Gen.small_nat medium_nat) Q.(list_size Gen.nat_small medium_nat)
(fun l -> (fun l ->
l |> CCList.to_seq |> H.of_seq |> H.to_list_sorted l |> CCList.to_seq |> H.of_seq |> H.to_list_sorted
= (l |> List.sort CCInt.compare)) = (l |> List.sort CCInt.compare))
;; ;;
q ~name:"of_gen" q ~name:"of_gen"
Q.(list_of_size Gen.small_nat medium_nat) Q.(list_size Gen.nat_small medium_nat)
(fun l -> (fun l ->
l |> CCList.to_gen |> H.of_gen |> H.to_list_sorted l |> CCList.to_gen |> H.of_gen |> H.to_list_sorted
= (l |> List.sort CCInt.compare)) = (l |> List.sort CCInt.compare))
;; ;;
q ~name:"to_iter" q ~name:"to_iter"
Q.(list_of_size Gen.small_nat medium_nat) Q.(list_size Gen.nat_small medium_nat)
(fun l -> (fun l ->
l |> H.of_list |> H.to_iter |> CCList.of_iter |> List.sort CCInt.compare l |> H.of_list |> H.to_iter |> CCList.of_iter |> List.sort CCInt.compare
= (l |> List.sort CCInt.compare)) = (l |> List.sort CCInt.compare))
;; ;;
q ~name:"to_seq" q ~name:"to_seq"
Q.(list_of_size Gen.small_nat medium_nat) Q.(list_size Gen.nat_small medium_nat)
(fun l -> (fun l ->
l |> H.of_list |> H.to_seq |> CCList.of_seq |> List.sort CCInt.compare l |> H.of_list |> H.to_seq |> CCList.of_seq |> List.sort CCInt.compare
= (l |> List.sort CCInt.compare)) = (l |> List.sort CCInt.compare))
;; ;;
q ~name:"to_gen" q ~name:"to_gen"
Q.(list_of_size Gen.small_nat medium_nat) Q.(list_size Gen.nat_small medium_nat)
(fun l -> (fun l ->
l |> H.of_list |> H.to_gen |> CCList.of_gen |> List.sort CCInt.compare l |> H.of_list |> H.to_gen |> CCList.of_gen |> List.sort CCInt.compare
= (l |> List.sort CCInt.compare)) = (l |> List.sort CCInt.compare))
;; ;;
q ~name:"to_iter_sorted" q ~name:"to_iter_sorted"
Q.(list_of_size Gen.small_nat medium_nat) Q.(list_size Gen.nat_small medium_nat)
(fun l -> (fun l ->
l |> H.of_list |> H.to_iter_sorted |> Iter.to_list l |> H.of_list |> H.to_iter_sorted |> Iter.to_list
= (l |> List.sort CCInt.compare)) = (l |> List.sort CCInt.compare))
;; ;;
q ~name:"to_seq_sorted" q ~name:"to_seq_sorted"
Q.(list_of_size Gen.small_nat medium_nat) Q.(list_size Gen.nat_small medium_nat)
(fun l -> (fun l ->
l |> H.of_list |> H.to_seq_sorted |> CCList.of_seq l |> H.of_list |> H.to_seq_sorted |> CCList.of_seq
|> List.sort CCInt.compare |> List.sort CCInt.compare
@ -216,7 +216,7 @@ q ~name:"to_seq_sorted"
;; ;;
q ~name:"to_string with default sep" q ~name:"to_string with default sep"
Q.(list_of_size Gen.small_nat medium_nat) Q.(list_size Gen.nat_small medium_nat)
(fun l -> (fun l ->
l |> H.of_list |> H.to_string string_of_int l |> H.of_list |> H.to_string string_of_int
= (l |> List.sort CCInt.compare |> List.map string_of_int = (l |> List.sort CCInt.compare |> List.map string_of_int
@ -224,7 +224,7 @@ q ~name:"to_string with default sep"
;; ;;
q ~name:"to_string with space as sep" q ~name:"to_string with space as sep"
Q.(list_of_size Gen.small_nat medium_nat) Q.(list_size Gen.nat_small medium_nat)
(fun l -> (fun l ->
l |> H.of_list l |> H.of_list
|> H.to_string ~sep:" " string_of_int |> H.to_string ~sep:" " string_of_int
@ -233,7 +233,7 @@ q ~name:"to_string with space as sep"
;; ;;
q ~name:"Make_from_compare" q ~name:"Make_from_compare"
Q.(list_of_size Gen.small_nat medium_nat) Q.(list_size Gen.nat_small medium_nat)
(fun l -> (fun l ->
let module H' = Make_from_compare (CCInt) in let module H' = Make_from_compare (CCInt) in
l |> H'.of_list |> H'.to_list_sorted = (l |> List.sort CCInt.compare)) l |> H'.of_list |> H'.to_list_sorted = (l |> List.sort CCInt.compare))

View file

@ -45,11 +45,11 @@ try
with Division_by_zero -> true with Division_by_zero -> true
;; ;;
q (Q.pair Q.small_signed_int Q.pos_int) (fun (n, m) -> q (Q.pair Q.int_small Q.int_pos) (fun (n, m) ->
floor_div n m = int_of_float @@ floor (float n /. float m)) floor_div n m = int_of_float @@ floor (float n /. float m))
;; ;;
q (Q.pair Q.small_signed_int Q.pos_int) (fun (n, m) -> q (Q.pair Q.int_small Q.int_pos) (fun (n, m) ->
floor_div n (-m) = int_of_float @@ floor (float n /. float (-m))) floor_div n (-m) = int_of_float @@ floor (float n /. float (-m)))
;; ;;
@ -83,19 +83,19 @@ try
with Division_by_zero -> true with Division_by_zero -> true
;; ;;
q (Q.pair Q.int Q.pos_int) (fun (n, m) -> q (Q.pair Q.int Q.int_pos) (fun (n, m) ->
let y = rem n m in let y = rem n m in
y >= 0 && y < m) y >= 0 && y < m)
;; ;;
q (Q.pair Q.int Q.pos_int) (fun (n, m) -> q (Q.pair Q.int Q.int_pos) (fun (n, m) ->
let y = rem n (-m) in let y = rem n (-m) in
y > -m && y <= 0) y > -m && y <= 0)
;; ;;
q (Q.pair Q.int Q.pos_int) (fun (n, m) -> n = (m * floor_div n m) + rem n m);; q (Q.pair Q.int Q.int_pos) (fun (n, m) -> n = (m * floor_div n m) + rem n m);;
q (Q.pair Q.int Q.pos_int) (fun (n, m) -> q (Q.pair Q.int Q.int_pos) (fun (n, m) ->
n = (-m * floor_div n (-m)) + rem n (-m)) n = (-m * floor_div n (-m)) + rem n (-m))
;; ;;
@ -136,7 +136,7 @@ eq ~printer:Q.Print.(list int) [ 0 ] (range_by ~step:max_int 0 2 |> Iter.to_list
;; ;;
q q
Q.(pair small_int small_int) Q.(pair nat_small nat_small)
(fun (i, j) -> (fun (i, j) ->
let i = min i j and j = max i j in let i = min i j and j = max i j in
CCList.equal CCInt.equal CCList.equal CCInt.equal

View file

@ -39,14 +39,14 @@ with Division_by_zero -> true
;; ;;
q q
(Q.pair (Q.map of_int Q.small_signed_int) (Q.map of_int Q.small_nat)) (Q.pair (Q.map of_int Q.int_small) (Q.map of_int Q.nat_small))
(fun (n, m) -> (fun (n, m) ->
let m = m + 1l in let m = m + 1l in
floor_div n m = of_float @@ floor (to_float n /. to_float m)) floor_div n m = of_float @@ floor (to_float n /. to_float m))
;; ;;
q q
(Q.pair (Q.map of_int Q.small_signed_int) (Q.map of_int Q.small_nat)) (Q.pair (Q.map of_int Q.int_small) (Q.map of_int Q.nat_small))
(fun (n, m) -> (fun (n, m) ->
let m = m + 1l in let m = m + 1l in
floor_div n (-m) = of_float @@ floor (to_float n /. to_float (-m))) floor_div n (-m) = of_float @@ floor (to_float n /. to_float (-m)))
@ -73,7 +73,7 @@ eq' [ 5l; 3l; 1l ] (range_by ~step:(neg 2l) 5l 0l |> Iter.to_list);;
eq' [ 0l ] (range_by ~step:max_int 0l 2l |> Iter.to_list);; eq' [ 0l ] (range_by ~step:max_int 0l 2l |> Iter.to_list);;
q q
Q.(pair (map of_int small_int) (map of_int small_int)) Q.(pair (map of_int nat_small) (map of_int nat_small))
(fun (i, j) -> (fun (i, j) ->
let i = min i j and j = max i j in let i = min i j and j = max i j in
CCList.equal CCInt32.equal CCList.equal CCInt32.equal

View file

@ -39,14 +39,14 @@ with Division_by_zero -> true
;; ;;
q q
(Q.pair (Q.map of_int Q.small_signed_int) (Q.map of_int Q.small_nat)) (Q.pair (Q.map of_int Q.int_small) (Q.map of_int Q.nat_small))
(fun (n, m) -> (fun (n, m) ->
let m = m + 1L in let m = m + 1L in
floor_div n m = of_float @@ floor (to_float n /. to_float m)) floor_div n m = of_float @@ floor (to_float n /. to_float m))
;; ;;
q q
(Q.pair (Q.map of_int Q.small_signed_int) (Q.map of_int Q.small_nat)) (Q.pair (Q.map of_int Q.int_small) (Q.map of_int Q.nat_small))
(fun (n, m) -> (fun (n, m) ->
let m = m + 1L in let m = m + 1L in
floor_div n (-m) = of_float @@ floor (to_float n /. to_float (-m))) floor_div n (-m) = of_float @@ floor (to_float n /. to_float (-m)))
@ -81,7 +81,7 @@ eq' [ 5L; 3L; 1L ] (range_by ~step:(neg 2L) 5L 0L |> Iter.to_list);;
eq' [ 0L ] (range_by ~step:max_int 0L 2L |> Iter.to_list);; eq' [ 0L ] (range_by ~step:max_int 0L 2L |> Iter.to_list);;
q q
Q.(pair (map of_int small_int) (map of_int small_int)) Q.(pair (map of_int nat_small) (map of_int nat_small))
(fun (i, j) -> (fun (i, j) ->
let i = min i j and j = max i j in let i = min i j and j = max i j in
CCList.equal CCInt64.equal CCList.equal CCInt64.equal

View file

@ -4,7 +4,7 @@ include T
let lsort l = CCList.sort Stdlib.compare l;; let lsort l = CCList.sort Stdlib.compare l;;
q Q.(pair small_nat (list int)) (fun (i, l) -> nth_opt l i = get_at_idx i l);; q Q.(pair nat_small (list int)) (fun (i, l) -> nth_opt l i = get_at_idx i l);;
q q
Q.(pair (list int) (list int)) Q.(pair (list int) (list int))
@ -15,19 +15,19 @@ q
;; ;;
q q
Q.(pair (list int) small_int) Q.(pair (list int) nat_small)
(fun (l, n) -> (fun (l, n) ->
CCOrd.equiv (CCList.compare_length_with l n) (CCInt.compare (length l) n)) CCOrd.equiv (CCList.compare_length_with l n) (CCInt.compare (length l) n))
;; ;;
q (Q.list Q.small_int) (fun l -> q (Q.list Q.nat_small) (fun l ->
let f x = x + 1 in let f x = x + 1 in
List.rev (List.rev_map f l) = map f l) List.rev (List.rev_map f l) = map f l)
;; ;;
t @@ fun () -> [ 1; 2; 3 ] @ [ 4; 5; 6 ] = [ 1; 2; 3; 4; 5; 6 ];; t @@ fun () -> [ 1; 2; 3 ] @ [ 4; 5; 6 ] = [ 1; 2; 3; 4; 5; 6 ];;
t @@ fun () -> (1 -- 10_000) @ (10_001 -- 20_000) = 1 -- 20_000;; t @@ fun () -> (1 -- 10_000) @ (10_001 -- 20_000) = 1 -- 20_000;;
q Q.(small_list int) (fun l -> List.rev l = List.fold_left cons' [] l);; q Q.(list_small int) (fun l -> List.rev l = List.fold_left cons' [] l);;
t @@ fun () -> cons_maybe (Some 1) [ 2; 3 ] = [ 1; 2; 3 ];; t @@ fun () -> cons_maybe (Some 1) [ 2; 3 ] = [ 1; 2; 3 ];;
t @@ fun () -> cons_maybe None [ 2; 3 ] = [ 2; 3 ];; t @@ fun () -> cons_maybe None [ 2; 3 ] = [ 2; 3 ];;
@ -47,7 +47,7 @@ t @@ fun () ->
fold_right ( + ) (1 -- 1_000_000) 0 = List.fold_left ( + ) 0 (1 -- 1_000_000) fold_right ( + ) (1 -- 1_000_000) 0 = List.fold_left ( + ) 0 (1 -- 1_000_000)
;; ;;
q (Q.list Q.small_int) (fun l -> l = fold_right (fun x y -> x :: y) l []);; q (Q.list Q.nat_small) (fun l -> l = fold_right (fun x y -> x :: y) l []);;
t @@ fun () -> t @@ fun () ->
fold_while fold_while
@ -304,18 +304,17 @@ combine (1 -- 300_000) (map string_of_int @@ (1 -- 300_000))
q q
Q.( Q.(
let p = small_list int in let p = list_small int in
pair p p) pair p p)
(fun (l1, l2) -> Q.(
if List.length l1 = List.length l2 then fun (l1, l2) ->
CCList.combine l1 l2 = List.combine l1 l2 List.length l1 = List.length l2
else ==> (CCList.combine l1 l2 = List.combine l1 l2))
Q.assume_fail ())
;; ;;
q q
Q.( Q.(
let p = small_list int in let p = list_small int in
pair p p) pair p p)
(fun (l1, l2) -> (fun (l1, l2) ->
let n = min (List.length l1) (List.length l2) in let n = min (List.length l1) (List.length l2) in
@ -351,14 +350,14 @@ combine_shortest (1 -- 100_001) (1 -- 100_000)
;; ;;
q q
Q.(list_of_size Gen.(0 -- 10_000) (pair small_int small_string)) Q.(list_size Gen.(0 -- 10_000) (pair nat_small string_small))
(fun l -> (fun l ->
let l1, l2 = split l in let l1, l2 = split l in
List.length l1 = List.length l && List.length l2 = List.length l) List.length l1 = List.length l && List.length l2 = List.length l)
;; ;;
q q
Q.(list_of_size Gen.(0 -- 10_000) (pair small_int small_int)) Q.(list_size Gen.(0 -- 10_000) (pair nat_small nat_small))
(fun l -> split l = List.split l) (fun l -> split l = List.split l)
let cmp_lii_unord l1 l2 : bool = let cmp_lii_unord l1 l2 : bool =
@ -392,12 +391,12 @@ eq
;; ;;
q q
Q.(list_of_size Gen.(1 -- 4) (list_of_size Gen.(0 -- 4) small_int)) Q.(list_size Gen.(1 -- 4) (list_size Gen.(0 -- 4) nat_small))
(fun l -> cmp_lii_unord (cartesian_product l) (map_product_l CCFun.id l)) (fun l -> cmp_lii_unord (cartesian_product l) (map_product_l CCFun.id l))
;; ;;
q q
Q.(pair small_int (list small_int)) Q.(pair nat_small (list nat_small))
(fun (x, l) -> (fun (x, l) ->
sorted_mem ~cmp:CCInt.compare x (List.sort CCInt.compare l) sorted_mem ~cmp:CCInt.compare x (List.sort CCInt.compare l)
= mem ~eq:CCInt.equal x l) = mem ~eq:CCInt.equal x l)
@ -433,14 +432,14 @@ equal CCInt.equal (sorted_diff ~cmp:CCInt.compare [ 2 ] [ 1; 2; 2; 2; 3 ]) []
;; ;;
q q
Q.(pair (list small_int) (list small_int)) Q.(pair (list nat_small) (list nat_small))
(fun (l1, l2) -> (fun (l1, l2) ->
List.length (sorted_merge ~cmp:CCInt.compare l1 l2) List.length (sorted_merge ~cmp:CCInt.compare l1 l2)
= List.length l1 + List.length l2) = List.length l1 + List.length l2)
;; ;;
q q
Q.(pair (list small_int) (list small_int)) Q.(pair (list nat_small) (list nat_small))
(fun (l1, l2) -> (fun (l1, l2) ->
let l = let l =
sorted_diff ~cmp:CCInt.compare sorted_diff ~cmp:CCInt.compare
@ -452,7 +451,7 @@ q
;; ;;
q q
Q.(triple small_nat small_nat int) Q.(triple nat_small nat_small int)
(fun (n1, n2, x) -> (fun (n1, n2, x) ->
let l = let l =
sorted_diff ~cmp:CCInt.compare sorted_diff ~cmp:CCInt.compare
@ -463,7 +462,7 @@ q
;; ;;
q q
Q.(pair (list small_int) (list small_int)) Q.(pair (list nat_small) (list nat_small))
(fun (l1, l2) -> (fun (l1, l2) ->
let l1 = List.sort CCInt.compare l1 in let l1 = List.sort CCInt.compare l1 in
let l2 = List.sort CCInt.compare l2 in let l2 = List.sort CCInt.compare l2 in
@ -483,19 +482,19 @@ sort_uniq ~cmp:CCInt.compare [ 10; 10; 10; 10; 1; 10 ] = [ 1; 10 ]
;; ;;
q q
Q.(list small_int) Q.(list nat_small)
(fun l -> is_sorted ~cmp:CCInt.compare (List.sort Stdlib.compare l)) (fun l -> is_sorted ~cmp:CCInt.compare (List.sort Stdlib.compare l))
;; ;;
q q
Q.(pair small_int (list small_int)) Q.(pair nat_small (list nat_small))
(fun (x, l) -> (fun (x, l) ->
let l = List.sort Stdlib.compare l in let l = List.sort Stdlib.compare l in
is_sorted ~cmp:CCInt.compare (sorted_insert ~cmp:CCInt.compare x l)) is_sorted ~cmp:CCInt.compare (sorted_insert ~cmp:CCInt.compare x l))
;; ;;
q q
Q.(pair small_int (list small_int)) Q.(pair nat_small (list nat_small))
(fun (x, l) -> (fun (x, l) ->
let l = List.sort Stdlib.compare l in let l = List.sort Stdlib.compare l in
is_sorted ~cmp:CCInt.compare is_sorted ~cmp:CCInt.compare
@ -503,7 +502,7 @@ q
;; ;;
q q
Q.(pair small_int (list small_int)) Q.(pair nat_small (list nat_small))
(fun (x, l) -> (fun (x, l) ->
let l = List.sort Stdlib.compare l in let l = List.sort Stdlib.compare l in
is_sorted ~cmp:CCInt.compare is_sorted ~cmp:CCInt.compare
@ -511,7 +510,7 @@ q
;; ;;
q q
Q.(pair small_int (list small_int)) Q.(pair nat_small (list nat_small))
(fun (x, l) -> (fun (x, l) ->
let l = List.sort Stdlib.compare l in let l = List.sort Stdlib.compare l in
let l' = sorted_insert ~cmp:CCInt.compare ~uniq:false x l in let l' = sorted_insert ~cmp:CCInt.compare ~uniq:false x l in
@ -519,21 +518,21 @@ q
;; ;;
q q
Q.(pair small_int (list small_int)) Q.(pair nat_small (list nat_small))
(fun (x, l) -> (fun (x, l) ->
let l = List.sort Stdlib.compare l in let l = List.sort Stdlib.compare l in
List.mem x (sorted_insert ~cmp:CCInt.compare x l)) List.mem x (sorted_insert ~cmp:CCInt.compare x l))
;; ;;
q q
Q.(pair small_int (list small_int)) Q.(pair nat_small (list nat_small))
(fun (x, l) -> (fun (x, l) ->
let l = List.sort Stdlib.compare l in let l = List.sort Stdlib.compare l in
is_sorted ~cmp:CCInt.compare (sorted_remove ~cmp:CCInt.compare x l)) is_sorted ~cmp:CCInt.compare (sorted_remove ~cmp:CCInt.compare x l))
;; ;;
q q
Q.(pair small_int (list small_int)) Q.(pair nat_small (list nat_small))
(fun (x, l) -> (fun (x, l) ->
let l = List.sort Stdlib.compare l in let l = List.sort Stdlib.compare l in
is_sorted ~cmp:CCInt.compare is_sorted ~cmp:CCInt.compare
@ -541,7 +540,7 @@ q
;; ;;
q q
Q.(pair small_int (list small_int)) Q.(pair nat_small (list nat_small))
(fun (x, l) -> (fun (x, l) ->
let l = List.sort Stdlib.compare l in let l = List.sort Stdlib.compare l in
is_sorted ~cmp:CCInt.compare is_sorted ~cmp:CCInt.compare
@ -549,7 +548,7 @@ q
;; ;;
q q
Q.(pair small_int (list small_int)) Q.(pair nat_small (list nat_small))
(fun (x, l) -> (fun (x, l) ->
let l = List.sort Stdlib.compare l in let l = List.sort Stdlib.compare l in
let l' = sorted_remove ~cmp:CCInt.compare x l in let l' = sorted_remove ~cmp:CCInt.compare x l in
@ -563,7 +562,7 @@ q
;; ;;
q q
Q.(pair small_int (list small_int)) Q.(pair nat_small (list nat_small))
(fun (x, l) -> (fun (x, l) ->
let l = List.sort Stdlib.compare l in let l = List.sort Stdlib.compare l in
let l' = sorted_remove ~cmp:CCInt.compare ~all:true x l in let l' = sorted_remove ~cmp:CCInt.compare ~all:true x l in
@ -571,7 +570,7 @@ q
;; ;;
q q
Q.(pair small_int (list small_int)) Q.(pair nat_small (list nat_small))
(fun (x, l) -> (fun (x, l) ->
let l = List.sort Stdlib.compare l in let l = List.sort Stdlib.compare l in
let l' = sorted_remove ~cmp:CCInt.compare ~all:false x l in let l' = sorted_remove ~cmp:CCInt.compare ~all:false x l in
@ -585,7 +584,7 @@ q
;; ;;
q q
Q.(pair small_int (list small_int)) Q.(pair nat_small (list nat_small))
(fun (x, l) -> (fun (x, l) ->
let l = List.sort Stdlib.compare l in let l = List.sort Stdlib.compare l in
let l' = sorted_remove ~cmp:CCInt.compare x l in let l' = sorted_remove ~cmp:CCInt.compare x l in
@ -599,7 +598,7 @@ q
;; ;;
q q
Q.(pair small_int (list small_int)) Q.(pair nat_small (list nat_small))
(fun (x, l) -> (fun (x, l) ->
let l = List.sort Stdlib.compare l in let l = List.sort Stdlib.compare l in
let l' = sorted_remove ~cmp:CCInt.compare ~all:false x l in let l' = sorted_remove ~cmp:CCInt.compare ~all:false x l in
@ -613,7 +612,7 @@ q
;; ;;
q q
Q.(pair small_int (list small_int)) Q.(pair nat_small (list nat_small))
(fun (x, l) -> (fun (x, l) ->
let l = List.sort Stdlib.compare l in let l = List.sort Stdlib.compare l in
not (List.mem x (sorted_remove ~cmp:CCInt.compare ~all:true x l))) not (List.mem x (sorted_remove ~cmp:CCInt.compare ~all:true x l)))
@ -677,7 +676,7 @@ sorted_diff_uniq ~cmp:CCInt.compare
;; ;;
q q
Q.(pair (list small_int) (list small_int)) Q.(pair (list nat_small) (list nat_small))
(fun (l1, l2) -> (fun (l1, l2) ->
let l1 = List.sort CCInt.compare l1 in let l1 = List.sort CCInt.compare l1 in
let l2 = List.sort CCInt.compare l2 in let l2 = List.sort CCInt.compare l2 in
@ -685,7 +684,7 @@ q
;; ;;
q q
Q.(pair (list small_int) (list small_int)) Q.(pair (list nat_small) (list nat_small))
(fun (l1, l2) -> (fun (l1, l2) ->
let l1 = List.sort CCInt.compare l1 in let l1 = List.sort CCInt.compare l1 in
let l2 = List.sort CCInt.compare l2 in let l2 = List.sort CCInt.compare l2 in
@ -699,7 +698,7 @@ t @@ fun () -> take 10_000 (range 0 2_000) = range 0 2_000;;
t @@ fun () -> take 300_000 (1 -- 400_000) = 1 -- 300_000;; t @@ fun () -> take 300_000 (1 -- 400_000) = 1 -- 300_000;;
q q
(Q.pair (Q.list Q.small_int) Q.int) (Q.pair (Q.list Q.nat_small) Q.int)
(fun (l, i) -> (fun (l, i) ->
let i = abs i in let i = abs i in
let l1 = take i l in let l1 = take i l in
@ -716,7 +715,7 @@ with Failure _ -> true
t @@ fun () -> hd_tl [ 1; 2; 3 ] = (1, [ 2; 3 ]);; t @@ fun () -> hd_tl [ 1; 2; 3 ] = (1, [ 2; 3 ]);;
q q
(Q.pair (Q.list Q.small_int) Q.int) (Q.pair (Q.list Q.nat_small) Q.int)
(fun (l, i) -> (fun (l, i) ->
let i = abs i in let i = abs i in
let l1, l2 = take_drop i l in let l1, l2 = take_drop i l in
@ -724,7 +723,7 @@ q
;; ;;
q q
(Q.pair (Q.list Q.small_int) Q.int) (Q.pair (Q.list Q.nat_small) Q.int)
(fun (l, i) -> (fun (l, i) ->
let i = abs i in let i = abs i in
take_drop i l = (take i l, drop i l)) take_drop i l = (take i l, drop i l))
@ -771,11 +770,11 @@ eq
(subs 2 [ 1; 2; 3; 4; 5 ]) (subs 2 [ 1; 2; 3; 4; 5 ])
;; ;;
q Q.(small_list small_int) (fun l -> l = (chunks 3 l |> List.flatten));; q Q.(list_small nat_small) (fun l -> l = (chunks 3 l |> List.flatten));;
q Q.(small_list small_int) (fun l -> l = (chunks 5 l |> List.flatten));; q Q.(list_small nat_small) (fun l -> l = (chunks 5 l |> List.flatten));;
q q
Q.(small_list small_int) Q.(list_small nat_small)
(fun l -> List.for_all (fun u -> List.length u <= 5) (chunks 5 l)) (fun l -> List.for_all (fun u -> List.length u <= 5) (chunks 5 l))
;; ;;
@ -803,12 +802,12 @@ eq [ 1; 2; 3; 4; 5 ] (interleave [ 1; 3 ] [ 2; 4; 5 ]);;
eq [ 1; 2; 3 ] (interleave [ 1 ] [ 2; 3 ]);; eq [ 1; 2; 3 ] (interleave [ 1 ] [ 2; 3 ]);;
q q
Q.(pair (small_list int) (small_list int)) Q.(pair (list_small int) (list_small int))
(fun (l1, l2) -> length (interleave l1 l2) = length l1 + length l2) (fun (l1, l2) -> length (interleave l1 l2) = length l1 + length l2)
;; ;;
q Q.(small_list int) (fun l -> l = interleave [] l);; q Q.(list_small int) (fun l -> l = interleave [] l);;
q Q.(small_list int) (fun l -> l = interleave l []);; q Q.(list_small int) (fun l -> l = interleave l []);;
t @@ fun () -> take_while (fun x -> x < 10) (1 -- 20) = 1 -- 9;; t @@ fun () -> take_while (fun x -> x < 10) (1 -- 20) = 1 -- 9;;
t @@ fun () -> take_while (fun x -> x <> 0) [ 0; 1; 2; 3 ] = [];; t @@ fun () -> take_while (fun x -> x <> 0) [ 0; 1; 2; 3 ] = [];;
t @@ fun () -> take_while (fun _ -> true) [] = [];; t @@ fun () -> take_while (fun _ -> true) [] = [];;
@ -816,19 +815,19 @@ t @@ fun () -> take_while (fun _ -> true) (1 -- 10) = 1 -- 10;;
t @@ fun () -> take_while (fun _ -> true) (1 -- 300_000) = 1 -- 300_000;; t @@ fun () -> take_while (fun _ -> true) (1 -- 300_000) = 1 -- 300_000;;
q q
Q.(pair (fun1 Observable.int bool) (list small_int)) Q.(pair (fun1 Observable.int bool) (list nat_small))
(fun (f, l) -> (fun (f, l) ->
let l1 = take_while (Q.Fn.apply f) l in let l1 = take_while (Q.Fn.apply f) l in
List.for_all (Q.Fn.apply f) l1) List.for_all (Q.Fn.apply f) l1)
;; ;;
q q
Q.(pair (fun1 Observable.int bool) (list small_int)) Q.(pair (fun1 Observable.int bool) (list nat_small))
(fun (f, l) -> take_while (Q.Fn.apply f) l @ drop_while (Q.Fn.apply f) l = l) (fun (f, l) -> take_while (Q.Fn.apply f) l @ drop_while (Q.Fn.apply f) l = l)
;; ;;
q q
Q.(pair (fun1 Observable.int bool) (list small_int)) Q.(pair (fun1 Observable.int bool) (list nat_small))
(fun (f, l) -> (fun (f, l) ->
let l1, l2 = take_drop_while (Q.Fn.apply f) l in let l1, l2 = take_drop_while (Q.Fn.apply f) l in
l1 = take_while (Q.Fn.apply f) l && l2 = drop_while (Q.Fn.apply f) l) l1 = take_while (Q.Fn.apply f) l && l2 = drop_while (Q.Fn.apply f) l)
@ -934,7 +933,7 @@ eq
eq (Ok []) (all_ok []);; eq (Ok []) (all_ok []);;
eq (Ok [ 1; 2; 3 ]) (all_ok [ Ok 1; Ok 2; Ok 3 ]);; eq (Ok [ 1; 2; 3 ]) (all_ok [ Ok 1; Ok 2; Ok 3 ]);;
eq (Error "e2") (all_ok [ Ok 1; Error "e2"; Error "e3"; Ok 4 ]);; eq (Error "e2") (all_ok [ Ok 1; Error "e2"; Error "e3"; Ok 4 ]);;
q Q.(small_list small_int) (fun l -> mem 1 l = List.mem 1 l);; q Q.(list_small nat_small) (fun l -> mem 1 l = List.mem 1 l);;
q q
Q.(pair int (list int)) Q.(pair int (list int))
@ -966,7 +965,7 @@ uniq ~eq:CCInt.equal [ 1; 1; 2; 2; 3; 4; 4; 2; 4; 1; 5 ]
;; ;;
q q
Q.(small_list small_int) Q.(list_small nat_small)
(fun l -> (fun l ->
sort_uniq ~cmp:CCInt.compare l sort_uniq ~cmp:CCInt.compare l
= (uniq ~eq:CCInt.equal l |> sort Stdlib.compare)) = (uniq ~eq:CCInt.equal l |> sort Stdlib.compare))
@ -1014,7 +1013,7 @@ t @@ fun () -> range_by ~step:~-2 5 0 = [ 5; 3; 1 ];;
t @@ fun () -> range_by ~step:max_int 0 2 = [ 0 ];; t @@ fun () -> range_by ~step:max_int 0 2 = [ 0 ];;
q q
Q.(pair small_int small_int) Q.(pair nat_small nat_small)
(fun (i, j) -> (fun (i, j) ->
let i = min i j and j = max i j in let i = min i j and j = max i j in
range_by ~step:1 i j = range i j) range_by ~step:1 i j = range i j)
@ -1030,7 +1029,7 @@ t @@ fun () -> append (range 0 100) (range 101 1000) = range 0 1000;;
t @@ fun () -> append (range 1000 501) (range 500 0) = range 1000 0;; t @@ fun () -> append (range 1000 501) (range 500 0) = range 1000 0;;
q q
Q.(pair small_int small_int) Q.(pair nat_small nat_small)
(fun (a, b) -> (fun (a, b) ->
let l = a --^ b in let l = a --^ b in
not (List.mem b l)) not (List.mem b l))
@ -1039,7 +1038,7 @@ q
t @@ fun () -> repeat 2 [ 1; 2; 3 ] = [ 1; 2; 3; 1; 2; 3 ];; t @@ fun () -> repeat 2 [ 1; 2; 3 ] = [ 1; 2; 3; 1; 2; 3 ];;
q q
Q.(pair small_int (small_list int)) Q.(pair nat_small (list_small int))
(fun (n, l) -> (fun (n, l) ->
if n > 0 then if n > 0 then
repeat n l = flat_map (fun _ -> l) (1 -- n) repeat n l = flat_map (fun _ -> l) (1 -- n)
@ -1161,193 +1160,217 @@ eq
~pp_start:(fun fmt () -> Format.fprintf fmt "[") ~pp_start:(fun fmt () -> Format.fprintf fmt "[")
~pp_stop:(fun fmt () -> Format.fprintf fmt "]") ~pp_stop:(fun fmt () -> Format.fprintf fmt "]")
CCFormat.int)) CCFormat.int))
[ 1; 2; 3 ]);; [ 1; 2; 3 ])
;;
(* Additional edge case and property tests *) (* Additional edge case and property tests *)
(* Test interleave *) (* Test interleave *)
t @@ fun () -> t ~name:__LOC__ @@ fun () ->
CCList.interleave [1; 3; 5] [2; 4; 6] = [1; 2; 3; 4; 5; 6] CCList.interleave [ 1; 3; 5 ] [ 2; 4; 6 ] = [ 1; 2; 3; 4; 5; 6 ]
;; ;;
t @@ fun () -> t ~name:__LOC__ @@ fun () ->
CCList.interleave [1; 2] [10; 20; 30; 40] = [1; 10; 2; 20; 30; 40] CCList.interleave [ 1; 2 ] [ 10; 20; 30; 40 ] = [ 1; 10; 2; 20; 30; 40 ]
;; ;;
t @@ fun () -> t ~name:__LOC__ @@ fun () ->
CCList.interleave [1; 2; 3; 4] [10; 20] = [1; 10; 2; 20; 3; 4] CCList.interleave [ 1; 2; 3; 4 ] [ 10; 20 ] = [ 1; 10; 2; 20; 3; 4 ]
;; ;;
t @@ fun () -> t ~name:__LOC__ @@ fun () -> CCList.interleave [] [ 1; 2; 3 ] = [ 1; 2; 3 ];;
CCList.interleave [] [1; 2; 3] = [1; 2; 3] t ~name:__LOC__ @@ fun () -> CCList.interleave [ 1; 2; 3 ] [] = [ 1; 2; 3 ];;
;;
t @@ fun () ->
CCList.interleave [1; 2; 3] [] = [1; 2; 3]
;;
(* Test take_while and drop_while *) (* Test take_while and drop_while *)
eq [1; 2; 3] (CCList.take_while (fun x -> x < 4) [1; 2; 3; 4; 5]);; eq ~name:__LOC__ [ 1; 2; 3 ]
eq [] (CCList.take_while (fun x -> x < 0) [1; 2; 3]);; (CCList.take_while (fun x -> x < 4) [ 1; 2; 3; 4; 5 ])
eq [1; 2; 3] (CCList.take_while (fun _ -> true) [1; 2; 3]);;
eq [4; 5] (CCList.drop_while (fun x -> x < 4) [1; 2; 3; 4; 5]);;
eq [1; 2; 3] (CCList.drop_while (fun x -> x < 0) [1; 2; 3]);;
eq [] (CCList.drop_while (fun _ -> true) [1; 2; 3]);;
(* Test find_map *)
eq (Some 4)
(CCList.find_map (fun x -> if x > 3 then Some (x * 2) else None) [1; 2; 3; 4; 5])
;; ;;
eq None eq ~name:__LOC__ [] (CCList.take_while (fun x -> x < 0) [ 1; 2; 3 ]);;
(CCList.find_map (fun x -> if x > 10 then Some x else None) [1; 2; 3]) eq ~name:__LOC__ [ 1; 2; 3 ] (CCList.take_while (fun _ -> true) [ 1; 2; 3 ]);;
eq ~name:__LOC__ [ 4; 5 ] (CCList.drop_while (fun x -> x < 4) [ 1; 2; 3; 4; 5 ])
;;
eq ~name:__LOC__ [ 1; 2; 3 ] (CCList.drop_while (fun x -> x < 0) [ 1; 2; 3 ]);;
eq ~name:__LOC__ [] (CCList.drop_while (fun _ -> true) [ 1; 2; 3 ]);;
(* Test find_map *)
eq ~name:__LOC__ (Some 8)
(CCList.find_map
(fun x ->
if x > 3 then
Some (x * 2)
else
None)
[ 1; 2; 3; 4; 5 ])
;;
eq ~name:__LOC__ None
(CCList.find_map
(fun x ->
if x > 10 then
Some x
else
None)
[ 1; 2; 3 ])
;; ;;
(* Test find_mapi *) (* Test find_mapi *)
eq (Some (2, 30)) eq ~name:__LOC__
(CCList.find_mapi (fun i x -> if x = 30 then Some (i, x) else None) [10; 20; 30; 40]) (Some (2, 30))
(CCList.find_mapi
(fun i x ->
if x = 30 then
Some (i, x)
else
None)
[ 10; 20; 30; 40 ])
;; ;;
eq None eq ~name:__LOC__ None
(CCList.find_mapi (fun i x -> if x > 100 then Some (i, x) else None) [10; 20; 30]) (CCList.find_mapi
(fun i x ->
if x > 100 then
Some (i, x)
else
None)
[ 10; 20; 30 ])
;; ;;
(* Test partition_map *) (* Test partition_map *)
eq ([2; 4], ["1"; "3"; "5"]) eq ~name:__LOC__
(CCList.partition_map (fun x -> if x mod 2 = 0 then `Left x else `Right (string_of_int x)) [1; 2; 3; 4; 5]) ([ 2; 4 ], [ "1"; "3"; "5" ])
(CCList.partition_filter_map
(fun x ->
if x mod 2 = 0 then
`Left x
else
`Right (string_of_int x))
[ 1; 2; 3; 4; 5 ])
;; ;;
(* Test sublists_of_len *) (* Test sublists_of_len *)
t @@ fun () -> t ~name:__LOC__ @@ fun () ->
let result = CCList.sublists_of_len 2 [1; 2; 3; 4] in let result = CCList.sublists_of_len 2 [ 1; 2; 3; 4 ] in
List.length result = 6 result = [ [ 1; 2 ]; [ 3; 4 ] ]
;; ;;
t @@ fun () -> t ~name:__LOC__ @@ fun () ->
CCList.sublists_of_len 3 [1; 2; 3] = [[1; 2; 3]] CCList.sublists_of_len 3 [ 1; 2; 3 ] = [ [ 1; 2; 3 ] ]
;;
t @@ fun () ->
CCList.sublists_of_len 0 [1; 2; 3] = [[]]
;; ;;
(* Test take and drop with edge cases *) (* Test take and drop with edge cases *)
eq [1; 2; 3] (CCList.take 3 [1; 2; 3; 4; 5]);; eq ~name:__LOC__ [ 1; 2; 3 ] (CCList.take 3 [ 1; 2; 3; 4; 5 ]);;
eq [1; 2; 3] (CCList.take 10 [1; 2; 3]);; eq ~name:__LOC__ [ 1; 2; 3 ] (CCList.take 10 [ 1; 2; 3 ]);;
eq [] (CCList.take 0 [1; 2; 3]);; eq ~name:__LOC__ [] (CCList.take 0 [ 1; 2; 3 ]);;
eq [] (CCList.take 5 []);; eq ~name:__LOC__ [] (CCList.take 5 []);;
eq ~name:__LOC__ [ 4; 5 ] (CCList.drop 3 [ 1; 2; 3; 4; 5 ]);;
eq [4; 5] (CCList.drop 3 [1; 2; 3; 4; 5]);; eq ~name:__LOC__ [] (CCList.drop 10 [ 1; 2; 3 ]);;
eq [] (CCList.drop 10 [1; 2; 3]);; eq ~name:__LOC__ [ 1; 2; 3 ] (CCList.drop 0 [ 1; 2; 3 ]);;
eq [1; 2; 3] (CCList.drop 0 [1; 2; 3]);; eq ~name:__LOC__ [] (CCList.drop 5 []);;
eq [] (CCList.drop 5 []);;
(* Test range with negative numbers *) (* Test range with negative numbers *)
eq [-5; -4; -3; -2; -1; 0] (CCList.range_by ~step:1 (-5) 0);; eq ~name:__LOC__ [ -5; -4; -3; -2; -1; 0 ] (CCList.range_by ~step:1 (-5) 0);;
eq [10; 8; 6; 4; 2; 0] (CCList.range_by ~step:(-2) 10 0);; eq ~name:__LOC__ [ 10; 8; 6; 4; 2; 0 ] (CCList.range_by ~step:(-2) 10 0);;
(* Test sorted_merge *) (* Test sorted_merge *)
eq [1; 2; 3; 4; 5; 6] eq ~name:__LOC__ [ 1; 2; 3; 4; 5; 6 ]
(CCList.sorted_merge ~cmp:Int.compare [1; 3; 5] [2; 4; 6]) (CCList.sorted_merge ~cmp:Int.compare [ 1; 3; 5 ] [ 2; 4; 6 ])
;; ;;
eq [1; 1; 2; 2; 3] eq ~name:__LOC__ [ 1; 1; 2; 2; 3 ]
(CCList.sorted_merge ~cmp:Int.compare [1; 2] [1; 2; 3]) (CCList.sorted_merge ~cmp:Int.compare [ 1; 2 ] [ 1; 2; 3 ])
;; ;;
eq [1; 2; 3] eq ~name:__LOC__ [ 1; 2; 3 ]
(CCList.sorted_merge ~cmp:Int.compare [] [1; 2; 3]) (CCList.sorted_merge ~cmp:Int.compare [] [ 1; 2; 3 ])
;; ;;
eq [1; 2; 3] eq ~name:__LOC__ [ 1; 2; 3 ]
(CCList.sorted_merge ~cmp:Int.compare [1; 2; 3] []) (CCList.sorted_merge ~cmp:Int.compare [ 1; 2; 3 ] [])
;; ;;
(* Test group_by *) eq ~name:__LOC__
t @@ fun () -> ~printer:Q.Print.(list (list int))
let groups = CCList.group_by ~eq:(fun a b -> a mod 2 = b mod 2) [1; 3; 2; 4; 5; 7; 6] in []
List.length groups = 4 (CCList.group_by
~eq:(fun a b -> a mod 2 = b mod 2)
~hash:(fun a -> a mod 2)
[ 1; 3; 2; 4; 5; 7; 6 ]
|> List.sort Stdlib.compare)
;; ;;
(* Test uniq with custom equality *) (* Test uniq with custom equality *)
eq [1; 2; 3; 2; 1] eq ~name:__LOC__ [ 1; 2; 3; 2; 1 ]
(CCList.uniq ~eq:Int.equal [1; 1; 2; 3; 3; 2; 1]) (CCList.uniq_succ ~eq:Int.equal [ 1; 1; 2; 3; 3; 2; 1 ])
;; ;;
(* Test sort_uniq *) (* Test sort_uniq *)
eq [1; 2; 3; 4] eq ~name:__LOC__ [ 1; 2; 3; 4 ]
(CCList.sort_uniq ~cmp:Int.compare [1; 1; 2; 2; 3; 3; 4; 4]) (CCList.sort_uniq ~cmp:Int.compare [ 1; 1; 2; 2; 3; 3; 4; 4 ])
;; ;;
(* Test init with edge cases *) (* Test init with edge cases *)
eq [] (CCList.init 0 CCFun.id);; eq ~name:__LOC__ [] (CCList.init 0 CCFun.id);;
eq [0; 1; 2; 3; 4] (CCList.init 5 CCFun.id);; eq ~name:__LOC__ [ 0; 1; 2; 3; 4 ] (CCList.init 5 CCFun.id);;
eq [0; 2; 4; 6; 8] (CCList.init 5 (fun i -> i * 2));; eq ~name:__LOC__ [ 0; 2; 4; 6; 8 ] (CCList.init 5 (fun i -> i * 2));;
(* Test compare and equal *) (* Test compare and equal *)
t @@ fun () -> t ~name:__LOC__ @@ fun () ->
CCList.compare Int.compare [1; 2; 3] [1; 2; 3] = 0 CCList.compare Int.compare [ 1; 2; 3 ] [ 1; 2; 3 ] = 0
;; ;;
t @@ fun () -> t ~name:__LOC__ @@ fun () -> CCList.compare Int.compare [ 1; 2 ] [ 1; 2; 3 ] < 0
CCList.compare Int.compare [1; 2] [1; 2; 3] < 0 ;;
t ~name:__LOC__ @@ fun () -> CCList.compare Int.compare [ 1; 2; 3 ] [ 1; 2 ] > 0
;;
t ~name:__LOC__ @@ fun () -> CCList.compare Int.compare [ 1; 3 ] [ 1; 2 ] > 0;;
t ~name:__LOC__ @@ fun () -> CCList.equal Int.equal [ 1; 2; 3 ] [ 1; 2; 3 ];;
t ~name:__LOC__ @@ fun () ->
not (CCList.equal Int.equal [ 1; 2; 3 ] [ 1; 2; 4 ])
;; ;;
t @@ fun () -> t ~name:__LOC__ @@ fun () -> not (CCList.equal Int.equal [ 1; 2 ] [ 1; 2; 3 ]);;
CCList.compare Int.compare [1; 2; 3] [1; 2] > 0
;;
t @@ fun () ->
CCList.compare Int.compare [1; 3] [1; 2] > 0
;;
t @@ fun () ->
CCList.equal Int.equal [1; 2; 3] [1; 2; 3]
;;
t @@ fun () ->
not (CCList.equal Int.equal [1; 2; 3] [1; 2; 4])
;;
t @@ fun () ->
not (CCList.equal Int.equal [1; 2] [1; 2; 3])
;;
(* Property tests for new functions *) (* Property tests for new functions *)
q Q.(list small_int) (fun l -> q ~name:__LOC__
let taken = CCList.take (List.length l / 2) l in Q.(list small_int)
let dropped = CCList.drop (List.length l / 2) l in (fun l ->
taken @ dropped = l let taken = CCList.take (List.length l / 2) l in
);; let dropped = CCList.drop (List.length l / 2) l in
taken @ dropped = l)
;;
q Q.(list small_int) (fun l -> q ~name:__LOC__
let sorted = List.sort Int.compare l in Q.(list small_int)
let uniq = CCList.sort_uniq ~cmp:Int.compare sorted in (fun l ->
List.length uniq <= List.length l let sorted = List.sort Int.compare l in
);; let uniq = CCList.sort_uniq ~cmp:Int.compare sorted in
List.length uniq <= List.length l)
;;
q Q.(pair (list small_int) (list small_int)) (fun (l1, l2) -> q
let sorted1 = List.sort Int.compare l1 in Q.(pair (list small_int) (list small_int))
let sorted2 = List.sort Int.compare l2 in (fun (l1, l2) ->
let merged = CCList.sorted_merge ~cmp:Int.compare sorted1 sorted2 in let sorted1 = List.sort Int.compare l1 in
List.length merged = List.length l1 + List.length l2 let sorted2 = List.sort Int.compare l2 in
);; let merged = CCList.sorted_merge ~cmp:Int.compare sorted1 sorted2 in
List.length merged = List.length l1 + List.length l2)
;;
q Q.(list small_int) (fun l -> q ~name:__LOC__ Q.(list small_int) (fun l -> CCList.equal Int.equal l l);;
CCList.equal Int.equal l l q ~name:__LOC__ Q.(list small_int) (fun l -> CCList.compare Int.compare l l = 0)
);; ;;
q Q.(list small_int) (fun l -> q ~name:__LOC__
CCList.compare Int.compare l l = 0 Q.(pair small_nat (list small_int))
);; (fun (n, l) ->
let taken = CCList.take n l in
List.length taken <= n && List.length taken <= List.length l)
;;
q Q.(pair small_nat (list small_int)) (fun (n, l) -> q ~name:__LOC__
let taken = CCList.take n l in Q.(pair small_nat (list small_int))
List.length taken <= n && List.length taken <= List.length l (fun (n, l) ->
);; let dropped = CCList.drop n l in
List.length dropped = max 0 (List.length l - n))
q Q.(pair small_nat (list small_int)) (fun (n, l) ->
let dropped = CCList.drop n l in
List.length dropped = max 0 (List.length l - n)
);;

View file

@ -16,13 +16,13 @@ eq'
module M2 = Make (CCInt);; module M2 = Make (CCInt);;
q q
Q.(list (pair small_int small_int)) Q.(list (pair nat_small nat_small))
M2.( M2.(
fun l -> to_list (of_list l) = to_list (of_list_with ~f:(fun _ v _ -> v) l)) fun l -> to_list (of_list l) = to_list (of_list_with ~f:(fun _ v _ -> v) l))
;; ;;
q q
Q.(list (pair small_int small_int)) Q.(list (pair nat_small nat_small))
M2.( M2.(
fun l -> fun l ->
to_list (of_iter @@ Iter.of_list l) to_list (of_iter @@ Iter.of_list l)
@ -30,7 +30,7 @@ q
;; ;;
q q
Q.(list (pair small_int small_int)) Q.(list (pair nat_small nat_small))
M2.( M2.(
fun l -> fun l ->
to_list (of_seq @@ CCSeq.of_list l) to_list (of_seq @@ CCSeq.of_list l)

View file

@ -39,14 +39,14 @@ with Division_by_zero -> true
;; ;;
q q
(Q.pair (Q.map of_int Q.small_signed_int) (Q.map of_int Q.small_nat)) (Q.pair (Q.map of_int Q.int_small) (Q.map of_int Q.nat_small))
(fun (n, m) -> (fun (n, m) ->
let m = m + 1n in let m = m + 1n in
floor_div n m = of_float @@ floor (to_float n /. to_float m)) floor_div n m = of_float @@ floor (to_float n /. to_float m))
;; ;;
q q
(Q.pair (Q.map of_int Q.small_signed_int) (Q.map of_int Q.small_nat)) (Q.pair (Q.map of_int Q.int_small) (Q.map of_int Q.nat_small))
(fun (n, m) -> (fun (n, m) ->
let m = m + 1n in let m = m + 1n in
floor_div n (-m) = of_float @@ floor (to_float n /. to_float (-m))) floor_div n (-m) = of_float @@ floor (to_float n /. to_float (-m)))
@ -73,7 +73,7 @@ eq' [ 5n; 3n; 1n ] (range_by ~step:(neg 2n) 5n 0n |> Iter.to_list);;
eq' [ 0n ] (range_by ~step:max_int 0n 2n |> Iter.to_list);; eq' [ 0n ] (range_by ~step:max_int 0n 2n |> Iter.to_list);;
q q
Q.(pair (map of_int small_int) (map of_int small_int)) Q.(pair (map of_int nat_small) (map of_int nat_small))
(fun (i, j) -> (fun (i, j) ->
let i = min i j and j = max i j in let i = min i j and j = max i j in
CCList.equal CCNativeint.equal CCList.equal CCNativeint.equal

View file

@ -161,7 +161,7 @@ eq
;; ;;
q q
Q.(printable_string) Q.(string_printable)
(fun s -> (fun s ->
let pred = function let pred = function
| 'a' .. 'z' | 'A' .. 'Z' | '{' | '}' -> true | 'a' .. 'z' | 'A' .. 'Z' | '{' | '}' -> true

View file

@ -2,10 +2,10 @@ open CCRandom
module T = (val Containers_testlib.make ~__FILE__ ()) module T = (val Containers_testlib.make ~__FILE__ ())
include T;; include T;;
q Q.(list small_int) (fun l -> l = [] || List.mem (run (pick_list l)) l);; q Q.(list nat_small) (fun l -> l = [] || List.mem (run (pick_list l)) l);;
q q
Q.(pair small_int small_int) Q.(pair nat_small nat_small)
(fun (i, j) -> (fun (i, j) ->
let len, n = 2 + min i j, max i j in let len, n = 2 + min i j, max i j in
let l = QCheck.Gen.generate1 (split_list n ~len) in let l = QCheck.Gen.generate1 (split_list n ~len) in

View file

@ -34,7 +34,7 @@ eq 42 (fold_ok ( + ) 2 (Ok 40));;
eq 40 (fold_ok ( + ) 40 (Error "foo"));; eq 40 (fold_ok ( + ) 40 (Error "foo"));;
eq (Ok []) (flatten_l []);; eq (Ok []) (flatten_l []);;
eq (Ok [ 1; 2; 3 ]) (flatten_l [ Ok 1; Ok 2; Ok 3 ]);; eq (Ok [ 1; 2; 3 ]) (flatten_l [ Ok 1; Ok 2; Ok 3 ]);;
eq (Error "ohno") (flatten_l [ Ok 1; Error "ohno"; Ok 2; Ok 3; Error "wut" ]) eq (Error "ohno") (flatten_l [ Ok 1; Error "ohno"; Ok 2; Ok 3; Error "wut" ]);;
(* Additional comprehensive tests for CCResult *) (* Additional comprehensive tests for CCResult *)
@ -44,15 +44,15 @@ eq (Error "failed") (fail "failed");;
(* Test of_exn and of_exn_trace *) (* Test of_exn and of_exn_trace *)
t @@ fun () -> t @@ fun () ->
match of_exn (Failure "test") with match of_exn (Failure "test") with
| Error msg -> String.length msg > 0 | Error msg -> String.length msg > 0
| Ok _ -> false | Ok _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
match of_exn_trace (Failure "test") with match of_exn_trace (Failure "test") with
| Error msg -> String.length msg > 0 | Error msg -> String.length msg > 0
| Ok _ -> false | Ok _ -> false
;; ;;
(* Test opt_map *) (* Test opt_map *)
@ -70,30 +70,35 @@ eq (Ok 5) (map_err String.uppercase_ascii (Ok 5));;
eq (Error "ERROR") (map_err String.uppercase_ascii (Error "error"));; eq (Error "ERROR") (map_err String.uppercase_ascii (Error "error"));;
(* Test map2 *) (* Test map2 *)
eq (Ok "HELLO") (map2 String.uppercase_ascii String.uppercase_ascii (Ok "hello"));; eq (Ok "HELLO")
eq (Error "ERROR") (map2 String.uppercase_ascii String.uppercase_ascii (Error "error"));; (map2 String.uppercase_ascii String.uppercase_ascii (Ok "hello"))
;;
eq (Error "ERROR")
(map2 String.uppercase_ascii String.uppercase_ascii (Error "error"))
;;
(* Test iter *) (* Test iter *)
t @@ fun () -> t @@ fun () ->
let r = ref 0 in let r = ref 0 in
iter (fun x -> r := x) (Ok 42); iter (fun x -> r := x) (Ok 42);
!r = 42 !r = 42
;; ;;
t @@ fun () -> t @@ fun () ->
let r = ref 0 in let r = ref 0 in
iter (fun x -> r := x) (Error "e"); iter (fun x -> r := x) (Error "e");
!r = 0 !r = 0
;; ;;
(* Test get_exn *) (* Test get_exn *)
eq 42 (get_exn (Ok 42));; eq 42 (get_exn (Ok 42));;
t @@ fun () -> t @@ fun () ->
try try
ignore (get_exn (Error "error")); ignore (get_exn (Error "error"));
false false
with Invalid_argument _ -> true with Invalid_argument _ -> true
;; ;;
(* Test get_or *) (* Test get_or *)
@ -102,8 +107,28 @@ eq 0 (get_or (Error "e") ~default:0);;
(* Test apply_or *) (* Test apply_or *)
eq 10 (apply_or (fun x -> Ok (x * 2)) 5);; eq 10 (apply_or (fun x -> Ok (x * 2)) 5);;
t @@ fun () -> apply_or (fun x -> if x > 0 then Ok (x * 2) else Error "neg") 5 = 10;;
t @@ fun () -> apply_or (fun x -> if x > 0 then Ok (x * 2) else Error "neg") (-5) = -5;; t @@ fun () ->
apply_or
(fun x ->
if x > 0 then
Ok (x * 2)
else
Error "neg")
5
= 10
;;
t @@ fun () ->
apply_or
(fun x ->
if x > 0 then
Ok (x * 2)
else
Error "neg")
(-5)
= -5
;;
(* Test map_or *) (* Test map_or *)
eq 10 (map_or (fun x -> x * 2) (Ok 5) ~default:0);; eq 10 (map_or (fun x -> x * 2) (Ok 5) ~default:0);;
@ -112,7 +137,10 @@ eq 0 (map_or (fun x -> x * 2) (Error "e") ~default:0);;
(* Test catch *) (* Test catch *)
eq 5 (catch (Ok 5) ~ok:CCFun.id ~err:(fun _ -> 0));; eq 5 (catch (Ok 5) ~ok:CCFun.id ~err:(fun _ -> 0));;
eq 0 (catch (Error "e") ~ok:CCFun.id ~err:(fun _ -> 0));; eq 0 (catch (Error "e") ~ok:CCFun.id ~err:(fun _ -> 0));;
eq "ERROR: e" (catch (Error "e") ~ok:Int.to_string ~err:(fun e -> "ERROR: " ^ e));;
eq "ERROR: e"
(catch (Error "e") ~ok:Int.to_string ~err:(fun e -> "ERROR: " ^ e))
;;
(* Test flat_map *) (* Test flat_map *)
eq (Ok 3) (flat_map (fun x -> Ok (x + 1)) (Ok 2));; eq (Ok 3) (flat_map (fun x -> Ok (x + 1)) (Ok 2));;
@ -131,65 +159,65 @@ t @@ fun () -> not (is_error (Ok 1));;
(* Test guard and guard_str *) (* Test guard and guard_str *)
t @@ fun () -> t @@ fun () ->
match guard (fun () -> 42) with match guard (fun () -> 42) with
| Ok 42 -> true | Ok 42 -> true
| _ -> false | _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
match guard (fun () -> failwith "error") with match guard (fun () -> failwith "error") with
| Error _ -> true | Error _ -> true
| _ -> false | _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
match guard_str (fun () -> 42) with match guard_str (fun () -> 42) with
| Ok 42 -> true | Ok 42 -> true
| _ -> false | _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
match guard_str (fun () -> failwith "test error") with match guard_str (fun () -> failwith "test error") with
| Error msg -> String.length msg > 0 | Error msg -> String.length msg > 0
| _ -> false | _ -> false
;; ;;
(* Test guard_str_trace *) (* Test guard_str_trace *)
t @@ fun () -> t @@ fun () ->
match guard_str_trace (fun () -> 42) with match guard_str_trace (fun () -> 42) with
| Ok 42 -> true | Ok 42 -> true
| _ -> false | _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
match guard_str_trace (fun () -> failwith "test error") with match guard_str_trace (fun () -> failwith "test error") with
| Error msg -> String.length msg > 0 | Error msg -> String.length msg > 0
| _ -> false | _ -> false
;; ;;
(* Test wrap functions *) (* Test wrap functions *)
eq (Ok 6) (wrap1 (( + ) 1) 5);; eq (Ok 6) (wrap1 (( + ) 1) 5);;
t @@ fun () -> t @@ fun () ->
match wrap1 (fun _ -> failwith "error") () with match wrap1 (fun _ -> failwith "error") () with
| Error _ -> true | Error _ -> true
| _ -> false | _ -> false
;; ;;
eq (Ok 7) (wrap2 ( + ) 3 4);; eq (Ok 7) (wrap2 ( + ) 3 4);;
t @@ fun () -> t @@ fun () ->
match wrap2 (fun _ _ -> failwith "error") 1 2 with match wrap2 (fun _ _ -> failwith "error") 1 2 with
| Error _ -> true | Error _ -> true
| _ -> false | _ -> false
;; ;;
eq (Ok 10) (wrap3 (fun a b c -> a + b + c) 2 3 5);; eq (Ok 10) (wrap3 (fun a b c -> a + b + c) 2 3 5);;
t @@ fun () -> t @@ fun () ->
match wrap3 (fun _ _ _ -> failwith "error") 1 2 3 with match wrap3 (fun _ _ _ -> failwith "error") 1 2 3 with
| Error _ -> true | Error _ -> true
| _ -> false | _ -> false
;; ;;
(* Test pure *) (* Test pure *)
@ -207,42 +235,65 @@ eq (Error "e2") (both (Ok 3) (Error "e2"));;
eq (Error "e1") (both (Error "e1") (Error "e2"));; eq (Error "e1") (both (Error "e1") (Error "e2"));;
(* Test map_l *) (* Test map_l *)
eq (Ok [2; 3; 4]) (map_l (fun x -> Ok (x + 1)) [1; 2; 3]);; eq (Ok [ 2; 3; 4 ]) (map_l (fun x -> Ok (x + 1)) [ 1; 2; 3 ]);;
eq (Error "e") (map_l (fun x -> if x > 0 then Ok x else Error "e") [1; -1; 2]);;
eq (Error "e")
(map_l
(fun x ->
if x > 0 then
Ok x
else
Error "e")
[ 1; -1; 2 ])
;;
eq (Ok []) (map_l (fun x -> Ok x) []);; eq (Ok []) (map_l (fun x -> Ok x) []);;
(* Test fold_l *) (* Test fold_l *)
eq (Ok 6) (fold_l (fun acc x -> Ok (acc + x)) 0 [1; 2; 3]);; eq (Ok 6) (fold_l (fun acc x -> Ok (acc + x)) 0 [ 1; 2; 3 ]);;
eq (Error "e") (fold_l (fun _ x -> if x > 0 then Ok x else Error "e") 0 [1; -1; 2]);;
eq (Error "e")
(fold_l
(fun _ x ->
if x > 0 then
Ok x
else
Error "e")
0 [ 1; -1; 2 ])
;;
(* Test choose *) (* Test choose *)
eq (Ok 1) (choose [Ok 1; Ok 2; Ok 3]);; eq (Ok 1) (choose [ Ok 1; Ok 2; Ok 3 ]);;
eq (Ok 2) (choose [Error "e1"; Ok 2; Ok 3]);; eq (Ok 2) (choose [ Error "e1"; Ok 2; Ok 3 ]);;
eq (Ok 3) (choose [Error "e1"; Error "e2"; Ok 3]);; eq (Ok 3) (choose [ Error "e1"; Error "e2"; Ok 3 ]);;
eq (Error ["e1"; "e2"; "e3"]) (choose [Error "e1"; Error "e2"; Error "e3"]);; eq (Error [ "e1"; "e2"; "e3" ]) (choose [ Error "e1"; Error "e2"; Error "e3" ])
;;
eq (Error []) (choose []);; eq (Error []) (choose []);;
(* Test retry *) (* Test retry *)
t @@ fun () -> t @@ fun () ->
let attempts = ref 0 in let attempts = ref 0 in
let f () = let f () =
incr attempts; incr attempts;
if !attempts < 3 then Error "fail" else Ok "success" if !attempts < 3 then
in Error "fail"
match retry 5 f with else
| Ok "success" -> !attempts = 3 Ok "success"
| _ -> false in
match retry 5 f with
| Ok "success" -> !attempts = 3
| _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
let attempts = ref 0 in let attempts = ref 0 in
let f () = let f () =
incr attempts; incr attempts;
Error "always fails" Error "always fails"
in in
match retry 3 f with match retry 3 f with
| Error errs -> !attempts = 3 && List.length errs = 3 | Error errs -> !attempts = 3 && List.length errs = 3
| _ -> false | _ -> false
;; ;;
(* Test to_opt *) (* Test to_opt *)
@ -257,71 +308,79 @@ eq (Error "option is None") (of_opt None);;
t @@ fun () -> equal ~err:String.equal Int.equal (Ok 5) (Ok 5);; t @@ fun () -> equal ~err:String.equal Int.equal (Ok 5) (Ok 5);;
t @@ fun () -> not (equal ~err:String.equal Int.equal (Ok 5) (Ok 6));; t @@ fun () -> not (equal ~err:String.equal Int.equal (Ok 5) (Ok 6));;
t @@ fun () -> equal ~err:String.equal Int.equal (Error "e") (Error "e");; t @@ fun () -> equal ~err:String.equal Int.equal (Error "e") (Error "e");;
t @@ fun () -> not (equal ~err:String.equal Int.equal (Error "e1") (Error "e2"));; t @@ fun () -> not (equal ~err:String.equal Int.equal (Error "e1") (Error "e2"))
;;
t @@ fun () -> not (equal ~err:String.equal Int.equal (Ok 5) (Error "e"));; t @@ fun () -> not (equal ~err:String.equal Int.equal (Ok 5) (Error "e"));;
(* Test compare *) (* Test compare *)
t @@ fun () -> compare ~err:String.compare Int.compare (Ok 5) (Ok 5) = 0;; t @@ fun () -> compare ~err:String.compare Int.compare (Ok 5) (Ok 5) = 0;;
t @@ fun () -> compare ~err:String.compare Int.compare (Ok 5) (Ok 6) < 0;; t @@ fun () -> compare ~err:String.compare Int.compare (Ok 5) (Ok 6) < 0;;
t @@ fun () -> compare ~err:String.compare Int.compare (Ok 6) (Ok 5) > 0;; t @@ fun () -> compare ~err:String.compare Int.compare (Ok 6) (Ok 5) > 0;;
t @@ fun () -> compare ~err:String.compare Int.compare (Error "a") (Error "a") = 0;;
t @@ fun () -> compare ~err:String.compare Int.compare (Error "a") (Error "b") < 0;; t @@ fun () ->
compare ~err:String.compare Int.compare (Error "a") (Error "a") = 0
;;
t @@ fun () ->
compare ~err:String.compare Int.compare (Error "a") (Error "b") < 0
;;
t @@ fun () -> compare ~err:String.compare Int.compare (Error "a") (Ok 5) < 0;; t @@ fun () -> compare ~err:String.compare Int.compare (Error "a") (Ok 5) < 0;;
t @@ fun () -> compare ~err:String.compare Int.compare (Ok 5) (Error "a") > 0;; t @@ fun () -> compare ~err:String.compare Int.compare (Ok 5) (Error "a") > 0;;
(* Property-based tests *) (* Property-based tests *)
q Q.int (fun x -> q Q.int (fun x -> return x = Ok x);;
return x = Ok x q Q.(result int string) (fun r -> is_ok r = not (is_error r));;
);; q Q.(result int string) (fun r -> map CCFun.id r = r);;
q Q.(result int string) (fun r -> map_err CCFun.id r = r);;
q Q.(result int string) (fun r -> flat_map return r = r);;
q Q.(result int string) (fun r -> equal ~err:String.equal Int.equal r r);;
q Q.(result int string) (fun r -> q
is_ok r = not (is_error r) Q.(result int string)
);; (fun r -> compare ~err:String.compare Int.compare r r = 0)
;;
q Q.(result int string) (fun r -> q
map CCFun.id r = r Q.(result int string)
);; (fun r ->
of_opt (to_opt r)
=
match r with
| Ok x -> Ok x
| Error _ -> Error "option is None")
;;
q Q.(result int string) (fun r -> q Q.int (fun x -> to_opt (Ok x) = Some x);;
map_err CCFun.id r = r q Q.string (fun e -> to_opt (Error e) = None);;
);;
q Q.(result int string) (fun r -> q
flat_map return r = r Q.(pair (result int string) int)
);; (fun (r, default) ->
let v = get_or r ~default in
match r with
| Ok x -> v = x
| Error _ -> v = default)
;;
q Q.(result int string) (fun r -> q
equal ~err:String.equal Int.equal r r Q.(list (result int string))
);; (fun l ->
match flatten_l l with
q Q.(result int string) (fun r -> | Ok values ->
compare ~err:String.compare Int.compare r r = 0 List.for_all
);; (function
| Ok _ -> true
q Q.(result int string) (fun r -> | Error _ -> false)
of_opt (to_opt r) = (match r with Ok x -> Ok x | Error _ -> Error "option is None") l
);; && List.length values <= List.length l
| Error _ ->
q Q.int (fun x -> List.exists
to_opt (Ok x) = Some x (function
);; | Error _ -> true
| Ok _ -> false)
q Q.string (fun e -> l)
to_opt (Error e) = None ;;
);;
q Q.(pair (result int string) int) (fun (r, default) ->
let v = get_or r ~default in
match r with
| Ok x -> v = x
| Error _ -> v = default
);;
q Q.(list (result int string)) (fun l ->
match flatten_l l with
| Ok values -> List.for_all (function Ok _ -> true | Error _ -> false) l && List.length values <= List.length l
| Error _ -> List.exists (function Error _ -> true | Ok _ -> false) l
);;
(* Additional focused tests for high-value functions *) (* Additional focused tests for high-value functions *)
t @@ fun () -> map (( + ) 1) (Ok 2) = Ok 3;; t @@ fun () -> map (( + ) 1) (Ok 2) = Ok 3;;
@ -329,4 +388,4 @@ t @@ fun () -> is_ok (Ok 1) && not (is_ok (Error "e"));;
t @@ fun () -> to_opt (Ok 5) = Some 5 && to_opt (Error "e") = None;; t @@ fun () -> to_opt (Ok 5) = Some 5 && to_opt (Error "e") = None;;
t @@ fun () -> both (Ok 3) (Ok 5) = Ok (3, 5);; t @@ fun () -> both (Ok 3) (Ok 5) = Ok (3, 5);;
q Q.int (fun x -> return x = Ok x);; q Q.int (fun x -> return x = Ok x);;
q Q.int (fun x -> to_opt (Ok x) = Some x);; q Q.int (fun x -> to_opt (Ok x) = Some x)

View file

@ -11,7 +11,7 @@ of_list [ 1; 2; 3; 4 ] |> take_while (fun x -> x < 4) |> to_list = [ 1; 2; 3 ]
;; ;;
q q
(Q.pair (Q.list Q.small_int) Q.small_int) (Q.pair (Q.list Q.nat_small) Q.nat_small)
(fun (l, n) -> (fun (l, n) ->
let s = of_list l in let s = of_list l in
let s1, s2 = take n s, drop n s in let s1, s2 = take n s, drop n s in

View file

@ -74,7 +74,7 @@ let sexp_gen =
match n with match n with
| 0 -> atom st | 0 -> atom st
| _ -> | _ ->
frequency oneof_weighted
[ [
1, atom; 2, map mklist (list_size (0 -- 10) (self (n / 10))); 1, atom; 2, map mklist (list_size (0 -- 10) (self (n / 10)));
] ]
@ -154,7 +154,7 @@ let gen_csexp (str : string Q.Gen.t) : CS0.t Q.Gen.t =
let open Csexp in let open Csexp in
( fix @@ fun self depth -> ( fix @@ fun self depth ->
let mklist n = list_size (0 -- n) (self (depth + 1)) >|= fun l -> List l in let mklist n = list_size (0 -- n) (self (depth + 1)) >|= fun l -> List l in
frequency oneof_weighted
@@ List.flatten @@ List.flatten
[ [
[ (3, str >|= fun s -> Atom s) ]; [ (3, str >|= fun s -> Atom s) ];

View file

@ -3,9 +3,9 @@ include T
open CCString open CCString
open Stdlib;; open Stdlib;;
q Q.printable_string (fun s -> s = rev (rev s));; q Q.string_printable (fun s -> s = rev (rev s));;
q Q.printable_string (fun s -> length s = length (rev s));; q Q.string_printable (fun s -> length s = length (rev s));;
q Q.printable_string (fun s -> rev s = (to_list s |> List.rev |> of_list));; q Q.string_printable (fun s -> rev s = (to_list s |> List.rev |> of_list));;
eq "abc" (rev "cba");; eq "abc" (rev "cba");;
eq "" (rev "");; eq "" (rev "");;
eq " " (rev " ") eq " " (rev " ")
@ -18,7 +18,7 @@ eq' 1 (find ~sub:"a" "_a_a_a_");;
eq' 6 (find ~start:5 ~sub:"a" "a1a234a");; eq' 6 (find ~start:5 ~sub:"a" "a1a234a");;
q ~count:10_000 q ~count:10_000
Q.(pair printable_string printable_string) Q.(pair string_printable string_printable)
(fun (s1, s2) -> (fun (s1, s2) ->
let i = find ~sub:s2 s1 in let i = find ~sub:s2 s1 in
i < 0 || String.sub s1 i (length s2) = s2) i < 0 || String.sub s1 i (length s2) = s2)
@ -45,7 +45,7 @@ eq' 4 (rfind ~sub:"bc" "abcdbcd");;
eq' 6 (rfind ~sub:"a" "a1a234a");; eq' 6 (rfind ~sub:"a" "a1a234a");;
q ~count:10_000 q ~count:10_000
Q.(pair printable_string printable_string) Q.(pair string_printable string_printable)
(fun (s1, s2) -> (fun (s1, s2) ->
let i = rfind ~sub:s2 s1 in let i = rfind ~sub:s2 s1 in
i < 0 || String.sub s1 i (length s2) = s2) i < 0 || String.sub s1 i (length s2) = s2)
@ -102,7 +102,7 @@ eq
;; ;;
q q
Q.(printable_string) Q.(string_printable)
(fun s -> (fun s ->
let s = split_on_char ' ' s |> String.concat " " in let s = split_on_char ' ' s |> String.concat " " in
s = (split_on_char ' ' s |> String.concat " ")) s = (split_on_char ' ' s |> String.concat " "))
@ -116,7 +116,7 @@ t @@ fun () -> compare_versions "0.foo" "0.0" < 0;;
t @@ fun () -> compare_versions "1.2.3.4" "01.2.4.3" < 0;; t @@ fun () -> compare_versions "1.2.3.4" "01.2.4.3" < 0;;
q q
Q.(pair printable_string printable_string) Q.(pair string_printable string_printable)
(fun (a, b) -> (fun (a, b) ->
CCOrd.equiv (compare_versions a b) (CCOrd.opp compare_versions b a)) CCOrd.equiv (compare_versions a b) (CCOrd.opp compare_versions b a))
;; ;;
@ -130,14 +130,14 @@ t @@ fun () -> compare_natural "foo1a1" "foo1a2" < 0;;
t @@ fun () -> compare_natural "foo1a17" "foo1a2" > 0;; t @@ fun () -> compare_natural "foo1a17" "foo1a2" > 0;;
q q
Q.(pair printable_string printable_string) Q.(pair string_printable string_printable)
(fun (a, b) -> CCOrd.opp compare_natural a b = compare_natural b a) (fun (a, b) -> CCOrd.opp compare_natural a b = compare_natural b a)
;; ;;
q Q.(printable_string) (fun a -> compare_natural a a = 0);; q Q.(string_printable) (fun a -> compare_natural a a = 0);;
q q
Q.(triple printable_string printable_string printable_string) Q.(triple string_printable string_printable string_printable)
(fun (a, b, c) -> (fun (a, b, c) ->
if compare_natural a b < 0 && compare_natural b c < 0 then if compare_natural a b < 0 && compare_natural b c < 0 then
compare_natural a c < 0 compare_natural a c < 0
@ -145,18 +145,18 @@ q
Q.assume_fail ()) Q.assume_fail ())
;; ;;
q Q.(string_of_size Gen.(0 -- 30)) (fun s -> edit_distance s s = 0);; q Q.(string_size Gen.(0 -- 30)) (fun s -> edit_distance s s = 0);;
q q
Q.( Q.(
let p = string_of_size Gen.(0 -- 20) in let p = string_size Gen.(0 -- 20) in
pair p p) pair p p)
(fun (s1, s2) -> edit_distance s1 s2 = edit_distance s2 s1) (fun (s1, s2) -> edit_distance s1 s2 = edit_distance s2 s1)
;; ;;
q q
Q.( Q.(
let p = string_of_size Gen.(0 -- 20) in let p = string_size Gen.(0 -- 20) in
pair p p) pair p p)
(fun (s1, s2) -> (fun (s1, s2) ->
let e = edit_distance s1 s2 in let e = edit_distance s1 s2 in
@ -232,7 +232,7 @@ eq ("abc", "") (take_drop 3 "abc");;
eq ("abc", "") (take_drop 5 "abc");; eq ("abc", "") (take_drop 5 "abc");;
q q
Q.(printable_string) Q.(string_printable)
(fun s -> (fun s ->
let predicate c = Char.code c mod 2 = 0 in let predicate c = Char.code c mod 2 = 0 in
let prefix = take_while predicate s in let prefix = take_while predicate s in
@ -243,7 +243,7 @@ q
;; ;;
q q
Q.(printable_string) Q.(string_printable)
(fun s -> (fun s ->
let predicate c = Char.code c mod 2 = 0 in let predicate c = Char.code c mod 2 = 0 in
let prefix = rdrop_while predicate s in let prefix = rdrop_while predicate s in
@ -279,28 +279,28 @@ eq' [ "ab"; "c" ] (lines "ab\nc\n");;
eq' [] (lines "");; eq' [] (lines "");;
eq' [ "" ] (lines "\n");; eq' [ "" ] (lines "\n");;
eq' [ ""; "a" ] (lines "\na");; eq' [ ""; "a" ] (lines "\na");;
q Q.(printable_string) (fun s -> lines s = (lines_gen s |> Gen.to_list));; q Q.(string_printable) (fun s -> lines s = (lines_gen s |> Gen.to_list));;
q Q.(printable_string) (fun s -> lines s = (lines_iter s |> Iter.to_list));; q Q.(string_printable) (fun s -> lines s = (lines_iter s |> Iter.to_list));;
q q
Q.(small_list printable_string) Q.(list_small string_printable)
(fun l -> concat_iter ~sep:"\n" (Iter.of_list l) = concat "\n" l) (fun l -> concat_iter ~sep:"\n" (Iter.of_list l) = concat "\n" l)
;; ;;
q q
Q.(small_list printable_string) Q.(list_small string_printable)
(fun l -> concat_gen ~sep:"\n" (Gen.of_list l) = concat "\n" l) (fun l -> concat_gen ~sep:"\n" (Gen.of_list l) = concat "\n" l)
;; ;;
q q
Q.(small_list printable_string) Q.(list_small string_printable)
(fun l -> concat_seq ~sep:"\n" (CCSeq.of_list l) = concat "\n" l) (fun l -> concat_seq ~sep:"\n" (CCSeq.of_list l) = concat "\n" l)
;; ;;
eq ~printer:CCFun.id "" (unlines []);; eq ~printer:CCFun.id "" (unlines []);;
eq ~printer:CCFun.id "ab\nc\n" (unlines [ "ab"; "c" ]);; eq ~printer:CCFun.id "ab\nc\n" (unlines [ "ab"; "c" ]);;
q Q.printable_string (fun s -> trim (unlines (lines s)) = trim s);; q Q.string_printable (fun s -> trim (unlines (lines s)) = trim s);;
q Q.printable_string (fun s -> trim (unlines_gen (lines_gen s)) = trim s);; q Q.string_printable (fun s -> trim (unlines_gen (lines_gen s)) = trim s);;
eq ~printer:CCFun.id "" (take_while (Char.equal 'c') "heloo_cc");; eq ~printer:CCFun.id "" (take_while (Char.equal 'c') "heloo_cc");;
eq ~printer:CCFun.id "" (take_while (Char.equal 'c') "");; eq ~printer:CCFun.id "" (take_while (Char.equal 'c') "");;
eq ~printer:CCFun.id "c" (take_while (Char.equal 'c') "c");; eq ~printer:CCFun.id "c" (take_while (Char.equal 'c') "c");;
@ -320,7 +320,7 @@ eq ~printer:CCFun.id "ANTED"
;; ;;
q q
Q.(small_list small_string) Q.(list_small string_small)
(fun l -> (fun l ->
let l = unlines l |> lines in let l = unlines l |> lines in
l = (unlines l |> lines)) l = (unlines l |> lines))
@ -352,16 +352,16 @@ eq ~printer:Q.Print.string "abde"
"abcdec") "abcdec")
;; ;;
q Q.printable_string (fun s -> filter (fun _ -> true) s = s);; q Q.string_printable (fun s -> filter (fun _ -> true) s = s);;
eq ~printer:Q.Print.string "abcde" (uniq Stdlib.( = ) "abbccdeeeee");; eq ~printer:Q.Print.string "abcde" (uniq Stdlib.( = ) "abbccdeeeee");;
eq ~printer:CCFun.id "abc " (ltrim " abc ");; eq ~printer:CCFun.id "abc " (ltrim " abc ");;
eq ~printer:CCFun.id " abc" (rtrim " abc ");; eq ~printer:CCFun.id " abc" (rtrim " abc ");;
q Q.(printable_string) (fun s -> String.trim s = (s |> ltrim |> rtrim));; q Q.(string_printable) (fun s -> String.trim s = (s |> ltrim |> rtrim));;
q Q.(printable_string) (fun s -> ltrim s = ltrim (ltrim s));; q Q.(string_printable) (fun s -> ltrim s = ltrim (ltrim s));;
q Q.(printable_string) (fun s -> rtrim s = rtrim (rtrim s));; q Q.(string_printable) (fun s -> rtrim s = rtrim (rtrim s));;
q q
Q.(printable_string) Q.(string_printable)
(fun s -> (fun s ->
let s' = ltrim s in let s' = ltrim s in
if s' = "" then if s' = "" then
@ -371,7 +371,7 @@ q
;; ;;
q q
Q.(printable_string) Q.(string_printable)
(fun s -> (fun s ->
let s' = rtrim s in let s' = rtrim s in
if s' = "" then if s' = "" then
@ -384,13 +384,13 @@ t @@ fun () -> equal_caseless "foo" "FoO";;
t @@ fun () -> equal_caseless "helLo" "HEllO";; t @@ fun () -> equal_caseless "helLo" "HEllO";;
q q
Q.(pair printable_string printable_string) Q.(pair string_printable string_printable)
(fun (s1, s2) -> (fun (s1, s2) ->
equal_caseless s1 s2 = (lowercase_ascii s1 = lowercase_ascii s2)) equal_caseless s1 s2 = (lowercase_ascii s1 = lowercase_ascii s2))
;; ;;
q Q.(printable_string) (fun s -> equal_caseless s s);; q Q.(string_printable) (fun s -> equal_caseless s s);;
q Q.(printable_string) (fun s -> equal_caseless (uppercase_ascii s) s) q Q.(string_printable) (fun s -> equal_caseless (uppercase_ascii s) s)
let eq' = eq ~printer:(Printf.sprintf "%S");; let eq' = eq ~printer:(Printf.sprintf "%S");;

View file

@ -63,12 +63,12 @@ assert_equal ~cmp:equal ~printer s s';
true true
;; ;;
q Q.small_string (fun s -> q Q.string_small (fun s ->
Q.assume (CCString.for_all (fun c -> Char.code c < 128) s); Q.assume (CCString.for_all (fun c -> Char.code c < 128) s);
is_valid s) is_valid s)
;; ;;
q ~long_factor:10 Q.small_string (fun s -> q ~long_factor:10 Q.string_small (fun s ->
Q.assume (CCString.for_all (fun c -> Char.code c < 128) s); Q.assume (CCString.for_all (fun c -> Char.code c < 128) s);
s = (of_string_exn s |> to_iter |> of_iter |> to_string)) s = (of_string_exn s |> to_iter |> of_iter |> to_string))
;; ;;
@ -79,21 +79,21 @@ q ~long_factor:10 Q.string (fun s ->
;; ;;
q ~long_factor:10 ~count:20_000 q ~long_factor:10 ~count:20_000
Q.(small_list arb_uchar) Q.(list_small arb_uchar)
(fun l -> (fun l ->
let s = of_list l in let s = of_list l in
l = to_list s) l = to_list s)
;; ;;
q ~long_factor:10 q ~long_factor:10
Q.(small_list arb_uchar) Q.(list_small arb_uchar)
(fun l -> (fun l ->
let s = of_list l in let s = of_list l in
l = to_list @@ of_gen @@ to_gen s) l = to_list @@ of_gen @@ to_gen s)
;; ;;
q ~long_factor:10 q ~long_factor:10
Q.(small_list arb_uchar) Q.(list_small arb_uchar)
(fun l -> (fun l ->
let s = of_list l in let s = of_list l in
l = to_list @@ of_iter @@ to_iter s) l = to_list @@ of_iter @@ to_iter s)
@ -127,7 +127,7 @@ q ~long_factor:40 Q.string (fun s ->
(* compare with uutf *) (* compare with uutf *)
q ~long_factor:40 ~count:50_000 Q.small_string (fun s -> q ~long_factor:40 ~count:50_000 Q.string_small (fun s ->
let v1 = is_valid s in let v1 = is_valid s in
let v2 = uutf_is_valid s in let v2 = uutf_is_valid s in
if v1 = v2 then if v1 = v2 then
@ -137,7 +137,7 @@ q ~long_factor:40 ~count:50_000 Q.small_string (fun s ->
;; ;;
q ~long_factor:40 ~count:50_000 q ~long_factor:40 ~count:50_000
Q.(small_list arb_uchar) Q.(list_small arb_uchar)
(fun l -> (fun l ->
let pp s = Q.Print.(list pp_uchar) s in let pp s = Q.Print.(list pp_uchar) s in
let uutf = uutf_of_l l in let uutf = uutf_of_l l in
@ -148,7 +148,7 @@ q ~long_factor:40 ~count:50_000
Q.Test.fail_reportf "l: '%s', uutf: '%s', containers: '%s'" (pp l) uutf s) Q.Test.fail_reportf "l: '%s', uutf: '%s', containers: '%s'" (pp l) uutf s)
;; ;;
q ~long_factor:40 ~count:50_000 Q.small_string (fun s -> q ~long_factor:40 ~count:50_000 Q.string_small (fun s ->
Q.assume (is_valid s && uutf_is_valid s); Q.assume (is_valid s && uutf_is_valid s);
let pp s = Q.Print.(list pp_uchar) s in let pp s = Q.Print.(list pp_uchar) s in
let l_uutf = uutf_to_iter s |> Iter.to_list in let l_uutf = uutf_to_iter s |> Iter.to_list in
@ -170,10 +170,10 @@ true
;; ;;
q q
Q.(small_list arb_uchar) Q.(list_small arb_uchar)
(fun l -> of_list l = concat empty (List.map of_uchar l)) (fun l -> of_list l = concat empty (List.map of_uchar l))
;; ;;
q q
Q.(pair small_nat arb_uchar) Q.(pair nat_small arb_uchar)
(fun (i, c) -> make i c = concat empty (CCList.init i (fun _ -> of_uchar c))) (fun (i, c) -> make i c = concat empty (CCList.init i (fun _ -> of_uchar c)))

View file

@ -269,7 +269,7 @@ true
;; ;;
q q
Q.(list_of_size (Gen.int_range 10 10) small_int) Q.(list_size (Gen.int_range 10 10) nat_small)
(fun l -> (fun l ->
let v1 = of_list l and v2 = of_list l in let v1 = of_list l and v2 = of_list l in
remove_and_shift v1 9; remove_and_shift v1 9;
@ -278,7 +278,7 @@ q
;; ;;
q q
Q.(list_of_size (Gen.int_range 10 10) small_int) Q.(list_size (Gen.int_range 10 10) nat_small)
(fun l -> (fun l ->
let l = List.sort CCInt.compare l in let l = List.sort CCInt.compare l in
let v = of_list l in let v = of_list l in
@ -287,7 +287,7 @@ q
;; ;;
q q
Q.(list_of_size (Gen.int_range 10 10) small_int) Q.(list_size (Gen.int_range 10 10) nat_small)
(fun l -> (fun l ->
let l = List.sort CCInt.compare l in let l = List.sort CCInt.compare l in
let v1 = of_list l and v2 = of_list l in let v1 = of_list l and v2 = of_list l in
@ -407,13 +407,13 @@ t @@ fun () -> not (equal ( = ) (return 42) (create ()));;
q q
Q.( Q.(
let g = list_of_size Gen.(0 -- 10) small_int in let g = list_size Gen.(0 -- 10) nat_small in
pair g g) pair g g)
(fun (l1, l2) -> equal ( = ) (of_list l1) (of_list l2) = (l1 = l2)) (fun (l1, l2) -> equal ( = ) (of_list l1) (of_list l2) = (l1 = l2))
;; ;;
q q
Q.(pair (small_list small_int) (small_list small_int)) Q.(pair (list_small nat_small) (list_small nat_small))
(fun (l1, l2) -> (fun (l1, l2) ->
let v1 = of_list l1 in let v1 = of_list l1 in
let v2 = of_list l2 in let v2 = of_list l2 in
@ -421,7 +421,7 @@ q
;; ;;
q q
Q.(pair (small_list small_int) (small_list small_int)) Q.(pair (list_small nat_small) (list_small nat_small))
(fun (l1, l2) -> (fun (l1, l2) ->
let v1 = of_list l1 in let v1 = of_list l1 in
let v2 = of_list l2 in let v2 = of_list l2 in
@ -452,7 +452,7 @@ true
;; ;;
q q
Q.(small_list small_int) Q.(list_small nat_small)
(fun l -> (fun l ->
let v = of_list l in let v = of_list l in
let v' = copy v in let v' = copy v in
@ -466,7 +466,7 @@ assert_equal [ 1; 2; 3; 4; 5 ] (to_list v);
true true
;; ;;
q (gen Q.small_int) (fun v -> q (gen Q.nat_small) (fun v ->
let n = size v / 2 in let n = size v / 2 in
let l = to_list v in let l = to_list v in
let h = Iter.(to_list (take n (of_list l))) in let h = Iter.(to_list (take n (of_list l))) in
@ -475,13 +475,13 @@ q (gen Q.small_int) (fun v ->
h = to_list v') h = to_list v')
;; ;;
q (gen Q.small_int) (fun v -> q (gen Q.nat_small) (fun v ->
let v' = copy v in let v' = copy v in
shrink_to_fit v; shrink_to_fit v;
to_list v = to_list v') to_list v = to_list v')
;; ;;
q (gen Q.small_int) (fun v -> q (gen Q.nat_small) (fun v ->
let v' = copy v in let v' = copy v in
sort' Stdlib.compare v'; sort' Stdlib.compare v';
let l = to_list v' in let l = to_list v' in
@ -495,7 +495,7 @@ to_list v = [ 1; 2; 3; 4; 5 ]
;; ;;
q ~long_factor:10 q ~long_factor:10
Q.(small_list small_int) Q.(list_small nat_small)
(fun l -> (fun l ->
let v = of_list l in let v = of_list l in
uniq_sort Stdlib.compare v; uniq_sort Stdlib.compare v;
@ -517,7 +517,7 @@ to_list (map string_of_int v) = [ "1"; "2"; "3" ]
;; ;;
q q
Q.(pair (fun1 Observable.int small_int) (small_list small_int)) Q.(pair (fun1 Observable.int nat_small) (list_small nat_small))
(fun (Q.Fun (_, f), l) -> (fun (Q.Fun (_, f), l) ->
let v = of_list l in let v = of_list l in
to_list (map f v) = List.map f l) to_list (map f v) = List.map f l)
@ -533,14 +533,14 @@ to_list (mapi (fun i e -> Printf.sprintf "%i %i" i e) v)
;; ;;
q q
Q.(pair (fun2 Observable.int Observable.int small_int) (small_list small_int)) Q.(pair (fun2 Observable.int Observable.int nat_small) (list_small nat_small))
(fun (Q.Fun (_, f), l) -> (fun (Q.Fun (_, f), l) ->
let v = of_list l in let v = of_list l in
to_list (mapi f v) = List.mapi f l) to_list (mapi f v) = List.mapi f l)
;; ;;
q q
Q.(pair (fun1 Observable.int small_int) (small_list small_int)) Q.(pair (fun1 Observable.int nat_small) (list_small nat_small))
(fun (Q.Fun (_, f), l) -> (fun (Q.Fun (_, f), l) ->
let v = of_list l in let v = of_list l in
map_in_place f v; map_in_place f v;
@ -554,7 +554,7 @@ to_list v = [ 1; 2; 3 ]
;; ;;
q q
Q.(pair (fun1 Observable.int bool) (small_list small_int)) Q.(pair (fun1 Observable.int bool) (list_small nat_small))
(fun (Q.Fun (_, f), l) -> (fun (Q.Fun (_, f), l) ->
let v = of_list l in let v = of_list l in
filter_in_place f v; filter_in_place f v;
@ -570,7 +570,7 @@ filter (fun x -> x mod 2 = 0) (1 -- 1_000_000) |> length = 500_000
;; ;;
q q
Q.(pair (fun1 Observable.int bool) (small_list small_int)) Q.(pair (fun1 Observable.int bool) (list_small nat_small))
(fun (Q.Fun (_, f), l) -> (fun (Q.Fun (_, f), l) ->
let v = of_list l in let v = of_list l in
to_list (filter f v) = List.filter f l) to_list (filter f v) = List.filter f l)
@ -580,35 +580,35 @@ t @@ fun () -> fold ( + ) 0 (of_list [ 1; 2; 3; 4; 5 ]) = 15;;
t @@ fun () -> fold ( + ) 0 (create ()) = 0;; t @@ fun () -> fold ( + ) 0 (create ()) = 0;;
q q
Q.(pair (fun2 Observable.int Observable.int small_int) (small_list small_int)) Q.(pair (fun2 Observable.int Observable.int nat_small) (list_small nat_small))
(fun (Q.Fun (_, f), l) -> (fun (Q.Fun (_, f), l) ->
let v = of_list l in let v = of_list l in
fold f 0 v = List.fold_left f 0 l) fold f 0 v = List.fold_left f 0 l)
;; ;;
q q
Q.(pair (fun1 Observable.int bool) (small_list small_int)) Q.(pair (fun1 Observable.int bool) (list_small nat_small))
(fun (Q.Fun (_, f), l) -> (fun (Q.Fun (_, f), l) ->
let v = of_list l in let v = of_list l in
exists f v = List.exists f l) exists f v = List.exists f l)
;; ;;
q q
Q.(pair (fun1 Observable.int bool) (small_list small_int)) Q.(pair (fun1 Observable.int bool) (list_small nat_small))
(fun (Q.Fun (_, f), l) -> (fun (Q.Fun (_, f), l) ->
let v = of_list l in let v = of_list l in
for_all f v = List.for_all f l) for_all f v = List.for_all f l)
;; ;;
q q
Q.(pair (fun1 Observable.int bool) (small_list small_int)) Q.(pair (fun1 Observable.int bool) (list_small nat_small))
(fun (Q.Fun (_, f), l) -> (fun (Q.Fun (_, f), l) ->
let v = of_list l in let v = of_list l in
find f v = CCList.find_pred f l) find f v = CCList.find_pred f l)
;; ;;
q q
Q.(list small_int) Q.(list nat_small)
(fun l -> (fun l ->
let v = of_list l in let v = of_list l in
let f x = x > 30 && x < 35 in let f x = x > 30 && x < 35 in
@ -623,14 +623,14 @@ q
;; ;;
q q
Q.(pair (fun1 Observable.int (option bool)) (small_list small_int)) Q.(pair (fun1 Observable.int (option bool)) (list_small nat_small))
(fun (Q.Fun (_, f), l) -> (fun (Q.Fun (_, f), l) ->
let v = of_list l in let v = of_list l in
to_list (filter_map f v) = CCList.filter_map f l) to_list (filter_map f v) = CCList.filter_map f l)
;; ;;
q q
Q.(pair (fun1 Observable.int (option small_int)) (small_list small_int)) Q.(pair (fun1 Observable.int (option nat_small)) (list_small nat_small))
(fun (Q.Fun (_, f), l) -> (fun (Q.Fun (_, f), l) ->
let v = of_list l in let v = of_list l in
filter_map_in_place f v; filter_map_in_place f v;
@ -668,7 +668,7 @@ eq ~cmp:( = )
;; ;;
q q
Q.(small_list small_int) Q.(list_small nat_small)
(fun l -> (fun l ->
let v = of_list l in let v = of_list l in
rev_in_place v; rev_in_place v;
@ -680,7 +680,7 @@ t @@ fun () -> rev (of_list [ 1; 2; 3; 4; 5 ]) |> to_list = [ 5; 4; 3; 2; 1 ];;
t @@ fun () -> rev (create ()) |> to_list = [];; t @@ fun () -> rev (create ()) |> to_list = [];;
q q
Q.(small_list small_int) Q.(list_small nat_small)
(fun l -> (fun l ->
let v = of_list l in let v = of_list l in
to_list (rev v) = List.rev l) to_list (rev v) = List.rev l)
@ -724,12 +724,12 @@ t @@ fun () -> 4 -- 1 |> to_list = [ 4; 3; 2; 1 ];;
t @@ fun () -> 0 -- 0 |> to_list = [ 0 ];; t @@ fun () -> 0 -- 0 |> to_list = [ 0 ];;
q q
Q.(pair small_int small_int) Q.(pair nat_small nat_small)
(fun (a, b) -> a -- b |> to_list = CCList.(a -- b)) (fun (a, b) -> a -- b |> to_list = CCList.(a -- b))
;; ;;
q q
Q.(pair small_int small_int) Q.(pair nat_small nat_small)
(fun (a, b) -> a --^ b |> to_list = CCList.(a --^ b)) (fun (a, b) -> a --^ b |> to_list = CCList.(a --^ b))
;; ;;

View file

@ -8,7 +8,7 @@ let ppli = CCFormat.(Dump.list int)
module Intset = CCSet.Make (CCInt);; module Intset = CCSet.Make (CCInt);;
q (Q.pair Q.small_int Q.bool) (fun (size, b) -> create ~size b |> length = size) q (Q.pair Q.nat_small Q.bool) (fun (size, b) -> create ~size b |> length = size)
;; ;;
t ~name:(spf "line %d" __LINE__) @@ fun () -> t ~name:(spf "line %d" __LINE__) @@ fun () ->
@ -31,14 +31,14 @@ t ~name:(spf "line %d" __LINE__) @@ fun () ->
create ~size:29 true |> to_sorted_list = CCList.range 0 28 create ~size:29 true |> to_sorted_list = CCList.range 0 28
;; ;;
q (Q.list Q.small_int) (fun l -> q (Q.list Q.nat_small) (fun l ->
let bv = of_list l in let bv = of_list l in
to_list bv = to_list (copy bv)) to_list bv = to_list (copy bv))
;; ;;
q Q.small_int (fun size -> create ~size true |> cardinal = size);; q Q.nat_small (fun size -> create ~size true |> cardinal = size);;
q Q.small_int (fun size -> q Q.nat_small (fun size ->
create ~size true |> to_sorted_list = CCList.init size CCFun.id) create ~size true |> to_sorted_list = CCList.init size CCFun.id)
;; ;;
@ -48,7 +48,7 @@ assert_equal ~printer:string_of_int 87 (CCBV.cardinal bv1);
true true
;; ;;
q Q.small_int (fun n -> CCBV.cardinal (CCBV.create ~size:n true) = n);; q Q.nat_small (fun n -> CCBV.cardinal (CCBV.create ~size:n true) = n);;
t ~name:(spf "line %d" __LINE__) @@ fun () -> t ~name:(spf "line %d" __LINE__) @@ fun () ->
let bv = CCBV.create ~size:99 false in let bv = CCBV.create ~size:99 false in
@ -169,7 +169,7 @@ eq'
;; ;;
q q
Q.(small_int) Q.(nat_small)
(fun n -> (fun n ->
assert (n >= 0); assert (n >= 0);
let bv = create ~size:n true in let bv = create ~size:n true in
@ -208,7 +208,7 @@ eq ~printer:(CCFormat.to_string ppli) [ 1; 2; 3; 4; 64; 130 ]
;; ;;
q q
Q.(small_list small_nat) Q.(list_small nat_small)
(fun l -> (fun l ->
let l = List.sort_uniq CCOrd.poly l in let l = List.sort_uniq CCOrd.poly l in
let l2 = of_list l |> to_sorted_list in let l2 = of_list l |> to_sorted_list in
@ -219,7 +219,7 @@ q
;; ;;
q q
Q.(small_list small_nat) Q.(list_small nat_small)
(fun l -> (fun l ->
let bv = of_list l in let bv = of_list l in
let l1 = bv |> to_sorted_list in let l1 = bv |> to_sorted_list in
@ -270,7 +270,7 @@ eq ~printer:(CCFormat.to_string ppli) [ 0; 3; 4; 6 ]
to_sorted_list v) to_sorted_list v)
;; ;;
q Q.small_int (fun size -> create ~size false |> negate |> cardinal = size);; q Q.nat_small (fun size -> create ~size false |> negate |> cardinal = size);;
t ~name:(spf "line %d" __LINE__) @@ fun () -> t ~name:(spf "line %d" __LINE__) @@ fun () ->
let bv1 = CCBV.of_list [ 1; 2; 3; 4 ] in let bv1 = CCBV.of_list [ 1; 2; 3; 4 ] in
@ -282,7 +282,7 @@ true
;; ;;
q ~name:"union" q ~name:"union"
Q.(pair (small_list small_nat) (small_list small_nat)) Q.(pair (list_small nat_small) (list_small nat_small))
(fun (l1, l2) -> (fun (l1, l2) ->
let bv1 = of_list l1 in let bv1 = of_list l1 in
let bv2 = of_list l2 in let bv2 = of_list l2 in
@ -343,7 +343,7 @@ true
;; ;;
q ~name:"inter" ~count:10_000 q ~name:"inter" ~count:10_000
Q.(pair (small_list small_nat) (small_list small_nat)) Q.(pair (list_small nat_small) (list_small nat_small))
(fun (l1, l2) -> (fun (l1, l2) ->
let bv1 = of_list l1 in let bv1 = of_list l1 in
let bv2 = of_list l2 in let bv2 = of_list l2 in
@ -374,7 +374,7 @@ diff (of_list [ 1; 2; 3 ]) (of_list [ 1; 2; 3 ]) |> to_list = []
;; ;;
q ~name:"diff" ~count:10_000 q ~name:"diff" ~count:10_000
Q.(pair (small_list small_nat) (small_list small_nat)) Q.(pair (list_small nat_small) (list_small nat_small))
(fun (l1, l2) -> (fun (l1, l2) ->
let bv1 = of_list l1 in let bv1 = of_list l1 in
let bv2 = of_list l2 in let bv2 = of_list l2 in
@ -438,7 +438,7 @@ eq
;; ;;
q q
Q.(small_int) Q.(nat_small)
(fun i -> (fun i ->
let i = max 1 i in let i = max 1 i in
let bv = create ~size:i true in let bv = create ~size:i true in
@ -526,7 +526,7 @@ t ~name:(spf "line %d" __LINE__) (fun () ->
;; ;;
q ~name:(spf "line %d" __LINE__) q ~name:(spf "line %d" __LINE__)
Q.(small_list small_nat) Q.(list_small nat_small)
(fun l -> (fun l ->
let l = CCList.sort_uniq ~cmp:CCInt.compare l in let l = CCList.sort_uniq ~cmp:CCInt.compare l in
let max = 1 + List.fold_left max 0 l in let max = 1 + List.fold_left max 0 l in
@ -636,7 +636,7 @@ module Op = struct
|> CCList.keep_some |> CCList.keep_some
in in
frequency oneof_weighted
@@ List.flatten @@ List.flatten
[ [
(if size > 0 then (if size > 0 then

View file

@ -274,7 +274,7 @@ true
;; ;;
q q
Q.(list small_nat) Q.(list nat_small)
(fun l -> (fun l ->
let f x = x mod 2 = 0 in let f x = x mod 2 = 0 in
let q = of_list l in let q = of_list l in
@ -284,7 +284,7 @@ q
;; ;;
q q
Q.(list small_nat) Q.(list nat_small)
(fun l -> (fun l ->
let f x = x mod 2 = 0 in let f x = x mod 2 = 0 in
let q = filter f (of_list l) in let q = filter f (of_list l) in

View file

@ -5,7 +5,7 @@ open CCFun_vec
let spf = Printf.sprintf let spf = Printf.sprintf
let _listuniq = let _listuniq =
let g = Q.(small_list (pair small_int small_int)) in let g = Q.(list_small (pair nat_small nat_small)) in
Q.map_same_type Q.map_same_type
(fun l -> (fun l ->
CCList.sort_uniq ~cmp:(fun a b -> Stdlib.compare (fst a) (fst b)) l) CCList.sort_uniq ~cmp:(fun a b -> Stdlib.compare (fst a) (fst b)) l)
@ -33,7 +33,7 @@ true
;; ;;
q q
Q.(pair int (small_list int)) Q.(pair int (list_small int))
(fun (x, l) -> (fun (x, l) ->
let q0 = of_list l in let q0 = of_list l in
let q = push x q0 in let q = push x q0 in
@ -45,18 +45,18 @@ q
;; ;;
q q
Q.(pair (fun1 Observable.int bool) (small_list int)) Q.(pair (fun1 Observable.int bool) (list_small int))
(fun (f, l) -> (fun (f, l) ->
let f = Q.Fn.apply f in let f = Q.Fn.apply f in
List.map f l = (of_list l |> map f |> to_list)) List.map f l = (of_list l |> map f |> to_list))
;; ;;
q q
Q.(pair (small_list int) (small_list int)) Q.(pair (list_small int) (list_small int))
(fun (l1, l2) -> l1 @ l2 = (append (of_list l1) (of_list l2) |> to_list)) (fun (l1, l2) -> l1 @ l2 = (append (of_list l1) (of_list l2) |> to_list))
;; ;;
q Q.(small_list int) (fun l -> l = to_list (of_list l));; q Q.(list_small int) (fun l -> l = to_list (of_list l));;
q _listuniq (fun l -> q _listuniq (fun l ->
List.sort Stdlib.compare l List.sort Stdlib.compare l
@ -162,7 +162,7 @@ module Op = struct
return [] return []
else ( else (
let op = let op =
frequency oneof_weighted
@@ List.flatten @@ List.flatten
[ [
[ [
@ -181,7 +181,7 @@ module Op = struct
[]); []);
[ [
( 1, ( 1,
small_list gen_x >|= fun l -> list_small gen_x >|= fun l ->
Add_list l, size + List.length l ); Add_list l, size + List.length l );
]; ];
] ]
@ -199,7 +199,7 @@ let arb_ops_int : int Op.t list Q.arbitrary =
~print:(fun o -> ~print:(fun o ->
spf "[%s]" @@ String.concat ";" @@ List.map (Op.show @@ spf "%d") o) spf "[%s]" @@ String.concat ";" @@ List.map (Op.show @@ spf "%d") o)
~shrink:(Op.shrink_l Q.Shrink.int) ~shrink:(Op.shrink_l Q.Shrink.int)
Q.Gen.(0 -- 40 >>= fun len -> Op.gen small_int len) Q.Gen.(0 -- 40 >>= fun len -> Op.gen nat_small len)
let check_ops ~show_x (ops : 'a Op.t list) : unit = let check_ops ~show_x (ops : 'a Op.t list) : unit =
let fail () = let fail () =

View file

@ -4,7 +4,7 @@ open CCHashTrie
module M = Make (CCInt) module M = Make (CCInt)
let _listuniq = let _listuniq =
let g = Q.(list (pair small_int small_int)) in let g = Q.(list (pair nat_small nat_small)) in
Q.map_same_type Q.map_same_type
(fun l -> (fun l ->
CCList.sort_uniq ~cmp:(fun a b -> Stdlib.compare (fst a) (fst b)) l) CCList.sort_uniq ~cmp:(fun a b -> Stdlib.compare (fst a) (fst b)) l)

View file

@ -30,7 +30,7 @@ let _list_uniq l =
;; ;;
q q
Q.(small_list (pair int int)) Q.(list_small (pair int int))
(fun l -> (fun l ->
let m = of_list l in let m = of_list l in
is_empty m = (cardinal m = 0)) is_empty m = (cardinal m = 0))
@ -183,14 +183,14 @@ let inter_l l1 l2 =
;; ;;
q q
Q.(pair (small_list (pair small_int unit)) (small_list (pair small_int unit))) Q.(pair (list_small (pair nat_small unit)) (list_small (pair nat_small unit)))
(fun (l1, l2) -> (fun (l1, l2) ->
union_l l1 l2 union_l l1 l2
= _list_uniq @@ to_list (union (fun _ _ _ -> ()) (of_list l1) (of_list l2))) = _list_uniq @@ to_list (union (fun _ _ _ -> ()) (of_list l1) (of_list l2)))
;; ;;
q q
Q.(pair (small_list (pair small_int unit)) (small_list (pair small_int unit))) Q.(pair (list_small (pair nat_small unit)) (list_small (pair nat_small unit)))
(fun (l1, l2) -> (fun (l1, l2) ->
inter_l l1 l2 inter_l l1 l2
= _list_uniq @@ to_list (inter (fun _ _ _ -> ()) (of_list l1) (of_list l2))) = _list_uniq @@ to_list (inter (fun _ _ _ -> ()) (of_list l1) (of_list l2)))
@ -225,7 +225,7 @@ q
;; ;;
q q
Q.(pair (fun2 Observable.int Observable.int bool) (small_list (pair int int))) Q.(pair (fun2 Observable.int Observable.int bool) (list_small (pair int int)))
(fun (f, l) -> (fun (f, l) ->
let (QCheck.Fun (_, f)) = f in let (QCheck.Fun (_, f)) = f in
_list_uniq (List.filter (fun (x, y) -> f x y) l) _list_uniq (List.filter (fun (x, y) -> f x y) l)
@ -236,7 +236,7 @@ q
Q.( Q.(
pair pair
(fun2 Observable.int Observable.int @@ option bool) (fun2 Observable.int Observable.int @@ option bool)
(small_list (pair int int))) (list_small (pair int int)))
(fun (f, l) -> (fun (f, l) ->
let (QCheck.Fun (_, f)) = f in let (QCheck.Fun (_, f)) = f in
_list_uniq _list_uniq
@ -257,7 +257,7 @@ let merge_inter _x o =
q q
Q.( Q.(
let p = small_list (pair small_int small_int) in let p = list_small (pair nat_small nat_small) in
pair p p) pair p p)
(fun (l1, l2) -> (fun (l1, l2) ->
check_invariants (merge ~f:merge_union (of_list l1) (of_list l2))) check_invariants (merge ~f:merge_union (of_list l1) (of_list l2)))
@ -265,7 +265,7 @@ q
q q
Q.( Q.(
let p = small_list (pair small_int small_int) in let p = list_small (pair nat_small nat_small) in
pair p p) pair p p)
(fun (l1, l2) -> (fun (l1, l2) ->
check_invariants (merge ~f:merge_inter (of_list l1) (of_list l2))) check_invariants (merge ~f:merge_inter (of_list l1) (of_list l2)))
@ -273,7 +273,7 @@ q
q q
Q.( Q.(
let p = small_list (pair small_int unit) in let p = list_small (pair nat_small unit) in
pair p p) pair p p)
(fun (l1, l2) -> (fun (l1, l2) ->
let l1 = _list_uniq l1 and l2 = _list_uniq l2 in let l1 = _list_uniq l1 and l2 = _list_uniq l2 in
@ -284,7 +284,7 @@ q
q q
Q.( Q.(
let p = small_list (pair small_int unit) in let p = list_small (pair nat_small unit) in
pair p p) pair p p)
(fun (l1, l2) -> (fun (l1, l2) ->
let l1 = _list_uniq l1 and l2 = _list_uniq l2 in let l1 = _list_uniq l1 and l2 = _list_uniq l2 in
@ -312,7 +312,7 @@ q
;; ;;
q q
Q.(list (pair small_int int)) Q.(list (pair nat_small int))
(fun l -> (fun l ->
of_list l |> cardinal of_list l |> cardinal
= List.length (l |> List.map fst |> CCList.sort_uniq ~cmp:CCInt.compare)) = List.length (l |> List.map fst |> CCList.sort_uniq ~cmp:CCInt.compare))
@ -419,7 +419,7 @@ let tree_gen int_gen : instr_tree Q.Gen.t =
Gen.map2 (fun i j -> Singleton (i, j)) int_gen int_gen; Gen.map2 (fun i j -> Singleton (i, j)) int_gen int_gen;
] ]
| _ -> | _ ->
frequency oneof_weighted
[ [
1, return Empty; 1, return Empty;
1, map2 (fun k v -> Singleton (k, v)) int_gen int_gen; 1, map2 (fun k v -> Singleton (k, v)) int_gen int_gen;
@ -469,7 +469,7 @@ let rec tshrink t : instr_tree Q.Iter.t =
<+> Iter.map (fun t1' -> Inter (t0, t1')) (tshrink t1) <+> Iter.map (fun t1' -> Inter (t0, t1')) (tshrink t1)
let arb_int = let arb_int =
frequency [ 5, small_signed_int; 3, int; 1, oneofl [ min_int; max_int ] ] oneof_weighted [ 5, int_small; 3, int; 1, oneof_list [ min_int; max_int ] ]
let arb_tree = make ~print:to_string ~shrink:tshrink (tree_gen arb_int.gen) let arb_tree = make ~print:to_string ~shrink:tshrink (tree_gen arb_int.gen)
let empty_m = [] let empty_m = []

View file

@ -12,7 +12,7 @@ let _list_uniq =
let _list_int_int = let _list_int_int =
Q.( Q.(
map_same_type _list_uniq map_same_type _list_uniq
(list_of_size Gen.(0 -- 40) (pair small_int small_int))) (list_size Gen.(0 -- 40) (pair nat_small nat_small)))
;; ;;
t @@ fun () -> t @@ fun () ->

View file

@ -3,7 +3,7 @@ open Test
open CCRAL;; open CCRAL;;
q q
Q.(pair (pair small_int int) (list int)) Q.(pair (pair nat_small int) (list int))
(fun ((i, v), l) -> (fun ((i, v), l) ->
l = [] l = []
|| ||
@ -14,7 +14,7 @@ q
;; ;;
q q
Q.(list small_int) Q.(list nat_small)
(fun l -> (fun l ->
let l1 = of_list l in let l1 = of_list l in
CCList.mapi (fun i x -> i, x) l CCList.mapi (fun i x -> i, x) l
@ -32,7 +32,7 @@ tl l |> to_list = [ 2; 3 ]
;; ;;
q q
Q.(list_of_size Gen.(1 -- 100) int) Q.(list_size Gen.(1 -- 100) int)
(fun l -> (fun l ->
let open Q in let open Q in
let l' = of_list l in let l' = of_list l in
@ -51,14 +51,14 @@ eq
(CCPair.map_snd to_list @@ get_and_remove_exn (of_list [ 1; 2; 3; 4 ]) 2) (CCPair.map_snd to_list @@ get_and_remove_exn (of_list [ 1; 2; 3; 4 ]) 2)
;; ;;
q Q.small_int (fun n -> q Q.nat_small (fun n ->
let l = CCList.(0 -- n) in let l = CCList.(0 -- n) in
let l' = of_list l |> mapi ~f:(fun i x -> i, x) in let l' = of_list l |> mapi ~f:(fun i x -> i, x) in
List.mapi (fun i x -> i, x) l = to_list l') List.mapi (fun i x -> i, x) l = to_list l')
;; ;;
q q
Q.(pair (list small_int) (fun2 Observable.int Observable.int bool)) Q.(pair (list nat_small) (fun2 Observable.int Observable.int bool))
(fun (l, f) -> (fun (l, f) ->
let f = Q.Fn.apply f in let f = Q.Fn.apply f in
mapi ~f (of_list l) |> to_list = List.mapi f l) mapi ~f (of_list l) |> to_list = List.mapi f l)
@ -72,14 +72,14 @@ q
;; ;;
q q
Q.(list small_int) Q.(list nat_small)
(fun l -> (fun l ->
let l = of_list l in let l = of_list l in
rev (rev l) = l) rev (rev l) = l)
;; ;;
q q
Q.(list small_int) Q.(list nat_small)
(fun l -> (fun l ->
let l1 = of_list l in let l1 = of_list l in
length l1 = List.length l) length l1 = List.length l)
@ -97,7 +97,7 @@ of_list [ 1; 2; 3; 4; 5; 6 ]
;; ;;
q q
Q.(pair (fun1 Observable.int (small_list int)) (small_list int)) Q.(pair (fun1 Observable.int (list_small int)) (list_small int))
(fun (f, l) -> (fun (f, l) ->
let f x = Q.Fn.apply f x in let f x = Q.Fn.apply f x in
let f' x = f x |> of_list in let f' x = f x |> of_list in
@ -110,7 +110,7 @@ flatten (of_list [ of_list [ 1 ]; of_list []; of_list [ 2; 3 ] ])
;; ;;
q q
Q.(small_list (small_list int)) Q.(list_small (list_small int))
(fun l -> (fun l ->
of_list l |> map ~f:of_list |> flatten |> to_list = CCList.flatten l) of_list l |> map ~f:of_list |> flatten |> to_list = CCList.flatten l)
;; ;;
@ -126,7 +126,7 @@ t @@ fun () -> take 5 (of_list CCList.(1 -- 10)) |> to_list = [ 1; 2; 3; 4; 5 ]
t @@ fun () -> take 0 (of_list CCList.(1 -- 10)) |> to_list = [];; t @@ fun () -> take 0 (of_list CCList.(1 -- 10)) |> to_list = [];;
q q
Q.(pair small_int (list int)) Q.(pair nat_small (list int))
(fun (n, l) -> of_list l |> take n |> to_list = CCList.take n l) (fun (n, l) -> of_list l |> take n |> to_list = CCList.take n l)
;; ;;
@ -147,7 +147,7 @@ q
t @@ fun () -> of_list [ 1; 2; 3 ] |> drop 2 |> length = 1;; t @@ fun () -> of_list [ 1; 2; 3 ] |> drop 2 |> length = 1;;
q q
Q.(pair small_int (list int)) Q.(pair nat_small (list int))
(fun (n, l) -> of_list l |> drop n |> to_list = CCList.drop n l) (fun (n, l) -> of_list l |> drop n |> to_list = CCList.drop n l)
;; ;;
@ -158,7 +158,7 @@ t @@ fun () -> drop 0 (of_list CCList.(1 -- 10)) |> to_list = CCList.(1 -- 10);;
t @@ fun () -> drop 15 (of_list CCList.(1 -- 10)) |> to_list = [];; t @@ fun () -> drop 15 (of_list CCList.(1 -- 10)) |> to_list = [];;
q q
Q.(list_of_size Gen.(0 -- 200) int) Q.(list_size Gen.(0 -- 200) int)
(fun l -> (fun l ->
let f x = x mod 10 <> 0 in let f x = x mod 10 <> 0 in
of_list l |> drop_while ~f |> to_list = CCList.drop_while f l) of_list l |> drop_while ~f |> to_list = CCList.drop_while f l)
@ -170,7 +170,7 @@ q
;; ;;
q q
Q.(pair small_int (small_list int)) Q.(pair nat_small (list_small int))
(fun (n, l) -> of_list l |> repeat n |> to_list = CCList.(repeat n l)) (fun (n, l) -> of_list l |> repeat n |> to_list = CCList.(repeat n l))
;; ;;
@ -179,7 +179,7 @@ t @@ fun () -> range 3 0 |> to_list = [ 3; 2; 1; 0 ];;
t @@ fun () -> range 17 17 |> to_list = [ 17 ];; t @@ fun () -> range 17 17 |> to_list = [ 17 ];;
q q
Q.(pair small_int small_int) Q.(pair nat_small nat_small)
(fun (i, j) -> range i j |> to_list = CCList.(i -- j)) (fun (i, j) -> range i j |> to_list = CCList.(i -- j))
let eq' = eq ~printer:CCFormat.(to_string (hbox (list int)));; let eq' = eq ~printer:CCFormat.(to_string (hbox (list int)));;
@ -190,21 +190,21 @@ eq' [ 1 ] (1 --^ 2 |> to_list);;
eq' [] (0 --^ 0 |> to_list);; eq' [] (0 --^ 0 |> to_list);;
q q
Q.(pair (list small_int) (list small_int)) Q.(pair (list nat_small) (list nat_small))
(fun (l1, l2) -> add_list (of_list l2) l1 |> to_list = l1 @ l2) (fun (l1, l2) -> add_list (of_list l2) l1 |> to_list = l1 @ l2)
;; ;;
q Q.(list int) (fun l -> to_list (of_list l) = l);; q Q.(list int) (fun l -> to_list (of_list l) = l);;
q Q.(array int) (fun a -> of_array a |> to_array = a);; q Q.(array int) (fun a -> of_array a |> to_array = a);;
q Q.(list small_int) (fun l -> of_list l |> to_iter |> Iter.to_list = l);; q Q.(list nat_small) (fun l -> of_list l |> to_iter |> Iter.to_list = l);;
q Q.(list small_int) (fun l -> Iter.of_list l |> of_iter |> to_list = l);; q Q.(list nat_small) (fun l -> Iter.of_list l |> of_iter |> to_list = l);;
t @@ fun () -> t @@ fun () ->
add_iter (of_list [ 3; 4 ]) (Iter.of_list [ 1; 2 ]) |> to_list = [ 1; 2; 3; 4 ] add_iter (of_list [ 3; 4 ]) (Iter.of_list [ 1; 2 ]) |> to_list = [ 1; 2; 3; 4 ]
;; ;;
q Q.(list small_int) (fun l -> of_list l |> to_gen |> Gen.to_list = l);; q Q.(list nat_small) (fun l -> of_list l |> to_gen |> Gen.to_list = l);;
q Q.(list small_int) (fun l -> Gen.of_list l |> of_gen |> to_list = l);; q Q.(list nat_small) (fun l -> Gen.of_list l |> of_gen |> to_list = l);;
q q
Q.(pair (list int) (list int)) Q.(pair (list int) (list int))

View file

@ -158,7 +158,7 @@ q a_str (fun s ->
with Exit -> false) with Exit -> false)
;; ;;
q (Q.pair Q.small_int a_str) (fun (i, s) -> q (Q.pair Q.nat_small a_str) (fun (i, s) ->
let s = Bytes.of_string (s ^ " ") in let s = Bytes.of_string (s ^ " ") in
let s_len = Bytes.length s in let s_len = Bytes.length s in
let b = Byte.create (max s_len 64) in let b = Byte.create (max s_len 64) in
@ -168,7 +168,7 @@ q (Q.pair Q.small_int a_str) (fun (i, s) ->
front = Bytes.get s index) front = Bytes.get s index)
;; ;;
q (Q.pair Q.small_int a_str) (fun (i, s) -> q (Q.pair Q.nat_small a_str) (fun (i, s) ->
let s = Bytes.of_string (s ^ " ") in let s = Bytes.of_string (s ^ " ") in
let s_len = Bytes.length s in let s_len = Bytes.length s in
let b = Byte.create (max s_len 64) in let b = Byte.create (max s_len 64) in
@ -370,7 +370,7 @@ let gen_op =
assert (len >= 0 && len <= String.length s); assert (len >= 0 && len <= String.length s);
0 -- (String.length s - len) >|= fun i -> blit s i len 0 -- (String.length s - len) >|= fun i -> blit s i len
in in
frequency oneof_weighted
[ [
3, return Take_back; 3, return Take_back;
3, return Take_front; 3, return Take_front;
@ -385,7 +385,7 @@ let gen_op =
] ]
let arb_op = Q.make ~shrink:shrink_op ~print:str_of_op gen_op let arb_op = Q.make ~shrink:shrink_op ~print:str_of_op gen_op
let arb_ops = Q.list_of_size Q.Gen.(0 -- 20) arb_op let arb_ops = Q.list_size Q.Gen.(0 -- 20) arb_op
module L_impl = struct module L_impl = struct
type t = { type t = {

View file

@ -3,45 +3,45 @@ open Test
open CCSimple_queue;; open CCSimple_queue;;
q q
Q.(list small_int) Q.(list nat_small)
(fun l -> (fun l ->
let q = of_list l in let q = of_list l in
equal CCInt.equal (Gen.unfold pop q |> of_gen) q) equal CCInt.equal (Gen.unfold pop q |> of_gen) q)
;; ;;
q q
Q.(list small_int) Q.(list nat_small)
(fun l -> equal CCInt.equal (of_list l |> rev) (of_list (List.rev l))) (fun l -> equal CCInt.equal (of_list l |> rev) (of_list (List.rev l)))
;; ;;
q q
Q.(list small_int) Q.(list nat_small)
(fun l -> (fun l ->
let q = of_list l in let q = of_list l in
equal CCInt.equal q (q |> rev |> rev)) equal CCInt.equal q (q |> rev |> rev))
;; ;;
q Q.(list small_int) (fun l -> length (of_list l) = List.length l);; q Q.(list nat_small) (fun l -> length (of_list l) = List.length l);;
q q
Q.(list small_int) Q.(list nat_small)
(fun l -> equal CCInt.equal (of_list l) (List.fold_left snoc empty l)) (fun l -> equal CCInt.equal (of_list l) (List.fold_left snoc empty l))
;; ;;
q q
Q.(list small_int) Q.(list nat_small)
(fun l -> equal CCInt.equal (of_iter (Iter.of_list l)) (of_list l)) (fun l -> equal CCInt.equal (of_iter (Iter.of_list l)) (of_list l))
;; ;;
q Q.(list small_int) (fun l -> l = (of_list l |> to_iter |> Iter.to_list));; q Q.(list nat_small) (fun l -> l = (of_list l |> to_iter |> Iter.to_list));;
q q
Q.(pair (list small_int) (list small_int)) Q.(pair (list nat_small) (list nat_small))
(fun (l1, l2) -> equal CCInt.equal (of_list l1) (of_list l2) = (l1 = l2)) (fun (l1, l2) -> equal CCInt.equal (of_list l1) (of_list l2) = (l1 = l2))
;; ;;
q q
Q.(pair (list small_int) (list small_int)) Q.(pair (list nat_small) (list nat_small))
(fun (l1, l2) -> (fun (l1, l2) ->
equal CCInt.equal equal CCInt.equal
(append (of_list l1) (of_list l2)) (append (of_list l1) (of_list l2))

View file

@ -33,8 +33,8 @@ eq ~printer:CCFun.id "catogan" (String.longest_prefix "catogan" s1);;
q q
Q.( Q.(
pair pair
(list (pair (printable_string_of_size Gen.(0 -- 30)) int)) (list (pair (string_size_of Gen.(0 -- 30) Gen.char_printable) int))
printable_string) string_printable)
(fun (l, s) -> (fun (l, s) ->
let m = String.of_list l in let m = String.of_list l in
let s' = String.longest_prefix s m in let s' = String.longest_prefix s m in
@ -61,7 +61,7 @@ eq
q ~count:30 q ~count:30
Q.( Q.(
let p = list_of_size Gen.(0 -- 100) (pair printable_string small_int) in let p = list_size Gen.(0 -- 100) (pair string_printable nat_small) in
pair p p) pair p p)
(fun (l1, l2) -> (fun (l1, l2) ->
let t1 = S.of_list l1 and t2 = S.of_list l2 in let t1 = S.of_list l1 and t2 = S.of_list l2 in
@ -109,7 +109,7 @@ true
;; ;;
q ~count:30 q ~count:30
Q.(list_of_size Gen.(0 -- 100) (pair printable_string small_int)) Q.(list_size Gen.(0 -- 100) (pair string_printable nat_small))
(fun l -> (fun l ->
let t = S.of_list l in let t = S.of_list l in
S.check_invariants t) S.check_invariants t)
@ -123,10 +123,10 @@ let rec sorted ~rev = function
x <= y) x <= y)
&& sorted ~rev tl && sorted ~rev tl
let gen_str = Q.small_printable_string;; let gen_str = Q.(string_size_of Gen.nat_small Gen.char_printable);;
q ~count:200 q ~count:200
Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int)) Q.(list_size Gen.(1 -- 20) (pair gen_str nat_small))
(fun l -> (fun l ->
let t = String.of_list l in let t = String.of_list l in
List.for_all List.for_all
@ -135,7 +135,7 @@ q ~count:200
;; ;;
q ~count:200 q ~count:200
Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int)) Q.(list_size Gen.(1 -- 20) (pair gen_str nat_small))
(fun l -> (fun l ->
let t = String.of_list l in let t = String.of_list l in
List.for_all List.for_all
@ -144,7 +144,7 @@ q ~count:200
;; ;;
q ~count:200 q ~count:200
Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int)) Q.(list_size Gen.(1 -- 20) (pair gen_str nat_small))
(fun l -> (fun l ->
let t = String.of_list l in let t = String.of_list l in
List.for_all List.for_all
@ -153,7 +153,7 @@ q ~count:200
;; ;;
q ~count:200 q ~count:200
Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int)) Q.(list_size Gen.(1 -- 20) (pair gen_str nat_small))
(fun l -> (fun l ->
let t = String.of_list l in let t = String.of_list l in
List.for_all List.for_all

View file

@ -48,14 +48,14 @@ q ~count:200
;; ;;
q q
Q.(list (pair small_int bool)) Q.(list (pair nat_small bool))
(fun l -> (fun l ->
let m = M.of_list l in let m = M.of_list l in
M.balanced m) M.balanced m)
;; ;;
q q
Q.(list (pair small_int small_int)) Q.(list (pair nat_small nat_small))
(fun l -> (fun l ->
let l = _list_uniq l in let l = _list_uniq l in
let m = M.of_list l in let m = M.of_list l in
@ -63,7 +63,7 @@ q
;; ;;
q q
Q.(list (pair small_int small_int)) Q.(list (pair nat_small nat_small))
(fun l -> (fun l ->
let l = _list_uniq l in let l = _list_uniq l in
let m = M.of_list l in let m = M.of_list l in
@ -71,7 +71,7 @@ q
;; ;;
q q
Q.(list_of_size Gen.(0 -- 30) (pair small_int small_int)) Q.(list_size Gen.(0 -- 30) (pair nat_small nat_small))
(fun l -> (fun l ->
let m = M.of_list l in let m = M.of_list l in
List.for_all List.for_all
@ -84,7 +84,7 @@ q
;; ;;
q q
Q.(list_of_size Gen.(0 -- 30) (pair small_int small_int)) Q.(list_size Gen.(0 -- 30) (pair nat_small nat_small))
(fun l -> (fun l ->
let m = M.of_list l in let m = M.of_list l in
List.for_all List.for_all
@ -100,7 +100,7 @@ List.for_all (fun i -> M.nth_exn i m = (i, i)) CCList.(0 -- 1000)
;; ;;
q ~count:1_000 q ~count:1_000
Q.(list_of_size Gen.(0 -- 30) (pair small_int small_int)) Q.(list_size Gen.(0 -- 30) (pair nat_small nat_small))
(fun l -> (fun l ->
let l = CCList.sort_uniq ~cmp:(CCFun.compose_binop fst compare) l in let l = CCList.sort_uniq ~cmp:(CCFun.compose_binop fst compare) l in
let m = M.of_list l in let m = M.of_list l in
@ -113,7 +113,7 @@ q ~count:1_000
;; ;;
q ~count:20 q ~count:20
Q.(list_of_size Gen.(1 -- 100) (pair small_int small_int)) Q.(list_size Gen.(1 -- 100) (pair nat_small nat_small))
(fun lst -> (fun lst ->
let lst = _list_uniq lst in let lst = _list_uniq lst in
let m = M.of_list lst in let m = M.of_list lst in
@ -143,7 +143,7 @@ true
q q
Q.( Q.(
let p = list (pair small_int small_int) in let p = list (pair nat_small nat_small) in
pair p p) pair p p)
(fun (l1, l2) -> (fun (l1, l2) ->
let l1 = _list_uniq l1 and l2 = _list_uniq l2 in let l1 = _list_uniq l1 and l2 = _list_uniq l2 in

View file

@ -5,13 +5,13 @@ open CCZipper;;
t @@ fun () -> is_empty empty;; t @@ fun () -> is_empty empty;;
t @@ fun () -> not ([ 42 ] |> make |> right |> is_empty) t @@ fun () -> not ([ 42 ] |> make |> right |> is_empty)
let zip_gen = Q.(pair (small_list int) (small_list int));; let zip_gen = Q.(pair (list_small int) (list_small int));;
q zip_gen (fun z -> to_list z = List.rev (to_rev_list z));; q zip_gen (fun z -> to_list z = List.rev (to_rev_list z));;
q zip_gen (fun g -> is_focused g = (focused g |> CCOption.is_some));; q zip_gen (fun g -> is_focused g = (focused g |> CCOption.is_some));;
q q
Q.(triple int (list small_int) (list small_int)) Q.(triple int (list nat_small) (list nat_small))
(fun (x, l, r) -> insert x (l, r) |> remove = (l, r)) (fun (x, l, r) -> insert x (l, r) |> remove = (l, r))
;; ;;

11
tests/leb128/dune Normal file
View file

@ -0,0 +1,11 @@
(executable
(name t_leb128)
(modules t_leb128)
(libraries containers containers.leb128 containers_testlib))
(rule
(alias runtest)
(deps t_leb128.exe)
(package containers)
(action
(run ./t_leb128.exe)))

269
tests/leb128/t_leb128.ml Normal file
View file

@ -0,0 +1,269 @@
include (val Containers_testlib.make ~__FILE__ ())
module Leb128 = Containers_leb128
module Buf = CCByte_buffer
module Slice = CCByte_slice
let encode_decode_u64 (i : int64) : bool =
let buf = Buf.create () in
Leb128.Encode.u64 buf i;
let slice = Buf.to_slice buf in
let i', n = Leb128.Decode.u64 slice 0 in
Int64.equal i i' && n = Slice.len slice
let encode_decode_i64 (i : int64) : bool =
let buf = Buf.create () in
Leb128.Encode.i64 buf i;
let slice = Buf.to_slice buf in
let i', n = Leb128.Decode.i64 slice 0 in
Int64.equal i i' && n = Slice.len slice
let encode_decode_uint (i : int) : bool =
i >= 0
&&
let buf = Buf.create () in
Leb128.Encode.uint buf i;
let slice = Buf.to_slice buf in
let i', n = Leb128.Decode.uint_truncate slice 0 in
Int.equal i i' && n = Slice.len slice
let encode_decode_int (i : int) : bool =
let buf = Buf.create () in
Leb128.Encode.int buf i;
let slice = Buf.to_slice buf in
let i', n = Leb128.Decode.int_truncate slice 0 in
Int.equal i i' && n = Slice.len slice
let zigzag_roundtrip (i : int64) : bool =
let encoded = Leb128.Encode.encode_zigzag i in
let decoded = Leb128.Decode.decode_zigzag encoded in
Int64.equal i decoded
;;
q ~count:10_000 ~long_factor:20 Q.int64 @@ fun i ->
if not (encode_decode_u64 (Int64.abs i)) then
Q.Test.fail_reportf "u64 roundtrip failed for %Ld" i;
true
;;
q ~count:10_000 ~long_factor:20 Q.int64 @@ fun i ->
if not (encode_decode_i64 i) then
Q.Test.fail_reportf "i64 roundtrip failed for %Ld" i;
true
;;
q ~count:10_000 ~long_factor:20 Q.int @@ fun i ->
(* make sure [i] is non negative *)
let i = max 0 (abs i) in
if not (encode_decode_uint i) then
Q.Test.fail_reportf "uint roundtrip failed for %d" i;
true
;;
q ~count:10_000 ~long_factor:20 Q.int @@ fun i ->
if not (encode_decode_int i) then
Q.Test.fail_reportf "int roundtrip failed for %d" i;
true
;;
q ~count:10_000 ~long_factor:20 Q.int64 @@ fun i ->
if not (zigzag_roundtrip i) then
Q.Test.fail_reportf "zigzag roundtrip failed for %Ld" i;
true
;;
t @@ fun () ->
let buf = Buf.create () in
Leb128.Encode.u64 buf 0L;
let slice = Buf.to_slice buf in
let v, n = Leb128.Decode.u64 slice 0 in
assert_equal ~printer:Int64.to_string 0L v;
assert_equal ~printer:string_of_int 1 n;
true
;;
t @@ fun () ->
let buf = Buf.create () in
Leb128.Encode.u64 buf 127L;
let slice = Buf.to_slice buf in
let v, n = Leb128.Decode.u64 slice 0 in
assert_equal ~printer:Int64.to_string 127L v;
assert_equal ~printer:string_of_int 1 n;
true
;;
t @@ fun () ->
let buf = Buf.create () in
Leb128.Encode.u64 buf 128L;
let slice = Buf.to_slice buf in
let v, n = Leb128.Decode.u64 slice 0 in
assert_equal ~printer:Int64.to_string 128L v;
assert_equal ~printer:string_of_int 2 n;
true
;;
t @@ fun () ->
let buf = Buf.create () in
Leb128.Encode.u64 buf 16383L;
let slice = Buf.to_slice buf in
let v, n = Leb128.Decode.u64 slice 0 in
assert_equal ~printer:Int64.to_string 16383L v;
assert_equal ~printer:string_of_int 2 n;
true
;;
t @@ fun () ->
let buf = Buf.create () in
Leb128.Encode.u64 buf 16384L;
let slice = Buf.to_slice buf in
let v, n = Leb128.Decode.u64 slice 0 in
assert_equal ~printer:Int64.to_string 16384L v;
assert_equal ~printer:string_of_int 3 n;
true
;;
t @@ fun () ->
let buf = Buf.create () in
Leb128.Encode.i64 buf 0L;
let slice = Buf.to_slice buf in
let v, n = Leb128.Decode.i64 slice 0 in
assert_equal ~printer:Int64.to_string 0L v;
assert_equal ~printer:string_of_int 1 n;
true
;;
t @@ fun () ->
let buf = Buf.create () in
Leb128.Encode.u64 buf 127L;
Leb128.Encode.u64 buf 16384L;
Leb128.Encode.u64 buf 300L;
let slice = Buf.to_slice buf in
let n1 = Leb128.Decode.skip slice 0 in
let n2 = Leb128.Decode.skip slice n1 in
let n3 = Leb128.Decode.skip slice (n1 + n2) in
assert_equal ~printer:string_of_int 1 n1;
assert_equal ~printer:string_of_int 3 n2;
assert_equal ~printer:string_of_int 2 n3;
assert_equal ~printer:string_of_int 6 (n1 + n2 + n3);
true
;;
t @@ fun () ->
let buf = Buf.create () in
Leb128.Encode.i64 buf (-1L);
let slice = Buf.to_slice buf in
let v, n = Leb128.Decode.i64 slice 0 in
assert_equal ~printer:Int64.to_string (-1L) v;
assert_equal ~printer:string_of_int 1 n;
true
;;
t @@ fun () ->
let buf = Buf.create () in
Leb128.Encode.i64 buf 63L;
let slice = Buf.to_slice buf in
let v, n = Leb128.Decode.i64 slice 0 in
assert_equal ~printer:Int64.to_string 63L v;
assert_equal ~printer:string_of_int 1 n;
true
;;
t @@ fun () ->
let buf = Buf.create () in
Leb128.Encode.i64 buf (-64L);
let slice = Buf.to_slice buf in
let v, n = Leb128.Decode.i64 slice 0 in
assert_equal ~printer:Int64.to_string (-64L) v;
assert_equal ~printer:string_of_int 1 n;
true
;;
t @@ fun () ->
let buf = Buf.create () in
Leb128.Encode.i64 buf 64L;
let slice = Buf.to_slice buf in
let v, n = Leb128.Decode.i64 slice 0 in
assert_equal ~printer:Int64.to_string 64L v;
assert_equal ~printer:string_of_int 2 n;
true
;;
t @@ fun () ->
let buf = Buf.create () in
Leb128.Encode.i64 buf (-65L);
let slice = Buf.to_slice buf in
let v, n = Leb128.Decode.i64 slice 0 in
assert_equal ~printer:Int64.to_string (-65L) v;
assert_equal ~printer:string_of_int 2 n;
true
;;
t @@ fun () ->
let buf = Buf.create () in
Leb128.Encode.i64 buf Int64.min_int;
let slice = Buf.to_slice buf in
let v, _n = Leb128.Decode.i64 slice 0 in
assert_equal ~printer:Int64.to_string Int64.min_int v;
true
;;
let buf = Buf.create () in
Leb128.Encode.i64 buf Int64.max_int;
let slice = Buf.to_slice buf in
let v, _n = Leb128.Decode.i64 slice 0 in
assert_equal ~printer:Int64.to_string Int64.max_int v;
true
;;
t @@ fun () ->
let buf = Buf.create () in
Leb128.Encode.u64 buf 300L;
Leb128.Encode.u64 buf 500L;
let slice = Buf.to_slice buf in
let v1, n1 = Leb128.Decode.u64 slice 0 in
let v2, n2 = Leb128.Decode.u64 slice n1 in
assert_equal ~printer:Int64.to_string 300L v1;
assert_equal ~printer:Int64.to_string 500L v2;
assert_equal ~printer:string_of_int 2 n1;
assert_equal ~printer:string_of_int 2 n2;
true
;;
t @@ fun () ->
(* Test decoding from a slice with non-zero offset *)
let bytes = Bytes.of_string "\x00\x00\x54\x00" in
let slice = Slice.create ~off:2 ~len:1 bytes in
assert_equal
~printer:(fun c -> Printf.sprintf "0x%02x" (Char.code c))
'\x54' (Slice.get slice 0);
let v, n = Leb128.Decode.int_truncate slice 0 in
assert_equal ~printer:string_of_int 42 v;
assert_equal ~printer:string_of_int 1 n;
true
;;
t @@ fun () ->
(* Test decoding u64 from a slice with non-zero offset *)
let bytes = Bytes.of_string "\xFF\xFF\x2A\x00" in
let slice = Slice.create ~off:2 ~len:1 bytes in
assert_equal
~printer:(fun c -> Printf.sprintf "0x%02x" (Char.code c))
'\x2A' (Slice.get slice 0);
let v, n = Leb128.Decode.u64 slice 0 in
assert_equal ~printer:Int64.to_string 42L v;
assert_equal ~printer:string_of_int 1 n;
true
;;
t @@ fun () ->
(* Test decoding from a sub-slice *)
let buf = Buf.create () in
Buf.append_string buf "padding";
Leb128.Encode.int buf 42;
let slice = Buf.to_slice buf in
let sub_slice = Slice.sub slice 7 (Slice.len slice - 7) in
let v, n = Leb128.Decode.int_truncate sub_slice 0 in
assert_equal ~printer:string_of_int 42 v;
assert_equal ~printer:string_of_int 1 n;
true
let () = Containers_testlib.run_all ~descr:"test leb128" [ get () ]

View file

@ -5,7 +5,7 @@ open Containers_pvec
let spf = Printf.sprintf let spf = Printf.sprintf
let _listuniq = let _listuniq =
let g = Q.(small_list (pair small_int small_int)) in let g = Q.(list_small (pair nat_small nat_small)) in
Q.map_same_type Q.map_same_type
(fun l -> (fun l ->
CCList.sort_uniq ~cmp:(fun a b -> Stdlib.compare (fst a) (fst b)) l) CCList.sort_uniq ~cmp:(fun a b -> Stdlib.compare (fst a) (fst b)) l)
@ -33,7 +33,7 @@ true
;; ;;
q ~name:"push length pop" q ~name:"push length pop"
Q.(pair int (small_list int)) Q.(pair int (list_small int))
(fun (x, l) -> (fun (x, l) ->
let q0 = of_list l in let q0 = of_list l in
let q = push q0 x in let q = push q0 x in
@ -45,18 +45,18 @@ q ~name:"push length pop"
;; ;;
q q
Q.(pair (fun1 Observable.int bool) (small_list int)) Q.(pair (fun1 Observable.int bool) (list_small int))
(fun (f, l) -> (fun (f, l) ->
let f = Q.Fn.apply f in let f = Q.Fn.apply f in
List.map f l = (of_list l |> map f |> to_list)) List.map f l = (of_list l |> map f |> to_list))
;; ;;
q q
Q.(pair (small_list int) (small_list int)) Q.(pair (list_small int) (list_small int))
(fun (l1, l2) -> l1 @ l2 = (append (of_list l1) (of_list l2) |> to_list)) (fun (l1, l2) -> l1 @ l2 = (append (of_list l1) (of_list l2) |> to_list))
;; ;;
q Q.(small_list int) (fun l -> l = to_list (of_list l));; q Q.(list_small int) (fun l -> l = to_list (of_list l));;
q _listuniq (fun l -> q _listuniq (fun l ->
List.sort Stdlib.compare l List.sort Stdlib.compare l
@ -74,11 +74,11 @@ t @@ fun () -> choose empty = None;;
t @@ fun () -> choose (of_list [ 1, 1; 2, 2 ]) <> None;; t @@ fun () -> choose (of_list [ 1, 1; 2, 2 ]) <> None;;
q q
Q.(pair (small_list int) (small_list int)) Q.(pair (list_small int) (list_small int))
(fun (l1, l2) -> equal CCInt.equal (of_list l1) (of_list l2) = (l1 = l2)) (fun (l1, l2) -> equal CCInt.equal (of_list l1) (of_list l2) = (l1 = l2))
;; ;;
q Q.(small_list int) (fun l1 -> equal CCInt.equal (of_list l1) (of_list l1)) q Q.(list_small int) (fun l1 -> equal CCInt.equal (of_list l1) (of_list l1))
let arb_list_with_idx = let arb_list_with_idx =
let open Q in let open Q in
@ -87,7 +87,7 @@ let arb_list_with_idx =
in in
let gen = let gen =
Gen.( Gen.(
let* l = small_list int in let* l = list_small int in
let+ i = let+ i =
if l = [] then if l = [] then
return 0 return 0
@ -238,7 +238,7 @@ module Op = struct
return [] return []
else ( else (
let op = let op =
frequency oneof_weighted
@@ List.flatten @@ List.flatten
[ [
[ [
@ -260,10 +260,10 @@ module Op = struct
[]); []);
[ [
( 1, ( 1,
small_list gen_x >|= fun l -> list_small gen_x >|= fun l ->
Add_list l, size + List.length l ); Add_list l, size + List.length l );
( 1, ( 1,
small_list gen_x >|= fun l -> list_small gen_x >|= fun l ->
Append l, size + List.length l ); Append l, size + List.length l );
( 1, ( 1,
list_size (0 -- 5) gen_x >|= fun l -> list_size (0 -- 5) gen_x >|= fun l ->
@ -284,7 +284,7 @@ let arb_ops_int : int Op.t list Q.arbitrary =
~print:(fun o -> ~print:(fun o ->
spf "[%s]" @@ String.concat ";" @@ List.map (Op.show @@ spf "%d") o) spf "[%s]" @@ String.concat ";" @@ List.map (Op.show @@ spf "%d") o)
~shrink:(Op.shrink_l Q.Shrink.int) ~shrink:(Op.shrink_l Q.Shrink.int)
Q.Gen.(0 -- 40 >>= fun len -> Op.gen small_int len) Q.Gen.(0 -- 40 >>= fun len -> Op.gen nat_small len)
let check_ops ~show_x (ops : 'a Op.t list) : unit = let check_ops ~show_x (ops : 'a Op.t list) : unit =
let fail () = let fail () =