pax_global_header00006660000000000000000000000064151521276070014520gustar00rootroot0000000000000052 comment=35f0f3350b94e82277049162a74f880bf7970166 obuild-0.2.2/000077500000000000000000000000001515212760700127775ustar00rootroot00000000000000obuild-0.2.2/.gitignore000066400000000000000000000000561515212760700147700ustar00rootroot00000000000000*.cmx *.o *.cmi dist src/obuild ext/compat.ml obuild-0.2.2/.merlin000066400000000000000000000003031515212760700142620ustar00rootroot00000000000000S ./ B dist/build/lib-obuild S lib/core B dist/build/lib-obuild_core S lib/base B dist/build/lib-obuild_base S src B dist/build/obuild PKG obuild PKG obuild_base PKG obuild_core PKG str PKG unix obuild-0.2.2/.ocamlformat000066400000000000000000000001251515212760700153020ustar00rootroot00000000000000if-then-else=fit-or-vertical break-cases=fit-or-vertical type-decl=sparse margin=100 obuild-0.2.2/DESIGN.md000066400000000000000000001447711515212760700143100ustar00rootroot00000000000000# Obuild Design Documentation This document explains the architecture and design decisions of obuild, a parallel, incremental, and declarative build system for OCaml. ## Table of Contents 1. [Genesis and Philosophy](#genesis-and-philosophy) 2. [Architectural Layers](#architectural-layers) 3. [Core Data Flow](#core-data-flow) 4. [The Two-DAG Architecture](#the-two-dag-architecture) 5. [Dependency Resolution System](#dependency-resolution-system) 6. [Build Execution Pipeline](#build-execution-pipeline) 7. [Type System Design](#type-system-design) 8. [Ctypes.cstubs Integration](#ctypescstubs-integration) 9. [Custom Code Generators](#custom-code-generators) 10. [PPX and Preprocessor Resolution](#ppx-and-preprocessor-resolution) 11. [Configuration Files](#configuration-files) 12. [CLI Reference](#cli-reference) 13. [Design Decisions and Trade-offs](#design-decisions-and-trade-offs) --- ## Genesis and Philosophy Obuild started on a bank holiday after xmas, as an experiment to make the simplest OCaml build system. The main goals are to: * provide a good user experience. * provide a building black box, no mocking around generic rules. * provide features in the highest level possible. * the cleanest build possible, with by-products hidden from the user. * provide good defaults, and standardize names as much as possible. * expose everything that the user of the build system needs in one place. * be simple to build to prevent any bootstrapping problem. One of the main influences was Haskell Cabal, which provides to all Haskellers a simple way to provide a build system to a project with a single file. This applies well for the myriad of OCaml options too. ### Simple to Build Obuild is buildable with just the compiler and the compiler standard library. This make bootstrapping very easy: all you need is the OCaml compiler installed. This creates some pain for developers of obuild, as lots of basic functions available in others libraries need to written again as part of obuild. As the initial development was done really quickly, some functions are not as performant (CPU or memory-wise) as they could be. This can be fixed as problem becomes apparent in scaling. ### Simple to Use Each project is described really simply in a one place, in a user friendly format. A central .obuild file is used, and provides high level description of your project. Along with some meta data (name, authors, description, etc), it defines the library, and/or executable that the project wants to have, from which inputs (source files, modules). All dependencies are fully autogenerated internally and used to recompile only the necessary bits. Along with library and executable, test and benchmark can be defined, so as to provide an easy way to test or bench some part of your project. It also provides a standard on how to build and execute tests and benchmarks. ### Design Principles ``` ┌─────────────────────────────────────────────────────────────────┐ │ OBUILD DESIGN GOALS │ ├─────────────────────────────────────────────────────────────────┤ │ Declarative │ Users describe targets, not build steps │ │ Parallel │ Independent tasks run concurrently │ │ Incremental │ Only rebuild what changed │ │ Self-contained │ No external build tool dependencies │ │ Discoverable │ Auto-detect modules, dependencies │ └─────────────────────────────────────────────────────────────────┘ ``` --- ## Architectural Layers Obuild is organized in four distinct layers, each with clear responsibilities: ``` ┌─────────────────────────────────────────────────────────────────┐ │ LAYER 4: CLI │ │ src/main.ml │ │ Command dispatcher, user interface │ ├─────────────────────────────────────────────────────────────────┤ │ LAYER 3: COMMANDS │ │ lib/help.ml, init.ml, install.ml, etc. │ │ High-level operations (init, install, doc) │ ├─────────────────────────────────────────────────────────────────┤ │ LAYER 2: CORE │ │ lib/core/*.ml │ │ Parsing, analysis, dependency resolution, build execution │ ├─────────────────────────────────────────────────────────────────┤ │ LAYER 1: BASE │ │ lib/base/*.ml │ │ Filepath, Filesystem, Fugue (utilities), CLI │ └─────────────────────────────────────────────────────────────────┘ ``` ### Layer 1: Base Utilities (`lib/base/`) The foundation layer has **no dependencies** on OCaml build tools. This is critical for bootstrapping - obuild must compile itself before it can use itself. | Module | Purpose | |--------|---------| | `compat.ml` | OCaml version compatibility shims | | `filepath.ml` | Type-safe path abstractions | | `filesystem.ml` | File I/O operations | | `fugue.ml` | Functional utilities (string, list, option) | | `cli.ml` | Command-line parsing framework | ### Layer 2: Core Build System (`lib/core/`) This layer contains ~60 modules implementing the build system logic: ``` lib/core/ ├── Parsing ──────────── obuild_lexer.ml, obuild_parser.ml, │ obuild_ast.ml, obuild_validate.ml, │ project.ml, project_read.ml, meta.ml │ ├── Types ────────────── types.ml, target.ml, libname.ml, │ modname.ml, hier.ml, filetype.ml │ ├── Analysis ─────────── analyze.ml, prepare.ml, prepare_types.ml, │ dependencies.ml, metacache.ml │ ├── Execution ────────── build.ml, scheduler.ml, taskdep.ml, │ process.ml, prog.ml, buildprogs.ml │ ├── Configuration ────── configure.ml, gconf.ml, findlibConf.ml │ └── Utilities ────────── dag.ml, dagutils.ml, utils.ml, helper.ml ``` ### Layer 3: Command Modules (`lib/`) High-level operations that users invoke: | Module | Command | Purpose | |--------|---------|---------| | `help.ml` | `obuild help` | Documentation system | | `init.ml` | `obuild init` | Create new projects | | `install.ml` | `obuild install` | Install artifacts | | `doc.ml` | `obuild doc` | Generate documentation | | `sdist.ml` | `obuild sdist` | Create source distributions | ### Layer 4: Main Entry Point (`src/main.ml`) The CLI dispatcher that: - Parses command-line arguments - Dispatches to appropriate command handler - Manages global configuration - Handles top-level error reporting --- ## Core Data Flow The build process follows a clear pipeline from configuration to compiled artifacts: ``` ┌──────────────────────────────────────────────────────────────────────────┐ │ BUILD PIPELINE │ └──────────────────────────────────────────────────────────────────────────┘ .obuild file META files Source files │ │ │ ▼ ▼ ▼ ┌─────────────┐ ┌─────────────────┐ ┌───────────────┐ │ PARSING │ │ DEPENDENCY │ │ MODULE │ │ │ │ RESOLUTION │ │ ANALYSIS │ │ Lexer │ │ │ │ │ │ Parser │ │ FindlibConf │ │ ocamldep │ │ Validator │ │ Meta parser │ │ Hier mapping │ │ │ │ Metacache │ │ │ └──────┬──────┘ └────────┬────────┘ └───────┬───────┘ │ │ │ ▼ ▼ ▼ ┌──────────────────────────────────────────────────────────────────────────┐ │ ANALYSIS │ │ (analyze.ml) │ │ │ │ Combines all inputs into project_config with resolved dependencies │ └──────────────────────────────────────────────────────────────────────────┘ │ ▼ ┌──────────────────────────────────────────────────────────────────────────┐ │ PREPARATION │ │ (prepare.ml) │ │ │ │ For each target: scan modules, build compilation DAG, compute paths │ └──────────────────────────────────────────────────────────────────────────┘ │ ▼ ┌──────────────────────────────────────────────────────────────────────────┐ │ EXECUTION │ │ (build.ml) │ │ │ │ Scheduler runs compile_steps in parallel, respecting dependencies │ └──────────────────────────────────────────────────────────────────────────┘ │ ▼ Compiled Artifacts (dist/build//...) ``` ### Sequence Diagram: Full Build ``` User main.ml Project_read Analyze Prepare Build Scheduler │ │ │ │ │ │ │ │──build───────>│ │ │ │ │ │ │ │──read()─────>│ │ │ │ │ │ │ │──parse──────│ │ │ │ │ │ │──validate───│ │ │ │ │ │<──Project.t──│ │ │ │ │ │ │ │ │ │ │ │ │ │──prepare()───────────────>│ │ │ │ │ │ │ │──resolve───│ │ │ │ │ │ │ META │ │ │ │ │ │ │ files │ │ │ │ │<──project_config───────────│ │ │ │ │ │ │ │ │ │ │ │ │──build_dag()────────────────────────────────────────>│ │ │ │ │ │ │ │ │ │ │ │ │──prepare_target()──────>│ │ │ │ │ │<──compilation_state─────│ │ │ │ │ │ │ │ │ │ │ │ │ │──schedule()────────────>│ │ │ │ │ │ │ ┌────────┤ │ │ │ │ │ │ │parallel│ │ │ │ │ │ │ │compile │ │ │ │ │ │ │ │steps │ │ │ │ │ │ │ └────────┤ │ │ │ │ │<───────────────done──────│ │<──success─────│ │ │ │ │ │ ``` --- ## The Two-DAG Architecture A distinctive feature of obuild is its use of **two separate DAGs** (Directed Acyclic Graphs) for dependency tracking. Understanding why requires understanding two different questions: ### Question 1: "What changed?" The **Files DAG** answers this question. It tracks file-level dependencies: ``` Files DAG Example (for module Bar that uses Foo): bar.cmo / | \ / | \ bar.ml bar.cmi foo.cmi | bar.mli ``` - **Nodes**: Individual files (.ml, .mli, .cmi, .cmo, .cmx, .c, .h, .o) - **Edges**: "file A depends on file B" (based on content) - **Purpose**: Check modification times to determine what needs rebuilding When `foo.ml` changes but `foo.mli` doesn't: - `bar.cmo` doesn't need rebuilding (it only depends on `foo.cmi`) - Only `foo.cmo` needs recompilation ### Question 2: "What order?" The **Steps DAG** answers this question. It tracks task execution order: ``` Steps DAG Example: LinkTarget(mylib) / | \ / | \ CompileModule CompileModule CompileC (Bar) (Foo) (stubs.c) | | CompileInterface CompileInterface (Bar) (Foo) ``` - **Nodes**: Compilation tasks (CompileModule, CompileInterface, CompileC, LinkTarget) - **Edges**: "task A must complete before task B" - **Purpose**: Enable parallel scheduling while respecting dependencies ### Why Two DAGs? | Aspect | Files DAG | Steps DAG | |--------|-----------|-----------| | Purpose | Incremental builds | Parallel execution | | Answers | "What changed?" | "What order?" | | Granularity | Individual files | Compilation tasks | | Usage | mtime comparison | Topological sort | Separating these concerns allows: 1. **Fine-grained incrementality**: Only recompile files whose dependencies changed 2. **Maximum parallelism**: Independent tasks run concurrently 3. **Correct ordering**: Dependent tasks wait for prerequisites --- ## Dependency Resolution System Obuild resolves dependencies through OCamlfind's META file system. This is one of the more complex subsystems. ### Internal META Parsing ocamlfind is the current de-facto standard for installed package querying. ocamlfind is usually injected on the command line to ocamlopt, ocamldep, ocamlc with special flags (-syntax, -package), that ocamlfind will re-write to call the program with something that the program can understand. All the information for this transformation is stored in META files. Unfortunately this design prevents META caching, and each time ocamlc/ocamlopt is used it will reparse the META files. This also causes problems if ocamlfind does not exist when used as a program, or if the library is not installed when used as a library. Because of those 2 reasons, obuild has its own implementation of META parsing with caching support. ### META File Discovery ``` Search Order for library "base": 1. Check each path in OCAMLPATH: ├── /home/user/.opam/default/lib/base/META ← Found! ├── /usr/lib/ocaml/base/META └── ... 2. Alternative: META. format: └── /usr/lib/ocaml/META.base ``` ### META Parsing Flow ``` META file (text) │ ▼ ┌─────────────┐ │ LEXER │ │ (meta.ml) │ └──────┬──────┘ │ tokens ▼ ┌─────────────┐ │ PARSER │ │ (meta.ml) │ └──────┬──────┘ │ ▼ ┌─────────────┐ │ Pkg.t │ │ (cached) │ └─────────────┘ ``` ### Metacache Architecture A critical design decision is how META files are cached: ``` ┌─────────────────────────────────────────────────────────────────┐ │ METACACHE │ │ │ │ Hashtbl: main_name → (filepath, root_pkg) │ │ │ │ "base" → ("/path/to/base/META", ) │ │ "str" → ("/path/to/str/META", ) │ │ │ └─────────────────────────────────────────────────────────────────┘ │ │ get_from_cache("base.shadow_stdlib") ▼ Returns: (filepath, ROOT package for "base") │ │ Caller must resolve subpackages: │ Meta.Pkg.find(["shadow_stdlib"], root) ▼ Resolved subpackage Pkg.t ``` **Key design**: Metacache always returns the **root package**. Callers are responsible for navigating to subpackages. This prevents: - Double resolution (cache pre-resolving, then caller resolving again) - Incorrect path generation for subpackages ### Include Path Resolution META files specify directories using special syntax: ``` Directory Field Resolves To ───────────────────────────────────────────────── "" or "." basePath (where META lives) "^" parent directory "^subdir" parent/subdir "+stdlib" $OCAMLLIB/stdlib "/absolute/path" /absolute/path "relative/path" basePath/relative/path ``` ### Dependency Graph Construction ``` Analyze.prepare() builds multiple graphs: ┌─────────────────────────────────────────────────────────────────┐ │ project_pkgdeps_dag │ │ (Complete dependency picture) │ │ │ │ ┌─────────┐ ┌─────────┐ ┌─────────┐ │ │ │Exe:main │────────>│Lib:mylib│────────>│Dep:base │ │ │ └─────────┘ └────┬────┘ └────┬────┘ │ │ │ │ │ │ ▼ ▼ │ │ ┌─────────┐ ┌─────────┐ │ │ │Dep:unix │ │Dep:sexp │ │ │ └─────────┘ └─────────┘ │ └─────────────────────────────────────────────────────────────────┘ ┌─────────────────────────────────────────────────────────────────┐ │ project_targets_dag │ │ (Internal targets only) │ │ │ │ ┌─────────┐ ┌─────────┐ │ │ │Exe:main │──────────────────>│Lib:mylib│ │ │ └─────────┘ └─────────┘ │ │ │ └─────────────────────────────────────────────────────────────────┘ ┌─────────────────────────────────────────────────────────────────┐ │ project_dep_data │ │ (Dependency classification) │ │ │ │ mylib → Internal (defined in project) │ │ base → System (from OCamlfind) │ │ unix → System (from OCamlfind) │ │ │ └─────────────────────────────────────────────────────────────────┘ ``` --- ## Build Execution Pipeline ### Scheduler Design The scheduler manages parallel job execution with dependency tracking: ``` ┌─────────────────────────────────────────────────────────────────┐ │ SCHEDULER │ │ │ │ ┌─────────────┐ ┌─────────────┐ ┌─────────────┐ │ │ │ Ready │ │ Running │ │ Completed │ │ │ │ Queue │───>│ Jobs │───>│ Tasks │ │ │ └─────────────┘ └─────────────┘ └─────────────┘ │ │ ▲ │ │ │ │ │ │ │ └──────────────────────────────────────┘ │ │ When dependencies are satisfied │ │ │ └─────────────────────────────────────────────────────────────────┘ ``` ### Compile Steps Each step represents an atomic compilation task: ```ocaml type compile_step = | CompileModule of Hier.t (* .ml → .cmo/.cmx *) | CompileInterface of Hier.t (* .mli → .cmi *) | CompileDirectory of Hier.t (* Pack directory modules *) | CompileC of filename (* .c → .o *) | GenerateCstubsTypes of Libname.t (* ctypes type discovery *) | GenerateCstubsFunctions of Libname.t (* ctypes stub generation *) | CompileCstubsC of Libname.t (* Compile generated C *) | LinkTarget of target (* Link library/executable *) | CheckTarget of target (* Verify outputs exist *) ``` ### Build Execution Sequence ``` For library "mylib" with modules Foo, Bar (Bar depends on Foo): Time ──────────────────────────────────────────────────────────> Thread 1: ┌──────────────────┐ │CompileInterface │ │ (Foo) │ └────────┬─────────┘ │ ┌────────▼─────────┐ │ CompileModule │ │ (Foo) │ └────────┬─────────┘ │ ▼ (Bar can now start) ┌──────────────────┐ │ CompileModule │ │ (Bar) │ └────────┬─────────┘ │ ▼ ┌──────────────────┐ │ LinkTarget │ │ (mylib) │ └──────────────────┘ Thread 2: ┌──────────────────┐ │CompileInterface │ (parallel with Foo interface) │ (Bar) │ └──────────────────┘ │ │ (waits for CompileModule(Foo)) ▼ ┌──────────────────┐ │ CompileC │ (parallel with Bar module) │ (stubs.c) │ └──────────────────┘ ``` --- ## Type System Design Obuild uses domain-specific types to prevent common errors: ### Path Types ```ocaml (* lib/base/filepath.ml *) type filepath (* Directory or file path *) type filename (* Just a filename, no directory *) (* These are abstract types - you cannot mix them up *) val () : filepath -> filename -> filepath (* Combine path + name *) val () : filepath -> filepath -> filepath (* Combine paths *) ``` ### Name Types ``` ┌─────────────────────────────────────────────────────────────────┐ │ NAME TYPES │ │ │ │ Libname.t │ │ ├── main_name: "base" │ │ └── subnames: ["shadow_stdlib"] │ │ → "base.shadow_stdlib" │ │ │ │ Modname.t │ │ └── Validated OCaml module name │ │ → "Base" (capitalized, valid chars) │ │ │ │ Hier.t │ │ └── Module hierarchy: [Base; Utils; String_extra] │ │ → "Base.Utils.String_extra" (module path) │ │ → "base/utils/string_extra" (file path) │ │ │ │ Target.Name.t │ │ ├── Lib of Libname.t │ │ ├── Exe of string │ │ ├── Test of string │ │ ├── Bench of string │ │ └── Example of string │ │ │ └─────────────────────────────────────────────────────────────────┘ ``` ### Why This Matters ```ocaml (* WRONG: Easy to confuse in stringly-typed code *) let path = dir ^ "/" ^ name ^ ".ml" (* What if name has a slash? *) (* RIGHT: Types prevent mistakes *) let path = dir (fn (name ^ ".ml")) (* Type-checked! *) ``` --- ## Ctypes.cstubs Integration Obuild supports ctypes.cstubs for generating C bindings declaratively. ### Configuration Syntax ``` library mylib modules: Bindings, C, Types_generated build-deps: ctypes, ctypes.stubs cstubs external-library-name: mylib_stubs type-description: Bindings.Types -> Types_gen function-description: Bindings.Functions -> Funcs_gen generated-types: Types_generated generated-entry-point: C headers: string.h ``` ### Cstubs Build Flow ``` .obuild configuration │ │ cstubs block parsed ▼ ┌─────────────────────────────────────────────────────────────────┐ │ PHASE 1: Type Discovery │ │ │ │ Generate discover.ml ───> Compile ───> Run ───> discover.c │ │ │ │ │ Compile discover.c ───> Run ───> types_generated.ml │ │ │ └─────────────────────────────────────────────────────────────────┘ │ ▼ ┌─────────────────────────────────────────────────────────────────┐ │ PHASE 2: Compile Bindings │ │ │ │ bindings.ml (user's functor definitions) │ │ │ │ │ ▼ │ │ Compile bindings.cmo │ │ │ └─────────────────────────────────────────────────────────────────┘ │ ▼ ┌─────────────────────────────────────────────────────────────────┐ │ PHASE 3: Stub Generation │ │ │ │ Generate stubgen.ml ───> Compile with bindings.cmo ───> Run │ │ │ │ │ ├───> mylib_stubs_generated.ml (FOREIGN implementation) │ │ ├───> c.ml (entry point) │ │ └───> mylib_stubs.c (C stubs) │ │ │ └─────────────────────────────────────────────────────────────────┘ │ ▼ ┌─────────────────────────────────────────────────────────────────┐ │ PHASE 4: Compile Everything │ │ │ │ Compile generated .ml files │ │ Compile mylib_stubs.c ───> mylib_stubs.o │ │ Archive ───> libmylib_stubs.a │ │ Link everything into final library │ │ │ └─────────────────────────────────────────────────────────────────┘ ``` ### Cstubs DAG Integration ``` LinkTarget(mylib) / | \ / | \ CompileModule CompileCstubsC CompileModule (C - entry) (stubs.c) (Mylib_stubs_generated) | | | └───────────────┼───────────────────┘ │ GenerateCstubsFunctions │ ┌──────────┴──────────┐ │ │ CompileModule(Bindings) GenerateCstubsTypes │ CompileModule(Types_generated) ``` --- ## Custom Code Generators Obuild supports custom code generators defined in the `.obuild` file. This allows any code generation tool (menhir, ocamllex, atdgen, protobuf, etc.) to be integrated without hardcoding support in obuild itself. ### Generator Architecture Generators are registered during project parsing and invoked during module resolution. When obuild looks for a module and cannot find a `.ml` file, it checks for source files matching registered generator suffixes. ``` Module resolution for "Parser": 1. Look for parser.ml in src-dir → Not found 2. Check registered generators: ├── suffix "mly" → look for parser.mly → Found! └── suffix "mll" → look for parser.mll → Not found 3. Run menhir generator on parser.mly 4. Produces parser.ml (and parser.mli) 5. Continue compilation with generated files ``` ### Generator Types Generators are defined in `lib/core/generators.ml` with two key types: ```ocaml (* Built-in generator *) type t = { suffix : string; (* File extension to match *) modname : Modname.t -> Modname.t; (* Module name transformation *) commands : filepath -> filepath -> string -> string list list; generated_files : filename -> string -> filename; } (* Custom generator from .obuild file *) type custom = { custom_name : string; (* Unique identifier *) custom_suffix : string option; (* Auto-detection suffix *) custom_command : string; (* Command template *) custom_outputs : string list; (* Output file patterns *) custom_module_name : string option; (* Optional module name pattern *) } ``` ### Variable Substitution Generator commands support template variables: | Variable | Description | |----------|-------------| | `${src}` | Full path to source file | | `${dest}` | Destination path without extension | | `${base}` | Base filename without extension | | `${srcdir}` | Source directory | | `${destdir}` | Destination directory | | `${sources}` | Space-separated list of all inputs (multi-input only) | ### Generator Execution Flow ``` .obuild file Module resolution Build execution │ │ │ │ generator menhir │ Parser not found │ │ suffix: mly │ parser.mly exists │ │ command: menhir ... │ │ │ outputs: ${base}.ml │ │ │ │ │ ▼ ▼ ▼ register_custom() get_generators("mly") run(dest, src, modName) │ │ │ │ Stored in global │ Returns matching │ substitute_variables() │ generator registry │ generators │ Execute via sh -c │ │ │ Produce .ml/.mli ``` Custom generators defined in `.obuild` take precedence over built-in ones, allowing users to override default behavior (e.g., using menhir instead of ocamlyacc for `.mly` files). --- ## PPX and Preprocessor Resolution The `ppx_resolver.ml` module handles resolution of PPX preprocessors and legacy camlp4 syntax extensions. ### Resolution Strategy PPX and syntax packages are resolved through the META file system using special predicates: ``` For a target with syntax dependencies: 1. Collect syntax deps from project DAG 2. For each syntax dep: ├── Internal (project library)? │ └── Use compiled bytecode archive path └── External (findlib package)? └── Query META with predicates: [Syntax, Preprocessor, Camlp4o/Camlp4r] 3. Generate -I include paths 4. Generate archive file arguments 5. Return complete preprocessor command ``` ### Key Functions - `get_syntax_pp`: Generates preprocessor flags (`-I` paths and archive files) for syntax packages - `get_target_pp`: Resolves all syntax/preprocessor dependencies for a target and returns a complete preprocessor configuration The resolver distinguishes between internal syntax packages (compiled as part of the project) and external ones (resolved via findlib META files). --- ## Configuration Files Obuild supports configuration files (`.obuildrc`) for setting default values that apply before command-line argument parsing. ### File Locations Configuration is loaded from two locations, in order: 1. `~/.obuildrc` — User-level defaults 2. `./.obuildrc` — Project-level defaults Project-level values override user-level values. Command-line arguments override both. ### File Format ``` # Comments start with # verbose = true jobs = 4 ocamlopt = /usr/local/bin/ocamlopt ``` Each line is a `key = value` pair. Keys correspond to CLI option names (without the `--` prefix). ### Integration The CLI framework (`lib/base/cli.ml`) loads configuration files via `load_config()` and applies them as argument defaults through `run_with_config`. This happens before command-line parsing, so CLI flags always take precedence. ``` Priority (highest to lowest): 1. Command-line arguments --jobs 8 2. Project .obuildrc jobs = 4 3. User ~/.obuildrc jobs = 2 4. Built-in defaults jobs = 2 ``` --- ## CLI Reference ### Commands | Command | Description | |---------|-------------| | `configure` | Detect dependencies and prepare build configuration | | `build` | Compile targets (all or specified) | | `clean` | Remove build artifacts | | `install` | Install compiled artifacts | | `test` | Build and run test targets | | `init` | Create a new project skeleton | | `sdist` | Create a source distribution tarball | | `get` | Query configuration values | | `generate` | Generate helper files (see subcommands below) | | `doc` | Generate documentation (not yet implemented) | | `infer` | Infer project structure (not yet implemented) | ### Generate Subcommands | Subcommand | Description | |------------|-------------| | `generate merlin` | Create `.merlin` file for IDE support (source dirs, build dirs, packages) | | `generate opam` | Create `.opam` file (OPAM 2.0 format) from project metadata | | `generate completion` | Generate shell completion scripts (bash, zsh, fish) | ### Global Options These options apply to all commands: | Option | Short | Description | |--------|-------|-------------| | `--help` | `-h` | Show help | | `--version` | `-V` | Show version | | `--verbose` | `-v` | Enable verbose output | | `--quiet` | `-q` | Suppress output | | `--debug` | `-d` | Enable debug output | | `--debug+` | | Enable debug output with commands | | `--color` | | Enable colored output | | `--findlib-conf` | | Path to findlib configuration | | `--ocamlopt` | | Path to ocamlopt compiler | | `--ocamldep` | | Path to ocamldep tool | | `--ocamlc` | | Path to ocamlc compiler | | `--cc` | | Path to C compiler | | `--ar` | | Path to ar archiver | | `--pkg-config` | | Path to pkg-config tool | | `--ranlib` | | Path to ranlib tool | | `--ocamldoc` | | Path to ocamldoc tool | | `--ld` | | Path to linker | ### Configure Options | Option | Default | Description | |--------|---------|-------------| | `--executable-native` | true | Build native executables | | `--executable-bytecode` | false | Build bytecode executables | | `--executable-profiling` | false | Build profiling executables | | `--executable-debugging` | false | Build debugging executables | | `--executable-as-obj` | false | Build executables as objects | | `--library-native` | true | Build native libraries | | `--library-bytecode` | true | Build bytecode libraries | | `--library-profiling` | false | Build profiling libraries | | `--library-debugging` | false | Build debugging libraries | | `--library-plugin` | true (Unix) | Build library plugins | | `--build-examples` | false | Build example targets | | `--build-benchs` | false | Build benchmark targets | | `--build-tests` | false | Build test targets | | `--annot` | false | Generate annotation files | ### Build Options | Option | Short | Description | |--------|-------|-------------| | `--jobs` | `-j` | Number of parallel jobs (default: 2) | | `--dot` | | Dump dependency graph in DOT format | | `--noocamlmklib` | | Disable ocamlmklib usage | | `-g` | | Shorthand for `--library-debugging --executable-debugging` | --- ## Design Decisions and Trade-offs ### Decision 1: Two Separate DAGs **Trade-off**: More complex implementation vs. better incrementality and parallelism. **Rationale**: A single DAG cannot efficiently answer both "what changed?" (file-level) and "what order?" (task-level). Separating them allows: - File DAG: Fine-grained mtime checks - Steps DAG: Coarse-grained parallel scheduling ### Decision 2: Metacache Returns Root Packages **Trade-off**: Callers must resolve subpackages vs. no double-resolution bugs. **Rationale**: When the cache pre-resolved subpackages, callers that also resolved (common pattern) caused `SubpackageNotFound` errors. Returning root packages consistently prevents this class of bugs. ### Decision 3: Type-Safe Path Abstractions **Trade-off**: More verbose code vs. compile-time path safety. **Rationale**: Path manipulation bugs are common and hard to debug. Type-safe `filepath`/`filename` types catch errors at compile time rather than runtime. ### Decision 4: Exception-Based Error Handling **Trade-off**: Less explicit control flow vs. simpler code structure. **Rationale**: OCaml's exception model allows errors to propagate naturally without Result types threading through every function. The main entry point catches and formats all exceptions. ### Decision 5: Lazy META Parsing with Caching **Trade-off**: First build is slower vs. subsequent builds are faster. **Rationale**: Parsing META files is I/O bound. Caching parsed results in memory dramatically speeds up dependency resolution for large projects with many dependencies. ### Decision 6: New Parser Architecture **Trade-off**: More code, separate modules vs. cleaner separation of concerns. **Rationale**: The new parser architecture (Lexer → Parser → AST → Validator) separates: - Tokenization (obuild_lexer.ml) - Syntax analysis (obuild_parser.ml) - Data representation (obuild_ast.ml) - Semantic validation (obuild_validate.ml) This makes each component easier to test, modify, and understand. --- ## Summary Obuild's architecture reflects its goals of being declarative, parallel, and incremental: ``` ┌─────────────────────────────────────────────────────────────────┐ │ ARCHITECTURE SUMMARY │ ├─────────────────────────────────────────────────────────────────┤ │ │ │ Declarative Input Parallel Execution │ │ │ │ │ │ .obuild file Scheduler + DAGs │ │ │ │ │ │ ▼ ▼ │ │ ┌─────────┐ ┌─────────┐ │ │ │ Parsing │──────────────│ Build │ │ │ │ Layer │ Analysis │ Layer │ │ │ └─────────┘ └─────────┘ │ │ │ │ │ │ Project.t Compiled Artifacts │ │ │ │ │ │ Type-Safe Incremental Rebuilds │ │ Representation │ │ │ └─────────────────────────────────────────────────────────────────┘ ``` The key insight is that build systems solve two distinct problems: 1. **What to build**: Declarative configuration, dependency resolution 2. **How to build**: Scheduling, parallelism, incrementality Obuild addresses both through its layered architecture and dual-DAG design. --- ## Librification Obuild has been designed to be used as a library eventually. The code is shifting towards using pure structures and functions, so that things can be reused. There is some global state that will be eventually reduced to provide better control of each part. One possible development would be to provide an optional daemon that monitors file changes and automatically rebuilds on demand without having to re-analyze the whole project. Some other possible scenarios include having other programs use the project file format, either to provide tools to write them or tools that read them. obuild-0.2.2/LICENSE000066400000000000000000000024521515212760700140070ustar00rootroot00000000000000Copyright (c) 2013 Vincent Hanquez All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. obuild-0.2.2/OBUILD_SPEC.md000066400000000000000000000034541515212760700151170ustar00rootroot00000000000000# obuild file specification (DRAFT) Here are the fields accepted in obuild files The syntax is field (flags): accepted_values * field = string * flags = M (mandatory) * boolean = true | True | false | False * accepted_values = comma separated string list | string list | string | boolean # Section types * executable * library * flag * test * bench * example # Toplevel fields These fields are only accepted in the top level, i.e. not in target sections, etc. * name (M): string * version (M): string * obuild-ver (M): 1 * synopsis: * description: * licence | license: string: Licence for the project * licence-file | license-file: string: Filename of the licence in the project directory * homepage: string: URL of the homepage of the project * tools: ? * authors: string list CSV, Info about the authors, separated by commas * author: string list: Info about the author * extra-srcs: ? * configure-script: ? # Target fields ## Common fields * buildable: boolean * installable: boolean ## OCaml target fields * builddepends | builddeps | build-deps: string list: ocamlfind library names * path | srcdir | src-dir: string: sources directory * preprocessor | pp: string: preprocessor to use * extra-deps: comma-separated string list: ? * stdlib: (none | no | standard | core): standard library to link ? ## C target fields * cdir | c-dir: * csources | c-sources: * cflags | c-flags | ccopts | ccopt | c-opts: * c-libpaths: * c-libs: * c-pkgs: ## Library only fields * sub | subdir | library: NO VALUE (define a new block) * per: NO VALUE (define a new block) * modules: * pack: * syntax: * description: ## Executable | Example | Test common fields * per: NO VALUE (define a new block) * main | mainis | main-is: string: ml file being the entry point for the executable ## Test only fields * rundir: * runopt: obuild-0.2.2/README.md000066400000000000000000000156601515212760700142660ustar00rootroot00000000000000obuild ====== A parallel, incremental and declarative build system for OCaml. Design ------ The goal is to make a very simple build system for users and developers of OCaml library and programs. `obuild` acts as building black box: user declare only what they want to build and with which sources, and it will be consistently built. The design is based on Haskell's Cabal, and borrow most of the layout and way of working, adapting parts where necessary to support OCaml fully. There's no way to build things that `obuild` has not been designed to do on purpose, so that the experience provided is consistent, and all future improvements to `obuild` will automatically benefit program and libraries using older versions. Currently unsupported features should be requested on the Github issue tracker. Feature ------- * Incremental & parallel build system. only rebuilding what's necessary. * Descriptive configuration file. * Easy for users: no rules to mess about, just describe what you want. * No building dependency apart from OCaml's stdlib: easy to build * No tool or binary dependencies apart from ocaml compilers * OCamlfind-like support integrated for faster compilation How to build a project using obuild ----------------------------------- obuild supports a clean, user-friendly command-line interface with helpful error messages and automatic help generation. ### Quick Start ```bash # Get help obuild -h # Show all available commands obuild build -h # Show build-specific options # Check version obuild --version # Typical workflow obuild configure --enable-tests obuild build obuild test ``` ### Available Commands ``` obuild configure Prepare to build the package obuild build Make this package ready for installation obuild clean Clean up after a build obuild install Install this package obuild test Run the tests obuild doc Generate documentation obuild sdist Generate a source distribution file (.tar.gz) obuild init Initialize a new project obuild get Get project metadata field ``` ### Command Details **configure** - Prepare the project by checking dependencies and setting build options ```bash obuild configure [OPTIONS] Options: --enable-tests Enable building tests --enable-examples Enable building examples --enable-library-bytecode Enable library bytecode compilation --enable-library-native Enable library native compilation -g Enable debugging symbols --annot Generate .annot files ``` **build** - Build every buildable target defined by the project ```bash obuild build [OPTIONS] [TARGETS...] Options: -j, --jobs N Maximum number of parallel jobs (default: auto-detected) --dot Dump dependency graphs as .dot files Examples: obuild build # Build everything obuild build -j 4 # Build with 4 parallel jobs obuild build mylib myexe # Build specific targets only ``` **clean** - Remove all build artifacts **test** - Run all test targets ```bash obuild test [OPTIONS] Options: --output Show test output (default: only show failures) ``` **install** - Install libraries and executables ```bash obuild install [OPTIONS] Options: --destdir DIR Override installation directory --opam Generate .install file for OPAM ``` **get** - Retrieve project metadata ```bash obuild get FIELD Fields: name, version, license Examples: obuild get name # Get project name obuild get version # Get project version ``` ### Global Options These options work with any command: ```bash -v, --verbose Verbose output -q, --quiet Quiet mode (errors only) --color Enable colored output --strict Enable strict mode ``` ### Configuration Files Obuild supports configuration files for setting default values. Config files use a simple `key = value` format. **Config file locations** (in order of precedence): 1. `./.obuildrc` - Project-specific settings 2. `~/.obuildrc` - User-wide settings **Example config file:** ```bash # ~/.obuildrc - User configuration for obuild # Set default number of parallel jobs jobs = 8 # Enable colored output by default color = true # Verbose mode verbose = false ``` **Supported options:** - `jobs` - Default number of parallel build jobs (integer) - `color` - Enable colored output (true/false) - `verbose` - Verbose output mode (true/false) - `quiet` - Quiet mode (true/false) - `strict` - Strict mode (true/false) Command-line arguments always override config file values. ### Shell Completion Obuild can generate shell completion scripts for bash, zsh, and fish: ```bash # Generate and install bash completion obuild completion bash > ~/.bash_completion.d/obuild source ~/.bash_completion.d/obuild # Generate zsh completion obuild completion zsh > ~/.zsh/completions/_obuild # Generate fish completion obuild completion fish > ~/.config/fish/completions/obuild.fish ``` How to write a project file --------------------------- A project file is a file terminated by the `.obuild` extension. Only one per project is supported. The content is declarative using a simple layout format. Every normal line needs to be in a "key: value" format. Multiple lines are supported by indenting (with spaces) the value related to the key. ``` name: myproject version: 0.0.1 description: This is my new cool project . This is a long description describing properly what the project does. licence: MyLicense authors: John Doe obuild-ver: 1 homepage: http://my.server.com/myproject ``` The different target types: * executable: this creates an executable that is going to be installed by default. * library: create a library that is going to be installed. * test: create an executable that will not be installed, and will interact with obuild according to the test_type field. cabal test will run every built tests in a row. for the exit test_type, the exit code is used to signal error (0 = success, anything else = failure) * bench: create an executable that will not be installed, and will allow to benchmarks, some part of the project. This is largely unimplemented and just a placeholder for future development. * example: create an executable that is not installed, nor compiled by default. you need to use configure with --enable-examples. This allow to make sure that examples are compiled with the sources to prevent bitrotting. At a later stage that can be used to generate extra documentation. Declaring an executable ----------------------- ``` executable myexec main-is: mymain.ml src-dir: src build-deps: unix ``` Declaring a library ------------------- ``` library mylib modules: Module1, Module2 src-dir: lib build-deps: mydep1, mydep2 ``` obuild-0.2.2/TODO.md000066400000000000000000000043201515212760700140650ustar00rootroot00000000000000This is an unexhaustive and probably inaccurate list of items that need to be looked at or completed to make obuild even better. It is a good source of idea for anyone wanting to contribute. Projects file ------------- * support if/then/else construct in project file. * add platform and architecture tests in project file: i.e. "if arch(x86) && ..." * utf8 in project file (maybe useful ?) Better configuring ------------------ * configure storing / build checking of system state (e.g. digest of libraries, pkg-config, etc) * cache meta in a friendlier format in dist/ after configure. speed up build. * arbitrary mechanism to poke at the platform and see what it supports. feeding the file autogeneration phase. * per project and per system configuration file (à la git) Perf Improvement ---------------- * use the transitive-edge-reduced dag for checking dependencies. * remove redundant mtime checks by using a invaliding mtime hashtbl caching mechanism. * improve change detection with a digest after mtime change. * improve compilation with .mli by moving the dag pointer of its parents to the compiled interface, not the compiled module. * ocamldep parallelization & multiples Completeness ----------- * add install, and generate META * generate HTML documentation * generate cmxs * generate opam files (.install and .config) * benchs Documenting ----------- * specification for the .obuild file format * mli files and code documentation Misc ---- * init: make it better * add globs for extras source * add automatic build-deps scanning/adding (see if possible and default to off probably) * librarify some part of obuild (Config parsing, meta parsing, opam generation, dependencies analysis, building analysis,...) * replace Digest by a faster (and more modern) digest module from cryptohash * better portability (windows) * add a way to refresh a .mli from scratch. for example obuild generate-mli src/ext.ml will (re-)write src/ext.mli * add a simple way to switch stdlib so that core can be used instead of the compiler stdlib for any target. (project field parsing done already) * have test (re-)build themselves when doing obuild test, instead of doing 'obuild build; obuild test'. * improve command line experience (cmdliner ?) obuild-0.2.2/bootstrap000077500000000000000000000072731515212760700147530ustar00rootroot00000000000000#!/bin/sh # Ensure we run from the repository root regardless of where the script is called from cd "$(dirname "$0")" || exit 1 libs="unix.cma" OCAMLC="ocamlc -g -I +unix" OCAMLVER=$($OCAMLC -version) echo "$OCAMLVER" ocaml configure.ml extmodules="compat location fugue string_utils filepath filesystem cli" coremodules="types gconf filetype dag libname pp expr utils modname taskdep helper dagutils process findlibConf scheduler prog dependencies generators hier meta metacache obuild_lexer obuild_ast obuild_parser target dist project obuild_validate project_read analyze configure prepare_types ppx_resolver prepare buildprogs build_cstubs build exception" commandmodules="sdist doc init help install" mainmodules="path_generated main" set -e ######################################################################## ######################################################################## ######################################################################## # build lib (combining base utilities, core library, and command modules) cd lib/ rm -f ./*.cmi ./*.cmo ./*.o rm -f base/*.cmi base/*.cmo base/*.o rm -f core/*.cmi core/*.cmo core/*.o # Compile base modules as top-level (for bootstrap compatibility) cd base for mod in $extmodules do echo "COMPILING base/$mod" [ -f "${mod}.mli" ] && $OCAMLC -c "${mod}.mli" $OCAMLC -c "${mod}.ml" done; cd .. # Compile core modules (can access base modules directly) cd core for mod in $coremodules do echo "COMPILING core/$mod" [ -f "${mod}.mli" ] && $OCAMLC -I .. -I ../base -c "${mod}.mli" $OCAMLC -I .. -I ../base -c "${mod}.ml" done; cd .. # Compile command modules for mod in $commandmodules do echo "COMPILING command/$mod" [ -f "${mod}.mli" ] && $OCAMLC -I . -I base -I core -c "${mod}.mli" $OCAMLC -I . -I base -I core -c "${mod}.ml" done; # During bootstrap, copy all modules to root for main.ml compatibility cd .. echo "COPYING modules to root for bootstrap" cp lib/base/*.cmo ./ cp lib/base/*.cmi ./ cp lib/core/*.cmo ./ cp lib/core/*.cmi ./ cp lib/*.cmo ./ cp lib/*.cmi ./ # then bootstrap the main executable # main needs the version number cat < src/path_generated.ml (* autogenerated file by bootstrap. do not modify *) let project_version = "0.0.0" EOF cd src MAINCMO="" for mod in $mainmodules do echo "COMPILING $mod" [ -f "${mod}.mli" ] && $OCAMLC -I ../ -c "${mod}.mli" $OCAMLC -I ../ -c "${mod}.ml" MAINCMO="$MAINCMO ${mod}.cmo" done echo "LINKING obuild.bootstrap" # Link with all individual .cmo files for bootstrap ALLCMO="" for mod in $extmodules; do ALLCMO="$ALLCMO ${mod}.cmo"; done for mod in $coremodules; do ALLCMO="$ALLCMO ${mod}.cmo"; done for mod in $commandmodules; do ALLCMO="$ALLCMO ${mod}.cmo"; done $OCAMLC -o ../obuild.bootstrap -I ../ ${libs} $ALLCMO $MAINCMO cd .. rm -f lib/*.cmi lib/*.cmo lib/*.o rm -f lib/base/*.cmi lib/base/*.cmo lib/base/*.o rm -f lib/core/*.cmi lib/core/*.cmo lib/core/*.o rm -f src/*.cmi src/*.cmo src/*.o rm -f ./*.cmi ./*.o ./*a ./*.cmo rm -f src/path_generated.ml ######################################################################## ######################################################################## ######################################################################## # rebuild everything with the bootstraped version export OCAMLRUNPARAM=b ./obuild.bootstrap clean if [ -x "$(command -v ocamlopt)" ]; then ./obuild.bootstrap configure ./obuild.bootstrap build else ./obuild.bootstrap configure \ --executable-native=false \ --library-native=false \ --library-plugin=false \ --executable-bytecode=true \ --library-bytecode=true ./obuild.bootstrap build mv dist/build/obuild/obuild.byte dist/build/obuild/obuild fi if [ -x dist/build/obuild/obuild ]; then rm obuild.bootstrap fi obuild-0.2.2/compat401.ml000066400000000000000000000010001515212760700150300ustar00rootroot00000000000000let bytes_of_string = String.copy let bytes_to_string = String.copy let bytes_make = String.make let bytes_create = String.create let bytes_get = String.get let bytes_set = String.set let bytes_length = String.length let bytes_index_from = String.index_from let buffer_add_subbytes = Buffer.add_substring let string_uncapitalize = String.uncapitalize let string_capitalize = String.capitalize let string_lowercase = String.lowercase let string_uppercase = String.uppercase let char_uppercase = Char.uppercase obuild-0.2.2/compat402.ml000066400000000000000000000010011515212760700150320ustar00rootroot00000000000000let bytes_of_string = Bytes.of_string let bytes_to_string = Bytes.to_string let bytes_make = Bytes.make let bytes_create = Bytes.create let bytes_get = Bytes.get let bytes_set = Bytes.set let bytes_length = Bytes.length let bytes_index_from = Bytes.index_from let buffer_add_subbytes = Buffer.add_subbytes let string_uncapitalize = String.uncapitalize let string_capitalize = String.capitalize let string_lowercase = String.lowercase let string_uppercase = String.uppercase let char_uppercase = Char.uppercase obuild-0.2.2/compat403.ml000066400000000000000000000010371515212760700150440ustar00rootroot00000000000000let bytes_of_string = Bytes.of_string let bytes_to_string = Bytes.to_string let bytes_make = Bytes.make let bytes_create = Bytes.create let bytes_get = Bytes.get let bytes_set = Bytes.set let bytes_length = Bytes.length let bytes_index_from = Bytes.index_from let buffer_add_subbytes = Buffer.add_subbytes let string_uncapitalize = String.uncapitalize_ascii let string_capitalize = String.capitalize_ascii let string_lowercase = String.lowercase_ascii let string_uppercase = String.uppercase_ascii let char_uppercase = Char.uppercase_ascii obuild-0.2.2/compat_common.ml000066400000000000000000000066161515212760700161750ustar00rootroot00000000000000 (* Result type definition - common across versions *) type ('a, 'b) result = Ok of 'a | Error of 'b module Result = struct type ('a, 'b) t = ('a, 'b) result let ok x = Ok x let error e = Error e let is_ok = function Ok _ -> true | Error _ -> false let is_error = function Ok _ -> false | Error _ -> true let map f = function | Ok x -> Ok (f x) | Error e -> Error e let map_error f = function | Ok x -> Ok x | Error e -> Error (f e) let bind r f = match r with | Ok x -> f x | Error e -> Error e let value r ~default = match r with | Ok x -> x | Error _ -> default let get_ok = function | Ok x -> x | Error _ -> invalid_arg "Result.get_ok" let get_error = function | Ok _ -> invalid_arg "Result.get_error" | Error e -> e end (* Option helpers *) module Option = struct let map f = function | Some x -> Some (f x) | None -> None let bind o f = match o with | Some x -> f x | None -> None let value o ~default = match o with | Some x -> x | None -> default let get = function | Some x -> x | None -> invalid_arg "Option.get" let is_some = function | Some _ -> true | None -> false let is_none = function | Some _ -> false | None -> true end (* SafeList - List module with exception-safe operations *) module SafeList = struct include List let find_opt pred lst = try Some (List.find pred lst) with Not_found -> None let assoc_opt key lst = try Some (List.assoc key lst) with Not_found -> None let nth_opt lst n = try Some (List.nth lst n) with Failure _ | Invalid_argument _ -> None let filter_map f lst = let rec aux acc = function | [] -> List.rev acc | x :: xs -> match f x with | Some y -> aux (y :: acc) xs | None -> aux acc xs in aux [] lst let find_map f lst = let rec aux = function | [] -> None | x :: xs -> match f x with | Some _ as result -> result | None -> aux xs in aux lst end (* SafeHashtbl - Hashtbl module with exception-safe operations *) module SafeHashtbl = struct include Hashtbl let find_opt tbl key = try Some (Hashtbl.find tbl key) with Not_found -> None let update tbl key f = match find_opt tbl key with | Some v -> Hashtbl.replace tbl key (f (Some v)) | None -> Hashtbl.replace tbl key (f None) let find_default tbl key default = try Hashtbl.find tbl key with Not_found -> default let add_or_update tbl key ~default ~update = match find_opt tbl key with | Some v -> Hashtbl.replace tbl key (update v) | None -> Hashtbl.add tbl key default end (* SafeString - String module with exception-safe operations *) module SafeString = struct include String let index_opt str ch = try Some (String.index str ch) with Not_found -> None let rindex_opt str ch = try Some (String.rindex str ch) with Not_found -> None let index_from_opt str pos ch = try Some (String.index_from str pos ch) with Not_found | Invalid_argument _ -> None let rindex_from_opt str pos ch = try Some (String.rindex_from str pos ch) with Not_found | Invalid_argument _ -> None let sub_safe str start len = try Some (String.sub str start len) with Invalid_argument _ -> None let get_opt str idx = try Some (String.get str idx) with Invalid_argument _ -> None end obuild-0.2.2/configure.ml000066400000000000000000000005511515212760700153130ustar00rootroot00000000000000let version = Sys.ocaml_version in ignore (Sys.command "rm -f lib/base/compat.ml"); if version < "4.02.0" then Sys.command "cat compat_common.ml compat401.ml > lib/base/compat.ml" else if version < "4.03.0" then Sys.command "cat compat_common.ml compat402.ml > lib/base/compat.ml" else Sys.command "cat compat_common.ml compat403.ml > lib/base/compat.ml" obuild-0.2.2/lib/000077500000000000000000000000001515212760700135455ustar00rootroot00000000000000obuild-0.2.2/lib/base/000077500000000000000000000000001515212760700144575ustar00rootroot00000000000000obuild-0.2.2/lib/base/cli.ml000066400000000000000000000601121515212760700155600ustar00rootroot00000000000000(** Simple, portable CLI library - Clean implementation *) open Compat (* ===== Type Definitions ===== *) type arg_value = | VBool of bool | VString of string | VInt of int | VStrings of string list type context = { command_name : string; values : (string, arg_value) Hashtbl.t; positionals : string list; } type arg_spec = { arg_name : string; arg_short : char option; arg_env : string option; arg_kind : [ `Flag | `String of string option * string (* default, placeholder *) | `Int of int option * string | `Bool of bool option * string (* default, placeholder *) | `Strings of string | `Positional of string | `Positionals of string ]; arg_doc : string; } type command_run = context -> unit type command = { cmd_name : string; cmd_doc : string; cmd_description : string option; cmd_args : arg_spec list; cmd_run : command_run option; cmd_subcommands : command list; } type app = { app_name : string; app_version : string; app_doc : string; app_description : string option; app_global_args : arg_spec list; app_on_global_args : (context -> unit) option; app_commands : command list; } (* ===== Exceptions and Global State ===== *) exception Parse_error of string exception Validation_error of string let exit_code_ref = ref 0 let set_exit_code code = exit_code_ref := code (* ===== Context Accessors ===== *) let get_flag ctx name = try match Hashtbl.find ctx.values name with | VBool b -> b | _ -> false with Not_found -> false let get_string_opt ctx name = try match Hashtbl.find ctx.values name with | VString s -> Some s | _ -> None with Not_found -> None let get_string ctx name ~default = match get_string_opt ctx name with | Some s -> s | None -> default let get_int_opt ctx name = try match Hashtbl.find ctx.values name with | VInt i -> Some i | _ -> None with Not_found -> None let get_int ctx name ~default = match get_int_opt ctx name with | Some i -> i | None -> default let get_bool_opt ctx name = try match Hashtbl.find ctx.values name with | VBool b -> Some b | _ -> None with Not_found -> None let get_bool ctx name ~default = match get_bool_opt ctx name with | Some b -> b | None -> default let get_strings ctx name = try match Hashtbl.find ctx.values name with | VStrings l -> l | VString s -> [ s ] | _ -> [] with Not_found -> [] let get_positionals ctx = ctx.positionals let get_command_name ctx = ctx.command_name (* ===== Command Construction (Functional Builders) ===== *) let command name ~doc ?description ?(args = []) ~run () = let base_cmd = { cmd_name = name; cmd_doc = doc; cmd_description = description; cmd_args = []; cmd_run = Some run; cmd_subcommands = []; } in List.fold_left (fun cmd f -> f cmd) base_cmd args let command_with_subcommands name ~doc ?description ~commands = { cmd_name = name; cmd_doc = doc; cmd_description = description; cmd_args = []; cmd_run = None; cmd_subcommands = commands; } let app name ~version ~doc ?description ?(global_args = []) ?on_global_args ~commands () = (* Create a temporary command to collect global args *) let temp_cmd = { cmd_name = ""; cmd_doc = ""; cmd_description = None; cmd_args = []; cmd_run = None; cmd_subcommands = []; } in let with_args = List.fold_left (fun cmd f -> f cmd) temp_cmd global_args in { app_name = name; app_version = version; app_doc = doc; app_description = description; app_global_args = with_args.cmd_args; app_on_global_args = on_global_args; app_commands = commands; } (* ===== Argument Builders (Return modified command) ===== *) let add_arg spec cmd = { cmd with cmd_args = spec :: cmd.cmd_args } let flag name ?short ?env ~doc cmd = add_arg { arg_name = name; arg_short = short; arg_env = env; arg_kind = `Flag; arg_doc = doc } cmd let option_string name ?short ?env ?default ?placeholder ~doc cmd = let ph = match placeholder with | Some p -> p | None -> "STRING" in add_arg { arg_name = name; arg_short = short; arg_env = env; arg_kind = `String (default, ph); arg_doc = doc; } cmd let option_int name ?short ?env ?default ?placeholder ~doc cmd = let ph = match placeholder with | Some p -> p | None -> "INT" in add_arg { arg_name = name; arg_short = short; arg_env = env; arg_kind = `Int (default, ph); arg_doc = doc; } cmd let option_bool name ?short ?env ?default ?placeholder ~doc cmd = let ph = match placeholder with | Some p -> p | None -> "true|false" in add_arg { arg_name = name; arg_short = short; arg_env = env; arg_kind = `Bool (default, ph); arg_doc = doc; } cmd let option_strings name ?short ?env ?placeholder ~doc cmd = let ph = match placeholder with | Some p -> p | None -> "STRING" in add_arg { arg_name = name; arg_short = short; arg_env = env; arg_kind = `Strings ph; arg_doc = doc } cmd let positional name ?placeholder ~doc cmd = let ph = match placeholder with | Some p -> p | None -> string_uppercase name in add_arg { arg_name = name; arg_short = None; arg_env = None; arg_kind = `Positional ph; arg_doc = doc } cmd let positionals name ?placeholder ~doc cmd = let ph = match placeholder with | Some p -> p | None -> string_uppercase name in add_arg { arg_name = name; arg_short = None; arg_env = None; arg_kind = `Positionals ph; arg_doc = doc } cmd (* ===== Standard Flags ===== *) let version_flag cmd = flag "version" ~doc:"Show version information" cmd let help_flag cmd = flag "help" ~short:'h' ~doc:"Show this help message" cmd let verbose_flag cmd = flag "verbose" ~short:'v' ~doc:"Verbose output" cmd let quiet_flag cmd = flag "quiet" ~short:'q' ~doc:"Quiet mode (errors only)" cmd (* ===== Error Formatting ===== *) let format_error msg = Printf.sprintf "\027[1;31mError:\027[0m %s" msg let format_suggestion similar = if similar = [] then "" else "\n\n\027[1mDid you mean:\027[0m\n " ^ String.concat "\n " similar (* ===== String Utilities ===== *) let levenshtein_distance s1 s2 = let m = String.length s1 and n = String.length s2 in if m = 0 then n else if n = 0 then m else let d = Array.make_matrix (m + 1) (n + 1) 0 in for i = 0 to m do d.(i).(0) <- i done; for j = 0 to n do d.(0).(j) <- j done; for j = 1 to n do for i = 1 to m do let cost = if s1.[i - 1] = s2.[j - 1] then 0 else 1 in d.(i).(j) <- min (min (d.(i - 1).(j) + 1) (d.(i).(j - 1) + 1)) (d.(i - 1).(j - 1) + cost) done done; d.(m).(n) let suggest_similar candidates target = let scored = List.map (fun c -> (c, levenshtein_distance c target)) candidates in let sorted = List.sort (fun (_, d1) (_, d2) -> compare d1 d2) scored in let threshold = max 3 (String.length target / 2) in let rec take n = function | [] -> [] | x :: xs -> if n <= 0 then [] else x :: take (n - 1) xs in take 5 (List.map fst (List.filter (fun (_, d) -> d <= threshold) sorted)) let suggest_command app name = suggest_similar (List.map (fun c -> c.cmd_name) app.app_commands) name (* ===== Configuration File Support ===== *) type config = (string, string) Hashtbl.t let parse_config_line line = (* Skip comments and empty lines *) let trimmed = String_utils.strip_spaces line in if String.length trimmed = 0 || trimmed.[0] = '#' then None else try let eq_pos = String.index trimmed '=' in let key = String_utils.strip_spaces (String.sub trimmed 0 eq_pos) in let value = String_utils.strip_spaces (String.sub trimmed (eq_pos + 1) (String.length trimmed - eq_pos - 1)) in Some (key, value) with Not_found -> None let load_config_file path = let config = Hashtbl.create 16 in if Sys.file_exists path then try let ic = open_in path in try while true do let line = input_line ic in match parse_config_line line with | Some (key, value) -> Hashtbl.replace config key value | None -> () done; config with End_of_file -> close_in ic; config with Sys_error _ -> config else config let load_config ?(paths = []) () = let default_paths = if paths = [] then let home = try Sys.getenv "HOME" with Not_found -> "" in let user_config = if home <> "" then [ Filename.concat home ".obuildrc" ] else [] in let project_config = [ ".obuildrc" ] in user_config @ project_config else paths in let config = Hashtbl.create 16 in List.iter (fun path -> let file_config = load_config_file path in Hashtbl.iter (fun k v -> Hashtbl.replace config k v) file_config) default_paths; config let config_get_string config key = try Some (Hashtbl.find config key) with Not_found -> None let config_get_int config key = try Some (int_of_string (Hashtbl.find config key)) with Not_found | Failure _ -> None let config_get_bool config key = try let value = string_lowercase (Hashtbl.find config key) in match value with | "true" | "yes" | "1" | "on" -> Some true | "false" | "no" | "0" | "off" -> Some false | _ -> None with Not_found -> None (* ===== Shell Completion Generation ===== *) let generate_bash_completion app = let commands = String.concat " " (List.map (fun c -> c.cmd_name) app.app_commands) in Printf.sprintf "# Bash completion for %s\n\ _%s_completions() {\n\ \ local cur prev\n\ \ COMPREPLY=()\n\ \ cur=\"${COMP_WORDS[COMP_CWORD]}\"\n\ \ prev=\"${COMP_WORDS[COMP_CWORD-1]}\"\n\ \n\ \ # Complete commands\n\ \ if [ $COMP_CWORD -eq 1 ]; then\n\ \ COMPREPLY=( $(compgen -W \"%s\" -- \"$cur\") )\n\ \ return 0\n\ \ fi\n\ \n\ \ # Complete global flags\n\ \ local flags=\"--help --version --verbose --quiet --debug --color\"\n\ \ COMPREPLY=( $(compgen -W \"$flags\" -- \"$cur\") )\n\ \ return 0\n\ }\n\ \n\ complete -F _%s_completions %s\n" app.app_name app.app_name commands app.app_name app.app_name let generate_zsh_completion app = let cmd_list = String.concat "\n " (List.map (fun c -> Printf.sprintf "'%s:%s'" c.cmd_name c.cmd_doc) app.app_commands) in Printf.sprintf "#compdef %s\n\ \n\ _%s() {\n\ \ local -a commands\n\ \ commands=(\n\ \ %s\n\ \ )\n\ \n\ \ _arguments -C \\\n\ \ '(- 1 *)'{-h,--help}'[Show help message]' \\\n\ \ '(- 1 *)--version[Show version information]' \\\n\ \ {-v,--verbose}'[Verbose output]' \\\n\ \ {-q,--quiet}'[Quiet mode]' \\\n\ \ '--color[Enable colored output]' \\\n\ \ '1: :->cmds' \\\n\ \ '*:: :->args' && return 0\n\ \n\ \ case \"$state\" in\n\ \ cmds)\n\ \ _describe -t commands 'command' commands\n\ \ ;;\n\ \ esac\n\ }\n\ \n\ _%s \"$@\"\n" app.app_name app.app_name cmd_list app.app_name let generate_fish_completion app = let completions = String.concat "\n" (List.map (fun c -> Printf.sprintf "complete -c %s -n '__fish_use_subcommand' -a %s -d '%s'" app.app_name c.cmd_name c.cmd_doc) app.app_commands) in Printf.sprintf "# Fish completion for %s\n\ \n\ # Global options\n\ complete -c %s -s h -l help -d 'Show help message'\n\ complete -c %s -l version -d 'Show version information'\n\ complete -c %s -s v -l verbose -d 'Verbose output'\n\ complete -c %s -s q -l quiet -d 'Quiet mode'\n\ complete -c %s -l color -d 'Enable colored output'\n\ \n\ # Commands\n\ %s\n" app.app_name app.app_name app.app_name app.app_name app.app_name app.app_name completions (* ===== Help Generation ===== *) let print_usage_line chan app_name cmd_name = Printf.fprintf chan "Usage: %s" app_name; (match cmd_name with | Some n -> Printf.fprintf chan " %s" n | None -> ()); Printf.fprintf chan " [OPTIONS]"; Printf.fprintf chan "\n" let print_arg_help chan spec = let short_str = match spec.arg_short with | Some c -> Printf.sprintf "-%c, " c | None -> " " in let long_name = "--" ^ spec.arg_name in let placeholder = match spec.arg_kind with | `String (_, ph) | `Int (_, ph) | `Bool (_, ph) | `Strings ph | `Positional ph | `Positionals ph -> " " ^ ph | `Flag -> "" in Printf.fprintf chan " %s%s%s\n" short_str long_name placeholder; Printf.fprintf chan " %s\n" spec.arg_doc let print_help app cmd_opt = let chan = stdout in (match cmd_opt with | None -> Printf.fprintf chan "%s - %s\n" app.app_name app.app_doc; Printf.fprintf chan "Version: %s\n\n" app.app_version; (match app.app_description with | Some d -> Printf.fprintf chan "%s\n\n" d | None -> ()); print_usage_line chan app.app_name None; if app.app_global_args <> [] then ( Printf.fprintf chan "\nGlobal Options:\n"; List.iter (print_arg_help chan) (List.rev app.app_global_args)); Printf.fprintf chan "\nCommands:\n"; List.iter (fun cmd -> Printf.fprintf chan " %-20s %s\n" cmd.cmd_name cmd.cmd_doc) app.app_commands; Printf.fprintf chan "\nRun '%s COMMAND -h' for command-specific help.\n" app.app_name | Some cmd -> Printf.fprintf chan "%s %s - %s\n\n" app.app_name cmd.cmd_name cmd.cmd_doc; (match cmd.cmd_description with | Some d -> Printf.fprintf chan "%s\n\n" d | None -> ()); print_usage_line chan app.app_name (Some cmd.cmd_name); if cmd.cmd_args <> [] then ( Printf.fprintf chan "\nOptions:\n"; List.iter (print_arg_help chan) (List.rev cmd.cmd_args)); if cmd.cmd_subcommands <> [] then ( Printf.fprintf chan "\nSubcommands:\n"; List.iter (fun subcmd -> Printf.fprintf chan " %-20s %s\n" subcmd.cmd_name subcmd.cmd_doc) cmd.cmd_subcommands)); flush chan (* ===== Argument Parsing ===== *) let parse_args ?(stop_at_positional = false) specs argv start_idx = let values = Hashtbl.create 16 in let positionals = ref [] in let idx = ref start_idx in let len = Array.length argv in let stopped = ref false in (* Initialize defaults and env vars *) List.iter (fun spec -> match spec.arg_kind with | `String (Some def, _) -> Hashtbl.add values spec.arg_name (VString def) | `Int (Some def, _) -> Hashtbl.add values spec.arg_name (VInt def) | `Bool (Some def, _) -> Hashtbl.add values spec.arg_name (VBool def) | `Flag -> Hashtbl.add values spec.arg_name (VBool false) | _ -> ()) specs; while !idx < len && not !stopped do let arg = argv.(!idx) in if String.length arg > 0 && arg.[0] = '-' then (* Parse option *) let is_long = String.length arg > 1 && arg.[1] = '-' in let opt_name, opt_val = if is_long then (* Long option: --name or --name=value *) let name_part = String.sub arg 2 (String.length arg - 2) in try let eq_pos = String.index name_part '=' in ( String.sub name_part 0 eq_pos, Some (String.sub name_part (eq_pos + 1) (String.length name_part - eq_pos - 1)) ) with Not_found -> (name_part, None) else if (* Short option: -n or -nvalue *) String.length arg < 2 then raise (Parse_error "Invalid option") else ( String.make 1 arg.[1], if String.length arg > 2 then Some (String.sub arg 2 (String.length arg - 2)) else None ) in (* Find matching spec *) let spec_opt = SafeList.find_opt (fun s -> if is_long then s.arg_name = opt_name else match s.arg_short with | Some c -> String.make 1 c = opt_name | None -> false) specs in match spec_opt with | None -> raise (Parse_error ("Unknown option: " ^ arg)) | Some spec -> ( match spec.arg_kind with | `Flag -> Hashtbl.replace values spec.arg_name (VBool true); incr idx | `String _ | `Int _ | `Bool _ -> let value = match opt_val with | Some v -> v | None -> incr idx; if !idx >= len then raise (Parse_error (spec.arg_name ^ " requires a value")); argv.(!idx) in (match spec.arg_kind with | `String _ -> Hashtbl.replace values spec.arg_name (VString value) | `Int _ -> ( try Hashtbl.replace values spec.arg_name (VInt (int_of_string value)) with Failure _ -> raise (Parse_error (spec.arg_name ^ " requires an integer"))) | `Bool _ -> ( try let bool_val = match string_lowercase value with | "true" | "yes" | "1" | "on" -> true | "false" | "no" | "0" | "off" -> false | _ -> raise (Parse_error (spec.arg_name ^ " requires true/false/yes/no/1/0")) in Hashtbl.replace values spec.arg_name (VBool bool_val) with Failure _ -> raise (Parse_error (spec.arg_name ^ " requires a boolean value"))) | _ -> ()); incr idx | `Strings _ -> let value = match opt_val with | Some v -> v | None -> incr idx; if !idx >= len then raise (Parse_error (spec.arg_name ^ " requires a value")); argv.(!idx) in let existing = try match Hashtbl.find values spec.arg_name with | VStrings l -> l | _ -> [] with Not_found -> [] in Hashtbl.replace values spec.arg_name (VStrings (existing @ [ value ])); incr idx | _ -> incr idx) else ( (* Positional argument *) positionals := !positionals @ [ arg ]; incr idx; if stop_at_positional then stopped := true) done; (* Collect remaining args if we stopped early *) let remaining = ref [] in while !idx < len do remaining := !remaining @ [ argv.(!idx) ]; incr idx done; (values, List.rev !positionals @ !remaining) (* ===== Main Execution ===== *) let run_internal argv app = if Array.length argv < 2 then ( print_help app None; raise (Parse_error "No command specified")); (* Parse global args - stop at first positional (command name) *) let global_vals, remaining = parse_args ~stop_at_positional:true app.app_global_args argv 1 in (* Check for global --help or --version *) (try let global_ctx = { command_name = ""; values = global_vals; positionals = [] } in if get_flag global_ctx "help" then ( print_help app None; exit 0); if get_flag global_ctx "version" then ( Printf.printf "%s %s\n" app.app_name app.app_version; exit 0) with Not_found -> ()); (* Invoke global args callback if provided *) (match app.app_on_global_args with | Some f -> f { command_name = ""; values = global_vals; positionals = [] } | None -> ()); match remaining with | [] -> print_help app None; raise (Parse_error "No command specified") | cmd_name :: cmd_args -> (* Find command *) let cmd_opt = SafeList.find_opt (fun c -> c.cmd_name = cmd_name) app.app_commands in match cmd_opt with | None -> let suggestions = suggest_command app cmd_name in let msg = Printf.sprintf "Unknown command '%s'" cmd_name in let msg = msg ^ format_suggestion suggestions in raise (Parse_error msg) | Some cmd -> ( (* Parse command args *) let cmd_vals, cmd_positionals = parse_args cmd.cmd_args (Array.of_list cmd_args) 0 in let ctx = { command_name = cmd.cmd_name; values = cmd_vals; positionals = cmd_positionals } in (* Check for command --help *) if get_flag ctx "help" then ( print_help app (Some cmd); exit 0); (* Run command or route to subcommand *) match cmd.cmd_run with | Some run -> run ctx | None -> if cmd.cmd_subcommands = [] then raise (Parse_error "Command has no implementation") else ( (* Handle subcommands *) match cmd_positionals with | [] -> print_help app (Some cmd); raise (Parse_error "Subcommand required") | subcmd_name :: subcmd_args -> (* Find subcommand *) let subcmd_opt = SafeList.find_opt (fun c -> c.cmd_name = subcmd_name) cmd.cmd_subcommands in match subcmd_opt with | None -> let msg = Printf.sprintf "Unknown subcommand '%s'" subcmd_name in raise (Parse_error msg) | Some subcmd -> ( (* Parse subcommand args *) let subcmd_vals, subcmd_positionals = parse_args subcmd.cmd_args (Array.of_list subcmd_args) 0 in let subcmd_ctx = { command_name = subcmd.cmd_name; values = subcmd_vals; positionals = subcmd_positionals; } in (* Check for subcommand --help *) if get_flag subcmd_ctx "help" then ( (* TODO: print subcommand help - for now just print command help *) print_help app (Some subcmd); exit 0); (* Run subcommand *) match subcmd.cmd_run with | Some run -> run subcmd_ctx | None -> raise (Parse_error "Subcommand has no implementation")))) let run ?(argv = Sys.argv) app = try run_internal argv app; exit !exit_code_ref with | Parse_error msg -> Printf.eprintf "%s\n" (format_error msg); exit 1 | Validation_error msg -> Printf.eprintf "%s\n" (format_error ("Validation failed: " ^ msg)); exit 1 | Failure msg -> Printf.eprintf "%s\n" (format_error msg); exit 1 let run_result ?(argv = Sys.argv) app = try run_internal argv app; Ok () with | Parse_error msg -> Error ("Parse error: " ^ msg) | Validation_error msg -> Error ("Validation error: " ^ msg) | Failure msg -> Error msg | exn -> Error (Printexc.to_string exn) (* Apply config defaults to argument specs *) let apply_config_to_specs config specs = List.map (fun spec -> match spec.arg_kind with | `String (_, ph) -> ( match config_get_string config spec.arg_name with | Some value -> { spec with arg_kind = `String (Some value, ph) } | None -> spec) | `Int (_, ph) -> ( match config_get_int config spec.arg_name with | Some value -> { spec with arg_kind = `Int (Some value, ph) } | None -> spec) | `Bool (_, ph) -> ( match config_get_bool config spec.arg_name with | Some value -> { spec with arg_kind = `Bool (Some value, ph) } | None -> spec) | `Flag -> ( match config_get_bool config spec.arg_name with | Some true -> spec (* Can't set flag default to true in current system, would need VBool in hashtable *) | _ -> spec) | _ -> spec) specs let run_with_config ?(argv = Sys.argv) ?config app = let app_with_config = match config with | None -> app | Some cfg -> (* Apply config to global args and all command args *) let new_global_args = apply_config_to_specs cfg app.app_global_args in let new_commands = List.map (fun cmd -> { cmd with cmd_args = apply_config_to_specs cfg cmd.cmd_args }) app.app_commands in { app with app_global_args = new_global_args; app_commands = new_commands } in run ~argv app_with_config obuild-0.2.2/lib/base/cli.mli000066400000000000000000000207131515212760700157340ustar00rootroot00000000000000(** Simple, portable command-line interface library This library provides a clean API for building CLI applications with subcommands, automatic help generation, and good error messages. It requires no external dependencies and works with OCaml 4.01+. {2 Example Usage} {[ open Cli let build_cmd = command "build" ~doc:"Compile the project" ~args:[ flag "verbose" ~short:'v' ~doc:"Show detailed output"; option_int "jobs" ~short:'j' ~doc:"Number of parallel jobs"; ] ~run:(fun ctx -> let verbose = get_flag ctx "verbose" in let jobs = get_int ctx "jobs" ~default:2 in Printf.printf "Building with %d jobs (verbose=%b)\\n" jobs verbose ) let cli = app "myapp" ~version:"1.0.0" ~doc:"My awesome application" ~commands:[build_cmd] let () = run cli ]} *) (** {1 Core Types} *) (** Execution context containing parsed arguments *) type context (** Command specification *) type command (** Application specification *) type app (** {1 Argument Specifications} *) (** Flag argument (boolean, no value required) *) val flag : string -> ?short:char -> ?env:string -> doc:string -> command -> command (** [flag name ~short ~env ~doc cmd] adds a boolean flag to command [cmd]. - [name]: Long name (e.g., "verbose" for --verbose) - [short]: Optional short name (e.g., 'v' for -v) - [env]: Optional environment variable name to read default from - [doc]: Help documentation string *) (** String option (requires a value) *) val option_string : string -> ?short:char -> ?env:string -> ?default:string -> ?placeholder:string -> doc:string -> command -> command (** [option_string name ~short ~env ~default ~placeholder ~doc cmd] adds a string option. - [placeholder]: Shown in help (e.g., "PATH" for --output PATH) *) (** Integer option (requires an integer value) *) val option_int : string -> ?short:char -> ?env:string -> ?default:int -> ?placeholder:string -> doc:string -> command -> command (** Boolean option (requires true/false/yes/no/1/0 value) *) val option_bool : string -> ?short:char -> ?env:string -> ?default:bool -> ?placeholder:string -> doc:string -> command -> command (** [option_bool name ~short ~env ~default ~placeholder ~doc cmd] adds a boolean option. - Accepts values: true/false, yes/no, 1/0, on/off (case insensitive) - [placeholder]: Shown in help (default: "true|false") *) (** String list option (can be specified multiple times) *) val option_strings : string -> ?short:char -> ?env:string -> ?placeholder:string -> doc:string -> command -> command (** Values accumulate when flag is used multiple times *) (** Positional arguments *) val positional : string -> ?placeholder:string -> doc:string -> command -> command (** [positional name ~placeholder ~doc cmd] adds a required positional argument *) val positionals : string -> ?placeholder:string -> doc:string -> command -> command (** [positionals name ~placeholder ~doc cmd] adds optional positional arguments (list) *) (** {1 Command Construction} *) val command : string -> doc:string -> ?description:string -> ?args:(command -> command) list -> run:(context -> unit) -> unit -> command (** [command name ~doc ~description ~args ~run] creates a command. - [name]: Command name (e.g., "build") - [doc]: Short one-line documentation - [description]: Optional longer description shown in help - [args]: List of argument specifications - [run]: Function to execute with parsed context *) val command_with_subcommands : string -> doc:string -> ?description:string -> commands:command list -> command (** [command_with_subcommands name ~doc ~description ~commands] creates a command that has its own subcommands (e.g., "git remote add") *) (** {1 Application Construction} *) val app : string -> version:string -> doc:string -> ?description:string -> ?global_args:(command -> command) list -> ?on_global_args:(context -> unit) -> commands:command list -> unit -> app (** [app name ~version ~doc ~description ~global_args ~on_global_args ~commands] creates the application. - [name]: Application name - [version]: Version string - [doc]: Short description - [description]: Longer description - [global_args]: Global flags/options available to all commands - [on_global_args]: Optional callback invoked with parsed global args before command execution - [commands]: List of commands *) (** {1 Execution} *) val run : ?argv:string array -> app -> unit (** [run ~argv app] parses arguments and executes the appropriate command. If [argv] is not provided, uses [Sys.argv]. Exits with code 0 on success, non-zero on error. *) val run_result : ?argv:string array -> app -> (unit, string) Compat.result (** [run_result ~argv app] same as [run] but returns a result instead of exiting. Useful for testing. *) (** {1 Context Accessors} *) (** Get boolean flag value *) val get_flag : context -> string -> bool (** Get optional string value *) val get_string_opt : context -> string -> string option (** Get string value with default *) val get_string : context -> string -> default:string -> string (** Get optional integer value *) val get_int_opt : context -> string -> int option (** Get integer value with default *) val get_int : context -> string -> default:int -> int (** Get optional boolean value *) val get_bool_opt : context -> string -> bool option (** Get boolean value with default *) val get_bool : context -> string -> default:bool -> bool (** Get list of strings (from repeated options or positionals) *) val get_strings : context -> string -> string list (** Get positional arguments *) val get_positionals : context -> string list (** {1 Error Handling} *) exception Parse_error of string (** Raised when argument parsing fails *) exception Validation_error of string (** Raised when argument validation fails *) (** {1 Error Handling Utilities} *) val format_error : string -> string (** [format_error msg] formats an error message with context and suggestions *) val format_suggestion : string list -> string (** [format_suggestion similar] formats a "Did you mean" suggestion *) (** {1 Utilities} *) val version_flag : command -> command (** Adds standard --version flag *) val help_flag : command -> command (** Adds standard -h/--help flag *) val verbose_flag : command -> command (** Adds standard -v/--verbose flag *) val quiet_flag : command -> command (** Adds standard -q/--quiet flag *) (** {1 Advanced Features} *) val set_exit_code : int -> unit (** Set the exit code (default: 0 for success, 1 for error) *) val get_command_name : context -> string (** Get the name of the currently executing command *) val print_help : app -> command option -> unit (** Print help text for the app or a specific command *) val suggest_command : app -> string -> string list (** [suggest_command app name] returns similar command names using fuzzy matching *) (** {1 Shell Completion} *) val generate_bash_completion : app -> string (** [generate_bash_completion app] generates a bash completion script *) val generate_zsh_completion : app -> string (** [generate_zsh_completion app] generates a zsh completion script *) val generate_fish_completion : app -> string (** [generate_fish_completion app] generates a fish completion script *) (** {1 Configuration File Support} *) type config (** Configuration loaded from config files *) val load_config : ?paths:string list -> unit -> config (** [load_config ~paths ()] loads configuration from files. If [paths] is not provided, searches in default locations: - ./.obuildrc (project-specific config) - ~/.obuildrc (user config) Project-specific config takes precedence over user config. *) val config_get_string : config -> string -> string option (** [config_get_string config key] retrieves a string value from config *) val config_get_int : config -> string -> int option (** [config_get_int config key] retrieves an integer value from config *) val config_get_bool : config -> string -> bool option (** [config_get_bool config key] retrieves a boolean value from config *) val run_with_config : ?argv:string array -> ?config:config -> app -> unit (** [run_with_config ~argv ~config app] runs the app with config file defaults. Config values are applied as defaults before parsing command-line arguments. Command-line arguments override config file values. *) obuild-0.2.2/lib/base/filepath.ml000066400000000000000000000043141515212760700166070ustar00rootroot00000000000000open Fugue exception EmptyFilename exception InvalidFilename of string type filepath = { absolute : bool; filepath : string list; } type filename = { filename : string } let is_absolute fp = fp.absolute let empty_fn = { filename = "" } let current_dir = { absolute = false; filepath = [] } let fp_to_string x = match (x.filepath, x.absolute) with | [], true -> "/" | [], false -> "./" | l, true -> "/" ^ String.concat Filename.dir_sep l | l, false -> String.concat Filename.dir_sep l let fn_to_string x = x.filename (** [got_dirsep s] returns [true] if [s] contains [Filename.dir_sep], i.e. "/" on Unix. *) let got_dirsep x = let gotDirsep = ref false in let dirsepLen = String.length Filename.dir_sep in for i = 0 to String.length x - dirsepLen - 1 do if String.sub x i dirsepLen = Filename.dir_sep then gotDirsep := true done; !gotDirsep (* this only strip the last / if it exists *) let fp x = (* TODO fix it properly, however separator is always a single char *) match String_utils.split Filename.dir_sep.[0] x with | "" :: p -> { absolute = true; filepath = List.filter (fun x -> x <> "." && x <> "") p } | p -> { absolute = false; filepath = List.filter (fun x -> x <> "." && x <> "") p } let fn = function | "" | "." | ".." -> raise EmptyFilename | filename when got_dirsep filename -> raise (InvalidFilename filename) | filename -> { filename } let valid_fn x = try let _ = fn x in true with EmptyFilename | InvalidFilename _ -> false let ( ) (afp : filepath) (bfp : filepath) = match (afp.absolute, bfp.absolute) with | _, true -> failwith "the second argument cannot be an absolute path" | _ -> { absolute = afp.absolute; filepath = afp.filepath @ bfp.filepath } let ( ) (afp : filepath) (bfp : filename) = { absolute = afp.absolute; filepath = afp.filepath @ [ bfp.filename ] } let ( <.> ) (afp : filename) ext = fn (afp.filename ^ "." ^ ext) let path_length path = List.length path.filepath let path_dirname path = { path with filepath = list_init path.filepath } let path_basename path = fn (list_last path.filepath) let in_current_dir (x : filename) = fp x.filename let chop_extension (x : filename) = fn (Filename.chop_extension (fn_to_string x)) obuild-0.2.2/lib/base/filepath.mli000066400000000000000000000046201515212760700167600ustar00rootroot00000000000000(** The module [Filepath] defines two types, [filepath] and [filename] to represent paths and file names in a file system. * a [filepath] represent a path in a filesystem. It can be relative or absolute, and is composed of components. The last component can correspond to a directory or a file in a filesystem. Other components correspond to directories. * a [filename] encapsulate the name of a file. *) (** Exceptions *) exception EmptyFilename (** [EmptyFilename] is raised by [fn] when trying to create a value of type [filename] out of strings "", "." or ".." *) exception InvalidFilename of string (** [InvalidFilename fn] is raised by [fn] when trying to create a value of type [filename] when [fn] contains [Filename.dir_sep]. *) (** Types *) type filepath (** Type representing a path in a filesystem. *) type filename (** Type representing a file in a filesystem. *) val empty_fn : filename (** Filename guaranteed to point to no valid file. Useful for initializing structures that have a field of type [filename]. *) val current_dir : filepath (** Filepath pointing to the current working directory. *) (** Functions to convert the above types to and from string. *) val fp_to_string : filepath -> string val fn_to_string : filename -> string val fp : string -> filepath val fn : string -> filename val is_absolute : filepath -> bool val valid_fn : string -> bool (** [valid_fn s] returns [true] if [s] is a valid file name, i.e. not ".", "..", not containing [Filename.dir_sep]. *) val ( ) : filepath -> filepath -> filepath (** [fp1 fp2] concatenate [fp2] to [fp1]. [fp2] cannot be an absolute path. *) val ( ) : filepath -> filename -> filepath (** [fp fn] concatenate [fn] to [fp]. *) val ( <.> ) : filename -> string -> filename (** [fn <.> ext] appends the extension [ext] to [fn]. *) val in_current_dir : filename -> filepath (** [in_current_dir fn] is equivalent to [current_dir fn]. *) val path_length : filepath -> int (** [path_length fp] returns the number of components in [fp], including the last (basename) one. *) val path_dirname : filepath -> filepath (** Analogous to [Filename.dirname], but operate on [filepath]s. *) val path_basename : filepath -> filename (** Analogous to [Filename.basename], but operate on [filepath]s. *) val chop_extension : filename -> filename (** Analogous to [Filename.chop_extension], but for [filename]s. *) obuild-0.2.2/lib/base/filesystem.ml000066400000000000000000000103701515212760700171760ustar00rootroot00000000000000open Fugue open Filepath open Compat exception UnexpectedFileType of string exception WriteFailed let remove_dir_content wpath = let path = fp_to_string wpath in let rec rmdir_recursive f path = let dirhandle = Unix.opendir path in finally (fun () -> try while true do let ent = Unix.readdir dirhandle in if String.length ent > 0 && ent.[0] <> '.' then let fent = path ^ Filename.dir_sep ^ ent in match (Unix.lstat fent).Unix.st_kind with | Unix.S_DIR -> rmdir_recursive Unix.rmdir fent | Unix.S_REG -> Unix.unlink fent | _ -> raise (UnexpectedFileType fent) done with End_of_file -> ()) (fun () -> Unix.closedir dirhandle); f path in if Sys.file_exists path then rmdir_recursive (const ()) path let remove_dir path = remove_dir_content path; Unix.rmdir (fp_to_string path); () let iterate f path = let entries = Sys.readdir (fp_to_string path) in Array.fast_sort String.compare entries; Array.iter (fun ent -> f (fn ent)) entries; () (* list directory entry with a map function included for efficiency *) let list_dir_pred_map (p : filename -> 'a option) path : 'a list = let accum = ref [] in iterate (fun ent -> match p ent with | None -> () | Some e -> accum := e :: !accum) path; !accum let list_dir_pred (p : filename -> bool) path : filename list = list_dir_pred_map (fun e -> if p e then Some e else None) path let get_modification_time path = try (Unix.stat (fp_to_string path)).Unix.st_mtime with Unix.Unix_error _ -> 0.0 let exists path = Sys.file_exists (fp_to_string path) let is_dir path = try Sys.is_directory (fp_to_string path) with Sys_error _ -> false (* create a directory safely. * * return false if the directory already exists * return true if the directory has been created *) let mkdir_safe path perm = if Sys.file_exists (fp_to_string path) then if Sys.is_directory (fp_to_string path) then false else failwith ("directory " ^ fp_to_string path ^ " cannot be created: file already exists") else ( Unix.mkdir (fp_to_string path) perm; true) let mkdir_safe_ path perm = let (_ : bool) = mkdir_safe path perm in () let rec mkdir_safe_recursive path perm = if not (is_dir path) then if path_length path > 1 then ( mkdir_safe_recursive (path_dirname path) perm; mkdir_safe_ path perm) (** [write_no_partial fd buf start len] writes [len] chars of [buf] starting at [start] in [fd], or raises [WriteFailed] if impossible. *) let write_no_partial fd b o l = let len = ref l in let ofs = ref o in while !len > 0 do let written = Unix.write fd (bytes_of_string b) !ofs !len in if written = 0 then raise WriteFailed; ofs := !ofs + written; len := !len - written done (** [with_file fp flags perms f] opens the file at [fp] and apply [f] to the obtained file descriptor. *) let with_file path openflags perms f = let fd = Unix.openfile (fp_to_string path) openflags perms in finally (fun () -> f fd) (fun () -> Unix.close fd) let write_file path s = with_file path [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o644 (fun fd -> write_no_partial fd s 0 (String.length s)) let read_file path = let buf = Buffer.create 1024 in let b = bytes_make 1024 ' ' in with_file path [ Unix.O_RDONLY ] 0o644 (fun fd -> let isDone = ref false in while not !isDone do let r = Unix.read fd b 0 1024 in if r > 0 then buffer_add_subbytes buf b 0 r else isDone := true done; Buffer.contents buf) let copy_file src dst = mkdir_safe_recursive (path_dirname dst) 0o755; let s = bytes_make 4096 ' ' in let srcStat = Unix.stat (fp_to_string src) in let operm = srcStat.Unix.st_perm in with_file dst [ Unix.O_WRONLY; Unix.O_CREAT ] operm (fun fdDst -> with_file src [ Unix.O_RDONLY ] 0o644 (fun fdSrc -> let isDone = ref false in while not !isDone do let r = Unix.read fdSrc s 0 4096 in if r > 0 then write_no_partial fdDst (bytes_to_string s) 0 r else isDone := true done)) let copy_to_dir src dst = copy_file src (dst src) obuild-0.2.2/lib/base/filesystem.mli000066400000000000000000000055041515212760700173520ustar00rootroot00000000000000(** The module [Filesystem] contain helpers to browse and operate on files and directories of a file system. It uses the abstraction provided by the module [Filepath]. *) (** Exceptions *) exception UnexpectedFileType of string (** Raised by [remove_dir_content] whenever trying to delete a block or char device. *) exception WriteFailed (** Raised by [write_no_partial]. *) val remove_dir_content : Filepath.filepath -> unit (** Removes the contents of a directory. Raises [UnexpectedFileType] if the directory contain a file representing a block or a character device. *) val remove_dir : Filepath.filepath -> unit (** Remove a directory and its content. *) val iterate : (Filepath.filename -> unit) -> Filepath.filepath -> unit (** [iterate f fp] calls [f] on each filename contained in [fp] (excluding "." and ".."). Note that a filename can represent either a file or a directory in the file system. *) val list_dir_pred_map : (Filepath.filename -> 'a option) -> Filepath.filepath -> 'a list (** [list_dir_pred_map f fp] applies [f] to each filename contained in [fp] using [iterate], and returns all elements that have been obtained when [f] did not return [None]. *) val list_dir_pred : (Filepath.filename -> bool) -> Filepath.filepath -> Filepath.filename list (** [list_dir_pred pred fp] returns a list of filenames (obtained with [iterate] that satisfy the predicate [pred]. *) val get_modification_time : Filepath.filepath -> float (** Returns the modification time of a filepath, or returns [0.] if any error occured. *) val exists : Filepath.filepath -> bool (** Analogous of [Sys.file_exists] but for a filepath *) val is_dir : Filepath.filepath -> bool (** Analogous of [Sys.is_directory] but for a filepath *) val mkdir_safe : Filepath.filepath -> Unix.file_perm -> bool (** [mkdir_safe fp perms] creates a directory at [fp] unless a directory or a file already exists here. Return [false] if a directory already exists, [true] if the directory has just been created, and raise an exception [Failure] if a file already exists at this location. *) val mkdir_safe_ : Filepath.filepath -> Unix.file_perm -> unit (** Analogous to [ignore (mkdir_safe fp perms). *) val mkdir_safe_recursive : Filepath.filepath -> Unix.file_perm -> unit (** Recursively create directories with [mkdirSafe_] until the all directories on the filepath specified as argument exists. *) (** Functions for writing/reading to/from a file in a filesystem. *) val write_file : Filepath.filepath -> string -> unit val read_file : Filepath.filepath -> string (** Functions for copying files. *) val copy_file : Filepath.filepath -> Filepath.filepath -> unit (** [copy_file src dst] will copy file [src] to [dst]. *) val copy_to_dir : Filepath.filepath -> Filepath.filepath -> unit (** [copy_to_dir src dst] fill copy file [src] in directory [dst]. *) obuild-0.2.2/lib/base/fugue.ml000066400000000000000000000053601515212760700161300ustar00rootroot00000000000000let finally fct clean_f = let result = try fct () with exn -> clean_f (); raise exn in clean_f (); result let maybe d f v = match v with | None -> d | Some x -> f x let default d v = maybe d (fun x -> x) v let maybe_unit f v = maybe () f v let const v _ = v let rec maybes_to_list l = match l with | [] -> [] | None :: xs -> maybes_to_list xs | Some x :: xs -> x :: maybes_to_list xs type ('a, 'b) either = | Left of 'a | Right of 'b let ( $ ) f a = f a let id x = x let char_is_alphanum c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9') let no_empty emptyVal = List.filter (fun x -> x <> emptyVal) let rec list_init l = match l with | [] -> failwith "init empty list" | [ _ ] -> [] | x :: xs -> x :: list_init xs let rec list_last l = match l with | [] -> failwith "last is empty" | [ x ] -> x | _ :: xs -> list_last xs let list_remove e list = List.filter (fun x -> x <> e) list let list_iteri f list = let rec loop i l = match l with | [] -> () | x :: xs -> f i x; loop (i + 1) xs in loop 1 list let list_eq_noorder (l1 : 'a list) (l2 : 'a list) : bool = List.for_all (fun z -> List.mem z l2) l1 let list_filter_map (f : 'a -> 'b option) (l : 'a list) : 'b list = (* Use safe implementation from Compat *) Compat.SafeList.filter_map f l let rec list_uniq l = match l with | [] -> [] | x :: xs -> if List.mem x xs then list_uniq xs else x :: list_uniq xs let list_find_map p l = (* Use safe implementation from Compat, convert option to exception *) match Compat.SafeList.find_map p l with | Some z -> z | None -> raise Not_found let hashtbl_map f h = let newh = Hashtbl.create (Hashtbl.length h) in Hashtbl.iter (fun k v -> Hashtbl.add newh k (f v)) h; newh let hashtbl_keys h = Hashtbl.fold (fun k _ l -> k :: l) h [] let hashtbl_modify_all f h = let keys = hashtbl_keys h in List.iter (fun k -> let v = Hashtbl.find h k in Hashtbl.replace h k (f v)) keys let hashtbl_from_list l = let h = Hashtbl.create (List.length l) in List.iter (fun (k, v) -> Hashtbl.add h k v) l; h let hashtbl_to_list h = Hashtbl.fold (fun k v l -> (k, v) :: l) h [] let first f (a, b) = (f a, b) let second f (a, b) = (a, f b) exception ConversionIntFailed of string * string exception ConversionBoolFailed of string * string let user_int_of_string loc s = try int_of_string s with _ -> raise (ConversionIntFailed (loc, s)) let user_bool_of_string loc s = try bool_of_string s with _ -> raise (ConversionBoolFailed (loc, s)) module StringSet = struct include Set.Make (struct type t = string let compare = compare end) let to_list t = fold (fun elt l -> elt :: l) t [] end obuild-0.2.2/lib/base/fugue.mli000066400000000000000000000106161515212760700163010ustar00rootroot00000000000000(** Utility functions for functional programming This module provides common functional programming utilities including option handling, string operations, list utilities, and more. *) (** {1 Control flow} *) val finally : (unit -> 'a) -> (unit -> unit) -> 'a (** [finally fct clean_f] executes [fct ()], then executes [clean_f ()] regardless of whether [fct] succeeded or raised an exception. If [fct] raises an exception, [clean_f] is called before re-raising. *) (** {1 Option utilities} *) val maybe : 'b -> ('a -> 'b) -> 'a option -> 'b (** [maybe default f opt] returns [f x] if [opt] is [Some x], otherwise [default] *) val default : 'a -> 'a option -> 'a (** [default d opt] returns [x] if [opt] is [Some x], otherwise [d] *) val maybe_unit : ('a -> unit) -> 'a option -> unit (** [maybe_unit f opt] executes [f x] if [opt] is [Some x], otherwise does nothing *) val const : 'a -> 'b -> 'a (** [const v _] always returns [v], ignoring the second argument *) val maybes_to_list : 'a option list -> 'a list (** [maybes_to_list opts] filters out [None] values and extracts values from [Some] *) (** {1 Either type} *) type ('a, 'b) either = | Left of 'a (** Left alternative *) | Right of 'b (** Right alternative *) (** {1 Function composition} *) val ( $ ) : ('a -> 'b) -> 'a -> 'b (** Function application operator. [f $ x] is equivalent to [f x] but with lower precedence, useful for avoiding parentheses *) val id : 'a -> 'a (** Identity function *) (** {1 Character utilities} *) val char_is_alphanum : char -> bool (** Test if character is alphanumeric (a-z, A-Z, or 0-9) *) (** {1 List utilities} *) val no_empty : 'a -> 'a list -> 'a list (** [no_empty emptyVal lst] filters out all occurrences of [emptyVal] from [lst] *) val list_init : 'a list -> 'a list (** [list_init lst] returns all elements except the last. @raise Failure if list is empty *) val list_last : 'a list -> 'a (** [list_last lst] returns the last element. @raise Failure if list is empty *) val list_remove : 'a -> 'a list -> 'a list (** [list_remove e lst] filters out all occurrences of [e] from [lst] *) val list_iteri : (int -> 'a -> unit) -> 'a list -> unit (** [list_iteri f lst] applies [f] to each element with its index (starting at 1) *) val list_eq_noorder : 'a list -> 'a list -> bool (** [list_eq_noorder l1 l2] tests if all elements of [l1] are in [l2], ignoring order (not bidirectional - only checks l1 ⊆ l2) *) val list_filter_map : ('a -> 'b option) -> 'a list -> 'b list (** [list_filter_map f lst] applies [f] to each element, keeping only [Some] results *) val list_uniq : 'a list -> 'a list (** Remove duplicate elements from list *) val list_find_map : ('a -> 'b option) -> 'a list -> 'b (** [list_find_map p lst] returns the first [Some v] result of applying [p]. @raise Not_found if no element produces [Some] *) (** {1 Hashtable utilities} *) val hashtbl_map : ('a -> 'b) -> ('c, 'a) Hashtbl.t -> ('c, 'b) Hashtbl.t (** [hashtbl_map f h] creates a new hashtable with [f] applied to all values *) val hashtbl_keys : ('a, 'b) Hashtbl.t -> 'a list (** Get list of all keys in hashtable *) val hashtbl_modify_all : ('a -> 'a) -> ('b, 'a) Hashtbl.t -> unit (** [hashtbl_modify_all f h] applies [f] to all values in [h] *) val hashtbl_from_list : ('a * 'b) list -> ('a, 'b) Hashtbl.t (** Create hashtable from association list *) val hashtbl_to_list : ('a, 'b) Hashtbl.t -> ('a * 'b) list (** Convert hashtable to association list *) (** {1 Tuple utilities} *) val first : ('a -> 'c) -> 'a * 'b -> 'c * 'b (** [first f (a, b)] returns [(f a, b)] *) val second : ('b -> 'c) -> 'a * 'b -> 'a * 'c (** [second f (a, b)] returns [(a, f b)] *) (** {1 Conversion exceptions} *) exception ConversionIntFailed of string * string (** Raised when integer conversion fails. Contains (location, input) *) exception ConversionBoolFailed of string * string (** Raised when boolean conversion fails. Contains (location, input) *) val user_int_of_string : string -> string -> int (** [user_int_of_string loc s] converts [s] to int. @raise ConversionIntFailed with [loc] if conversion fails *) val user_bool_of_string : string -> string -> bool (** [user_bool_of_string loc s] converts [s] to bool. @raise ConversionBoolFailed with [loc] if conversion fails *) (** {1 String set} *) module StringSet : sig include Set.S with type elt = string val to_list : t -> string list (** Convert set to list *) end obuild-0.2.2/lib/base/location.ml000066400000000000000000000007441515212760700166260ustar00rootroot00000000000000(** Source location tracking *) (** A position in a source file *) type loc = { line: int; col: int; } let new_location l c = {line = l; col = c} (** A value paired with its source location *) type 'a located = { value: 'a; loc: loc; } (** Create a located value *) let located value loc = { value; loc } (** Create a dummy location *) let dummy_loc = { line = 0; col = 0 } (** Create a located value with dummy location *) let no_loc value = { value; loc = dummy_loc } obuild-0.2.2/lib/base/string_utils.ml000066400000000000000000000066151515212760700175470ustar00rootroot00000000000000open Fugue (** [index_pred p s] returns the index of the first character in [s] satisfying predicate [p]. @raise Not_found if no character satisfies the predicate *) let index_pred p s = let len = String.length s in let i = ref 0 in while !i < len && not (p s.[!i]) do i := !i + 1 done; if !i == len then raise Not_found else !i (** [strip_predicate p s] removes leading and trailing characters satisfying predicate [p] from [s] *) let rec split ?(limit = -1) c s = let i = try String.index s c with Not_found -> -1 in let nlimit = if limit = -1 || limit = 0 then limit else limit - 1 in if i = -1 || nlimit = 0 then [ s ] else let a = String.sub s 0 i and b = String.sub s (i + 1) (String.length s - i - 1) in a :: split ~limit:nlimit c b let rec split_pred ?(limit = -1) p s = let i = try index_pred p s with Not_found -> -1 in let nlimit = if limit = -1 || limit = 0 then limit else limit - 1 in if i = -1 || nlimit = 0 then [ s ] else let a = String.sub s 0 i and b = String.sub s (i + 1) (String.length s - i - 1) in a :: split_pred ~limit:nlimit p b let startswith prefix x = let x_l = String.length x and prefix_l = String.length prefix in prefix_l <= x_l && String.sub x 0 prefix_l = prefix let endswith suffix x = Filename.check_suffix x suffix let strip_predicate p str = let len = String.length str in let s = ref 0 in let e = ref (String.length str) in while !s < len && p str.[!s] do s := !s + 1 done; let start = !s in while !e > start && p str.[!e - 1] do e := !e - 1 done; String.sub str start (!e - start) let strip_spaces = strip_predicate (fun c -> c = ' ' || c = '\t' || c = '\n') let split_at pos s = let len = String.length s in if pos > len then invalid_arg "splitAt" else (String.sub s 0 pos, String.sub s pos (len - pos)) let drop n s = let len = String.length s in if n > len then invalid_arg "String.drop" else String.sub s n (len - n) let init n s = let len = String.length s in if n > len then invalid_arg "String.init" else String.sub s 0 (len - n) let all p s = let len = String.length s in let rec loop i = if i = len then true else if not (p s.[i]) then false else loop (i + 1) in loop 0 let escape_ocaml_string s = let buf = Buffer.create (String.length s) in for i = 0 to String.length s - 1 do match s.[i] with | '\\' -> Buffer.add_string buf "\\\\" | '"' -> Buffer.add_string buf "\\\"" | '\n' -> Buffer.add_string buf "\\n" | '\r' -> Buffer.add_string buf "\\r" | '\t' -> Buffer.add_string buf "\\t" | c -> Buffer.add_char buf c done; Buffer.contents buf let escape_c_string s = let buf = Buffer.create (String.length s) in for i = 0 to String.length s - 1 do match s.[i] with | '\\' -> Buffer.add_string buf "\\\\" | '"' -> Buffer.add_string buf "\\\"" | '\n' -> Buffer.add_string buf "\\n" | '\r' -> Buffer.add_string buf "\\r" | '\t' -> Buffer.add_string buf "\\t" | '%' -> Buffer.add_string buf "%%" | c -> Buffer.add_char buf c done; Buffer.contents buf let strip_cr s = let len = String.length s in if len > 0 && s.[len - 1] = '\r' then String.sub s 0 (len - 1) else s let lines s = List.map strip_cr (split '\n' s) let words s = split_pred (fun c -> c = ' ' || c = '\n' || c = '\t') s let words_noempty s = no_empty "" (words s) let lines_noempty s = no_empty "" (lines s) obuild-0.2.2/lib/base/string_utils.mli000066400000000000000000000040141515212760700177070ustar00rootroot00000000000000(** {1 String operations} *) val split : ?limit:int -> char -> string -> string list (** [split ?limit c s] splits string [s] on character [c]. [limit] controls maximum number of splits (-1 for unlimited) *) val split_pred : ?limit:int -> (char -> bool) -> string -> string list (** [split_pred ?limit p s] splits string [s] at characters satisfying predicate [p]. [limit] controls maximum number of splits (-1 for unlimited) *) val startswith : string -> string -> bool (** [startswith prefix s] tests if [s] starts with [prefix] *) val endswith : string -> string -> bool (** [endswith suffix s] tests if [s] ends with [suffix] *) val strip_spaces : string -> string (** Remove leading and trailing whitespace (space, tab, newline) *) val split_at : int -> string -> string * string (** [split_at pos s] splits [s] at position [pos] into [(left, right)]. @raise Invalid_argument if [pos] > length of [s] *) val drop : int -> string -> string (** [drop n s] returns [s] with first [n] characters removed. @raise Invalid_argument if [n] > length of [s] *) val init : int -> string -> string (** [init n s] returns [s] with last [n] characters removed. @raise Invalid_argument if [n] > length of [s] *) val all : (char -> bool) -> string -> bool (** [all p s] tests if all characters in [s] satisfy predicate [p] *) val escape_ocaml_string : string -> string (** Escape a string for embedding in an OCaml string literal. Escapes backslash, double-quote, newline, carriage return and tab. *) val escape_c_string : string -> string (** Escape a string for embedding in a C string literal. Escapes backslash, double-quote, newline, carriage return, tab and percent. *) val lines : string -> string list (** Split string on newline characters *) val words : string -> string list (** Split string on whitespace (space, newline, tab) *) val words_noempty : string -> string list (** Like {!words} but filters out empty strings *) val lines_noempty : string -> string list (** Like {!lines} but filters out empty strings *) obuild-0.2.2/lib/core/000077500000000000000000000000001515212760700144755ustar00rootroot00000000000000obuild-0.2.2/lib/core/analyze.ml000066400000000000000000000252741515212760700165040ustar00rootroot00000000000000open Fugue open Filepath open Compat open Helper open Printf open Gconf open Target open Dependencies exception SublibraryNotFound of Libname.t exception OcamlConfigMissing of string (* differentiate if the dependency is system or is internal to the project *) type dep_type = | System | Internal type dependency_tag = | Target of Name.t | Dependency of Libname.t type cpkg_config = { cpkg_conf_libs : string list; cpkg_conf_includes : filepath list; } (* this is a read only config of the project for configuring and building. *) type project_config = { project_dep_data : (Libname.t, dep_type) Hashtbl.t; project_pkgdeps_dag : dependency_tag Dag.t; project_targets_dag : Name.t Dag.t; project_all_deps : dependency list; project_file : Project.t; project_ocamlcfg : (string, string) Hashtbl.t; project_ocamlmkcfg : (string, string) Hashtbl.t; project_cpkgs : (string, cpkg_config) Hashtbl.t; } let get_ocaml_config_key_hashtbl key h = try Hashtbl.find h key with Not_found -> raise (OcamlConfigMissing key) let get_ocaml_config_key_global key = get_ocaml_config_key_hashtbl key (Prog.get_ocaml_config ()) let get_ocaml_config_key key project = get_ocaml_config_key_hashtbl key project.project_ocamlcfg let get_pkg_deps target project = let pkgs = Taskdep.linearize project.project_pkgdeps_dag Taskdep.FromParent [ Target target.target_name ] in List.rev (list_filter_map (fun pkg -> match pkg with | Dependency d -> Some d | Target _ -> None) pkgs) let get_c_pkg cname project = try Hashtbl.find project.project_cpkgs cname with Not_found -> failwith (sprintf "C package %s not found in the hashtbl: internal error" cname) let is_pkg_internal project pkg = Hashtbl.find project.project_dep_data pkg = Internal let is_pkg_system project pkg = Hashtbl.find project.project_dep_data pkg = System let get_internal_library_deps project target = let internalDeps = Dag.get_children project.project_targets_dag target.target_name in list_filter_map (fun name -> match name with | Name.Lib lname -> Some lname | _ -> None) internalDeps (* all the standard libraries shipped with ocaml, comes *without* META files, so * we pre-populate the META cache with whatever we need by scanning the * directory that ocaml use as standard_library (found by running ocamlc -config). * * it allows to bootstrap better when ocamlfind has not been yet installed or * to detect difference of opinions of where the stdlib is, between ocamlfind and ocamlc. *) let initializeSystemStdlib ocamlCfg = let ocaml_ver = Hashtbl.find (Prog.get_ocaml_config ()) "version" in let stdlibPath = fp (get_ocaml_config_key_hashtbl "standard_library" ocamlCfg) in let stdlibLibs = Filesystem.list_dir_pred_map (fun n -> let ext = Filetype.of_filename n in if ext = Filetype.FileCMXA || ext = Filetype.FileCMA then Some n else None) stdlibPath in let libs = list_uniq $ List.map (fun f -> fn_to_string $ Filepath.chop_extension f) stdlibLibs in List.iter (fun lib -> (* skip .p library which are just variant of the no .p library *) if not (String_utils.endswith ".p" lib) then ( log Verbose "initializing standard library : package %s\n" lib; let libCmxa = lib ^ ".cmxa" in let libCma = lib ^ ".cma" in let archives = (if List.mem (fn libCmxa) stdlibLibs then [ ([ Meta.Predicate.Native ], libCmxa) ] else []) @ if List.mem (fn libCma) stdlibLibs then [ ([ Meta.Predicate.Byte ], libCma) ] else [] in let meta = { (Meta.Pkg.make lib) with Meta.Pkg.directory = fp_to_string stdlibPath; Meta.Pkg.requires = [] (* AFAIK this is always empty for stdlibs *); Meta.Pkg.version = ocaml_ver; Meta.Pkg.archives; } in Metacache.add lib (stdlibPath fn ("META-" ^ lib), meta))) libs let readOcamlMkConfig filename = let lines = Utils.read_file_with (function | "" -> None | s when s.[0] = '#' -> None | s -> Some s) (filename ^ "/Makefile.config") in let h = Hashtbl.create 32 in List.iter (fun l -> let k, v = Utils.toKVeq l in Hashtbl.add h (string_lowercase k) (default "" v)) lines; h (* get all the dependencies required * and prepare the global bstate.of value *) let prepare projFile user_flags = log Verbose "analyzing project\n%!"; let ocamlCfg = Prog.get_ocaml_config () in let ocamlMkCfg = readOcamlMkConfig (Hashtbl.find ocamlCfg "standard_library") in let depsTable = Hashtbl.create 16 in let cpkgsTable = Hashtbl.create 1 in let depsDag = Dag.init () in let targetsDag = Dag.init () in let missingDeps = ref StringSet.empty in initializeSystemStdlib ocamlCfg; (* check for findlib / ocaml configuration mismatch *) let () = let stdlibPath = fp (get_ocaml_config_key_hashtbl "standard_library" ocamlCfg) in if not (List.exists (fun p -> String_utils.startswith (fp_to_string p) (fp_to_string stdlibPath) || String_utils.startswith (fp_to_string stdlibPath) (fp_to_string p)) (FindlibConf.get_paths ())) then Meta.path_warning := true in let allTargets = Project.get_all_buildable_targets projFile user_flags in let internalLibs = List.map (fun lib -> lib.Project.Library.name.Libname.main_name) projFile.Project.libs in let isInternal lib = List.mem lib.Libname.main_name internalLibs in (* establish inter-dependencies in the project. * only consider internal libraries *) List.iter (fun target -> Dag.add_node target.target_name targetsDag; List.iter (fun (dep, _) -> if isInternal dep then ( log Debug " internal depends: %s\n" (Libname.to_string dep); Dag.add_edge target.target_name (Name.Lib dep) targetsDag)) (Target.get_all_builddeps target)) allTargets; let add_missing dep = missingDeps := StringSet.add dep !missingDeps in (* load every dependencies META files and at the same time generate the * graph of inter-dependencies. * * This recursively load all dependencies and dependencies's dependencies. *) let rec loop dep = let dataDep () = if isInternal dep then ( let iLib = Project.find_lib projFile dep in let iLibDep = Dependency iLib.Project.Library.name in Dag.add_node iLibDep depsDag; List.iter (fun (reqDep, _) -> log Debug " library %s depends on %s\n" (Libname.to_string iLib.Project.Library.name) (Libname.to_string reqDep); Dag.add_edge iLibDep (Dependency reqDep) depsDag; loop reqDep) iLib.Project.Library.target.target_obits.target_builddeps; Internal) else try let _, meta = Metacache.get dep.Libname.main_name in Dag.add_node (Dependency dep) depsDag; let pkg = try Meta.Pkg.find dep.Libname.subnames meta with | Not_found -> raise (SublibraryNotFound dep) | Meta.SubpackageNotFound _ -> raise (SublibraryNotFound dep) in List.iter (fun (preds, reqDeps) -> match preds with | [ Meta.Predicate.Toploop ] -> () | _ -> List.iter (fun reqDep -> log Debug " library %s depends on %s\n" (Libname.to_string dep) (Libname.to_string reqDep); Dag.add_edge (Dependency dep) (Dependency reqDep) depsDag; loop reqDep) reqDeps) pkg.Meta.Pkg.requires; System with DependencyMissing dep -> add_missing dep; System in if not (Hashtbl.mem depsTable dep) then Hashtbl.add depsTable dep (dataDep ()); () in List.iter (fun target -> log Debug " getting dependencies for target %s\n%!" (Target.get_target_name target); let nodeTarget = Target target.target_name in Dag.add_node nodeTarget depsDag; (* if a lib, then we insert ourself as dependency for executable or other library *) let insertEdgeForDependency = match target.target_name with | Name.Lib l -> Dag.add_node (Dependency l) depsDag; Dag.add_edge (Dependency l) | _ -> fun _ _ -> () in List.iter (fun (dep, constr) -> maybe_unit (fun c -> let _, pkg = Metacache.get dep.Libname.main_name in if not (Expr.eval pkg.Meta.Pkg.version c) then raise (Dependencies.BuildDepAnalyzeFailed (Libname.to_string dep ^ " (" ^ pkg.Meta.Pkg.version ^ ") doesn't match the constraint " ^ Expr.to_string c))) constr; Dag.add_edge nodeTarget (Dependency dep) depsDag; insertEdgeForDependency (Dependency dep) depsDag; loop dep) (Target.get_all_builddeps target); if not (StringSet.is_empty !missingDeps) then raise (DependenciesMissing (StringSet.to_list !missingDeps)); List.iter (fun (cpkg, cconstr) -> let ver = Prog.run_pkg_config_version cpkg in (* TODO compare the constraints *) ignore cconstr; ignore ver; let pkgIncludes = List.map fp (Prog.run_pkg_config_includes cpkg) in let pkgLibs = Prog.run_pkg_config_libs cpkg in let pkgConf = { cpkg_conf_libs = pkgLibs; cpkg_conf_includes = pkgIncludes } in Hashtbl.add cpkgsTable cpkg pkgConf) target.target_cbits.target_cpkgs) allTargets; if gconf.dump_dot then ( let dotDir = Dist.create_build Dist.Dot in let path = dotDir fn "dependencies.dot" in let toString t = match t with | Target s -> "target(" ^ Name.to_string s ^ ")" | Dependency s -> Libname.to_string s in let dotContent = Dag.to_dot toString "dependencies" true depsDag in Filesystem.write_file path dotContent; let ipath = dotDir fn "internal-dependencies.dot" in let dotIContent = Dag.to_dot Name.to_string "internal-dependencies" true targetsDag in Filesystem.write_file ipath dotIContent); { project_dep_data = depsTable; project_pkgdeps_dag = depsDag; project_targets_dag = targetsDag; project_all_deps = List.concat $ List.map (fun target -> target.target_obits.target_builddeps) allTargets; project_ocamlcfg = ocamlCfg; project_ocamlmkcfg = ocamlMkCfg; project_file = projFile; project_cpkgs = cpkgsTable; } obuild-0.2.2/lib/core/analyze.mli000066400000000000000000000070621515212760700166500ustar00rootroot00000000000000(** Project analysis and dependency resolution *) (** Exception raised when a sublibrary doesn't exist *) exception SublibraryNotFound of Libname.t (** Exception raised when an OCaml configuration key is missing *) exception OcamlConfigMissing of string (** Dependency origin type *) type dep_type = | System (** External system dependency *) | Internal (** Internal project dependency *) (** Dependency graph node tags *) type dependency_tag = | Target of Target.Name.t (** Build target node *) | Dependency of Libname.t (** Library dependency node *) (** C package configuration from pkg-config *) type cpkg_config = { cpkg_conf_libs : string list; (** Linker flags *) cpkg_conf_includes : Filepath.filepath list; (** Include paths *) } (** Analyzed project configuration with resolved dependencies *) type project_config = { project_dep_data : (Libname.t, dep_type) Hashtbl.t; (** Mapping of dependencies to their type (system/internal) *) project_pkgdeps_dag : dependency_tag Dag.t; (** Full dependency graph including targets and libraries *) project_targets_dag : Target.Name.t Dag.t; (** Internal target dependency graph *) project_all_deps : Dependencies.dependency list; (** All dependencies across all targets *) project_file : Project.t; (** Original project configuration *) project_ocamlcfg : (string, string) Hashtbl.t; (** OCaml compiler configuration *) project_ocamlmkcfg : (string, string) Hashtbl.t; (** OCaml makefile configuration *) project_cpkgs : (string, cpkg_config) Hashtbl.t; (** C package configurations *) } val prepare : Project.t -> (string * bool) list -> project_config (** [prepare proj_file user_flags] analyzes project and resolves dependencies Performs full dependency analysis: - Resolves all library dependencies recursively - Builds dependency DAGs - Initializes META cache with standard library - Validates dependency constraints - Processes C package dependencies @param proj_file the project to analyze @param user_flags configured project flags @return analyzed project configuration @raise Dependencies.DependencyMissing if a dependency is not found @raise Dependencies.DependenciesMissing if multiple dependencies are missing @raise SublibraryNotFound if a sublibrary is not found *) val get_ocaml_config_key_global : string -> string (** [get_ocaml_config_key_global key] retrieves OCaml config value from global config @raise OcamlConfigMissing if key not found *) val get_ocaml_config_key : string -> project_config -> string (** [get_ocaml_config_key key project] retrieves OCaml config value from project @raise OcamlConfigMissing if key not found *) val get_pkg_deps : Target.target -> project_config -> Libname.t list (** [get_pkg_deps target project] gets all package dependencies for a target Returns dependencies in topological order *) val get_c_pkg : string -> project_config -> cpkg_config (** [get_c_pkg cname project] retrieves C package configuration @raise Failure if C package not found *) val is_pkg_internal : project_config -> Libname.t -> bool (** [is_pkg_internal project pkg] checks if package is internal to project *) val is_pkg_system : project_config -> Libname.t -> bool (** [is_pkg_system project pkg] checks if package is a system dependency *) val get_internal_library_deps : project_config -> Target.target -> Libname.t list (** [get_internal_library_deps project target] gets internal library dependencies Returns only dependencies that are libraries defined in the project *) obuild-0.2.2/lib/core/build.ml000066400000000000000000001276071515212760700161430ustar00rootroot00000000000000open Fugue open Filepath open Types open Helper open Printf open Analyze open Target open Prepare open Gconf open Buildprogs exception CCompilationFailed of string exception CompilationFailed of string exception InternalInconsistency of string * string (* Polling constants for waiting on filesystem *) let poll_interval_sec = 0.02 (* 20ms between file existence checks *) let mtime_poll_interval_sec = 0.01 (* 10ms between mtime freshness checks *) let mtime_poll_timeout_sec = 5.0 (* safety timeout for mtime polling *) let initial_task_context_size = 64 (* Timestamp set at the start of each compile phase. C object files whose mtime is >= this value were compiled during the current build run and may need mtime-freshness polling. Files older than this are from a previous run and need no polling. *) let build_start_time = ref 0.0 (* check that destination is valid (mtime wise) against a list of srcs and * if not valid gives the filepath that has changed. *) let check_destination_valid_with srcs (_, dest) = if Filesystem.exists dest then let dest_time = Filesystem.get_modification_time dest in try Some (List.find (fun (_, path) -> let mtime = Filesystem.get_modification_time path in dest_time < mtime) srcs) with Not_found -> None else Some (Filetype.FileO, current_dir) (* same as before but the list of sources is automatically determined * from the file DAG *) let check_destination_valid cstate (filety, dest) = let children = try Dag.get_children cstate.compilation_filesdag (Filetype.make_id (filety, dest)) with Dag.DagNodeNotFound -> raise (InternalInconsistency (Filetype.to_string filety, "missing destination: " ^ fp_to_string dest)) in check_destination_valid_with (List.map Filetype.get_id children) (filety, dest) (* get a nice reason of why a destination is not deemed valid against * the source filepath that triggered the unvalid check. * * if source filepath is empty, it means that destination doesn't exists *) let reason_from_paths (_, dest) (srcTy, changedSrc) = let trim_pd_exts z = let n = fn_to_string z in if String_utils.endswith ".d" n then fn (Filename.chop_suffix n ".d") else if String_utils.endswith ".p" n then fn (Filename.chop_suffix n ".p") else z in if changedSrc = current_dir then "" else let bdest = path_basename dest in let bsrc = path_basename changedSrc in match (Filetype.of_filename bdest, srcTy) with | (Filetype.FileCMX | Filetype.FileCMO), (Filetype.FileCMX | Filetype.FileCMO) -> let bml = Filetype.replace_extension bdest Filetype.FileML in let bmli = Filetype.replace_extension bdest Filetype.FileMLI in if bml = bsrc then "Source changed" else if bmli = bsrc then "Interface changed" else "Dependency " ^ Modname.to_string (Modname.of_filename (trim_pd_exts bsrc)) ^ " changed " ^ fp_to_string changedSrc | (Filetype.FileCMX | Filetype.FileCMO), (Filetype.FileCMXA | Filetype.FileCMA) -> "Library changed " ^ fp_to_string changedSrc | (Filetype.FileCMX | Filetype.FileCMO), _ -> "Dependencies changed " ^ fp_to_string changedSrc | Filetype.FileO, _ -> let bc = Filetype.replace_extension bdest Filetype.FileC in let bh = Filetype.replace_extension bdest Filetype.FileH in if bc = bsrc then "C file " ^ fn_to_string bsrc ^ " changed" else if bh = bsrc then "H file " ^ fn_to_string bsrc ^ " changed" else "file changed " ^ fp_to_string changedSrc | _, _ -> fp_to_string changedSrc ^ " changed" let get_all_modes target = let compile_opts = Target.get_compilation_opts target in let compiled_types = Target.get_ocaml_compiled_types target in let all_modes = List.concat (List.map (fun ty -> List.map (fun cmode -> (ty, cmode)) compile_opts) compiled_types) in List.filter (fun (t, o) -> match (t, o) with | ByteCode, WithProf -> false | _ -> true) all_modes let annot_mode () = if Gconf.get_target_option_typed Annot && gconf.bin_annot then AnnotationBoth else if Gconf.get_target_option_typed Annot then AnnotationText else if gconf.bin_annot then AnnotationBin else AnnotationNone let get_nb_step dag = let nb_step = Dag.length dag in let nb_step_len = String.length (string_of_int nb_step) in (nb_step, nb_step_len) let buildmode_to_filety bmode = if bmode = Native then Filetype.FileCMX else Filetype.FileCMO let buildmode_to_library_filety bmode = if bmode = Native then Filetype.FileCMXA else Filetype.FileCMA let internal_libs_paths self_deps = let tbl = Hashtbl.create 6 in List.iter (fun (compile_opt, compile_type) -> let paths = List.map (fun dep -> let dirname = Dist.get_build_exn (Dist.Target (Name.Lib dep)) in let filety = buildmode_to_library_filety compile_type in let libpath = dirname Libname.to_cmca compile_type compile_opt dep in (filety, libpath)) self_deps in Hashtbl.replace tbl (compile_opt, compile_type) paths) (List.concat (List.map (fun opt -> List.map (fun ty -> (opt, ty)) [Native; ByteCode]) [Normal; WithProf; WithDebug])); tbl (* Helper: get include paths for ctypes from dependencies *) (* Generate ctypes.cstubs type discovery - produces types_generated.ml *) let generate_cstubs_types = Build_cstubs.generate_cstubs_types (* Generate ctypes.cstubs function stubs - produces C.ml and stubs.c *) let generate_cstubs_functions = Build_cstubs.generate_cstubs_functions (* Compile generated ctypes.cstubs C code *) let compile_cstubs_c = Build_cstubs.compile_cstubs_c (* Run explicit generate block *) let run_generate_block task_index task (gen_block : Target.target_generate) _bstate task_context dag = let _cstate, _target = Hashtbl.find task_context task in let autogenDir = Dist.get_build_exn Dist.Autogen in (* Match a filename against a glob pattern segment (e.g., "*.scm", "*") *) let matches_glob_pattern pattern name = let name_str = fn_to_string name in if pattern = "*" then true else if String.length pattern > 1 && pattern.[0] = '*' then let suffix = String.sub pattern 1 (String.length pattern - 1) in String_utils.endswith suffix name_str else name_str = pattern in (* Collect all files recursively under a directory *) let rec collect_all_files base = try let accum = ref [] in Filesystem.iterate (fun entry -> let full = base entry in if Filesystem.is_dir full then accum := !accum @ collect_all_files full else accum := full :: !accum ) base; !accum with Sys_error _ -> [] in (* Expand glob patterns in generate_from *) let expand_pattern pattern = let pattern_str = fp_to_string pattern in if not (String.contains pattern_str '*') then [pattern] else let segments = String_utils.split Filename.dir_sep.[0] pattern_str in (* Split into leading literal path and glob segments *) let rec split_at_glob acc = function | [] -> (List.rev acc, []) | seg :: rest when String.contains seg '*' -> (List.rev acc, seg :: rest) | seg :: rest -> split_at_glob (seg :: acc) rest in let (literal_parts, glob_parts) = split_at_glob [] segments in let base = match literal_parts with | [] -> current_dir | parts -> fp (String.concat Filename.dir_sep parts) in let rec glob_match base_path = function | [] -> [base_path] | "**" :: [] -> (* ** at end: all files recursively *) collect_all_files base_path | "**" :: rest -> (* ** matches zero or more directory levels *) let zero_match = glob_match base_path rest in let sub_matches = try let accum = ref [] in Filesystem.iterate (fun entry -> let full = base_path entry in if Filesystem.is_dir full then accum := !accum @ glob_match full ("**" :: rest) ) base_path; !accum with Sys_error _ -> [] in zero_match @ sub_matches | [file_pattern] -> (* Terminal segment: match files *) (try Filesystem.list_dir_pred (fun entry -> (not (Filesystem.is_dir (base_path entry))) && matches_glob_pattern file_pattern entry ) base_path |> List.map (fun entry -> base_path entry) with Sys_error _ -> []) | dir_pattern :: rest -> (* Non-terminal segment: match directories and recurse *) (try let subdirs = Filesystem.list_dir_pred (fun entry -> Filesystem.is_dir (base_path entry) && matches_glob_pattern dir_pattern entry ) base_path in List.concat (List.map (fun d -> glob_match (base_path d) rest ) subdirs) with Sys_error _ -> []) in let results = glob_match base glob_parts in List.sort compare results in let sources = List.concat (List.map expand_pattern gen_block.generate_from) in (* Check if any source is newer than output *) let output_module = gen_block.generate_module in let output_file = autogenDir fn (Compat.string_lowercase (Hier.to_string output_module) ^ ".ml") in let needs_rebuild = if not (Filesystem.exists output_file) then true else let output_mtime = Filesystem.get_modification_time output_file in List.exists (fun src -> Filesystem.exists src && Filesystem.get_modification_time src > output_mtime ) sources in if needs_rebuild then begin let nb_step, nb_step_len = get_nb_step dag in log Report "[%*d of %d] Generating %-30s\n%!" nb_step_len task_index nb_step (Hier.to_string output_module); let dest = autogenDir fn (Compat.string_lowercase (Hier.to_string output_module)) in Generators.run_custom_multi ~generator_name:gen_block.generate_using ~dest ~sources ~extra_args:gen_block.generate_args end; Scheduler.FinishTask task (* compile C files *) let compile_c task_index task c_file bstate task_context dag = let cstate, target = Hashtbl.find task_context task in let cbits = target.target_cbits in let c_dir_spec = { include_dirs = cstate.compilation_c_include_paths; dst_dir = cstate.compilation_builddir_c; src_dir = cbits.target_cdir; } in let dest = (Filetype.FileO, c_dir_spec.dst_dir o_from_cfile c_file) in match check_destination_valid cstate dest with | None -> Scheduler.FinishTask task | Some src_changed -> let reason = reason_from_paths dest src_changed in let nb_step, nb_step_len = get_nb_step dag in log Report "[%*d of %d] Compiling C %-30s%s\n%!" nb_step_len task_index nb_step (fn_to_string c_file) (if reason <> "" then " ( " ^ reason ^ " )" else ""); let cflags = cbits.target_cflags in Scheduler.AddProcess (task, run_c_compile bstate.bstate_config c_dir_spec cflags c_file) (* compile a set of modules in directory into a pack *) let compile_directory task_index task (h : Hier.t) task_context dag = let cstate, target = Hashtbl.find task_context task in let pack_opt = Hier.parent h in (* get all the modules defined at level h+1 *) let modules_task = Taskdep.linearize cstate.compilation_dag Taskdep.FromParent [ task ] in let filter_modules t : Hier.t option = match t with | CompileC _ | LinkTarget _ | CheckTarget _ -> None | GenerateCstubsTypes _ | GenerateCstubsFunctions _ | CompileCstubsC _ | RunGenerateBlock _ -> None | CompileDirectory m | CompileModule m -> if Hier.lvl m = Hier.lvl h + 1 then Some m else None | CompileInterface m -> if Hier.lvl m = Hier.lvl h + 1 then begin let fe = Hier.get_file_entry_maybe m in match fe with | None -> None | Some e -> ( match e with | Hier.FileEntry (_, f) -> if Filetype.of_filepath f = Filetype.FileMLI then Some m else None | _ -> None) end else None in let modules = List.rev $ list_filter_map filter_modules modules_task in let all_modes = get_all_modes target in let annot_mode = annot_mode () in (* directory never have interface (?) so we serialize the native/bytecode creation. * the mtime checking is sub-optimal. low hanging fruits warning *) let tasks_ops : (string * Scheduler.call) option list list = let byte_list, native_list = List.partition (fun (t, _) -> t = ByteCode) all_modes in List.map (fun pair_list -> List.map (fun (build_mode, comp_opt) -> let path = cstate.compilation_builddir_ml comp_opt in let dest = (Filetype.FileCMI, Hier.get_dest_file path Filetype.FileCMI h) in let mdeps = List.map (fun m -> (Filetype.FileCMI, Hier.get_dest_file path Filetype.FileCMI m)) modules in let dir = cstate.compilation_builddir_ml comp_opt in let fcompile = fun () -> run_ocaml_pack dir dir annot_mode build_mode pack_opt h modules in match check_destination_valid_with mdeps dest with | None -> None | Some src_changed -> Some (reason_from_paths dest src_changed, fcompile)) pair_list) [ byte_list; native_list ] in let reason, ops = (*[ [(r,f)] ]*) let l : (string * Scheduler.call) list list = List.map maybes_to_list tasks_ops in match List.filter (fun x -> x <> []) l with | [] -> ("", []) | ((r, x) :: xs) :: ys -> (r, (x :: List.map snd xs) :: List.map (List.map snd) ys) in if ops <> [] then ( let nb_step, nb_step_len = get_nb_step dag in log Report "[%*d of %d] Packing %-30s%s\n%!" nb_step_len task_index nb_step (Hier.to_string h) reason; Scheduler.AddTask (task, ops)) else Scheduler.FinishTask task (** Helper: Check if recompilation is needed and prepare compilation functions Examines source files and dependencies to determine if recompilation is required. Returns a pair of (compilation_reason option, list of compilation functions). *) let check_compilation_needed is_intf dep_descs dir_spec use_thread annot_mode pack_opt use_pp oflags h cstate = let rec check invalid descs = match descs with | [] -> (None, []) | (dest, build_mode, comp_opt, srcs) :: xs -> ( let r_dir_spec = { dir_spec with dst_dir = cstate.compilation_builddir_ml comp_opt Hier.to_dirpath h; include_dirs = cstate.compilation_include_paths comp_opt h; } in let fcompile = ( build_mode, fun () -> run_ocaml_compile r_dir_spec use_thread annot_mode build_mode comp_opt pack_opt use_pp oflags h ) in if invalid then let _, ys = check invalid xs in (Some "", fcompile :: ys) else match check_destination_valid_with srcs dest with | None -> check false xs | Some src_changed -> let reason = reason_from_paths dest src_changed in let _, ys = check true xs in (Some reason, fcompile :: ys)) in check false dep_descs (** Helper: Organize compilation functions based on build modes Groups compilation functions appropriately: - Interface compilations run in parallel - Modules with interfaces run in parallel - Modules without interfaces partition native/bytecode builds *) let organize_compilation_functions is_intf check_fun_list hdesc = if is_intf || Module.file_has_interface hdesc then [ List.map snd check_fun_list ] else let l1, l2 = List.partition (fun (x, _) -> x = Compiled Native) check_fun_list in List.filter (fun x -> x <> []) [ List.map snd l1; List.map snd l2 ] let dep_descs is_intf hdesc bstate cstate target h = let self_deps = Analyze.get_internal_library_deps bstate.bstate_config target in let internal_libs_paths_all_modes = internal_libs_paths self_deps in let module_deps = hdesc.Module.File.dep_cwd_modules in let compile_opts = Target.get_compilation_opts target in let all_modes = get_all_modes target in if is_intf then let intf_desc = match hdesc.Module.File.intf_desc with | None -> failwith "assertion error, task interface and no module_intf" | Some intf -> intf in List.map (fun comp_opt -> let path = cstate.compilation_builddir_ml comp_opt in let dest = (Filetype.FileCMI, Hier.get_dest_file path Filetype.FileCMI h) in let src = [ (Filetype.FileMLI, intf_desc.Module.Intf.path) ] in let m_deps = List.map (fun module_dep -> (Filetype.FileCMI, Hier.get_dest_file path Filetype.FileCMI module_dep)) module_deps in let internal_deps = Hashtbl.find internal_libs_paths_all_modes (comp_opt, ByteCode) in (dest, Interface, comp_opt, src @ internal_deps @ m_deps)) compile_opts else List.map (fun (compiled_ty, comp_opt) -> let file_compile_ty = buildmode_to_filety compiled_ty in let ext = if compiled_ty = ByteCode then Filetype.FileCMO else Filetype.FileCMX in let path = cstate.compilation_builddir_ml comp_opt in let dest = (file_compile_ty, Hier.get_dest_file path ext h) in let src = (match hdesc.Module.File.intf_desc with | None -> [] | Some intf -> [ (Filetype.FileMLI, intf.Module.Intf.path) ]) @ [ (Filetype.FileML, hdesc.Module.File.path) ] in let own_cmi_dep = match hdesc.Module.File.intf_desc with | None -> [] | Some _ -> (* Add dependency on the module's own .cmi file *) [ (Filetype.FileCMI, Hier.get_dest_file path Filetype.FileCMI h) ] in let m_deps = own_cmi_dep @ List.concat (List.map (fun module_dep -> (* In bytecode mode, .cmo files only depend on .cmi files of dependencies. In native mode, .cmx files depend on both .cmx (for inlining) and .cmi *) let compiled_file_dep = if compiled_ty = Native then [ (file_compile_ty, Hier.get_dest_file path ext module_dep) ] else [] in compiled_file_dep @ [ (Filetype.FileCMI, Hier.get_dest_file path Filetype.FileCMI module_dep) ]) module_deps) in let internal_deps = Hashtbl.find internal_libs_paths_all_modes (comp_opt, compiled_ty) in (dest, Compiled compiled_ty, comp_opt, src @ internal_deps @ m_deps)) all_modes (* add a OCaml module or interface compilation process *) let compile_module task_index task is_intf h bstate task_context dag = let all = Hashtbl.find_all task_context task in let process_one_target cstate target = let pack_opt = Hier.parent h in let hdesc = let desc = Hashtbl.find cstate.compilation_modules h in match desc with | Module.DescFile z -> z | Module.DescDir _ -> failwith (sprintf "internal error compile module on directory (%s). steps dag internal error" (Hier.to_string h)) in let src_path = path_dirname hdesc.Module.File.path in let use_thread = hdesc.Module.File.use_threads in let dir_spec = { src_dir = src_path; dst_dir = current_dir; include_dirs = [ current_dir ] } in let dep_descs = dep_descs is_intf hdesc bstate cstate target h in let annot_mode = annot_mode () in let check_result = check_compilation_needed is_intf dep_descs dir_spec use_thread annot_mode pack_opt hdesc.Module.File.use_pp hdesc.Module.File.oflags h cstate in (check_result, hdesc) in let all = List.map (fun (c, t) -> process_one_target c t) all in match all with | [] -> Scheduler.FinishTask task | ((compilation_reason, _), _) :: _ -> match compilation_reason with | None -> Scheduler.FinishTask task | Some reason -> (* if the module has an interface, we create one list, so everything can be run in parallel, * otherwise we partition the build_mode functions in build_modes group. *) let all_fun_lists = List.fold_left (fun l ((_, check), hdesc) -> let funlist = organize_compilation_functions is_intf check hdesc in l @ funlist) [] all in let verb = if is_intf then "Intfing" else "Compiling" in let nb_step, nb_step_len = get_nb_step dag in log Report "[%*d of %d] %s %-30s%s\n%!" nb_step_len task_index nb_step verb (Hier.to_string h) (if reason <> "" then " ( " ^ reason ^ " )" else ""); Scheduler.AddTask (task, all_fun_lists) let wait_for_files cdep_files = let max_wait = 30.0 in let start = Unix.gettimeofday () in let rec loop remaining = match remaining with | [] -> true | _ -> if Unix.gettimeofday () -. start > max_wait then begin log Report "warning: timed out waiting for files: %s" (String.concat ", " (List.map fp_to_string remaining)); false end else let still_missing = List.filter (fun f -> let test = Filesystem.exists f in if not test then log Debug "warning: (temporarily?) missing file %s" (fp_to_string f); not test) remaining in if still_missing = [] then true else begin ignore (Unix.select [] [] [] poll_interval_sec); loop still_missing end in loop cdep_files let link_c cstate clib_name = let lib_name = cstate.compilation_builddir_c fn clib_name in let cdep_files = List.map (fun x -> cstate.compilation_builddir_c o_from_cfile x) cstate.compilation_csources in (* Not sure why it is necessary ... gcc seems to return before the files are ready. *) ignore (wait_for_files cdep_files); if gconf.ocamlmklib then [ [ (fun () -> run_c_linking LinkingShared cdep_files lib_name) ] ] else let so_file = cstate.compilation_builddir_c fn (Utils.shared_lib_name clib_name) in let a_file = cstate.compilation_builddir_c fn (Utils.static_lib_name clib_name) in [ [ (fun () -> run_c_linking LinkingShared cdep_files so_file) ]; [ (fun () -> run_ar a_file cdep_files) ]; [ (fun () -> run_ranlib a_file) ]; ] let satisfy_preds dep preds = let satisfy_all current_pkg = let res = List.fold_left (fun acc (req_preds, req_libs) -> List.fold_left (fun _in_acc lib -> if lib = dep then Meta.Pkg.satisfy req_preds preds else true) acc req_libs) true current_pkg.Meta.Pkg.requires in res in let rec dep_is_satisfied current_pkg = satisfy_all current_pkg && List.for_all satisfy_all current_pkg.Meta.Pkg.subs in let _, root_pkg = Metacache.get dep.Libname.main_name in dep_is_satisfied root_pkg (** Helper: Resolve build dependencies to actual library file paths *) let resolve_build_dependencies bstate pkgDeps compiledType compileOpt useThreadLib is_lib_target = let systhread = Analyze.get_ocaml_config_key_global "systhread_supported" in if is_lib_target then [] else List.flatten (List.map (fun dep -> match Hashtbl.find bstate.bstate_config.project_dep_data dep with | Internal -> [ in_current_dir (Libname.to_cmca compiledType compileOpt dep) ] | System -> let path, rootPkg = Metacache.get_from_cache dep in let libDir = Meta.get_include_dir_with_subpath (fp (Analyze.get_ocaml_config_key "standard_library" bstate.bstate_config)) (path, rootPkg) dep.Libname.subnames in let pred = match compiledType with | Native -> Meta.Predicate.Native | ByteCode -> Meta.Predicate.Byte in let preds = match useThreadLib with | PosixThread -> [ pred; Meta.Predicate.Mt; Meta.Predicate.Mt_posix ] | VMThread -> [ pred; Meta.Predicate.Mt; Meta.Predicate.Mt_vm ] | DefaultThread -> (if systhread = "true" then Meta.Predicate.Mt_posix else Meta.Predicate.Mt_vm) :: [ pred; Meta.Predicate.Mt ] | NoThreads -> [ pred ] in let preds = match compileOpt with | WithProf -> Meta.Predicate.Gprof :: preds | _ -> preds in if satisfy_preds dep preds then let archives = Meta.Pkg.get_archive_with_filter (path, rootPkg) dep preds in List.fold_left (fun acc (_, a) -> let files = String_utils.split ' ' a in acc @ List.map (fun f -> libDir fn f) files) [] archives else []) pkgDeps) (** Helper: Calculate destination path for linked output *) let get_link_destination cstate target compiledType compileOpt plugin = match target.target_name with | Name.Lib libname -> if plugin then cstate.compilation_builddir_ml Normal Libname.to_cmxs compileOpt libname else cstate.compilation_builddir_ml Normal Libname.to_cmca compiledType compileOpt libname | _ -> let outputName = Utils.to_exe_name compileOpt compiledType (Target.get_target_dest_name target) in cstate.compilation_builddir_ml Normal outputName (** Helper: Wait for C object files to be ready with fresh modification times. Filesystem buffering can cause stat() to return stale mtimes even after the C compiler has finished. We only need to poll when a C file was actually compiled during the current build run (mtime >= build_start_time). On a cached build all .o files are older than build_start_time, so the poll is skipped entirely — this is what was causing the ~5 s delay per link mode. *) let wait_for_c_objects c_obj_files destTime = if c_obj_files <> [] then ( ignore (wait_for_files c_obj_files); (* Only poll when at least one .o file was written during this build run. *) let any_recently_compiled = List.exists (fun obj_file -> try Filesystem.get_modification_time obj_file >= !build_start_time with Unix.Unix_error _ -> false) c_obj_files in if any_recently_compiled then ( let max_wait_time = Unix.gettimeofday () +. mtime_poll_timeout_sec in let rec poll_fresh () = if Unix.gettimeofday () > max_wait_time then log Debug "Warning: timeout waiting for C object mtimes to update\n" else let all_fresh = List.for_all (fun obj_file -> try Filesystem.get_modification_time obj_file > destTime with Unix.Unix_error _ -> false) c_obj_files in if not all_fresh then ( ignore (Unix.select [] [] [] mtime_poll_interval_sec); poll_fresh ()) in poll_fresh ())) (** Helper: Check if relinking is needed by comparing modification times *) let check_needs_relink cstate compiled c_obj_files dest compiledType compileOpt = let destTime = Filesystem.get_modification_time dest in let ext = if compiledType = ByteCode then Filetype.FileCMO else Filetype.FileCMX in let path = cstate.compilation_builddir_ml compileOpt in (* Wait for C objects to have fresh mtimes (skipped automatically on cached builds — see wait_for_c_objects). *) wait_for_c_objects c_obj_files destTime; (* Check OCaml module files *) try Some (List.find (fun p -> destTime < Filesystem.get_modification_time p) (List.map (fun m -> Hier.get_dest_file path ext m) compiled)) with Not_found -> ( (* Also check C object files *) try Some (List.find (fun p -> destTime < Filesystem.get_modification_time p) c_obj_files) with Not_found -> None) (** Main linking function - orchestrates dependency resolution, freshness checking, and linking *) let link_ task_index bstate cstate pkgDeps target dag compiled useThreadLib cclibs compiledType compileOpt plugin = let buildDeps = resolve_build_dependencies bstate pkgDeps compiledType compileOpt useThreadLib (is_lib target) in let dest = get_link_destination cstate target compiledType compileOpt plugin in let linking_paths_of compileOpt = match compileOpt with | Normal -> cstate.compilation_linking_paths | WithDebug -> cstate.compilation_linking_paths_d | WithProf -> cstate.compilation_linking_paths_p in let c_obj_files = List.map (fun csrc -> cstate.compilation_builddir_c o_from_cfile csrc) cstate.compilation_csources in let depsTime = check_needs_relink cstate compiled c_obj_files dest compiledType compileOpt in if depsTime <> None then ( let nb_step, nb_step_len = get_nb_step dag in let systhread = Analyze.get_ocaml_config_key_global "systhread_supported" in let link_type = if plugin then LinkingPlugin else if is_lib target then LinkingLibrary else LinkingExecutable in log Report "[%*d of %d] Linking %s %s\n%!" nb_step_len task_index nb_step (if is_lib target then "library" else "executable") (fp_to_string dest); [ (fun () -> run_ocaml_linking (linking_paths_of compileOpt) compiledType link_type compileOpt useThreadLib systhread target.target_obits.target_oflags cclibs buildDeps compiled dest); ]) else [] let link task_index task bstate task_context dag = let cstate, target = Hashtbl.find task_context task in let cbits = target.target_cbits in let compiled = get_compilation_order cstate in log Debug " compilation order: %s\n" (Utils.showList "," Hier.to_string compiled); let selfDeps = Analyze.get_internal_library_deps bstate.bstate_config target in log Debug " self deps: %s\n" (Utils.showList "," Libname.to_string selfDeps); let selfLibDirs = List.map (fun dep -> Dist.get_build_exn (Dist.Target (Name.Lib dep))) selfDeps in (* Helper: find library by name in project *) let find_lib_by_name libname = try Some (List.find (fun lib -> lib.Project.Library.name = libname) bstate.bstate_config.Analyze.project_file.Project.libs) with Not_found -> None in (* Collect cstubs info and internal C library info from dependencies *) let deps_cstubs_info = list_filter_map (fun dep_name -> match find_lib_by_name dep_name with | Some lib -> (match lib.Project.Library.target.Target.target_cstubs with | Some cstubs -> Some (dep_name, cstubs.Target.cstubs_external_library_name) | None -> None) | None -> None ) selfDeps in (* Collect internal C library names from dependencies that have csources *) let deps_internal_cclibs = list_filter_map (fun dep_name -> match find_lib_by_name dep_name with | Some lib -> if lib.Project.Library.target.Target.target_cbits.Target.target_csources <> [] then Some (Target.Name.get_clibname (Name.Lib dep_name)) else None | None -> None ) selfDeps in (* cstubs objects are now included in the main stubs library, not separate *) (* Get cstubs libs from dependencies - they use the standard stubs_ naming *) let deps_cstubs_cclibs = List.map (fun (dep_name, _) -> Target.Name.get_clibname (Name.Lib dep_name)) deps_cstubs_info in (* Internal C library: created if we have c-sources OR cstubs *) let has_c_lib = cstate.compilation_csources <> [] || target.target_cstubs <> None in let internal_cclibs = if has_c_lib then [ Target.get_target_clibname target ] else [] in let cclibs = List.concat (List.map (fun (cpkg, _) -> List.map (fun x -> "-l" ^ x) (Analyze.get_c_pkg cpkg bstate.bstate_config).cpkg_conf_libs) cbits.target_cpkgs) @ List.map (fun x -> "-L" ^ fp_to_string x) selfLibDirs @ List.map (fun x -> "-l" ^ x) (cbits.target_clibs @ deps_cstubs_cclibs @ internal_cclibs @ deps_internal_cclibs) in let pkgDeps = Analyze.get_pkg_deps target bstate.bstate_config in log Verbose "package deps: [%s]\n" (Utils.showList "," Libname.to_string pkgDeps); let useThreadLib = if List.mem (Libname.of_string "threads") pkgDeps then DefaultThread else if List.mem (Libname.of_string "threads.posix") pkgDeps then PosixThread else if List.mem (Libname.of_string "threads.vm") pkgDeps then VMThread else NoThreads in (* Create C library from regular C sources and cstubs combined *) let cfunlist = let csource_objs = List.map (fun x -> cstate.compilation_builddir_c o_from_cfile x) cstate.compilation_csources in let cstubs_objs = match (target.target_cstubs, target.target_name) with | Some cstubs, Name.Lib libname -> let autogen_dir = get_cstubs_autogen_dir libname in let c_lib_name = cstubs.cstubs_external_library_name in let c_stubs_file = fn (c_lib_name ^ "_stubs.c") in [ autogen_dir o_from_cfile c_stubs_file ] | _ -> [] in let all_objs = csource_objs @ cstubs_objs in if all_objs <> [] then begin let clib_name = Target.get_target_clibname target in ignore (wait_for_files all_objs); if gconf.ocamlmklib then [ [ (fun () -> run_c_linking LinkingShared all_objs (cstate.compilation_builddir_c fn clib_name)) ] ] else let so_file = cstate.compilation_builddir_c fn (Utils.shared_lib_name clib_name) in let a_file = cstate.compilation_builddir_c fn (Utils.static_lib_name clib_name) in [ [ (fun () -> run_c_linking LinkingShared all_objs so_file) ]; [ (fun () -> run_ar a_file all_objs) ]; [ (fun () -> run_ranlib a_file) ]; ] end else [] in let all_modes = get_all_modes target in let funlist = List.fold_left (fun flist (compiledType, compileOpt) -> let normal = link_ task_index bstate cstate pkgDeps target dag compiled useThreadLib cclibs compiledType compileOpt false in let res = if is_lib target && compiledType = Native && Gconf.get_target_option_typed Library_plugin then link_ task_index bstate cstate pkgDeps target dag compiled useThreadLib cclibs compiledType compileOpt true @ normal else normal in res @ flist) [] all_modes in if funlist <> [] then Scheduler.AddTask (task, cfunlist @ [ funlist ]) else Scheduler.FinishTask task let get_destination_files target = let all_modes = get_all_modes target in match target.Target.target_name with | Name.Lib libname -> List.map (fun (typ, opt) -> Libname.to_cmca typ opt libname) all_modes | Name.Exe _ | Name.Test _ | Name.Bench _ | Name.Example _ -> List.map (fun (ty, opt) -> Utils.to_exe_name opt ty (Target.get_target_dest_name target)) all_modes let sanity_check build_dir target = let files = get_destination_files target in let allOK = List.for_all (fun f -> let test = Filesystem.exists (build_dir f) in if not test then log Debug "warning: missing file %s" (fp_to_string (build_dir f)); test) files in if not allOK then log Report "warning: some target file appears to be missing"; () let check task_index task task_context dag = let _, target = Hashtbl.find task_context task in let buildDir = Dist.get_build_path (Dist.Target target.target_name) in let nb_step, nb_step_len = get_nb_step dag in log Report "[%*d of %d] Checking %s\n%!" nb_step_len task_index nb_step (fp_to_string buildDir); sanity_check buildDir target; Scheduler.FinishTask task (* compile will process the compilation DAG, * which will compile all C sources and OCaml modules. *) let compile (bstate : build_state) task_context dag = build_start_time := Unix.gettimeofday (); let taskdep = Helper.Timing.measure_time "Taskdep.init" (fun () -> Taskdep.init dag) in (* a compilation task has finished, terminate the process, * and process the result *) let schedule_finish (task, st) is_done = (match Process.terminate (task, st) with | Process.Success (_, warnings, duration) -> log Gconf.Debug "[TIMING] %s: %.3fs\n" (string_of_compile_step task) duration; (* TODO: store warnings for !isDone and print them if they are different when isDone *) if is_done then print_warnings warnings | Process.Failure er -> ( match task with | CompileC _ -> raise (CCompilationFailed er) | _ -> raise (CompilationFailed er))); if is_done then Taskdep.mark_done taskdep task in let dispatch (task_index, task) = let t0 = Unix.gettimeofday () in let result = match task with | CompileC m -> compile_c task_index task m bstate task_context dag | CompileInterface m -> compile_module task_index task true m bstate task_context dag | CompileModule m -> compile_module task_index task false m bstate task_context dag | CompileDirectory m -> compile_directory task_index task m task_context dag | GenerateCstubsTypes lib -> generate_cstubs_types task_index task lib bstate task_context dag | GenerateCstubsFunctions lib -> generate_cstubs_functions task_index task lib bstate task_context dag | CompileCstubsC lib -> compile_cstubs_c task_index task lib bstate task_context dag | RunGenerateBlock gen_block -> run_generate_block task_index task gen_block bstate task_context dag | LinkTarget _ -> link task_index task bstate task_context dag | CheckTarget _ -> check task_index task task_context dag in let elapsed = Unix.gettimeofday () -. t0 in if elapsed > 0.01 then log Gconf.Debug "[TIMING] dispatch %s: %.3fs\n" (string_of_compile_step task) elapsed; result in let stat = Helper.Timing.measure_time "Scheduler.schedule" (fun () -> Scheduler.schedule gconf.parallel_jobs taskdep dispatch schedule_finish) in log Verbose "schedule finished: #processes=%d max_concurrency=%d\n" stat.Scheduler.nb_processes stat.Scheduler.max_runqueue; () let build_exe bstate exe = let target = Project.Executable.to_target exe in let modules = [ Hier.of_filename exe.Project.Executable.main ] in let task_context = Hashtbl.create initial_task_context_size in let build_dir = Dist.create_build (Dist.Target target.target_name) in let cstate = prepare_target bstate build_dir target modules in List.iter (fun n -> Hashtbl.add task_context n (cstate, target)) (Dag.get_nodes cstate.compilation_dag); compile bstate task_context cstate.compilation_dag let select_leaves children duplicate dag = let dup_set = Hashtbl.create (List.length duplicate) in List.iter (fun d -> Hashtbl.replace dup_set d ()) duplicate; let rec loop children = let good, bad = List.partition (fun a -> not (Hashtbl.mem dup_set a)) children in match bad with | [] -> good | _ -> let new_ = ref [] in List.iter (fun a -> let parents = Dag.get_parents dag a in List.iter (fun p -> new_ := p :: !new_) parents) bad; loop (!new_ @ good) in loop children let build_dag bstate proj_file targets_dag = Helper.Timing.measure_time "build_dag (total)" (fun () -> let dag = Helper.Timing.measure_time "DAG initialization" (fun () -> Dag.init ()) in let task_context = Hashtbl.create initial_task_context_size in let taskdep = Taskdep.init targets_dag in let targets_deps = Hashtbl.create initial_task_context_size in (* Register all generated modules globally before preparing any target. This allows dependent targets to recognize generated modules. *) List.iter (fun lib -> let target = Project.Library.to_target lib in List.iter (fun (gen : Target.target_generate) -> let module_name = Hier.to_string gen.Target.generate_module in Hier.register_generated_module module_name ) target.Target.target_generates ) proj_file.Project.libs; let prepare_state target modules = let build_dir = Dist.create_build (Dist.Target target.target_name) in let cstate = Helper.Timing.measure_time "prepare_target" (fun () -> prepare_target bstate build_dir target modules) in List.iter (fun n -> Hashtbl.add task_context n (cstate, target)) (Dag.get_nodes cstate.compilation_dag); let duplicate = Helper.Timing.measure_time "DAG merge" (fun () -> Dag.merge dag cstate.compilation_dag) in (cstate.compilation_dag, duplicate) in Helper.Timing.measure_time "target preparation loop" (fun () -> while not (Taskdep.is_complete taskdep) do match Taskdep.get_next taskdep with | None -> failwith "no free task in targets" | Some (_, ntask) -> log Verbose "preparing target %s\n%!" (Name.to_string ntask); let cur_dag, dups = match ntask with | Name.Exe name -> let exe = Project.find_exe proj_file name in prepare_state (Project.Executable.to_target exe) [ Hier.of_filename exe.Project.Executable.main ] | Name.Lib name -> let lib = Project.find_lib proj_file name in let target = Project.Library.to_target lib in (* Include generated modules from generate blocks - they belong to the library *) let generated_modules = List.map (fun (g : Target.target_generate) -> g.Target.generate_module ) target.Target.target_generates in prepare_state target (lib.Project.Library.modules @ generated_modules) | Name.Bench name -> let bench = Project.find_bench proj_file name in prepare_state (Project.Bench.to_target bench) [ Hier.of_filename bench.Project.Bench.main ] | Name.Test name -> let test = Project.find_test proj_file name in prepare_state (Project.Test.to_target test) [ Hier.of_filename test.Project.Test.main ] | Name.Example name -> let example = Project.find_example proj_file name in prepare_state (Project.Example.to_target example) [ Hier.of_filename example.Project.Example.main ] in if Hashtbl.mem targets_deps ntask then begin let children = Dag.get_leaves cur_dag in let children = select_leaves children dups cur_dag in let roots = Hashtbl.find targets_deps ntask in List.iter (fun child -> List.iter (fun root -> Dag.add_edge child root dag) roots) children end; let roots = Dag.get_roots cur_dag in (* should be LinkTarget *) List.iter (fun p -> Hashtbl.add targets_deps p roots) (Dag.get_parents targets_dag ntask); Taskdep.mark_done taskdep ntask done); Helper.Timing.measure_time "compilation phase" (fun () -> compile bstate task_context dag)) obuild-0.2.2/lib/core/build.mli000066400000000000000000000030551515212760700163020ustar00rootroot00000000000000(** Build orchestration and compilation *) (** Exception raised when C compilation fails *) exception CCompilationFailed of string (** Exception raised when OCaml compilation fails *) exception CompilationFailed of string (** Exception raised for internal consistency errors *) exception InternalInconsistency of string * string val build_exe : Prepare.build_state -> Project.Executable.t -> unit (** [build_exe bstate exe] builds a single executable Prepares compilation state and compiles the executable with all its dependencies. @param bstate global build state @param exe executable to build @raise CCompilationFailed if C compilation fails @raise CompilationFailed if OCaml compilation fails *) val build_dag : Prepare.build_state -> Project.t -> Target.Name.t Dag.t -> unit (** [build_dag bstate proj_file targets_dag] builds targets according to DAG Orchestrates parallel compilation of multiple targets respecting dependency order defined in the DAG. @param bstate global build state @param proj_file project configuration @param targets_dag target dependency DAG @raise CCompilationFailed if C compilation fails @raise CompilationFailed if OCaml compilation fails *) val sanity_check : Filepath.filepath -> Target.target -> unit (** [sanity_check build_dir target] verifies all target output files exist Checks that all expected compilation outputs are present in the build directory. Logs warnings for missing files. @param build_dir target build directory @param target target to check *) obuild-0.2.2/lib/core/build_cstubs.ml000066400000000000000000000606141515212760700175200ustar00rootroot00000000000000open Fugue open Filepath open Types open Helper open Printf open Analyze open Target open Prepare open Gconf open Buildprogs (* Helper: get include paths for ctypes from dependencies *) let get_ctypes_includes bstate = let stdlib = fp (Analyze.get_ocaml_config_key "standard_library" bstate.bstate_config) in (* Find ctypes package paths *) try (* Get integers library path *) let (integers_path, integers_pkg) = Metacache.get "integers" in let integers_dir = Meta.get_include_dir stdlib (integers_path, integers_pkg) in (* Get str library path *) let (str_path, str_pkg) = Metacache.get "str" in let str_dir = Meta.get_include_dir stdlib (str_path, str_pkg) in let (path, pkg) = Metacache.get "ctypes" in let ctypes_dir = Meta.get_include_dir stdlib (path, pkg) in let ctypes_stubs_lib = Libname.of_string "ctypes.stubs" in let (stubs_path, stubs_root_pkg) = Metacache.get "ctypes" in let stubs_pkg = Meta.Pkg.find ctypes_stubs_lib.Libname.subnames stubs_root_pkg in let stubs_dir = Meta.get_include_dir stdlib (stubs_path, stubs_pkg) in [integers_dir; str_dir; ctypes_dir; stubs_dir] with Not_found | Meta.SubpackageNotFound _ | Dependencies.DependencyMissing _ -> [] (* Helper: get ctypes library files for linking *) let get_ctypes_libs bstate = let stdlib = fp (Analyze.get_ocaml_config_key "standard_library" bstate.bstate_config) in try (* Get integers library (required by ctypes) *) let (integers_path, integers_pkg) = Metacache.get "integers" in let integers_dir = Meta.get_include_dir stdlib (integers_path, integers_pkg) in let integers_cma = integers_dir fn "integers.cma" in (* Get str library (required by ctypes.stubs) *) let (str_path, str_pkg) = Metacache.get "str" in let str_dir = Meta.get_include_dir stdlib (str_path, str_pkg) in let str_cma = str_dir fn "str.cma" in (* Get ctypes library *) let (path, pkg) = Metacache.get "ctypes" in let ctypes_dir = Meta.get_include_dir stdlib (path, pkg) in let ctypes_cma = ctypes_dir fn "ctypes.cma" in (* Get ctypes.stubs library *) let ctypes_stubs_lib = Libname.of_string "ctypes.stubs" in let (stubs_path, stubs_root_pkg) = Metacache.get "ctypes" in let stubs_pkg = Meta.Pkg.find ctypes_stubs_lib.Libname.subnames stubs_root_pkg in let stubs_dir = Meta.get_include_dir stdlib (stubs_path, stubs_pkg) in let stubs_cma = stubs_dir fn "ctypes_stubs.cma" in [integers_cma; str_cma; ctypes_cma; stubs_cma] with Not_found | Meta.SubpackageNotFound _ | Dependencies.DependencyMissing _ -> [] let get_nb_step dag = let nb_step = Dag.length dag in let nb_step_len = String.length (string_of_int nb_step) in (nb_step, nb_step_len) (* Generate ctypes.cstubs type discovery - produces types_generated.ml *) let generate_cstubs_types task_index task lib bstate task_context dag = let (cstate, target) = Hashtbl.find task_context task in let (nb_step, nb_step_len) = get_nb_step dag in log Report "[%*d of %d] Generating cstubs types for %s\n%!" nb_step_len task_index nb_step (Libname.to_string lib); match target.target_cstubs with | None -> log Report " No cstubs configuration found\n%!"; Scheduler.FinishTask task | Some cstubs -> let autogen_dir = Dist.get_build_exn Dist.Autogen fn (Libname.to_string lib) in Filesystem.mkdir_safe autogen_dir 0o755; let generated_types_name = cstubs.cstubs_generated_types in (* Write generated files to autogen directory - no placeholders needed *) let target_file = autogen_dir fn (Compat.string_uncapitalize generated_types_name ^ ".ml") in (* Check if we have type description *) match cstubs.cstubs_type_description with | None -> (* No type description - generate empty types module *) let content = Printf.sprintf "(* Auto-generated type bindings for %s *)\n\ (* No type description specified *)\n" (Libname.to_string lib) in Filesystem.write_file target_file content; log Report " Generated %s (no types)\n%!" (fp_to_string target_file); Scheduler.FinishTask task | Some type_desc -> (* Get the bindings module name *) let bindings_hier = type_desc.Target.cstubs_functor in let bindings_parts = Hier.to_string bindings_hier in (* Split "Bindings.Types" into module "Bindings" and functor "Types" *) let parts = String_utils.split '.' bindings_parts in let (bindings_module, types_functor) = match parts with | [m; f] -> (m, f) | [m] -> (m, "Types") | m :: _ -> (m, "Types") | [] -> (bindings_parts, "Types") in (* Get paths *) let ctypes_includes = get_ctypes_includes bstate in let build_dir = cstate.compilation_builddir_ml Normal in let src_dirs = target.target_obits.target_srcdir in (* Generate discover.ml that uses Cstubs_structs.write_c to discover type layouts. This properly handles structs defined in the user's Types functor. *) let discover_ml = autogen_dir fn "discover.ml" in let headers_str = String.concat "; " (List.map (fun h -> Printf.sprintf "\"#include <%s>\\n\"" h) cstubs.cstubs_headers) in let headers_list = if headers_str = "" then "[]" else Printf.sprintf "[%s]" headers_str in let discover_content = Printf.sprintf "(* Auto-generated type discovery for %s using Cstubs_structs *)\n\ let () =\n\ \ let headers = String.concat \"\" %s in\n\ \ let fmt = Format.std_formatter in\n\ \ Format.fprintf fmt \"#include @.\";\n\ \ Format.fprintf fmt \"#include @.\";\n\ \ Format.fprintf fmt \"%%s\" headers;\n\ \ Cstubs_structs.write_c fmt (module %s.%s)\n" (Libname.to_string lib) headers_list bindings_module types_functor in Filesystem.write_file discover_ml discover_content; log Report " Generated %s\n%!" (fp_to_string discover_ml); (* Compile discover.ml - needs ctypes.stubs and the bindings module *) let discover_exe = autogen_dir fn "discover.byte" in let ocamlc = Prog.get_ocamlc () in let ctypes_libs = get_ctypes_libs bstate in let bindings_cmo = build_dir fn (Compat.string_uncapitalize bindings_module ^ ".cmo") in let include_args = List.concat [ Utils.to_include_path_options ctypes_includes; Utils.to_include_path_options [build_dir]; Utils.to_include_path_options src_dirs; Utils.to_include_path_options [autogen_dir]; ] in let lib_args = List.map fp_to_string ctypes_libs in (* Check if bindings.cmo exists *) let bindings_exists = Filesystem.exists bindings_cmo in (* Link with ctypes libs and the user's bindings module *) let compile_args = [ocamlc] @ include_args @ lib_args @ (if bindings_exists then [fp_to_string bindings_cmo] else []) @ ["-o"; fp_to_string discover_exe; fp_to_string discover_ml] in log Report " Compiling type discovery program...\n%!"; (match Process.run compile_args with | Process.Failure err -> log Report " Warning: Failed to compile discover.ml: %s\n%!" err; log Report " Falling back to static type sizes\n%!"; (* Fallback: generate static content *) let content = Printf.sprintf "(* Auto-generated type bindings for %s *)\n\ (* Generated statically - type discovery compilation failed *)\n\ \n\ let size_t_size = %d\n" (Libname.to_string lib) (Sys.word_size / 8) in Filesystem.write_file target_file content; Scheduler.FinishTask task | Process.Success _ -> (* Run discover to generate C code *) log Report " Running type discovery program...\n%!"; (match Process.run [fp_to_string discover_exe] with | Process.Failure err -> log Report " Warning: Failed to run discover: %s\n%!" err; let content = Printf.sprintf "(* Auto-generated type bindings for %s *)\n\ let size_t_size = %d\n" (Libname.to_string lib) (Sys.word_size / 8) in Filesystem.write_file target_file content; Scheduler.FinishTask task | Process.Success (c_code, _, _) -> (* Write the C program *) let discover_c = autogen_dir fn "discover.c" in Filesystem.write_file discover_c c_code; log Report " Generated %s\n%!" (fp_to_string discover_c); (* Compile the C program - include ctypes directory for ctypes_cstubs_internals.h *) let discover_c_exe = autogen_dir fn "discover_c" in let cc = Prog.get_cc () in let ocaml_include = Analyze.get_ocaml_config_key "standard_library" bstate.bstate_config in (* Get ctypes include paths for ctypes_cstubs_internals.h *) let ctypes_c_includes = List.concat (List.map (fun p -> ["-I"; fp_to_string p]) (ctypes_includes @ src_dirs)) in let compile_c_args = [cc; "-I"; ocaml_include] @ ctypes_c_includes @ ["-o"; fp_to_string discover_c_exe; fp_to_string discover_c] in log Report " Compiling C type discovery...\n%!"; (match Process.run compile_c_args with | Process.Failure err -> log Report " Warning: Failed to compile discover.c: %s\n%!" err; let content = Printf.sprintf "(* Auto-generated type bindings for %s *)\n\ let size_t_size = %d\n" (Libname.to_string lib) (Sys.word_size / 8) in Filesystem.write_file target_file content; Scheduler.FinishTask task | Process.Success _ -> (* Run the C program to get types *) log Report " Running C type discovery...\n%!"; (match Process.run [fp_to_string discover_c_exe] with | Process.Failure err -> log Report " Warning: Failed to run C discover: %s\n%!" err; let content = Printf.sprintf "(* Auto-generated type bindings for %s *)\n\ let size_t_size = %d\n" (Libname.to_string lib) (Sys.word_size / 8) in Filesystem.write_file target_file content; Scheduler.FinishTask task | Process.Success (ml_code, _, _) -> Filesystem.write_file target_file ml_code; log Report " Generated %s\n%!" (fp_to_string target_file); ignore (bindings_module, types_functor); Scheduler.FinishTask task ) ) ) ) (* Generate ctypes.cstubs function stubs - produces C.ml and stubs.c *) let generate_cstubs_functions task_index task lib bstate task_context dag = let (cstate, target) = Hashtbl.find task_context task in let (nb_step, nb_step_len) = get_nb_step dag in log Report "[%*d of %d] Generating cstubs functions for %s\n%!" nb_step_len task_index nb_step (Libname.to_string lib); match target.target_cstubs with | None -> log Report " No cstubs configuration found\n%!"; Scheduler.FinishTask task | Some cstubs -> let autogen_dir = Dist.get_build_exn Dist.Autogen fn (Libname.to_string lib) in Filesystem.mkdir_safe autogen_dir 0o755; let entry_point_name = cstubs.cstubs_generated_entry_point in let c_lib_name = cstubs.cstubs_external_library_name in let generated_types = cstubs.cstubs_generated_types in match cstubs.cstubs_function_description with | None -> (* No function description - generate minimal entry point *) let entry_file = autogen_dir fn (Compat.string_uncapitalize entry_point_name ^ ".ml") in let entry_content = Printf.sprintf "(* Auto-generated entry point for %s *)\n\ module Types = %s\n\ module Functions = struct end\n" (Libname.to_string lib) generated_types in Filesystem.write_file entry_file entry_content; (* Generate empty C stubs *) let c_stubs_file = autogen_dir fn (c_lib_name ^ "_stubs.c") in Filesystem.write_file c_stubs_file "/* Auto-generated C stubs - no functions bound */\n\ #include \n"; log Report " Generated %s (no functions)\n%!" (fp_to_string entry_file); Scheduler.FinishTask task | Some func_desc -> let bindings_hier = func_desc.Target.cstubs_functor in let bindings_parts = Hier.to_string bindings_hier in let parts = String_utils.split '.' bindings_parts in let (bindings_module, functions_functor) = match parts with | [m; f] -> (m, f) | [m] -> (m, "Functions") | m :: _ -> (m, "Functions") | [] -> (bindings_parts, "Functions") in (* Get types functor name from type description *) let types_functor = match cstubs.cstubs_type_description with | Some type_desc -> let type_parts = String_utils.split '.' (Hier.to_string type_desc.Target.cstubs_functor) in (match type_parts with | [_; f] -> f | [_] -> "Types" | _ -> "Types") | None -> "Types" in (* Get paths *) let ctypes_includes = get_ctypes_includes bstate in let ctypes_libs = get_ctypes_libs bstate in let build_dir = cstate.compilation_builddir_ml Normal in let src_dirs = target.target_obits.target_srcdir in (* Write all generated ML files to autogen directory - no placeholders needed *) let ml_output_dir = autogen_dir in ignore src_dirs; (* Path to compiled bindings module and generated types module *) let bindings_cmo = build_dir fn (Compat.string_uncapitalize bindings_module ^ ".cmo") in let types_cmo = build_dir fn (Compat.string_uncapitalize generated_types ^ ".cmo") in (* Generate stubgen.ml *) let stubgen_ml = autogen_dir fn "stubgen.ml" in let prefix = c_lib_name in let entry_file_name = Compat.string_uncapitalize entry_point_name ^ ".ml" in let stubs_file_name = c_lib_name ^ "_stubs.c" in (* Generate a module name for the generated FOREIGN implementation *) let generated_foreign_name = c_lib_name ^ "_generated" in let generated_foreign_file = Compat.string_uncapitalize generated_foreign_name ^ ".ml" in (* Convert concurrency policy to Cstubs module value string *) let concurrency_str = match cstubs.cstubs_concurrency with | Target.Cstubs_sequential -> "Cstubs.sequential" | Target.Cstubs_unlocked -> "Cstubs.unlocked" | Target.Cstubs_lwt_jobs -> "Cstubs.lwt_jobs" | Target.Cstubs_lwt_preemptive -> "Cstubs.lwt_preemptive" in (* Convert errno policy to Cstubs module value string *) let errno_str = match cstubs.cstubs_errno with | Target.Cstubs_ignore_errno -> "Cstubs.ignore_errno" | Target.Cstubs_return_errno -> "Cstubs.return_errno" in (* Generate header includes for C stubs *) let headers_includes = String.concat "" (List.map (fun h -> Printf.sprintf " Format.fprintf c_fmt \"#include <%s>\\n\";\n" h) cstubs.cstubs_headers) in let has_types = match cstubs.cstubs_type_description with Some _ -> true | None -> false in let apply_types = if has_types then "(Types)" else "" in let types_def = if has_types then Printf.sprintf " let module Types = %s.%s(%s) in\n" bindings_module types_functor (Compat.string_capitalize generated_types) else "" in let stubgen_content = Printf.sprintf "(* Auto-generated stub generator for %s *)\n\ let prefix = \"%s\"\n\ let autogen_dir = \"%s\"\n\ let ml_output_dir = \"%s\"\n\ \n\ let () =\n\ \ (* Generate C stubs to autogen directory *)\n\ \ let c_file = open_out (Filename.concat autogen_dir \"%s\") in\n\ \ let c_fmt = Format.formatter_of_out_channel c_file in\n\ \ Format.fprintf c_fmt \"/* Auto-generated by ctypes.cstubs */\\n\";\n\ \ Format.fprintf c_fmt \"#include \\n\";\n\ \ Format.fprintf c_fmt \"#include \\n\";\n\ \ Format.fprintf c_fmt \"#include \\n\";\n\ \ Format.fprintf c_fmt \"#include \\n\";\n\ \ Format.fprintf c_fmt \"#include \\n\";\n\ \ Format.fprintf c_fmt \"#include \\n\";\n\ \ Format.fprintf c_fmt \"#include \\n\";\n\ %s\ \ Format.fprintf c_fmt \"\\n\";\n\ \ (* Apply user's Functions functor to both FOREIGN and discovered TYPES *)\n\ \ %s\ \ let module M (F : Ctypes.FOREIGN) = %s.%s(F)%s in\n\ \ Cstubs.write_c c_fmt ~concurrency:%s ~errno:%s ~prefix (module M);\n\ \ close_out c_file;\n\ \n\ \ (* Generate FOREIGN implementation module to source directory *)\n\ \ let foreign_file = open_out (Filename.concat ml_output_dir \"%s\") in\n\ \ let foreign_fmt = Format.formatter_of_out_channel foreign_file in\n\ \ Format.fprintf foreign_fmt \"(* Auto-generated FOREIGN implementation for %s *)\\n\";\n\ \ Cstubs.write_ml foreign_fmt ~concurrency:%s ~errno:%s ~prefix (module M);\n\ \ close_out foreign_file;\n\ \n\ \ (* Generate entry point that applies user's functor to generated module *)\n\ \ let entry_file = open_out (Filename.concat ml_output_dir \"%s\") in\n\ \ let entry_fmt = Format.formatter_of_out_channel entry_file in\n\ \ Format.fprintf entry_fmt \"(* Auto-generated entry point for %s *)\\n\";\n\ \ Format.fprintf entry_fmt \"(* Apply user's Types functor to generated TYPE implementation for struct layouts *)\\n\";\n\ \ Format.fprintf entry_fmt \"module Types = %s.%s(%s)\\n\\n\";\n\ \ Format.fprintf entry_fmt \"(* Apply user's Functions functor to generated FOREIGN implementation *)\\n\";\n\ \ Format.fprintf entry_fmt \"module C_Functions = %s.%s(%s)%s\\n\";\n\ \ close_out entry_file;\n\ \n\ \ print_endline \"Stub generation complete\"\n" (Libname.to_string lib) prefix (fp_to_string autogen_dir) (fp_to_string ml_output_dir) stubs_file_name headers_includes types_def bindings_module functions_functor apply_types concurrency_str errno_str generated_foreign_file (Libname.to_string lib) concurrency_str errno_str entry_file_name (Libname.to_string lib) bindings_module types_functor (Compat.string_capitalize generated_types) bindings_module functions_functor (Compat.string_capitalize generated_foreign_name) (if has_types then "(Types)" else "") in Filesystem.write_file stubgen_ml stubgen_content; log Report " Generated %s\n%!" (fp_to_string stubgen_ml); (* Compile stubgen.ml *) let stubgen_exe = autogen_dir fn "stubgen.byte" in let ocamlc = Prog.get_ocamlc () in let include_args = List.concat [ Utils.to_include_path_options ctypes_includes; Utils.to_include_path_options [build_dir]; Utils.to_include_path_options src_dirs; ] in let lib_args = List.map fp_to_string ctypes_libs in (* Check if bindings and types modules exist *) let bindings_exists = Filesystem.exists bindings_cmo in let types_exists = Filesystem.exists types_cmo in log Report " Bindings module at %s: %s\n%!" (fp_to_string bindings_cmo) (if bindings_exists then "found" else "not found"); log Report " Types generated module at %s: %s\n%!" (fp_to_string types_cmo) (if types_exists then "found" else "not found"); (* Compile and link user provided C sources *) let c_objs = List.map (fun c_fn -> let c_src = fn_to_string c_fn in let dst_file = autogen_dir o_from_cfile c_fn in let src_file = target.target_cbits.target_cdir c_fn in let cc = Prog.get_cc () in let include_args = Utils.to_include_path_options (cstate.compilation_c_include_paths @ ctypes_includes @ src_dirs) in let args = [cc] @ include_args @ ["-o"; fp_to_string dst_file; "-c"; fp_to_string src_file] in log Report " Compiling C source %s for stubgen...\n%!" c_src; (match Process.run args with | Process.Failure err -> failwith ("Failed to compile C source " ^ c_src ^ ": " ^ err) | Process.Success _ -> ()); fp_to_string dst_file ) target.target_cbits.target_csources in let compile_args = [ocamlc] @ include_args @ lib_args @ (if bindings_exists then [fp_to_string bindings_cmo] else []) @ (if types_exists then [fp_to_string types_cmo] else []) @ c_objs @ ["-o"; fp_to_string stubgen_exe; fp_to_string stubgen_ml] in log Report " Compiling stub generator...\n%!"; (match Process.run compile_args with | Process.Failure err -> log Report " Warning: Failed to compile stubgen.ml: %s\n%!" err; log Report " Falling back to placeholder stubs\n%!"; (* Fallback: generate placeholder content *) let entry_file = autogen_dir fn (Compat.string_uncapitalize entry_point_name ^ ".ml") in let entry_content = Printf.sprintf "(* Auto-generated entry point for %s *)\n\ (* Stub generation failed - placeholder *)\n\ \n\ module Types = %s\n\ \n\ module Functions = struct\n\ \ (* Function stubs would be here *)\n\ end\n" (Libname.to_string lib) generated_types in Filesystem.write_file entry_file entry_content; let c_stubs_file = autogen_dir fn (c_lib_name ^ "_stubs.c") in Filesystem.write_file c_stubs_file "/* Auto-generated C stubs - placeholder */\n\ #include \n\ #include \n\ #include \n"; log Report " Generated placeholder stubs\n%!"; Scheduler.FinishTask task | Process.Success _ -> (* Run stubgen *) log Report " Running stub generator...\n%!"; (match Process.run [fp_to_string stubgen_exe] with | Process.Failure err -> log Report " Warning: Failed to run stubgen: %s\n%!" err; (* Fallback *) let entry_file = autogen_dir fn (Compat.string_uncapitalize entry_point_name ^ ".ml") in let entry_content = Printf.sprintf "(* Auto-generated entry point for %s *)\n\ module Types = %s\n\ module Functions = struct end\n" (Libname.to_string lib) generated_types in Filesystem.write_file entry_file entry_content; let c_stubs_file = autogen_dir fn (c_lib_name ^ "_stubs.c") in Filesystem.write_file c_stubs_file "/* Auto-generated C stubs */\n\ #include \n"; Scheduler.FinishTask task | Process.Success (output, _, _) -> log Report " %s\n%!" output; log Report " Stubs generated successfully\n%!"; Scheduler.FinishTask task ) ) (* Compile generated ctypes.cstubs C code *) let compile_cstubs_c task_index task lib bstate task_context dag = let (cstate, target) = Hashtbl.find task_context task in let (nb_step, nb_step_len) = get_nb_step dag in log Report "[%*d of %d] Compiling cstubs C for %s\n%!" nb_step_len task_index nb_step (Libname.to_string lib); match target.target_cstubs with | None -> log Report " No cstubs configuration found\n%!"; Scheduler.FinishTask task | Some cstubs -> let autogen_dir = Dist.get_build_exn Dist.Autogen fn (Libname.to_string lib) in let c_lib_name = cstubs.cstubs_external_library_name in let c_stubs_file = fn (c_lib_name ^ "_stubs.c") in (* Add ctypes include paths for C headers like ctypes_cstubs_internals.h *) let ctypes_c_includes = get_ctypes_includes bstate in let src_dirs = target.target_obits.target_srcdir in let c_dir_spec = { include_dirs = cstate.compilation_c_include_paths @ ctypes_c_includes @ src_dirs; dst_dir = autogen_dir; src_dir = autogen_dir } in let dest = (Filetype.FileO, c_dir_spec.dst_dir o_from_cfile c_stubs_file) in log Report " Compiling %s -> %s\n%!" (fn_to_string c_stubs_file) (fp_to_string (snd dest)); (* Use the C compiler to compile the stubs *) Scheduler.AddProcess (task, run_c_compile bstate.bstate_config c_dir_spec [] c_stubs_file) obuild-0.2.2/lib/core/buildprogs.ml000066400000000000000000000302241515212760700172020ustar00rootroot00000000000000open Types open Filepath open Fugue open Process open Prepare open Gconf exception LinkingFailed of string exception InferFailed of string type c_linking_mode = | LinkingStatic | LinkingShared type linking_mode = | LinkingLibrary | LinkingPlugin | LinkingExecutable type annotation_mode = | AnnotationNone | AnnotationBin | AnnotationText | AnnotationBoth type packopt = Hier.t option let annotToOpts mode = let bin_annot_opts = if gconf.bin_annot_occurrences then [ "-bin-annot"; "-bin-annot-occurrences" ] else [ "-bin-annot" ] in match mode with | AnnotationNone -> [] | AnnotationBin -> bin_annot_opts | AnnotationText -> [ "-annot" ] | AnnotationBoth -> bin_annot_opts @ [ "-annot" ] let run_ocaml_compile dirSpec useThread annotMode buildMode compileOpt packopt pp oflags modhier = let dstDir = dirSpec.dst_dir in let entry = Hier.get_file_entry modhier [ dirSpec.src_dir ] in let src_file = Hier.get_src_file dirSpec.src_dir entry in let compileOpt = if buildMode = Interface && compileOpt = WithProf then WithDebug else compileOpt in Filesystem.mkdir_safe_recursive dstDir 0o755; let prog, srcFile, dstFile = match buildMode with | Interface -> ( Prog.get_ocamlc (), Hier.ml_to_ext src_file Filetype.FileMLI, Hier.get_dest_file dstDir Filetype.FileCMI modhier ) | Compiled ct -> let ext = if ct = ByteCode then Filetype.FileCMO else Filetype.FileCMX in ( (if ct = ByteCode then Prog.get_ocamlc () else Prog.get_ocamlopt ()), src_file, Hier.get_dest_file dstDir ext modhier ) in let args = [ prog ] @ (match useThread with | NoThread -> [] | WithThread -> [ "-thread" ]) @ Utils.to_include_path_options dirSpec.include_dirs @ (match compileOpt with | Normal -> [] | WithDebug -> [ "-g" ] | WithProf -> [ "-p" ]) @ annotToOpts annotMode @ oflags @ gconf.ocaml_extra_args @ Pp.to_params pp @ maybe [] (fun x -> if buildMode = Compiled Native then [ "-for-pack"; Hier.to_string x ] else []) packopt @ (if gconf.short_path then [ "-short-paths" ] else []) @ [ "-o"; fp_to_string dstFile ] @ [ "-c"; fp_to_string srcFile ] in Process.make args let run_ocaml_pack _srcDir dstDir annotMode buildMode packOpt dest modules = let prog = if buildMode = ByteCode then Prog.get_ocamlc () else Prog.get_ocamlopt () in let ext = if buildMode = ByteCode then Filetype.FileCMO else Filetype.FileCMX in let ext_f = function | Filetype.FileML -> ext | Filetype.FileMLI -> Filetype.FileCMI | _ -> (* It should not happen *) if buildMode = ByteCode then Filetype.FileCMO else Filetype.FileCMX in Filesystem.mkdir_safe_recursive dstDir 0o755; let args = [ prog ] @ maybe [] (fun x -> if buildMode = Native then [ "-for-pack"; Hier.to_string x ] else []) packOpt @ annotToOpts annotMode @ [ "-pack"; "-o"; fp_to_string (Hier.get_dest_file dstDir ext dest) ] @ List.map (fun m -> fp_to_string (Hier.get_dest_file_ext dstDir m ext_f)) modules in Process.make args let run_ocaml_infer srcDir includes pp modname = let entry = Hier.get_file_entry modname [ srcDir ] in let args = [ Prog.get_ocamlc (); "-i" ] @ Pp.to_params pp @ Utils.to_include_path_options includes @ [ fp_to_string (Hier.get_src_file srcDir entry) ] in match run args with | Success (mli, _, _) -> mli | Process.Failure er -> raise (InferFailed er) let o_from_cfile file = file <.> "o" let run_c_compile project dirSpec cflags file = let dstDir = dirSpec.dst_dir in Filesystem.mkdir_safe_recursive dstDir 0o755; let callCCompiler = String_utils.words_noempty (Analyze.get_ocaml_config_key "bytecomp_c_compiler" project) in let srcFile = dirSpec.src_dir file in (* make a .c.o file to avoid collision *) let dstFile = dirSpec.dst_dir o_from_cfile file in let args = callCCompiler @ cflags @ Utils.to_include_path_options dirSpec.include_dirs @ [ "-o"; fp_to_string dstFile ] @ [ "-c"; fp_to_string srcFile ] in Process.make args let run_ar dest deps = let args = [ Prog.get_ar (); "rc"; fp_to_string dest ] @ List.map fp_to_string deps in Process.make args let run_ranlib dest = Process.make [ Prog.get_ranlib (); fp_to_string dest ] let run_c_linking sharingMode depfiles dest = let args = if gconf.ocamlmklib then [ Prog.get_ocamlmklib () ] @ (match sharingMode with | LinkingStatic -> [ "-custom" ] | LinkingShared -> []) @ [ "-o"; fp_to_string dest ] @ List.map fp_to_string depfiles else [ Prog.get_cc () ] @ (match sharingMode with | LinkingStatic -> [] | LinkingShared -> if Sys.os_type = "Unix" then (* -shared works on both Linux and macOS with clang *) [ "-shared" ] else [ "-shared" ]) @ [ "-o"; fp_to_string dest ] @ List.map fp_to_string depfiles in Process.make args let run_ocaml_linking includeDirs buildMode linkingMode compileType useThread systhread oflags cclibs libs modules dest = (* create a soft link to a freshly compiled exe, unless a file with the same name already exist *) let link_maybe linking_mode dest = let file_or_link_exists fn = try let _ = Unix.lstat fn in true with Unix.Unix_error _ -> false in match linking_mode with | LinkingPlugin | LinkingLibrary -> () | LinkingExecutable -> if not (Gconf.get_target_option_typed Executable_as_obj) then let real = fp_to_string dest in let basename = Filename.basename real in if not (file_or_link_exists basename) then if Utils.isWindows then Filesystem.copy_file dest (fp basename) else Unix.symlink real basename in let prog = match buildMode with | Native -> Prog.get_ocamlopt () | ByteCode -> Prog.get_ocamlc () in let ext = if buildMode = ByteCode then Filetype.FileCMO else Filetype.FileCMX in let args = [ prog ] @ (match useThread with | NoThreads -> [] | PosixThread -> [ "-thread" ] | VMThread -> [ "-vmthread" ] | DefaultThread -> if systhread = "true" then [ "-thread" ] else [ "-vmthread" ]) @ (match linkingMode with | LinkingPlugin -> [ "-shared" ] | LinkingLibrary -> [ "-a" ] | LinkingExecutable -> if Gconf.get_target_option_typed Executable_as_obj then [ "-output-obj" ] else []) @ [ "-o"; fp_to_string dest ] @ (match compileType with | Normal -> [] | WithDebug -> [ "-g" ] | WithProf -> [ "-p" ]) @ oflags @ Utils.to_include_path_options includeDirs @ List.map fp_to_string libs @ List.concat (List.map (fun x -> [ (match buildMode with | Native -> "-cclib" | ByteCode -> if x.[1] = 'L' then "-cclib" else "-dllib") (* Ugly hack but do the job for now *); x; ]) cclibs) @ List.map (fun m -> fp_to_string (Hier.get_dest_file current_dir ext m)) modules in let res = Process.make args in let () = link_maybe linkingMode dest in res (* ================================================================ ctypes.cstubs generation functions ================================================================ *) exception CstubsGenerationFailed of string (* Get the autogen directory for a library, creating it if needed *) let get_cstubs_autogen_dir libname = let autogen_base = Dist.get_build_path Dist.Autogen in let lib_autogen = autogen_base fn (Libname.to_string libname) in Filesystem.mkdir_safe_recursive lib_autogen 0o755; lib_autogen (* Generate type discovery ML source that uses Cstubs_structs *) let generate_cstubs_type_discovery_source cstubs libname autogen_dir = match cstubs.Target.cstubs_type_description with | None -> None | Some type_desc -> let prefix = cstubs.Target.cstubs_external_library_name in let functor_name = Hier.to_string type_desc.Target.cstubs_functor in let headers_includes = String.concat "\n" (List.map (fun h -> Printf.sprintf " header \"#include <%s>\";" h) cstubs.Target.cstubs_headers) in let source = Printf.sprintf "\n\ (* Auto-generated type discovery program for %s *)\n\ let () =\n\ \ let prefix = \"%s\" in\n\ \ let generate_types_struct name =\n\ \ print_endline (Printf.sprintf \"let %%s = %%d\" name (Ctypes.sizeof Ctypes.size_t))\n\ \ in\n\ \ (* Generate type bindings *)\n\ \ print_endline \"(* Auto-generated type bindings *)\";\n\ \ generate_types_struct \"size_t_size\"\n" (Libname.to_string libname) prefix in ignore (functor_name, headers_includes); let discover_ml = autogen_dir fn "discover_types.ml" in Filesystem.write_file discover_ml source; Some discover_ml (* Generate function stubs ML source that uses Cstubs *) let generate_cstubs_function_stubs_source cstubs libname autogen_dir = match cstubs.Target.cstubs_function_description with | None -> None | Some func_desc -> let prefix = cstubs.Target.cstubs_external_library_name in let functor_name = Hier.to_string func_desc.Target.cstubs_functor in let entry_point = cstubs.Target.cstubs_generated_entry_point in (* Generate the stub generator program *) let source = Printf.sprintf "\n\ (* Auto-generated stub generator for %s *)\n\ (* Functor: %s, Entry point: %s *)\n\ \n\ let c_headers = \"/* Auto-generated C stubs for %s */\\n\"\n\ \n\ let () =\n\ \ (* Generate C stubs *)\n\ \ let c_file = open_out \"%s_stubs.c\" in\n\ \ output_string c_file c_headers;\n\ \ output_string c_file \"#include \\n\";\n\ \ output_string c_file \"#include \\n\";\n\ \ output_string c_file \"#include \\n\";\n\ \ output_string c_file \"/* Stub implementations would be generated here */\\n\";\n\ \ close_out c_file;\n\ \n\ \ (* Generate ML entry point *)\n\ \ let ml_file = open_out \"%s.ml\" in\n\ \ Printf.fprintf ml_file \"(* Auto-generated entry point for %s *)\\n\";\n\ \ Printf.fprintf ml_file \"module Types = Types_generated\\n\";\n\ \ Printf.fprintf ml_file \"module Functions = struct\\n\";\n\ \ Printf.fprintf ml_file \" (* Function bindings would be here *)\\n\";\n\ \ Printf.fprintf ml_file \"end\\n\";\n\ \ close_out ml_file;\n\ \n\ \ print_endline \"Stubs generated successfully\"\n" (Libname.to_string libname) functor_name entry_point (Libname.to_string libname) prefix entry_point (Libname.to_string libname) in let stubgen_ml = autogen_dir fn "stubgen.ml" in Filesystem.write_file stubgen_ml source; Some stubgen_ml (* Compile and run a generated ML program *) let run_cstubs_generator project includes ml_file output_file = let prog = Prog.get_ocamlc () in let exe_file = Filetype.replace_extension (path_basename ml_file) (Filetype.FileOther "exe") in let exe_path = path_dirname ml_file exe_file in (* Compile the generator *) let compile_args = [ prog ] @ Utils.to_include_path_options includes @ [ "-I"; "+ctypes" ] @ [ "-o"; fp_to_string exe_path ] @ [ fp_to_string ml_file ] in ignore project; match Process.run compile_args with | Process.Failure err -> raise (CstubsGenerationFailed ("Failed to compile cstubs generator: " ^ err)) | Process.Success _ -> ( (* Run the generator *) let run_args = [ fp_to_string exe_path ] in match Process.run run_args with | Process.Failure err -> raise (CstubsGenerationFailed ("Failed to run cstubs generator: " ^ err)) | Process.Success (stdout, _, _) -> (* Write output to the target file *) Filesystem.write_file output_file stdout; ()) obuild-0.2.2/lib/core/buildprogs.mli000066400000000000000000000052131515212760700173530ustar00rootroot00000000000000(** Build program execution *) exception LinkingFailed of string exception InferFailed of string (** C linking mode *) type c_linking_mode = | LinkingStatic (** Static linking *) | LinkingShared (** Shared linking *) (** OCaml linking mode *) type linking_mode = | LinkingLibrary (** Library linking *) | LinkingPlugin (** Plugin linking *) | LinkingExecutable (** Executable linking *) (** Annotation mode for compiled files *) type annotation_mode = | AnnotationNone (** No annotations *) | AnnotationBin (** Binary annotations *) | AnnotationText (** Text annotations *) | AnnotationBoth (** Both binary and text annotations *) (** Pack option *) type packopt = Hier.t option val run_ocaml_compile : Prepare.dir_spec -> Prepare.use_thread_flag -> annotation_mode -> Types.ocaml_compilation_mode -> Types.ocaml_compilation_option -> packopt -> Pp.t -> string list -> Hier.t -> Process.t (** Compile an OCaml module *) val run_ocaml_pack : Filepath.filepath -> Filepath.filepath -> annotation_mode -> Types.ocaml_compiled_type -> packopt -> Hier.t -> Hier.t list -> Process.t (** Pack multiple OCaml modules into one *) val run_ocaml_infer : Filepath.filepath -> Filepath.filepath list -> Pp.t -> Hier.t -> string (** Infer OCaml interface from implementation *) val o_from_cfile : Filepath.filename -> Filepath.filename (** Convert C filename to object filename *) val run_c_compile : Analyze.project_config -> Prepare.dir_spec -> string list -> Filepath.filename -> Process.t (** Compile a C file *) val run_ar : Filepath.filepath -> Filepath.filepath list -> Process.t (** Create static archive *) val run_ranlib : Filepath.filepath -> Process.t (** Run ranlib on static archive *) val run_c_linking : c_linking_mode -> Filepath.filepath list -> Filepath.filepath -> Process.t (** Link C object files *) val run_ocaml_linking : Filepath.filepath list -> Types.ocaml_compiled_type -> linking_mode -> Types.ocaml_compilation_option -> Prepare.thread_type -> string -> string list -> string list -> Filepath.filepath list -> Hier.t list -> Filepath.filepath -> Process.t (** Link OCaml modules into library or executable. Parameters: includeDirs buildMode linkingMode compileType useThread systhread oflags cclibs libs modules dest *) (** {2 ctypes.cstubs support} *) exception CstubsGenerationFailed of string (** Exception raised when cstubs generation fails *) val get_cstubs_autogen_dir : Libname.t -> Filepath.filepath (** [get_cstubs_autogen_dir libname] returns the autogen directory for cstubs, creating it if necessary *) obuild-0.2.2/lib/core/configure.ml000066400000000000000000000210431515212760700170100ustar00rootroot00000000000000open Fugue open Filepath open Compat open Helper open Printf open Gconf exception ConfigChanged of string exception ToolNotFound of filename exception ConfigurationMissingKey of string exception ConfigurationTypeMismatch of string * string * string exception ConfigureScriptFailed of string type flag_action = | SetFlag of string | ClearFlag of string let getDigestKV () = let digest = Project.digest () in [ ("obuild-digest", digest) ] let generateMlFile project file flags = Utils.generateFile file (fun add -> add "(* autogenerated file by obuild. do not modify *)\n"; add (sprintf "let project_name = \"%s\"\n" (String_utils.escape_ocaml_string project.Analyze.project_file.Project.name)); add (sprintf "let project_version = \"%s\"\n" (String_utils.escape_ocaml_string project.Analyze.project_file.Project.version)); List.iter (fun (name, v) -> add (sprintf "let project_flag_%s = %b\n" name v)) flags) let generateCFile project file flags = Utils.generateFile file (fun add -> add "/* autogenerated file by obuild. do not modify */\n"; add (sprintf "#define PROJECT_NAME \"%s\"\n" (String_utils.escape_c_string project.Analyze.project_file.Project.name)); add (sprintf "#define PROJECT_VERSION \"%s\"\n" (String_utils.escape_c_string project.Analyze.project_file.Project.version)); List.iter (fun (name, v) -> add (sprintf "#define PROJECT_FLAG_%s %d\n" (string_uppercase name) (if v then 1 else 0))) flags) let makeSetup digestKV project flags = hashtbl_from_list (digestKV @ hashtbl_to_list project.Analyze.project_ocamlcfg @ List.map (fun (opt, v) -> (opt, string_of_bool v)) (Gconf.get_target_options ()) @ List.map (fun (flagname, flagval) -> ("flag-" ^ flagname, string_of_bool flagval)) flags) let sanityCheck ?(needs_c_toolchain=false) () = let (_ : string) = Prog.get_ocamlopt () in let (_ : string) = Prog.get_ocamlc () in let (_ : string) = Prog.get_ocamldep () in if needs_c_toolchain then begin let (_ : string) = Prog.get_cc () in let (_ : string) = Prog.get_ar () in let (_ : string) = Prog.get_ranlib () in () end let comparekvs reason setup l = List.iter (fun (k, v) -> try let v' = Hashtbl.find setup k in if v' <> v then raise (ConfigChanged reason) with Not_found -> raise (ConfigChanged reason)) l let comparekvs_hashtbl reason setup l = Hashtbl.iter (fun k v -> try let v' = Hashtbl.find setup k in if v' <> v then raise (ConfigChanged reason) with Not_found -> raise (ConfigChanged reason)) l let execute_configure_script proj_file = match proj_file.Project.configure_script with | None -> () | Some script -> ( let args = [ Prog.get_ocaml (); fp_to_string script ] in match Process.run args with | Process.Success (_, warnings, _) -> print_warnings warnings | Process.Failure er -> raise (ConfigureScriptFailed er)) let create_dist project flags = log Verbose "configuration changed, deleting dist\n%!"; Filesystem.remove_dir_content Dist.build_path; Dist.remove_dead_links (); log Verbose "auto-generating configuration files\n%!"; let autogenDir = Dist.create_build Dist.Autogen in generateMlFile project (autogenDir fn "path_generated.ml") flags; generateCFile project (autogenDir fn "obuild_macros.h") flags let get_assoc name assoc = try let v = List.assoc name assoc in Some v with Not_found -> None let get_flags_value proj_file setup_flags user_flags = List.map (fun flag -> let name = flag.Project.Flag.name in let def = flag.Project.Flag.default in let override = ref (get_assoc name setup_flags) in List.iter (fun tw -> match tw with | ClearFlag s -> if s = name then override := Some false | SetFlag s -> if s = name then override := Some true) user_flags; match (!override, def) with | None, None -> (name, false) | None, Some v -> (name, v) | Some v, _ -> (name, v)) proj_file.Project.flags let check_extra_tools proj_file = let syspath = Utils.get_system_paths () in List.iter (fun tool -> try let _ = Utils.find_in_paths syspath tool in () with Utils.FileNotFoundInPaths _ -> raise (ToolNotFound tool)) proj_file.Project.extra_tools let get_flags hash = Hashtbl.fold (fun k v acc -> if String_utils.startswith "flag-" k then (String_utils.drop 5 k, bool_of_string v) :: acc else acc) hash [] let bool_of_opt hashtable k = let get_opt k = try Hashtbl.find hashtable k with Not_found -> raise (ConfigurationMissingKey k) in let v = get_opt k in try bool_of_string v with Failure _ -> raise (ConfigurationTypeMismatch (k, "bool", v)) let set_opts hashtable = (* load the environment *) let opts = Gconf.get_target_options_keys () in List.iter (fun k -> Gconf.set_target_options k (bool_of_opt hashtable k)) opts let check_ocaml () = let ocamlCfg = Prog.get_ocaml_config () in let ocaml_ver = Hashtbl.find ocamlCfg "version" in let ver = String_utils.split '.' ocaml_ver in (match ver with | major :: minor :: _ -> let maj = int_of_string major in let min = int_of_string minor in if maj < 4 then gconf.bin_annot <- false; if maj > 4 || (maj = 4 && min > 1) then gconf.short_path <- true; if maj > 5 || (maj = 5 && min >= 2) then gconf.bin_annot_occurrences <- true | _ -> gconf.bin_annot <- false); ocamlCfg let run proj_file user_flags user_opts = Dist.create_maybe (); let _ = check_ocaml () in (* Auto-detect CPU count and set default parallelism *) let cpu_count = Utils.get_cpu_count () in log Report "Detected %d CPU core%s, setting default parallelism to %d\n" cpu_count (if cpu_count = 1 then "" else "s") cpu_count; gconf.parallel_jobs <- cpu_count; let digestKV = getDigestKV () in execute_configure_script proj_file; let configure = try Some (Dist.read_configure ()) with Dist.DistFileNotFound _ -> None in let configure_flags = match configure with | None -> [] | Some h -> (* set opts and return the flags *) Hashtbl.iter (fun k _ -> if not (String_utils.startswith "flag-" k) then Gconf.set_target_options k (bool_of_opt h k)) h; get_flags h in let flags = get_flags_value proj_file configure_flags user_flags in log Debug " configure flag: [%s]\n" (Utils.showList "," (fun (n, v) -> n ^ "=" ^ string_of_bool v) flags); check_extra_tools proj_file; (* Set the user opts BEFORE analyzing the project *) List.iter (fun (o, v) -> Gconf.set_target_options o v) user_opts; let project = Analyze.prepare proj_file flags in let currentSetup = makeSetup digestKV project flags in let actualSetup = try Some (Dist.read_setup ()) with Dist.DistFileNotFound _ -> None in let projectSystemChanged = match actualSetup with | None -> true | Some stp -> ( (* TODO harcoded for now till we do all the checks. *) try comparekvs "setup" stp (hashtbl_to_list currentSetup); (* FORCED should be false *) true with ConfigChanged _ | Not_found -> true) in if projectSystemChanged then ( create_dist project flags; (* write setup file *) log Verbose "Writing new setup\n%!"; Dist.write_setup currentSetup) let check proj_file reconf setup = let ocamlCfg = check_ocaml () in let digestKV = getDigestKV () in (* check if the environment changed. *) comparekvs_hashtbl "ocaml config" setup ocamlCfg; (* if the digest of .obuild changed, let's reconfigure *) let reconfigure = try comparekvs "digest" setup digestKV; false with e -> if reconf then true else raise e in (* user_flags are also restored from setup file *) let setup_flags = get_flags setup in let flags = get_flags_value proj_file setup_flags [] in (* .obuild changed, maybe we should compare a little bit deeper to not retriggerd reconf too often ... *) if reconfigure then ( (* let's call configure-script if available, however we don't care about the content of dist/configure *) execute_configure_script proj_file; log Debug " configure flag: [%s]\n" (Utils.showList "," (fun (n, v) -> n ^ "=" ^ string_of_bool v) flags); check_extra_tools proj_file; let project = Analyze.prepare proj_file flags in create_dist project flags; (* write setup file *) log Verbose "Writing new setup\n%!"; let current_setup = makeSetup digestKV project flags in Dist.write_setup current_setup); flags obuild-0.2.2/lib/core/configure.mli000066400000000000000000000035651515212760700171720ustar00rootroot00000000000000(** Project configuration management *) (** Exception raised when configuration has changed *) exception ConfigChanged of string (** Exception raised when a required external tool is not found *) exception ToolNotFound of Filepath.filename (** Exception raised when a configuration key is missing *) exception ConfigurationMissingKey of string (** Exception raised when a configuration value has wrong type *) exception ConfigurationTypeMismatch of string * string * string (** Exception raised when a configure script fails *) exception ConfigureScriptFailed of string (** Flag manipulation actions *) type flag_action = | SetFlag of string (** Enable a flag *) | ClearFlag of string (** Disable a flag *) val run : Project.t -> flag_action list -> (string * bool) list -> unit (** [run proj_file user_flags user_opts] configures the project Performs configuration including: - Checking OCaml version and capabilities - Executing configure script if present - Processing user flags and options - Creating build directories - Generating auto-configuration files - Writing setup file @param proj_file the project to configure @param user_flags flags to set or clear @param user_opts additional options to set *) val check : Project.t -> bool -> (string, string) Hashtbl.t -> (string * bool) list (** [check proj_file reconf setup] checks configuration and potentially reconfigures Validates that: - OCaml configuration hasn't changed - Project file digest matches - Returns the configured flags @param proj_file the project to check @param reconf whether to force reconfiguration on digest change @param setup the existing setup hashtable @return list of (flag_name, flag_value) pairs *) val set_opts : (string, string) Hashtbl.t -> unit (** [set_opts hashtable] sets target options from configuration hashtable *) obuild-0.2.2/lib/core/dag.ml000066400000000000000000000230271515212760700155660ustar00rootroot00000000000000(* Optimized bi-directional DAG implementation using sets and int indexing *) open Printf open Compat (* IntSet for efficient membership and removal operations *) module IntSet = Set.Make(struct type t = int let compare = compare end) (* Internal representation: nodes are mapped to integer IDs, and parent/child relationships use IntSet for O(log n) operations *) type 'a dagnode = { mutable parents : IntSet.t ; mutable children : IntSet.t } type 'a t = { nodes : (int, 'a dagnode) Hashtbl.t (* ID -> node structure *) ; node_to_id : ('a, int) Hashtbl.t (* node -> ID mapping *) ; id_to_node : (int, 'a) Hashtbl.t (* ID -> node mapping *) ; mutable next_id : int (* counter for new IDs *) } let init () = { nodes = Hashtbl.create 16 ; node_to_id = Hashtbl.create 16 ; id_to_node = Hashtbl.create 16 ; next_id = 0 } (* Get or create ID for a node *) let get_node_id dag node = match SafeHashtbl.find_opt dag.node_to_id node with | Some id -> id | None -> let id = dag.next_id in dag.next_id <- dag.next_id + 1; Hashtbl.add dag.node_to_id node id; Hashtbl.add dag.id_to_node id node; id let length dag = Hashtbl.length dag.nodes (* Add an directed edge from a to b. * * 'a' is the parent of 'b' * 'b' is the child of 'a' *) let add_edge a b dag = let aid = get_node_id dag a in let bid = get_node_id dag b in let maNode = SafeHashtbl.find_opt dag.nodes aid in let mbNode = SafeHashtbl.find_opt dag.nodes bid in (match (maNode, mbNode) with | None, None -> Hashtbl.add dag.nodes aid { parents = IntSet.empty; children = IntSet.singleton bid }; Hashtbl.add dag.nodes bid { parents = IntSet.singleton aid; children = IntSet.empty } | Some aNode, None -> aNode.children <- IntSet.add bid aNode.children; Hashtbl.add dag.nodes bid { parents = IntSet.singleton aid; children = IntSet.empty } | None, Some bNode -> bNode.parents <- IntSet.add aid bNode.parents; Hashtbl.add dag.nodes aid { parents = IntSet.empty; children = IntSet.singleton bid } | Some aNode, Some bNode -> aNode.children <- IntSet.add bid aNode.children; bNode.parents <- IntSet.add aid bNode.parents ); () exception DagNodeNotFound exception DagNodeAlreadyExists let add_node a dag = let aid = get_node_id dag a in if not (Hashtbl.mem dag.nodes aid) then Hashtbl.add dag.nodes aid { parents = IntSet.empty; children = IntSet.empty } let add_node_exclusive a dag = let aid = get_node_id dag a in if Hashtbl.mem dag.nodes aid then raise DagNodeAlreadyExists else Hashtbl.add dag.nodes aid { parents = IntSet.empty; children = IntSet.empty } (* has edge from a to b *) let has_edge a b dag = match SafeHashtbl.find_opt dag.node_to_id a, SafeHashtbl.find_opt dag.node_to_id b with | Some aid, Some bid -> (match SafeHashtbl.find_opt dag.nodes aid, SafeHashtbl.find_opt dag.nodes bid with | Some aNode, Some bNode -> IntSet.mem bid aNode.children && IntSet.mem aid bNode.parents | _ -> false) | _ -> false let del_edge a b dag = match SafeHashtbl.find_opt dag.node_to_id a, SafeHashtbl.find_opt dag.node_to_id b with | Some aid, Some bid -> (match SafeHashtbl.find_opt dag.nodes aid, SafeHashtbl.find_opt dag.nodes bid with | Some aNode, Some bNode -> aNode.children <- IntSet.remove bid aNode.children; bNode.parents <- IntSet.remove aid bNode.parents | _ -> ()) | _ -> () let add_edges l dag = List.iter (fun (n1, n2) -> add_edge n1 n2 dag) l (* add edges connected to each other in a list * n1 -> n2 -> n3 -> ... -> nn *) let add_edges_connected l dag = let rec loop parent nodes = match nodes with | [] -> () | n::ns -> add_edge parent n dag; loop n ns in match l with | [] -> () | x::[] -> add_node x dag | x::l -> loop x l (* add children edges with p the parent * p -> l[1], p -> l[2], ..., p -> l[n] *) let add_children_edges p l dag = List.iter (fun x -> add_edge p x dag) l let exists_node a dag = Hashtbl.mem dag.node_to_id a let get_leaves dag = Hashtbl.fold (fun id v acc -> if IntSet.is_empty v.children then match SafeHashtbl.find_opt dag.id_to_node id with | Some node -> node :: acc | None -> acc (* Should not happen - ID exists in nodes *) else acc ) dag.nodes [] let get_roots dag = Hashtbl.fold (fun id v acc -> if IntSet.is_empty v.parents then match SafeHashtbl.find_opt dag.id_to_node id with | Some node -> node :: acc | None -> acc (* Should not happen - ID exists in nodes *) else acc ) dag.nodes [] let get_node dag a = match SafeHashtbl.find_opt dag.node_to_id a with | Some aid -> (match SafeHashtbl.find_opt dag.nodes aid with | Some node -> node | None -> raise DagNodeNotFound) | None -> raise DagNodeNotFound let get_nodes dag = Hashtbl.fold (fun id _ acc -> match SafeHashtbl.find_opt dag.id_to_node id with | Some node -> node :: acc | None -> acc (* Should not happen - ID exists in nodes *) ) dag.nodes [] let get_children dag a = let node = get_node dag a in IntSet.fold (fun id acc -> match SafeHashtbl.find_opt dag.id_to_node id with | Some n -> n :: acc | None -> acc (* Should not happen - ID in children set *) ) node.children [] let get_parents dag a = let node = get_node dag a in IntSet.fold (fun id acc -> match SafeHashtbl.find_opt dag.id_to_node id with | Some n -> n :: acc | None -> acc (* Should not happen - ID in parents set *) ) node.parents [] let get_children_full dag a = let visited = Hashtbl.create 16 in let result = ref [] in let queue = Queue.create () in List.iter (fun c -> Queue.push c queue) (get_children dag a); while not (Queue.is_empty queue) do let node = Queue.pop queue in if not (Hashtbl.mem visited node) then begin Hashtbl.replace visited node (); result := node :: !result; List.iter (fun c -> Queue.push c queue) (get_children dag node) end done; List.rev !result let is_children dag a b = List.mem b (get_children dag a) let rec is_children_full dag a b = let children = get_children dag a in (* either it's present here, or in one of the kiddy *) List.mem b children || List.fold_left (fun acc child -> acc || is_children_full dag child b ) false children let subset dag roots = let subdag = init () in let rec loop node = add_node node subdag; let children = get_children dag node in List.iter (fun child -> add_edge node child subdag; loop child) children in List.iter (fun root -> loop root) roots; subdag let copy dag = let nodes = get_nodes dag in let dag2 = init () in let copy_node node = add_node node dag2; let children = get_children dag node in add_children_edges node children dag2 in List.iter (fun node -> copy_node node) nodes; dag2 let merge dest src = let nodes = get_nodes src in let dups = ref [] in List.iter (fun node -> if exists_node node dest then dups := node :: !dups) nodes; let copy_node node = add_node node dest; let children = get_children src node in add_children_edges node children dest in List.iter (fun node -> copy_node node) nodes; !dups (* O(v^3) use with care *) let transitive_reduction dag = let reducedDag = copy dag in let nodes = get_nodes dag in List.iter (fun x -> List.iter (fun y -> List.iter (fun z -> if has_edge x y dag && has_edge y z dag then del_edge x z reducedDag else () ) nodes ) nodes ) nodes; reducedDag (* this is for debugging the DAG. * dump the dag links and node in a textual format *) let dump a_to_string dag = let all = get_nodes dag in List.iter (fun n -> printf "%s:\n" (a_to_string n); printf " | parents = %s\n" (String.concat ", " (List.map a_to_string (get_parents dag n))); printf " | children = %s\n" (String.concat ", " (List.map a_to_string (get_children dag n))) ) all (* it's useful to be able to visualize the DAG with the excellent dot *) let to_dot a_to_string name fromLeaf dag = let buf = Buffer.create 1024 in let nodes = get_nodes dag in let dotIndex = Hashtbl.create (List.length nodes) in let append = Buffer.add_string buf in let sanitizeName = bytes_of_string name in for i = 0 to String.length name - 1 do if (bytes_get sanitizeName i) = '-' then bytes_set sanitizeName i '_' done; append ("digraph " ^ (bytes_to_string sanitizeName) ^ " {\n"); let list_iteri f list = let rec loop i l = match l with | [] -> () | x::xs -> f i x; loop (i+1) xs in loop 1 list in list_iteri (fun i n -> Hashtbl.add dotIndex n i; append (sprintf " %d [label = \"%s\"];\n" i (a_to_string n)); ) nodes; List.iter (fun n -> let i = Hashtbl.find dotIndex n in List.iter (fun child -> let ci = Hashtbl.find dotIndex child in append (sprintf " %d -> %d;\n" i ci) ) ((if fromLeaf then get_parents else get_children) dag n) ) nodes; append "}\n"; Buffer.contents buf obuild-0.2.2/lib/core/dag.mli000066400000000000000000000104051515212760700157330ustar00rootroot00000000000000(** Directed Acyclic Graph (DAG) implementation This module provides a bi-directional DAG where each node maintains references to both its parents and children for efficient traversal. *) (** The type of a DAG with nodes of type ['a] *) type 'a t (** Internal node structure - abstract type for encapsulation *) type 'a dagnode (** {1 Exceptions} *) exception DagNodeNotFound (** Raised when attempting to access a node that doesn't exist in the DAG *) exception DagNodeAlreadyExists (** Raised when attempting to exclusively add a node that already exists *) (** {1 Construction} *) val init : unit -> 'a t (** [init ()] creates a new empty DAG *) val add_node : 'a -> 'a t -> unit (** [add_node n dag] adds node [n] to [dag]. Does nothing if [n] already exists *) val add_node_exclusive : 'a -> 'a t -> unit (** [add_node_exclusive n dag] adds node [n] to [dag]. @raise DagNodeAlreadyExists if [n] already exists *) val add_edge : 'a -> 'a -> 'a t -> unit (** [add_edge a b dag] adds a directed edge from [a] to [b]. [a] becomes a parent of [b], and [b] becomes a child of [a]. Creates nodes [a] and [b] if they don't exist *) val add_edges : ('a * 'a) list -> 'a t -> unit (** [add_edges edges dag] adds multiple edges to [dag]. Equivalent to [List.iter (fun (a,b) -> add_edge a b dag) edges] *) val add_edges_connected : 'a list -> 'a t -> unit (** [add_edges_connected [n1; n2; n3; ...]] creates a chain of edges: n1 -> n2 -> n3 -> ... *) val add_children_edges : 'a -> 'a list -> 'a t -> unit (** [add_children_edges parent children dag] adds edges from [parent] to each element in [children] *) val del_edge : 'a -> 'a -> 'a t -> unit (** [del_edge a b dag] removes the edge from [a] to [b] if it exists *) (** {1 Queries} *) val length : 'a t -> int (** [length dag] returns the number of nodes in [dag] *) val exists_node : 'a -> 'a t -> bool (** [exists_node n dag] returns [true] if node [n] exists in [dag] *) val has_edge : 'a -> 'a -> 'a t -> bool (** [has_edge a b dag] returns [true] if there is an edge from [a] to [b] *) val get_node : 'a t -> 'a -> 'a dagnode (** [get_node dag n] returns the node structure for [n]. @raise DagNodeNotFound if [n] doesn't exist *) val get_nodes : 'a t -> 'a list (** [get_nodes dag] returns all nodes in [dag] *) val get_leaves : 'a t -> 'a list (** [get_leaves dag] returns all nodes with no children *) val get_roots : 'a t -> 'a list (** [get_roots dag] returns all nodes with no parents *) val get_children : 'a t -> 'a -> 'a list (** [get_children dag n] returns the immediate children of [n]. @raise DagNodeNotFound if [n] doesn't exist *) val get_parents : 'a t -> 'a -> 'a list (** [get_parents dag n] returns the immediate parents of [n]. @raise DagNodeNotFound if [n] doesn't exist *) val get_children_full : 'a t -> 'a -> 'a list (** [get_children_full dag n] returns all descendants of [n] (transitive closure). @raise DagNodeNotFound if [n] doesn't exist *) val is_children : 'a t -> 'a -> 'a -> bool (** [is_children dag a b] returns [true] if [b] is an immediate child of [a] *) val is_children_full : 'a t -> 'a -> 'a -> bool (** [is_children_full dag a b] returns [true] if [b] is a descendant of [a] (checks transitive closure) *) (** {1 Operations} *) val copy : 'a t -> 'a t (** [copy dag] creates a deep copy of [dag] *) val subset : 'a t -> 'a list -> 'a t (** [subset dag roots] creates a new DAG containing only the subgraph reachable from [roots] *) val merge : 'a t -> 'a t -> 'a list (** [merge dest src] merges [src] into [dest] and returns a list of duplicate nodes (nodes that existed in both DAGs) *) val transitive_reduction : 'a t -> 'a t (** [transitive_reduction dag] returns a new DAG with redundant edges removed. An edge (a,c) is redundant if there exists a path a -> b -> c. WARNING: O(v³) complexity - use with care *) (** {1 Debugging} *) val dump : ('a -> string) -> 'a t -> unit (** [dump to_string dag] prints the DAG structure to stdout for debugging *) val to_dot : ('a -> string) -> string -> bool -> 'a t -> string (** [to_dot to_string name from_leaf dag] generates a GraphViz DOT representation. - [to_string]: function to convert nodes to strings - [name]: name of the graph - [from_leaf]: if [true], edges point from leaves to roots *) obuild-0.2.2/lib/core/dagutils.ml000066400000000000000000000016771515212760700166560ustar00rootroot00000000000000let iter f dag = let tdep = Taskdep.init dag in while not (Taskdep.is_complete tdep) do match Taskdep.get_next tdep with | None -> failwith "taskdep dag next didn't work" | Some (_,task) -> f task; Taskdep.mark_done tdep task done let iteri f dag = let tdep = Taskdep.init dag in while not (Taskdep.is_complete tdep) do match Taskdep.get_next tdep with | None -> failwith "taskdep dag next didn't work" | Some (idx,task) -> f idx task; Taskdep.mark_done tdep task done let linearize dag = let tdep = Taskdep.init dag in let rec loop () = if Taskdep.is_complete tdep then [] else ( match Taskdep.get_next tdep with | None -> failwith "taskdep dag next didn't work" | Some (_,task) -> Taskdep.mark_done tdep task; task :: loop () ) in loop () obuild-0.2.2/lib/core/dagutils.mli000066400000000000000000000014101515212760700170100ustar00rootroot00000000000000(** DAG Utility Functions This module provides iteration and linearization utilities for DAGs (Directed Acyclic Graphs). It uses the Taskdep module to traverse DAGs in topological order. *) (** Iterate over DAG nodes in topological order @param f Function to apply to each node @param dag The DAG to iterate over *) val iter : ('a -> unit) -> 'a Dag.t -> unit (** Iterate over DAG nodes with indices in topological order @param f Function to apply to each node with its index @param dag The DAG to iterate over *) val iteri : (int -> 'a -> unit) -> 'a Dag.t -> unit (** Linearize a DAG into a topologically sorted list @param dag The DAG to linearize @return List of nodes in topological order *) val linearize : 'a Dag.t -> 'a list obuild-0.2.2/lib/core/dependencies.ml000066400000000000000000000051671515212760700174660ustar00rootroot00000000000000open Filepath open Compat exception BuildDepAnalyzeFailed of string exception BuildCDepAnalyzeFailed of string exception DependencyMissing of string exception DependenciesMissing of string list exception DependencyFailedParsing of string type dependency = Libname.t * Expr.t option type cdependency = string * Expr.t option type dep_opt = { dep_includes : filepath list; dep_pp : Pp.t; } let parse_output_KsemiVs onNonKV mapFstTy mapSndTys out = List.map (fun (k, mv) -> match mv with | None -> onNonKV k | Some v -> (mapFstTy k, List.map mapSndTys (String_utils.words_noempty v))) (List.map Utils.toKV (String_utils.lines_noempty out)) (* return the (modules list) dependency for a specific file *) let run_ocamldep dopt srcFile = let wrap_module_safe f = try Modname.wrap f with Modname.InvalidModuleName _ | Modname.EmptyModuleName -> raise (BuildDepAnalyzeFailed ("ocamldep returned a bad module name " ^ f)) in let fileType = Filetype.of_filepath srcFile in let baseFile = fp_to_string srcFile in let files = if fileType = Filetype.FileML then [ baseFile; baseFile ^ "i" ] else [ baseFile ] in let args = [ Prog.get_ocamldep () ] @ Utils.to_include_path_options dopt.dep_includes @ Pp.to_params dopt.dep_pp @ [ "-modules" ] @ files in match Process.run args with | Process.Failure er -> raise (BuildDepAnalyzeFailed er) | Process.Success (out, _, _) -> List.map snd (parse_output_KsemiVs (fun _ -> raise (BuildDepAnalyzeFailed ("assumption failed: " ^ out))) fp wrap_module_safe out) (* TODO * gcc escape spaces in filename with a \, tweak strings_words_noempty * to take that in consideration. *) let joinLines s = let s = bytes_of_string s in let s_end = bytes_length s in let rec replace start = try let index = bytes_index_from s start '\\' in if index < s_end - 1 then if bytes_get s (index + 1) = '\n' then begin bytes_set s index ' '; bytes_set s (index + 1) ' '; replace (index + 2) end else replace (index + 1) else s with Not_found -> s in bytes_to_string (replace 0) let run_ccdep srcDir files : (filename * filepath list) list = let args = [ Prog.get_cc (); "-MM" ] @ List.map (fun fn -> fp_to_string (srcDir fn)) files in match Process.run args with | Process.Failure err -> raise (BuildCDepAnalyzeFailed err) | Process.Success (out, _, _) -> parse_output_KsemiVs (fun _ -> raise (BuildCDepAnalyzeFailed "missing semicolon in gcc dependency output")) fn fp (joinLines out) obuild-0.2.2/lib/core/dependencies.mli000066400000000000000000000036361515212760700176360ustar00rootroot00000000000000(** Dependency analysis for OCaml and C code *) (** Exception raised when OCaml dependency analysis fails *) exception BuildDepAnalyzeFailed of string (** Exception raised when C dependency analysis fails *) exception BuildCDepAnalyzeFailed of string (** Exception raised when a single dependency is missing *) exception DependencyMissing of string (** Exception raised when multiple dependencies are missing *) exception DependenciesMissing of string list (** Exception raised when dependency parsing fails *) exception DependencyFailedParsing of string (** OCaml library dependency with optional version constraint *) type dependency = Libname.t * (Expr.t option) (** C package dependency with optional version constraint *) type cdependency = string * (Expr.t option) (** Dependency analysis options *) type dep_opt = { dep_includes : Filepath.filepath list; (** Include paths for dependency analysis *) dep_pp : Pp.t; (** Preprocessor to use *) } val run_ocamldep : dep_opt -> Filepath.filepath -> Modname.t list list (** [run_ocamldep dopt src_file] analyzes OCaml module dependencies Runs ocamldep to determine which modules a source file depends on. Returns a list of module lists (for .ml and .mli if both exist). @param dopt dependency analysis options @param src_file source file to analyze @return list of module dependency lists @raise BuildDepAnalyzeFailed if ocamldep fails or returns invalid output *) val run_ccdep : Filepath.filepath -> Filepath.filename list -> (Filepath.filename * Filepath.filepath list) list (** [run_ccdep src_dir files] analyzes C file dependencies Runs gcc -MM to determine C file dependencies (headers, etc.). @param src_dir source directory containing C files @param files C source files to analyze @return list of (object_file, dependency_files) pairs @raise BuildCDepAnalyzeFailed if gcc dependency analysis fails *) obuild-0.2.2/lib/core/dist.ml000066400000000000000000000045021515212760700157730ustar00rootroot00000000000000open Fugue open Filepath type t = | Autogen | Dot | Target of Target.Name.t let to_string = function | Autogen -> "autogen" | Dot -> "dot" | Target n -> "target(" ^ Target.Name.to_string n ^ ")" let to_filename = function | Target tn -> Target.Name.to_dirname tn | Dot -> fn "dot" | Autogen -> fn "autogen" exception DistNotADirectory exception MissingDestinationDirectory of t exception DistNotFound exception DistFileNotFound of string let path = ref (fp "dist") let set_path p = path := p let get_path () = !path let setup_path = get_path () fn "setup" let configure_path = get_path () fn "configure" let build_path = get_path () fn "build" let check_exn f = if Filesystem.exists (get_path ()) then if Sys.is_directory $ fp_to_string (get_path ()) then () else raise DistNotADirectory else f () let exist () = check_exn (fun () -> raise DistNotFound) let create_maybe () = check_exn (fun () -> let _ = Filesystem.mkdir_safe (get_path ()) 0o755 in ()) let get_build () = get_path () fn "build" let get_build_path buildtype = get_build () to_filename buildtype let get_build_exn buildtype = let dist = get_build_path buildtype in if not (Filesystem.is_dir dist) then raise (MissingDestinationDirectory buildtype) else dist let create_build buildtype = let _ = Filesystem.mkdir_safe (get_build ()) 0o755 in let dest = get_build_path buildtype in let _ = Filesystem.mkdir_safe dest 0o755 in dest let read_dist_file path = try let content = Filesystem.read_file path in hashtbl_from_list (List.map (fun l -> second (default "") $ Utils.toKV l) $ String_utils.split '\n' content) with Sys_error _ | Unix.Unix_error _ -> raise (DistFileNotFound (fp_to_string path)) let read_setup () = read_dist_file setup_path let read_configure () = read_dist_file configure_path let write_setup setup = let kv (k, v) = k ^ ": " ^ v in Filesystem.write_file setup_path (String.concat "\n" $ List.map kv (hashtbl_to_list setup)) let remove_dead_links () = let files = Sys.readdir "." in let build_path = fp_to_string (get_build ()) in Array.iter (fun fn -> try let l = Unix.readlink fn in if String_utils.startswith build_path l then Sys.remove fn with Unix.Unix_error _ | Sys_error _ -> ()) files obuild-0.2.2/lib/core/dist.mli000066400000000000000000000026711515212760700161510ustar00rootroot00000000000000(** Distribution directory management *) (** Build directory type *) type t = | Autogen (** Auto-generated files *) | Dot (** DOT graph files *) | Target of Target.Name.t (** Target-specific directory *) val to_string : t -> string (** Convert build directory type to string *) exception DistNotADirectory exception MissingDestinationDirectory of t exception DistNotFound exception DistFileNotFound of string val set_path : Filepath.filepath -> unit val get_path : unit -> Filepath.filepath val build_path : Filepath.filepath val setup_path : Filepath.filepath val configure_path : Filepath.filepath val check_exn : (unit -> unit) -> unit (** Check dist directory exists, call function if it doesn't *) val exist : unit -> unit (** Check dist directory exists, raise DistNotFound if not *) val create_maybe : unit -> unit (** Create dist directory if it doesn't exist *) val get_build : unit -> Filepath.filepath val get_build_path : t -> Filepath.filepath val get_build_exn : t -> Filepath.filepath (** Get build path, raise MissingDestinationDirectory if doesn't exist *) val create_build : t -> Filepath.filepath (** Create and return build directory for given type *) val read_setup : unit -> (string, string) Hashtbl.t val read_configure : unit -> (string, string) Hashtbl.t val write_setup : (string, string) Hashtbl.t -> unit val remove_dead_links : unit -> unit (** Remove symlinks pointing to build directories *) obuild-0.2.2/lib/core/exception.ml000066400000000000000000000121451515212760700170300ustar00rootroot00000000000000open Printf open Helper open Filepath (* TODO normalize exit code *) let show exn = let error fmt = eprintf ("%serror%s: " ^^ fmt) (color_white ()) (color_white ()) in match exn with | Arg.Bad err -> eprintf "%s\n" err; exit 2 | Arg.Help h -> eprintf "%s\n" h; exit 0 (* project file related *) | Project.NoConfFile -> error "couldn't find obuild file\n"; exit 3 | Project.MultipleConfFiles -> error "multiples obuild files found\n"; exit 3 | Project.FileNotFound (t, f) -> error "project is referencing in %s, a file %s that cannot be found\n" (Target.get_target_name t) (fn_to_string f); exit 3 | Project.ModuleNotFound (t, m) -> error "project is referencing in '%s', a module %s that cannot be found\n" (Target.get_target_name t) (Hier.to_string m); exit 3 | Project.ModuleListEmpty l -> error "library %s doesn't have any modules defined.\n" (Libname.to_string l); exit 3 | Project.InvalidConfFile c -> error "configuration file appears invalid: %s\n" c; exit 3 | Project.BlockSectionAsValue s -> error "trying to define a section %s using parameter syntax:\n" s; eprintf " spurious colon between section definition and section name\n"; exit 3 | Project.BadOcamlVersion (ver, c) -> error "wrong ocaml version: actual %s expected %s\n" ver (Expr.to_string c); exit 3 | Expr.CannotParseConstraints (builddep, s) -> error "cannot parse constraints for build dependency '%s': %s\n" builddep s; exit 3 (* dist directory related *) | Dist.DistNotADirectory -> error "dist is not a directory\n"; exit 4 | Dist.DistNotFound -> error "run 'obuild configure' first\n"; exit 4 | Dist.MissingDestinationDirectory dir -> error "missing destination directory: %s\n" (Dist.to_string dir); exit 4 (* types stuff *) | Target.TargetNameNoType s -> error "Unknown target '%s' with no prefix:\n" s; error " targets need to start by one of lib-,exe-,bench-,test-,example-\n"; exit 4 | Target.TargetUnknownType (p, s) -> error "unknown type prefix '%s' in '%s':\n" p s; error " targets need to start by one of lib-,exe-,bench-,test-,example-\n"; exit 4 | Target.TargetNotRecognized s -> error "Unknown target specified '%s'\n" s; exit 4 (* reconfigure *) | Configure.ConfigChanged r -> ( match r with | "digest" -> error "project file changed. run 'obuild configure' again\n"; exit 4 | _ -> error "config changed (reason=%s). run 'obuild configure' again\n" r; exit 4) | Configure.ConfigurationMissingKey k -> error "cannot find key %s in setup. run 'obuild configure' again\n" k; exit 4 | Configure.ConfigurationTypeMismatch (k, t, v) -> error "%s type mismatch (got '%s') in setup key %s. run 'obuild configure' again\n" t v k; exit 4 | Meta.MetaParseError (fp, err) -> error "unexpected parse error '%s' in meta file %s\n" err (fp_to_string fp); exit 4 | Meta.ArchiveNotFound (path, dep, preds) -> error "archive %s not found in %s (%s)\n" (Utils.showList "," Meta.Predicate.to_string preds) (Libname.to_string dep) (fp_to_string path); exit 4 | Analyze.SublibraryNotFound dep -> error "dependency %s not found\n" (Libname.to_string dep); exit 4 (* build related failure *) | Prepare.Module.DependsItself m -> error "cyclic dependency module detected in module %s\n" (Hier.to_string m); exit 5 | Prepare.Module.NotFound (paths, m) -> error "module not found %s - search paths:\n" (Hier.to_string m); List.iter (fun path -> eprintf "\t%s\n" (fp_to_string path)) paths; exit 5 | Prepare.Module.DependenciesProblem l -> error "cyclic dependency detected. cannot infer dependencies between modules:\n"; eprintf "\t%s\n" (Utils.showList ", " Hier.to_string l); exit 5 | Build.CompilationFailed e -> eprintf "\n%s\n%!" e; exit 6 | Build.CCompilationFailed e -> eprintf "\n%s\n%!" e; exit 6 | Buildprogs.LinkingFailed e -> eprintf "\n%s\n%!" e; exit 7 | Dependencies.BuildDepAnalyzeFailed e -> eprintf "\n%s\n%!" e; exit 8 | Dependencies.DependenciesMissing missing -> ( match missing with | [] -> assert false | [dep] -> error "missing dependency '%s'\n" dep; exit 9 | _ -> eprintf "missing dependencies:\n%s\n" (Utils.showList "\n" (fun x -> x) missing); exit 9) (* others exception *) | Unix.Unix_error (err, fname, params) -> error "unexpected unix error: \"%s\" during %s(%s)\n" (Unix.error_message err) fname params; exit 20 | Filepath.InvalidFilename f -> error "the filename \"%s\" is not valid, it contains a directory separator\n" f; exit 30 | Utils.FileNotFoundInPaths (ds, f) -> error "File %s not found in directories %s\n" (fn_to_string f) (Utils.showList "; " fp_to_string ds); exit 40 | Exit -> () | e -> eprintf "uncaught exception\n"; raise e obuild-0.2.2/lib/core/exception.mli000066400000000000000000000005261515212760700172010ustar00rootroot00000000000000(** Exception handling and error reporting *) val show : exn -> unit (** Handle and display exception with appropriate error message and exit code. Matches against known exceptions from various modules (Project, Dist, Configure, Build, etc.) and prints formatted error messages before exiting with module-specific exit codes. *) obuild-0.2.2/lib/core/expr.ml000066400000000000000000000204461515212760700160130ustar00rootroot00000000000000exception UnknownSymbol of (string * string) exception UnknownExpression of string exception ExpressionEmpty exception UnbalancedParenthesis exception MalformedExpression exception InvalidDependencyName of string exception CannotParseConstraints of (string * string) type version = string module Token = struct type t = | VER of string (* version *) | ID of string (* ident *) | LPAREN | RPAREN | AND | OR | NOT | EQ | NE | GT | LT | GE | LE let to_string = function | VER v -> v | ID s -> s | LPAREN -> "(" | RPAREN -> ")" | AND -> "&" | OR -> "|" | NOT -> "!" | EQ -> "==" | NE -> "!=" | GT -> ">" | LT -> "<" | GE -> ">=" | LE -> "<=" let of_string symbol s = match symbol with | "&&" | "&" -> AND | "||" | "|" -> OR | ">" -> GT | "<" -> LT | ">=" -> GE | "<=" -> LE | "==" | "=" -> EQ | "!=" | "/=" -> NE | "!" -> NOT | _ -> raise (UnknownSymbol (symbol, s)) let process_one_char c next = match (c, next) with | '(', _ -> LPAREN | ')', _ -> RPAREN | '!', Some '=' -> raise Not_found (* should be parsed as a string != *) | '!', _ -> NOT | _ -> raise Not_found (* valid char per types *) let is_symbol_char c = try let _ = String.index "&/|!+=><()" c in true with Not_found -> false let is_ident_char c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9') || c == '_' || c == '.' || c == '-' let is_version_char c = (c >= '0' && c <= '9') || c = '.' || c = '*' let lexer s = let len = String.length s in let while_pred pred o = let i = ref o in while !i < len && pred s.[!i] do i := !i + 1 done; (String.sub s o (!i - o), !i) in (* Per type lexer *) let eat_symbol o = let tok, no = let next = if o + 1 < len then Some s.[o + 1] else None in try let tok = process_one_char s.[o] next in (tok, o + 1) with Not_found -> let p, no = while_pred is_symbol_char o in let tok = of_string p s in (tok, no) in (tok, no) in let eat_version o = while_pred is_version_char o in let eat_ident o = while_pred is_ident_char o in (* main lexing loop *) let rec loop o = if o >= len then [] else begin (* TODO skip chunk of space in one go *) if s.[o] == ' ' || s.[o] == '\t' then loop (o + 1) else if is_symbol_char s.[o] then let sym, no = eat_symbol o in sym :: loop no else if (s.[o] >= 'a' && s.[o] <= 'z') || (s.[o] >= 'A' && s.[o] <= 'Z') then let id, no = eat_ident o in ID id :: loop no else if is_version_char s.[o] then let ver, no = eat_version o in VER ver :: loop no else failwith (Printf.sprintf "unknown character in expression '%c'" s.[o]) end in loop 0 end type t = | And of t * t | Or of t * t | Not of t | Paren of t | Eq of version | Le of version | Lt of version | Ge of version | Gt of version | Ne of version let compare_version v1 v2 = let skip i p s e = let rec loop i = if i = e then i else if p s.[i] then loop (i + 1) else i in loop i in let split_version v = let p1, rest = match String_utils.split ':' v ~limit:2 with | [ _ ] -> ("", v) | [ p1; rest ] -> (p1, rest) in let p1, p2, p3 = match String_utils.split '-' rest ~limit:2 with | [ _ ] -> (p1, rest, "") | [ p2; p3 ] -> (p1, p2, p3) in (p1, p2, p3) in let compare_part p1 p2 = let l1 = String.length p1 in let l2 = String.length p2 in let is_digit = function | '0' .. '9' -> true | _ -> false in let rec loop i1 i2 = let compare_numbers i1 i2 = let rec loop_numbers n1 n2 last = if n2 = last then loop n1 n2 else let comp = Char.compare p1.[n1] p2.[n2] in if comp = 0 then loop_numbers (n1 + 1) (n2 + 1) last else comp in let end1 = skip i1 is_digit p1 l1 in let end2 = skip i2 is_digit p2 l2 in let comp = compare (end1 - i1) (end2 - i2) in if comp = 0 then loop_numbers i1 i2 end1 else comp in match (i1 = l1, i2 = l2) with | true, true -> 0 | true, false -> let end2 = skip i2 (fun c -> c = '0') p2 l2 in if end2 = l2 then 0 else -1 | false, true -> let end1 = skip i1 (fun c -> c = '0') p1 l1 in if end1 = l1 then 0 else 1 | false, false -> ( match (is_digit p1.[i1], is_digit p2.[i2]) with | true, true -> compare_numbers (skip i1 (fun c -> c = '0') p1 l1) (skip i2 (fun c -> c = '0') p2 l2) | true, false -> -1 | false, true -> 1 | false, false -> let comp = Char.compare p1.[i1] p2.[i2] in if comp = 0 then loop (i1 + 1) (i2 + 1) else comp) in loop 0 0 in if v1 = v2 then 0 else let v1_1, v1_2, v1_3 = split_version v1 in let v2_1, v2_2, v2_3 = split_version v2 in let c1 = compare_part v1_1 v2_1 in if c1 <> 0 then c1 else let c2 = compare_part v1_2 v2_2 in if c2 <> 0 then c2 else compare_part v1_3 v2_3 let rec eval version constr = match constr with | And (e1, e2) -> eval version e1 && eval version e2 | Or (e1, e2) -> eval version e1 || eval version e2 | Not e -> not (eval version e) | Paren e -> eval version e | Eq v -> compare_version version v = 0 | Le v -> compare_version version v <= 0 | Lt v -> compare_version version v < 0 | Ge v -> compare_version version v >= 0 | Gt v -> compare_version version v > 0 | Ne v -> compare_version version v <> 0 let rec to_string = function | And (e1, e2) -> to_string e1 ^ " && " ^ to_string e2 | Or (e1, e2) -> to_string e1 ^ " || " ^ to_string e2 | Not e -> "! " ^ to_string e | Paren e -> "(" ^ to_string e ^ ")" | Eq v -> "=" ^ v | Le v -> "<=" ^ v | Lt v -> "<" ^ v | Ge v -> ">=" ^ v | Gt v -> ">" ^ v | Ne v -> "!=" ^ v let showList sep f l = String.concat sep (List.map f l) let parse_expr l = let rec parse_sub_expr l = match l with | [] -> raise MalformedExpression | Token.NOT :: r -> let e, r = parse_sub_expr r in (Not e, r) | Token.LPAREN :: r -> let e, r = parse_sub_expr r in let rec loop e r = match r with | Token.RPAREN :: r -> (Paren e, r) | Token.OR :: _ | Token.AND :: _ -> let e, r = parse_bin_expr e r in loop e r | _ -> raise UnbalancedParenthesis in loop e r | Token.GT :: Token.VER v :: r -> (Gt v, r) | Token.GE :: Token.VER v :: r -> (Ge v, r) | Token.EQ :: Token.VER v :: r -> (Eq v, r) | Token.LT :: Token.VER v :: r -> (Lt v, r) | Token.LE :: Token.VER v :: r -> (Le v, r) | Token.NE :: Token.VER v :: r -> (Ne v, r) | z -> raise (UnknownExpression (showList "," Token.to_string z)) and parse_bin_expr expr l = match l with | Token.OR :: r -> let e, r = parse_sub_expr r in (Or (expr, e), r) | Token.AND :: r -> let e, r = parse_sub_expr r in (And (expr, e), r) | _ -> raise MalformedExpression in let e, r = parse_sub_expr l in let rec loop e r = match r with | [] -> e | _ -> let e, r = parse_bin_expr e r in loop e r in loop e r let parse_constraints name cs = try match cs with | [] -> None | expr -> let e = parse_expr expr in Some e with e -> let err = match e with | UnknownExpression z -> "unknown constraints expression \"" ^ z ^ "\"" | UnbalancedParenthesis -> "unbalanced parenthesis" | MalformedExpression -> "malformed expression" | _ -> Printexc.to_string e in raise (CannotParseConstraints (name, err)) let parse name s = match Token.lexer s with | [] -> raise ExpressionEmpty | constraints -> parse_constraints name constraints let parse_builddep s = match Token.lexer s with | [] -> raise ExpressionEmpty | Token.ID name :: constraints -> (name, parse_constraints name constraints) | x :: _ -> raise (InvalidDependencyName (Token.to_string x)) obuild-0.2.2/lib/core/expr.mli000066400000000000000000000061451515212760700161640ustar00rootroot00000000000000(** Expression parsing and evaluation for version constraints This module provides parsing and evaluation of boolean expressions used for version constraints in dependencies (e.g., ">= 1.2.0 && < 2.0.0"). *) (** {1 Exceptions} *) exception UnknownSymbol of (string * string) (** Raised when an unknown operator symbol is encountered *) exception UnknownExpression of string (** Raised when expression cannot be parsed *) exception ExpressionEmpty (** Raised when expression string is empty *) exception UnbalancedParenthesis (** Raised when parentheses don't match *) exception MalformedExpression (** Raised when expression has invalid structure *) exception InvalidDependencyName of string (** Raised when dependency name is invalid *) exception CannotParseConstraints of (string * string) (** Raised when constraint expression parsing fails. First string is the package name, second is the error message *) (** {1 Types} *) type version = string (** Version string (e.g., "1.2.3", "4.02.0+beta1") *) type t = | And of t * t (** Conjunction: both constraints must hold *) | Or of t * t (** Disjunction: either constraint can hold *) | Not of t (** Negation: constraint must not hold *) | Paren of t (** Parenthesized expression *) | Eq of version (** Equality: version must equal specified version *) | Le of version (** Less than or equal: version <= specified *) | Lt of version (** Less than: version < specified *) | Ge of version (** Greater than or equal: version >= specified *) | Gt of version (** Greater than: version > specified *) | Ne of version (** Not equal: version != specified *) (** Version constraint expression AST *) (** {1 Expression Operations} *) val compare_version : version -> version -> int (** [compare_version v1 v2] compares two version strings. Returns -1 if v1 < v2, 0 if v1 = v2, 1 if v1 > v2. Handles complex version formats including epoch, release, and patch parts *) val eval : version -> t -> bool (** [eval version constraint] evaluates whether a version satisfies a constraint. @param version The version to test @param constraint The constraint expression @return true if version satisfies the constraint *) val to_string : t -> string (** [to_string expr] converts constraint expression to string representation *) (** {1 Parsing} *) val parse : string -> string -> t option (** [parse name expr_str] parses a version constraint expression. @param name Package name (for error messages) @param expr_str The constraint expression string @return [Some constraint] if parsing succeeds, [None] if expression is empty @raise CannotParseConstraints if parsing fails *) val parse_builddep : string -> (string * t option) (** [parse_builddep dep_str] parses a build dependency with optional constraints. Format: "package_name constraint_expr" Example: "unix >= 4.02.0" @return Tuple of (package_name, optional_constraint) @raise InvalidDependencyName if package name is invalid @raise CannotParseConstraints if constraint expression is invalid *) obuild-0.2.2/lib/core/filetype.ml000066400000000000000000000043401515212760700166510ustar00rootroot00000000000000open Filepath type t = | FileML | FileMLI | FileH | FileC | FileCMX | FileCMO | FileCMI | FileCMA | FileCMXA | FileCMXS | FileCMT | FileCMTI | FileO | FileA | FileSO | FileEXE | FileObj (* Windows .obj *) | FileLib (* Windows .lib *) | FileDylib (* macOS .dylib *) | FileOther of string let of_string s = match s with | "ml" -> FileML | "mli" -> FileMLI | "h" -> FileH | "c" -> FileC | "cmx" -> FileCMX | "cmo" -> FileCMO | "cmi" -> FileCMI | "cma" -> FileCMA | "cmxa" -> FileCMXA | "cmxs" -> FileCMXS | "cmt" -> FileCMT | "cmti" -> FileCMTI | "o" -> FileO | "a" -> FileA | "so" -> FileSO | "exe" -> FileEXE | "obj" -> FileObj | "lib" -> FileLib | "dylib" -> FileDylib | _ -> FileOther s let to_string fty = match fty with | FileML -> "ml" | FileMLI -> "mli" | FileH -> "h" | FileC -> "c" | FileCMX -> "cmx" | FileCMO -> "cmo" | FileCMI -> "cmi" | FileCMA -> "cma" | FileCMXA -> "cmxa" | FileCMXS -> "cmxs" | FileCMT -> "cmt" | FileCMTI -> "cmti" | FileO -> "o" | FileA -> "a" | FileSO -> "so" | FileEXE -> "exe" | FileObj -> "obj" | FileLib -> "lib" | FileDylib -> "dylib" | FileOther s -> s type id = { fdep_ty : t; fdep_path : filepath; } let make_id (ty, p) = { fdep_ty = ty; fdep_path = p } let get_id fdep = (fdep.fdep_ty, fdep.fdep_path) let get_type fdep = fdep.fdep_ty let get_path fdep = fdep.fdep_path let of_filename (name : filename) : t = try let nameUnpack = fn_to_string name in let len = String.length (Filename.chop_extension nameUnpack) in (* +1 to remove the dot *) of_string (String.sub nameUnpack (len + 1) (String.length nameUnpack - len - 1)) with Invalid_argument _ -> FileEXE (* no extension: assume executable *) let of_filepath (path : filepath) : t = of_filename (path_basename path) let replace_extension (name : filename) ext = let extStr = to_string ext in try let choppedName = Filename.chop_extension (fn_to_string name) in fn (String.concat "." [ choppedName; extStr ]) with Invalid_argument _ -> fn (fn_to_string name ^ "." ^ extStr) let replace_extension_path path ext = let dir = path_dirname path in dir replace_extension (path_basename path) ext obuild-0.2.2/lib/core/filetype.mli000066400000000000000000000043441515212760700170260ustar00rootroot00000000000000(** File type identification and manipulation *) (** File type enumeration *) type t = | FileML (** OCaml implementation file (.ml) *) | FileMLI (** OCaml interface file (.mli) *) | FileH (** C header file (.h) *) | FileC (** C source file (.c) *) | FileCMX (** Native compiled object file (.cmx) *) | FileCMO (** Bytecode compiled object file (.cmo) *) | FileCMI (** Compiled interface file (.cmi) *) | FileCMA (** Bytecode library archive (.cma) *) | FileCMXA (** Native library archive (.cmxa) *) | FileCMXS (** Native plugin (.cmxs) *) | FileCMT (** Compiled typed abstract syntax tree (.cmt) *) | FileCMTI (** Compiled interface typed abstract syntax tree (.cmti) *) | FileO (** Object file (.o) *) | FileA (** Static archive (.a) *) | FileSO (** Shared object (.so) *) | FileEXE (** Executable (.exe) *) | FileObj (** Windows object file (.obj) *) | FileLib (** Windows static library (.lib) *) | FileDylib (** macOS dynamic library (.dylib) *) | FileOther of string (** Other file type with extension *) val of_string : string -> t (** Parse file type from extension string *) val to_string : t -> string (** Convert file type to extension string *) (** File dependency identifier combining type and path *) type id = { fdep_ty : t; (** File type *) fdep_path : Filepath.filepath; (** File path *) } val make_id : t * Filepath.filepath -> id (** Create file dependency identifier from type and path *) val get_id : id -> t * Filepath.filepath (** Extract type and path from file dependency identifier *) val get_type : id -> t (** Get file type from identifier *) val get_path : id -> Filepath.filepath (** Get file path from identifier *) val of_filename : Filepath.filename -> t (** Determine file type from filename extension *) val of_filepath : Filepath.filepath -> t (** Determine file type from filepath extension *) val replace_extension : Filepath.filename -> t -> Filepath.filename (** Replace filename extension with given file type *) val replace_extension_path : Filepath.filepath -> t -> Filepath.filepath (** Replace filepath extension with given file type *) obuild-0.2.2/lib/core/findlibConf.ml000066400000000000000000000033201515212760700172420ustar00rootroot00000000000000open Filepath type t = { path : filepath list; destdir : filepath option; _all : (string * string option) list; (* kept for potential future use *) _loaded : bool; (* kept for potential future use *) } let default = { _all = []; path = []; destdir = None; _loaded = false } let conf = ref default let parse_file path = let content = Filesystem.read_file path in let unquote s = match s with | None -> failwith "unknown configuration key with no value" | Some x -> String_utils.init 1 (String_utils.drop 1 x) in let kvs = List.map Utils.toKVeq (String_utils.lines_noempty content) in let paths = String_utils.split ':' (unquote (List.assoc "path" kvs)) in let destdir = unquote (List.assoc "destdir" kvs) in { _all = kvs; path = List.map fp paths; destdir = Some (fp destdir); _loaded = true } let get_program_config () = match Process.run [ "ocamlfind"; "printconf"; "conf" ] with | Process.Failure err -> failwith ("ocamlfind printconf failed err " ^ err) | Process.Success (out, _, _) -> ( match String_utils.lines_noempty out with | [ x ] -> [ fp x ] | _ -> failwith ("ocamlfind printconf failed output: " ^ out)) let get_paths () = try [ fp (Sys.getenv "OCAMLFIND_CONF") ] with Not_found -> ( try get_program_config () with Failure _ | Not_found -> [ fp "/etc/findlib.conf"; fp "/etc/ocamlfind.conf" ]) let get_system () = let paths = get_paths () in try let found_path = List.find Filesystem.exists paths in parse_file found_path with Not_found -> default let load () = match Gconf.get_env "findlib-path" with | None -> conf := get_system () | Some p -> conf := parse_file (fp p) let get_paths () = !conf.path let get_destdir () = !conf.destdir obuild-0.2.2/lib/core/findlibConf.mli000066400000000000000000000021641515212760700174200ustar00rootroot00000000000000(** OCamlfind configuration file parsing This module handles reading and parsing OCamlfind/findlib configuration files to locate library search paths. *) (** {1 Configuration Loading} *) val load : unit -> unit (** [load ()] loads the OCamlfind configuration from the system. Configuration sources (in priority order): 1. User-specified path via [-findlib-path] flag 2. [OCAMLFIND_CONF] environment variable 3. Output of [ocamlfind printconf conf] 4. Default paths: [/etc/findlib.conf] or [/etc/ocamlfind.conf] This function should be called before using {!get_paths}. *) val get_paths : unit -> Filepath.filepath list (** [get_paths ()] returns the library search paths from the loaded configuration. @return List of directory paths where OCaml libraries are installed Note: Call {!load} first to populate the configuration *) val get_destdir : unit -> Filepath.filepath option (** [get_destdir ()] returns the destination directory for library installation. @return [Some path] if destdir is configured, [None] otherwise Note: Call {!load} first to populate the configuration *) obuild-0.2.2/lib/core/gconf.ml000066400000000000000000000105341515212760700161260ustar00rootroot00000000000000open Fugue type verbosity_t = | Silent | Report | Verbose | Debug | Trace type t = { mutable verbosity : verbosity_t; mutable parallel_jobs : int; mutable dump_dot : bool; mutable color : bool; mutable bin_annot : bool; mutable bin_annot_occurrences : bool; mutable short_path : bool; mutable ocamlmklib : bool; mutable ocaml_extra_args : string list; } type target_option = | Executable_profiling | Executable_debugging | Executable_native | Executable_bytecode | Executable_as_obj | Library_profiling | Library_debugging | Library_native | Library_bytecode | Library_plugin | Build_benchs | Build_tests | Build_examples | Annot let all_target_options = [ Executable_profiling; Executable_debugging; Executable_native; Executable_bytecode; Executable_as_obj; Library_profiling; Library_debugging; Library_native; Library_bytecode; Library_plugin; Build_benchs; Build_tests; Build_examples; Annot; ] let target_option_to_string = function | Executable_profiling -> "executable-profiling" | Executable_debugging -> "executable-debugging" | Executable_native -> "executable-native" | Executable_bytecode -> "executable-bytecode" | Executable_as_obj -> "executable-as-obj" | Library_profiling -> "library-profiling" | Library_debugging -> "library-debugging" | Library_native -> "library-native" | Library_bytecode -> "library-bytecode" | Library_plugin -> "library-plugin" | Build_benchs -> "build-benchs" | Build_tests -> "build-tests" | Build_examples -> "build-examples" | Annot -> "annot" exception UnknownOption of string let target_option_of_string = function | "executable-profiling" -> Executable_profiling | "executable-debugging" -> Executable_debugging | "executable-native" -> Executable_native | "executable-bytecode" -> Executable_bytecode | "executable-as-obj" -> Executable_as_obj | "library-profiling" -> Library_profiling | "library-debugging" -> Library_debugging | "library-native" -> Library_native | "library-bytecode" -> Library_bytecode | "library-plugin" -> Library_plugin | "build-benchs" -> Build_benchs | "build-tests" -> Build_tests | "build-examples" -> Build_examples | "annot" -> Annot | s -> raise (UnknownOption s) let env_variables = [ "ocamlopt"; "ocamlc"; "ocaml"; "ocamldep"; "ocamldoc"; "ocamlmklib"; "ocamlmktop"; "cc"; "ranlib"; "ar"; "ld"; "pkg-config"; "camlp4"; "findlib-path"; ] let env_ = let h : (string, string option) Hashtbl.t = Hashtbl.create (List.length env_variables) in List.iter (fun v -> Hashtbl.add h v None) env_variables; h let get_env field = try Hashtbl.find env_ field with Not_found -> raise (UnknownOption field) let set_env field value = if not (Hashtbl.mem env_ field) then raise (UnknownOption field); Hashtbl.replace env_ field (Some value) let target_options_ = let h = Hashtbl.create (List.length all_target_options) in List.iter (fun opt -> let default = match opt with | Executable_native | Library_native | Library_bytecode -> true | Library_plugin -> Sys.os_type = "Unix" | _ -> false in Hashtbl.add h opt default) all_target_options; h let rec set_target_option_typed opt value = Hashtbl.replace target_options_ opt value; match (opt, value) with | Executable_profiling, true -> set_target_option_typed Library_profiling true | Executable_debugging, true -> set_target_option_typed Library_debugging true | Library_plugin, true -> set_target_option_typed Library_native true | Library_native, false -> set_target_option_typed Library_plugin false | _ -> () let set_target_options field value = set_target_option_typed (target_option_of_string field) value let get_target_options_keys () = List.map target_option_to_string all_target_options let get_target_options () = Hashtbl.fold (fun k v acc -> (target_option_to_string k, v) :: acc) target_options_ [] let get_target_option_typed opt = try Hashtbl.find target_options_ opt with Not_found -> false let get_target_option field = get_target_option_typed (target_option_of_string field) let defaults = { verbosity = Report; parallel_jobs = 2; dump_dot = false; color = false; bin_annot = true; bin_annot_occurrences = false; short_path = false; ocamlmklib = true; ocaml_extra_args = []; } let gconf = defaults obuild-0.2.2/lib/core/gconf.mli000066400000000000000000000035321515212760700162770ustar00rootroot00000000000000(** Global configuration *) (** Verbosity levels *) type verbosity_t = | Silent (** No output *) | Report (** Normal output *) | Verbose (** Verbose output *) | Debug (** Debug output *) | Trace (** Debug with command output *) type t = { mutable verbosity : verbosity_t; mutable parallel_jobs : int; mutable dump_dot : bool; mutable color : bool; mutable bin_annot : bool; mutable bin_annot_occurrences : bool; mutable short_path : bool; mutable ocamlmklib : bool; mutable ocaml_extra_args : string list; } (** Global configuration record *) (** Typed target options *) type target_option = | Executable_profiling | Executable_debugging | Executable_native | Executable_bytecode | Executable_as_obj | Library_profiling | Library_debugging | Library_native | Library_bytecode | Library_plugin | Build_benchs | Build_tests | Build_examples | Annot val target_option_to_string : target_option -> string val target_option_of_string : string -> target_option exception UnknownOption of string val gconf : t (** Global configuration instance *) val get_env : string -> string option (** Get environment variable value *) val set_env : string -> string -> unit (** Set environment variable value *) val get_target_option : string -> bool (** Get target-specific option value by string key *) val get_target_option_typed : target_option -> bool (** Get target-specific option value by typed key *) val set_target_options : string -> bool -> unit (** Set target-specific option value by string key *) val set_target_option_typed : target_option -> bool -> unit (** Set target-specific option value by typed key *) val get_target_options : unit -> (string * bool) list (** Get all target options as string-keyed pairs *) val get_target_options_keys : unit -> string list (** Get all target option keys as strings *) obuild-0.2.2/lib/core/generators.ml000066400000000000000000000167341515212760700172130ustar00rootroot00000000000000open Filepath open Helper open Gconf exception GeneratorFailed of string exception GeneratorNotFound of string (** Internal generator representation for build system integration *) type t = { suffix : string; modname : (Modname.t -> Modname.t); commands : (filepath -> filepath -> string -> string list list); generated_files : (filename -> string -> filename); } (** Custom generator definition from .obuild file *) type custom = { custom_name : string; (** Generator name for reference *) custom_suffix : string option; (** File extension for automatic detection *) custom_command : string; (** Command template with variables *) custom_outputs : string list; (** Output file patterns *) custom_module_name : string option; (** Module name pattern if different from base *) } (** Custom generators registered from project file *) let custom_generators : custom list ref = ref [] (** Find substring in string, returns index or raises Not_found *) let find_substring str sub = let len = String.length str in let sublen = String.length sub in if sublen = 0 then 0 else if sublen > len then raise Not_found else let rec search i = if i + sublen > len then raise Not_found else if String.sub str i sublen = sub then i else search (i + 1) in search 0 (** Substitute variables in a string Variables supported: - ${src} : Full path to source file - ${dest} : Destination path without extension - ${base} : Base filename without extension - ${srcdir} : Source directory - ${destdir} : Destination directory - ${sources} : Space-separated list of all input files (for multi-input) *) let substitute_variables ~src ~dest ~sources str = let src_str = fp_to_string src in let dest_str = fp_to_string dest in let base = fn_to_string (chop_extension (path_basename src)) in let srcdir = fp_to_string (path_dirname src) in let destdir = fp_to_string (path_dirname dest) in let sources_str = String.concat " " (List.map fp_to_string sources) in let replacements = [ ("${src}", src_str); ("${dest}", dest_str); ("${base}", base); ("${srcdir}", srcdir); ("${destdir}", destdir); ("${sources}", sources_str); ] in List.fold_left (fun s (var, value) -> let rec replace_all str = try let i = find_substring str var in let before = String.sub str 0 i in let after = String.sub str (i + String.length var) (String.length str - i - String.length var) in replace_all (before ^ value ^ after) with Not_found -> str in replace_all s ) str replacements (** Substitute variables in output pattern *) let substitute_output_pattern ~src pattern = let base = fn_to_string (chop_extension (path_basename src)) in let replacements = [ ("${base}", base); ] in List.fold_left (fun s (var, value) -> let rec replace_all str = try let i = find_substring str var in let before = String.sub str 0 i in let after = String.sub str (i + String.length var) (String.length str - i - String.length var) in replace_all (before ^ value ^ after) with Not_found -> str in replace_all s ) pattern replacements (** Convert custom generator to internal type for build system *) let custom_to_builtin (custom : custom) : t = let suffix = match custom.custom_suffix with | Some s -> s | None -> "" (* No suffix means generate-block-only *) in let modname = match custom.custom_module_name with | None -> (fun m -> m) | Some pattern -> (fun m -> let base = Compat.string_lowercase (Modname.to_string m) in let name = substitute_output_pattern ~src:(fp base) pattern in Modname.of_string (Compat.string_capitalize name)) in let commands = fun src dest _moduleName -> let cmd = substitute_variables ~src ~dest ~sources:[src] custom.custom_command in (* Run command through shell to support shell features like &&, |, etc. *) [["sh"; "-c"; cmd]] in let generated_files = fun f _moduleName -> match custom.custom_outputs with | [] -> chop_extension f <.> "ml" (* default to .ml *) | output :: _ -> let pattern = substitute_output_pattern ~src:(fp (fn_to_string f)) output in fn pattern in { suffix; modname; commands; generated_files } (** Register a custom generator from project file *) let register_custom (gen : custom) = custom_generators := gen :: !custom_generators (** Register multiple custom generators *) let register_customs (gens : custom list) = List.iter register_custom gens (** Clear all custom generators (useful for testing) *) let clear_custom_generators () = custom_generators := [] (** Get all generators with suffixes (for automatic detection) *) let get_all () = let custom_as_builtin = List.map custom_to_builtin !custom_generators in (* Only include generators with non-empty suffix for automatic detection *) List.filter (fun gen -> gen.suffix <> "") custom_as_builtin (** Check if a file extension has a registered generator *) let is_generator_ext ext = let ext_with_dot = "." ^ ext in List.exists (fun gen -> gen.suffix = ext || gen.suffix = ext_with_dot) (get_all ()) (** Get ALL generators for filepath based on extension *) let get_generators fp = let ext = Filetype.of_filepath fp in match ext with | Filetype.FileOther s -> let s_with_dot = "." ^ s in List.filter (fun gen -> gen.suffix = s || gen.suffix = s_with_dot) (get_all ()) | _ -> [] (** Get single generator for filepath (for backward compatibility) *) let get_generator fp = match get_generators fp with | [] -> raise (GeneratorNotFound (fp_to_string fp)) | gen :: _ -> gen (** Run ALL generators for source file *) let run dest src modName = log Debug " generator dest = %s src = %s\n%!" (fp_to_string dest) (fp_to_string src); let gens = get_generators src in if gens = [] then raise (GeneratorNotFound (fp_to_string src)); List.iter (fun gen -> let args = gen.commands src dest modName in List.iter (fun arg -> match Process.run arg with | Process.Success (_, warnings,_) -> print_warnings warnings | Process.Failure er -> raise (GeneratorFailed er) ) args ) gens (** Find a custom generator by name *) let find_generator_by_name name = try Some (List.find (fun (g : custom) -> g.custom_name = name) !custom_generators) with Not_found -> None (** Run a generator with multiple inputs (for generate blocks) *) let run_custom_multi ~generator_name ~dest ~sources ~extra_args = (* Find the custom generator by name *) let custom = match find_generator_by_name generator_name with | Some g -> g | None -> raise (GeneratorNotFound generator_name) in let src = match sources with | [] -> raise (GeneratorFailed "No source files provided") | s :: _ -> s in let cmd_base = substitute_variables ~src ~dest ~sources custom.custom_command in let cmd = match extra_args with | None -> cmd_base | Some args -> cmd_base ^ " " ^ args in log Debug " custom generator: %s\n%!" cmd; (* Run command through shell to support shell features *) let args = ["sh"; "-c"; cmd] in match Process.run args with | Process.Success (_, warnings, _) -> print_warnings warnings | Process.Failure er -> raise (GeneratorFailed er) (** Get the output files for a custom generator *) let get_custom_outputs (custom : custom) ~src = List.map (fun pattern -> fn (substitute_output_pattern ~src pattern) ) custom.custom_outputs obuild-0.2.2/lib/core/generators.mli000066400000000000000000000073441515212760700173610ustar00rootroot00000000000000(** Code generators for OCaml sources Generators transform source files (e.g., .mly, .mll) into OCaml code. Generators with a suffix are automatically triggered during module discovery. Generators without a suffix must be used via explicit generate blocks. *) exception GeneratorFailed of string exception GeneratorNotFound of string (** Internal generator representation for build system integration *) type t = { suffix : string; (** File extension that triggers this generator (empty for generate-block-only) *) modname : Modname.t -> Modname.t; (** Transform module name *) commands : Filepath.filepath -> Filepath.filepath -> string -> string list list; (** Generate command-line arguments for running the generator @param src Source filepath @param dest_root Destination root filepath @param moduleName Module name string @return List of command lists to execute *) generated_files : Filepath.filename -> string -> Filepath.filename; (** Determine output filename @param f Input filename @param moduleName Module name string @return Output filename *) } (** Custom generator definition from .obuild file *) type custom = { custom_name : string; (** Generator name for reference *) custom_suffix : string option; (** File extension for automatic detection *) custom_command : string; (** Command template with variables *) custom_outputs : string list; (** Output file patterns *) custom_module_name : string option; (** Module name pattern if different from base *) } val get_all : unit -> t list (** Get list of all registered generators (built-in + custom) *) val is_generator_ext : string -> bool (** Check if file extension has a registered generator *) val get_generator : Filepath.filepath -> t (** Get generator for filepath based on extension @raise GeneratorNotFound if no generator found *) val run : Filepath.filepath -> Filepath.filepath -> string -> unit (** Run generator for source file @param dest Destination filepath @param src Source filepath @param modName Module name @raise GeneratorFailed if generation fails *) (** {2 Custom Generator Registration} *) val register_custom : custom -> unit (** Register a custom generator from project file *) val register_customs : custom list -> unit (** Register multiple custom generators *) val clear_custom_generators : unit -> unit (** Clear all custom generators (useful for testing) *) (** {2 Multi-Input Generators (for generate blocks)} *) val run_custom_multi : generator_name:string -> dest:Filepath.filepath -> sources:Filepath.filepath list -> extra_args:string option -> unit (** Run a generator with multiple input files (for generate blocks) @param generator_name Name of the generator to use @param dest Destination filepath (without extension) @param sources List of source files @param extra_args Additional command-line arguments @raise GeneratorFailed if generation fails @raise GeneratorNotFound if generator not found *) val get_custom_outputs : custom -> src:Filepath.filepath -> Filepath.filename list (** Get the output files for a custom generator given a source file *) val find_generator_by_name : string -> custom option (** Find a custom generator by name *) (** {2 Variable Substitution} *) val substitute_variables : src:Filepath.filepath -> dest:Filepath.filepath -> sources:Filepath.filepath list -> string -> string (** Substitute variables in a command string. Variables: ${src}, ${dest}, ${base}, ${srcdir}, ${destdir}, ${sources} *) val substitute_output_pattern : src:Filepath.filepath -> string -> string (** Substitute variables in an output pattern. Variables: ${base} *) obuild-0.2.2/lib/core/helper.ml000066400000000000000000000022731515212760700163120ustar00rootroot00000000000000open Printf open Gconf let print_warnings warnings = if warnings <> "" then fprintf stderr "%s\n%!" warnings else () let log lvl fmt = if lvl <= gconf.verbosity then printf fmt else ifprintf stdout fmt let support_color () = if Utils.isWindows then false else if Unix.isatty Unix.stdout then Gconf.gconf.color else false let color_red () = if support_color () then "\x1b[1;31m" else "" let color_green () = if support_color () then "\x1b[1;32m" else "" let color_blue () = if support_color () then "\x1b[1;34m" else "" let color_white () = if support_color () then "\x1b[0m" else "" (** Performance timing utilities *) module Timing = struct let measure_time name f = let start = Unix.gettimeofday () in let result = f () in let elapsed = Unix.gettimeofday () -. start in log Gconf.Debug "[TIMING] %s: %.3fs\n" name elapsed; result let measure_time_verbose name f = let start = Unix.gettimeofday () in log Gconf.Debug "[TIMING] %s: starting...\n" name; let result = f () in let elapsed = Unix.gettimeofday () -. start in log Gconf.Debug "[TIMING] %s: completed in %.3fs\n" name elapsed; result end obuild-0.2.2/lib/core/helper.mli000066400000000000000000000021031515212760700164530ustar00rootroot00000000000000(** Helper functions for logging and output *) val print_warnings : string -> unit (** Print warnings to stderr if non-empty *) val log : Gconf.verbosity_t -> ('a, out_channel, unit, unit) format4 -> 'a (** Log message if verbosity level is sufficient *) val support_color : unit -> bool (** Check if terminal supports color output *) val color_red : unit -> string (** Get ANSI red color escape sequence (or empty if no color) *) val color_green : unit -> string (** Get ANSI green color escape sequence (or empty if no color) *) val color_blue : unit -> string (** Get ANSI blue color escape sequence (or empty if no color) *) val color_white : unit -> string (** Get ANSI white/reset color escape sequence (or empty if no color) *) (** Performance timing utilities *) module Timing : sig val measure_time : string -> (unit -> 'a) -> 'a (** [measure_time name f] executes [f ()] and prints timing info at Debug level *) val measure_time_verbose : string -> (unit -> 'a) -> 'a (** [measure_time_verbose name f] executes [f ()] with start/end messages at Debug level *) end obuild-0.2.2/lib/core/hier.ml000066400000000000000000000213061515212760700157600ustar00rootroot00000000000000open Fugue open Filepath open Compat exception EmptyModuleHierarchy type t = Modname.t list (* first filepath is the source path, second is the actual path *) type file_entry = | FileEntry of (filepath * filepath) (* root_path, full_path *) | GeneratedFileEntry of (filepath * filepath * filename) (* root_path, full_path, generated_path *) | DirectoryEntry of (filepath * filepath) (* root_path, full_path *) let file_entry_to_string = function | FileEntry (p, f) -> Printf.sprintf "FileEntry %s %s" (fp_to_string p) (fp_to_string f) | DirectoryEntry (p, f) -> Printf.sprintf "DirectoryEntry %s %s" (fp_to_string p) (fp_to_string f) | GeneratedFileEntry (p, f, n) -> Printf.sprintf "GeneratedFileEntry %s %s %s" (fp_to_string p) (fp_to_string f) (fn_to_string n) let hiers : (t, file_entry) Hashtbl.t = Hashtbl.create 128 (* Global registry of generated module names (from generate blocks across all targets) *) let generated_modules : (string, unit) Hashtbl.t = Hashtbl.create 16 let register_generated_module name = Hashtbl.replace generated_modules name () let is_generated_module name = Hashtbl.mem generated_modules name let clear () = Hashtbl.clear hiers; Hashtbl.clear generated_modules let root = function | x :: _ -> x | [] -> raise EmptyModuleHierarchy let parent x = match x with | [] -> assert false | [ _ ] -> None | l -> Some (list_init l) let leaf = list_last let make l = if l = [] then raise EmptyModuleHierarchy else l let lvl x = List.length x - 1 let to_string x = String.concat "." (List.map Modname.to_string x) let of_string x = let l = String_utils.split '.' x in make (List.map Modname.of_string l) let ml_to_ext path ext = let f = path_basename path in let d = path_dirname path in d (chop_extension f <.> Filetype.to_string ext) let of_modname x = [ x ] let to_node x = x let to_dirpath x = match x with | [] | [_] -> current_dir | _ -> fp (String.concat Filename.dir_sep (List.map Modname.to_dir $ list_init x)) let append x m = x @ [ m ] let add_prefix prefix_path hier = match hier with | [] | [_] -> prefix_path | _ -> let to_fp = fp (String.concat Filename.dir_sep (List.map Modname.to_dir $ list_init hier)) in if path_length prefix_path = 0 then to_fp else let rec loop path hier_list = match hier_list with | [] -> path to_fp | x :: xs -> if path_basename path = fn (Modname.to_dir x) then if path_length prefix_path = 1 then to_fp (* prefix_path is fully included in hier *) else loop (path_dirname path) xs else path to_fp in loop prefix_path (List.tl (List.rev hier)) let check_file path filename ext = if ext <> Filetype.FileOther "" then Filesystem.exists (path (fn filename <.> Filetype.to_string ext)) else Filesystem.exists (path fn filename) let check_modname path modname ext = if check_file path modname ext then Some modname else let name = string_uncapitalize modname in if check_file path name ext then Some name else None let get_filepath root_path hier ext : file_entry option = match SafeHashtbl.find_opt hiers hier with | Some entry -> Some entry | None -> ( let path = add_prefix root_path hier in let modname = Modname.to_string (leaf hier) in let res = check_modname path modname ext in match res with | None -> None | Some name -> let entry = if ext <> Filetype.FileOther "" then FileEntry (root_path, path (fn name <.> Filetype.to_string ext)) else DirectoryEntry (root_path, path fn name) in Hashtbl.add hiers hier entry; Some entry) let to_filename hier prefix_path = get_filepath prefix_path hier Filetype.FileML let to_directory hier prefix_path = get_filepath prefix_path hier (Filetype.FileOther "") let to_generators hier prefix_path = match SafeHashtbl.find_opt hiers hier with | Some entry -> Some entry | None -> ( try Some (list_find_map (fun gen -> let path = add_prefix prefix_path hier in let modname_t = leaf hier in let modname_t = gen.Generators.modname modname_t in let modname_str = Modname.to_string modname_t in let ext = Filetype.FileOther gen.Generators.suffix in let res = check_modname path modname_str ext in match res with | None -> None | Some name -> let filename = fn name <.> Filetype.to_string ext in let fullname = path filename in let generated_file = gen.Generators.generated_files filename (Modname.to_string (leaf hier)) in Hashtbl.add hiers hier (GeneratedFileEntry (prefix_path, fullname, generated_file)); Some (GeneratedFileEntry (prefix_path, fullname, generated_file))) (Generators.get_all ())) with Not_found -> None) let get_src_file dst_dir = function | FileEntry (_, f) -> f | GeneratedFileEntry (_, _, fn) -> dst_dir fn | DirectoryEntry (_, f) -> f let get_dest_file dst_dir ext hier = let entry = match SafeHashtbl.find_opt hiers hier with | Some e -> e | None -> raise Not_found in match entry with | FileEntry (_, f) -> let filename = path_basename f in let path = add_prefix dst_dir hier in path (chop_extension filename <.> Filetype.to_string ext) | GeneratedFileEntry (_, _, filename) -> let path = add_prefix dst_dir hier in path (chop_extension filename <.> Filetype.to_string ext) | DirectoryEntry (_, f) -> let filename = path_basename f in let path = add_prefix dst_dir hier in path (filename <.> Filetype.to_string ext) let get_dest_file_ext dst_dir hier ext_f = let entry = match SafeHashtbl.find_opt hiers hier with | Some e -> e | None -> raise Not_found in match entry with | FileEntry (_, f) -> let filename = path_basename f in let filetype = Filetype.of_filepath f in let path = add_prefix dst_dir hier in path (chop_extension filename <.> Filetype.to_string (ext_f filetype)) | GeneratedFileEntry (_, _, filename) -> let path = add_prefix dst_dir hier in let filetype = Filetype.of_filename filename in path (chop_extension filename <.> Filetype.to_string (ext_f filetype)) | DirectoryEntry (_, f) -> let filename = path_basename f in let path = add_prefix dst_dir hier in let filetype = Filetype.of_filepath f in path (filename <.> Filetype.to_string (ext_f filetype)) let to_interface hier prefix_path = get_filepath prefix_path hier Filetype.FileMLI let get_file_entry_maybe hier = SafeHashtbl.find_opt hiers hier let get_file_entry hier paths = match SafeHashtbl.find_opt hiers hier with | Some entry -> entry | None -> list_find_map (fun path -> try Some (list_find_map (fun lookup -> lookup hier path) [ to_filename; to_directory; to_generators; to_interface ]) with Not_found -> None) paths (* Register a synthetic file entry for modules that will be generated during build (e.g., cstubs-generated modules, generate-block modules). This allows get_dest_file to work for these modules even before the source file exists. This function REPLACES any existing entry because during dependency analysis a directory or other entry might have been cached before we knew it was synthetic. *) let register_synthetic_entry hier root_path full_path = Hashtbl.replace hiers hier (FileEntry (root_path, full_path)) (* Register a generated file entry for modules produced by generators (e.g., atdgen). This allows modules like Ollama_t (from ollama.atd) to be discovered. - hier: the module hierarchy (e.g., Ollama_t) - root_path: the source directory containing the generator input - src_path: full path to the source file (e.g., lib/ollama.atd) - output_file: the generated output filename (e.g., ollama_t.ml) *) let register_generated_entry hier root_path src_path output_file = Hashtbl.replace hiers hier (GeneratedFileEntry (root_path, src_path, output_file)) let of_filename filename = let name = Filename.chop_extension (fn_to_string filename) in let m = try Modname.wrap (string_capitalize name) with | Modname.EmptyModuleName -> raise (Modname.ModuleFilenameNotValid (fn_to_string filename)) | Invalid_argument _ -> raise (Modname.ModuleFilenameNotValid (fn_to_string filename)) in make [ m ] obuild-0.2.2/lib/core/hier.mli000066400000000000000000000146151515212760700161360ustar00rootroot00000000000000(** Module hierarchy management This module handles hierarchical module names (like A.B.C) and their mapping to filesystem paths. It manages the lookup and caching of module files across directory structures. *) (** The type of a module hierarchy - a list of module names *) type t = Modname.t list (** File entry types representing different kinds of source files *) type file_entry = | FileEntry of (Filepath.filepath * Filepath.filepath) (** Normal source file: (root_path, full_path) *) | GeneratedFileEntry of (Filepath.filepath * Filepath.filepath * Filepath.filename) (** Generated source file: (root_path, full_path, generated_filename) *) | DirectoryEntry of (Filepath.filepath * Filepath.filepath) (** Directory representing a module: (root_path, full_path) *) (** {1 Exceptions} *) exception EmptyModuleHierarchy (** Raised when attempting to create an empty module hierarchy *) (** {1 Construction and Conversion} *) val make : Modname.t list -> t (** [make mods] creates a module hierarchy from a list of module names. @raise EmptyModuleHierarchy if the list is empty *) val of_string : string -> t (** [of_string "A.B.C"] creates a module hierarchy by splitting on dots *) val of_modname : Modname.t -> t (** [of_modname m] creates a single-level hierarchy from module name [m] *) val of_filename : Filepath.filename -> t (** [of_filename fn] creates a hierarchy from a filename, removing extension and capitalizing *) val to_string : t -> string (** [to_string hier] converts to dot-separated string (e.g., "A.B.C") *) val to_node : t -> Modname.t list (** [to_node hier] returns the underlying module name list *) (** {1 Hierarchy Navigation} *) val root : t -> Modname.t (** [root hier] returns the first module in the hierarchy *) val leaf : t -> Modname.t (** [leaf hier] returns the last module in the hierarchy *) val parent : t -> t option (** [parent hier] returns the parent hierarchy, or [None] if single-level. Example: parent [A; B; C] = Some [A; B] *) val lvl : t -> int (** [lvl hier] returns the depth level (0-indexed from root). Example: lvl [A; B; C] = 2 *) val append : t -> Modname.t -> t (** [append hier m] appends module [m] to hierarchy *) (** {1 Path Conversion} *) val to_dirpath : t -> Filepath.filepath (** [to_dirpath hier] converts hierarchy to directory path. Example: [A; B; C] -> "a/b" (excludes leaf) *) val add_prefix : Filepath.filepath -> t -> Filepath.filepath (** [add_prefix prefix hier] combines prefix path with hierarchy path, intelligently handling overlapping components *) val ml_to_ext : Filepath.filepath -> Filetype.t -> Filepath.filepath (** [ml_to_ext path ext] changes file extension of path to [ext] *) (** {1 File Lookup} *) val get_filepath : Filepath.filepath -> t -> Filetype.t -> file_entry option (** [get_filepath root hier ext] searches for a file matching the hierarchy with the given extension. Returns cached result if available. *) val to_filename : t -> Filepath.filepath -> file_entry option (** [to_filename hier root] finds the .ml file for hierarchy *) val to_interface : t -> Filepath.filepath -> file_entry option (** [to_interface hier root] finds the .mli file for hierarchy *) val to_directory : t -> Filepath.filepath -> file_entry option (** [to_directory hier root] finds the directory for hierarchy *) val to_generators : t -> Filepath.filepath -> file_entry option (** [to_generators hier root] finds source files matching custom generators defined in .obuild *) val get_file_entry : t -> Filepath.filepath list -> file_entry (** [get_file_entry hier paths] searches for hierarchy across multiple root paths, trying all lookup methods (filename, directory, generators, interface). @raise Not_found if hierarchy not found in any path *) val get_file_entry_maybe : t -> file_entry option (** [get_file_entry_maybe hier] returns cached file entry if available *) (** {1 File Entry Operations} *) val file_entry_to_string : file_entry -> string (** [file_entry_to_string entry] converts file entry to debug string *) val get_src_file : Filepath.filepath -> file_entry -> Filepath.filepath (** [get_src_file dst_dir entry] returns the source file path from an entry *) val get_dest_file : Filepath.filepath -> Filetype.t -> t -> Filepath.filepath (** [get_dest_file dst_dir ext hier] computes destination file path for hierarchy with given extension in destination directory. @raise Not_found if hierarchy not cached *) val get_dest_file_ext : Filepath.filepath -> t -> (Filetype.t -> Filetype.t) -> Filepath.filepath (** [get_dest_file_ext dst_dir hier ext_fn] computes destination file path using [ext_fn] to transform the source file type. @raise Not_found if hierarchy not cached *) val register_synthetic_entry : t -> Filepath.filepath -> Filepath.filepath -> unit (** [register_synthetic_entry hier root_path full_path] registers a synthetic file entry for modules that will be generated during build (e.g., cstubs-generated modules, generate-block modules). This allows get_dest_file to work for these modules even before the source file exists. Replaces any existing entry (which may have been cached during dependency analysis before the module was identified as synthetic). *) val register_generated_entry : t -> Filepath.filepath -> Filepath.filepath -> Filepath.filename -> unit (** [register_generated_entry hier root_path src_path output_file] registers a generated file entry for modules produced by generators (e.g., atdgen). This allows modules like Ollama_t (from ollama.atd) to be discovered before generation. - [hier]: the module hierarchy (e.g., Ollama_t) - [root_path]: the source directory containing the generator input - [src_path]: full path to the source file (e.g., lib/ollama.atd) - [output_file]: the generated output filename (e.g., ollama_t.ml) *) (** {1 Global Generated Module Registry} *) val register_generated_module : string -> unit (** [register_generated_module name] registers a module name as globally generated (from a generate block in any target). This allows dependent targets to recognize generated modules before their generating target is prepared. *) val is_generated_module : string -> bool (** [is_generated_module name] returns true if the module was registered as generated via [register_generated_module]. *) val clear : unit -> unit (** [clear ()] resets all caches (file entry cache and generated module registry). *) obuild-0.2.2/lib/core/libname.ml000066400000000000000000000021571515212760700164430ustar00rootroot00000000000000open Types open Filepath exception EmptyLibName (* represent a library in a form abc[.def.xyz] *) type t = { main_name : string; subnames : string list; } let of_string s = match String_utils.split '.' s with | [] -> raise EmptyLibName | x :: xs -> { main_name = x; subnames = xs } let to_string lname = String.concat "." (lname.main_name :: lname.subnames) let to_string_nodes lname = lname.main_name :: lname.subnames let append lname sub = { lname with subnames = lname.subnames @ [ sub ] } let to_libstring lib = String.concat "_" (to_string_nodes lib) let to_cmxs (compileType : ocaml_compilation_option) lib = fn (to_libstring lib ^ extDP compileType ^ ".cmxs") let to_cmxa (compileType : ocaml_compilation_option) lib = fn (to_libstring lib ^ extDP compileType ^ ".cmxa") let to_cma (compileType : ocaml_compilation_option) lib = fn (to_libstring lib ^ extDP compileType ^ ".cma") let to_cmca b = if b = Native then to_cmxa else to_cma (* only used for stdlib stuff *) (* let of_cmca b file = let suffix = if b = Native then ".cmxa" else ".cma" in Filename.chop_suffix (fn_to_string file) suffix *) obuild-0.2.2/lib/core/libname.mli000066400000000000000000000040261515212760700166110ustar00rootroot00000000000000(** Library name handling with support for hierarchical names This module provides support for library names in the form "abc" or "abc.def.xyz" where the main name can have multiple subpackage components. *) (** The type of a library name with main name and optional subpackages *) type t = { main_name : string; (** The root package name *) subnames : string list; (** List of subpackage names *) } (** {1 Exceptions} *) exception EmptyLibName (** Raised when attempting to create a library name from an empty string *) (** {1 Construction and Conversion} *) val of_string : string -> t (** [of_string "abc.def.xyz"] creates a library name with main_name="abc" and subnames=["def"; "xyz"]. @raise EmptyLibName if the string is empty *) val to_string : t -> string (** [to_string lname] converts library name to dot-separated string. Example: {main_name="abc"; subnames=["def"]} -> "abc.def" *) val to_string_nodes : t -> string list (** [to_string_nodes lname] returns list of all name components. Example: {main_name="abc"; subnames=["def"]} -> ["abc"; "def"] *) val append : t -> string -> t (** [append lname sub] adds a subpackage name to the library name *) (** {1 Library File Extensions} *) val to_libstring : t -> string (** [to_libstring lname] converts to underscore-separated string. Example: "abc.def" -> "abc_def" *) val to_cmxs : Types.ocaml_compilation_option -> t -> Filepath.filename (** [to_cmxs opt lib] returns the dynamically loadable native plugin filename (.cmxs) *) val to_cmxa : Types.ocaml_compilation_option -> t -> Filepath.filename (** [to_cmxa opt lib] returns the native archive filename (.cmxa) *) val to_cma : Types.ocaml_compilation_option -> t -> Filepath.filename (** [to_cma opt lib] returns the bytecode archive filename (.cma) *) val to_cmca : Types.ocaml_compiled_type -> Types.ocaml_compilation_option -> t -> Filepath.filename (** [to_cmca compiled_type opt lib] returns the appropriate archive based on compilation type: - [Native] -> .cmxa - [ByteCode] -> .cma *) obuild-0.2.2/lib/core/meta.ml000066400000000000000000000504501515212760700157610ustar00rootroot00000000000000open Fugue open Filepath open Printf module Predicate = struct type t = | Byte | Native | Toploop | CreateToploop | Plugin | Mt | Mt_vm | Mt_posix | Gprof | Autolink | Syntax | Preprocessor | Camlp4o | Camlp4r | Ppx_driver | Neg of t | Unknown of string let rec to_string = function | Byte -> "byte" | Native -> "native" | Toploop -> "toploop" | CreateToploop -> "create_toploop" | Plugin -> "plugin" | Mt -> "mt" | Mt_vm -> "mt_vm" | Mt_posix -> "mt_posix" | Gprof -> "gprof" | Autolink -> "autolink" | Syntax -> "syntax" | Preprocessor -> "preprocessor" | Camlp4o -> "camlp4o" | Camlp4r -> "camlp4r" | Ppx_driver -> "ppx_driver" | Neg t -> "-" ^ to_string t | Unknown s -> s let rec of_string s = if s.[0] = '-' then Neg (of_string (String.sub s 1 (String.length s - 1))) else match s with | "byte" -> Byte | "native" -> Native | "toploop" -> Toploop | "create_toploop" -> CreateToploop | "plugin" -> Plugin | "mt" -> Mt | "mt_vm" -> Mt_vm | "mt_posix" -> Mt_posix | "gprof" -> Gprof | "autolink" -> Autolink | "syntax" -> Syntax | "preprocessor" -> Preprocessor | "camlp4o" -> Camlp4o | "camlp4r" -> Camlp4r | "ppx_driver" -> Ppx_driver | _ as s -> Unknown s end exception LibraryNotFound of string exception SubpackageNotFound of string exception ArchiveNotFound of filepath * Libname.t * Predicate.t list exception MetaParseError of filepath * string module Pkg = struct (* preliminaries structures, adjust as needed by meta. *) type t = { name : string; requires : (Predicate.t list * Libname.t list) list; directory : string; description : string; exists_if : string; preprocessor : string; ppx : (Predicate.t list * string) option; ppxopt : (Predicate.t list * string) list; browse_interface : string; type_of_threads : string; archives : (Predicate.t list * string) list; warning : (Predicate.t list * string) list; append_archives : (Predicate.t list * string) list; version : string; assignment : (string * string) list; linkopts : (Predicate.t list option * string) list; subs : t list; } type meta_t = Filepath.filepath * t let make name = { name; requires = []; directory = ""; description = ""; preprocessor = ""; ppx = None; ppxopt = []; linkopts = []; browse_interface = ""; type_of_threads = ""; exists_if = ""; archives = []; append_archives = []; warning = []; version = ""; assignment = []; subs = []; } let rec iter f package = f package; List.iter (iter f) package.subs let rec find subs pkg = match subs with | [] -> pkg | x :: xs -> find xs (try List.find (fun spkg -> spkg.name = x) pkg.subs with Not_found -> raise (SubpackageNotFound x)) let get_syntaxes pkg = list_filter_map (fun (preds, s) -> if List.mem Predicate.Syntax preds then Some (list_remove Predicate.Syntax preds, s) else None) pkg.archives let satisfy preds constraints = List.for_all (fun p -> match p with | Predicate.Neg n -> not (List.mem n constraints) | _ -> List.mem p constraints) preds let is_syntax_ pkg = get_syntaxes pkg <> [] let is_syntax (_, rootPkg) dep = is_syntax_ (find dep.Libname.subnames rootPkg) let get_archive_with_filter (_, rootPkg) dep preds = let pkg = find dep.Libname.subnames rootPkg in let preds_set = Hashtbl.create (List.length preds) in List.iter (fun p -> Hashtbl.replace preds_set p ()) preds; let fulfills archive_preds = List.for_all (fun p -> match p with | Predicate.Neg n -> not (Hashtbl.mem preds_set n) | _ -> Hashtbl.mem preds_set p) archive_preds in let rec best_archive best_n best_value archives = match archives with | [] -> if best_n >= 0 then [ best_value ] else [] | ((archive_preds, _) as archive) :: rest -> if fulfills archive_preds && List.length archive_preds > best_n then best_archive (List.length archive_preds) archive rest else best_archive best_n best_value rest in let rec all_append_archives archives = match archives with | [] -> [] | ((archive_preds, _) as archive) :: rest -> if fulfills archive_preds then archive :: all_append_archives rest else all_append_archives rest in let res = if pkg.archives = [] then [] else best_archive (-1) (List.hd pkg.archives) pkg.archives in res @ all_append_archives pkg.append_archives let get_archive (path, root) dep preds = let pkg = find dep.Libname.subnames root in try snd (List.find (fun (e, _) -> list_eq_noorder e preds) pkg.archives) with Not_found -> raise (ArchiveNotFound (path, dep, preds)) let write path package = let out = Buffer.create 1024 in let append = Buffer.add_string out in let preds_to_string preds = if preds = [] then "" else "(" ^ String.concat "," (List.map Predicate.to_string preds) ^ ")" in let rec write_one indent pkg = let indent_str = String.make indent ' ' in let output_field field name = if field <> "" then append (sprintf "%s%s = \"%s\"\n" indent_str name field) in output_field pkg.description "description"; output_field pkg.version "version"; output_field pkg.browse_interface "browse_interface"; output_field pkg.exists_if "exists_if"; List.iter (fun (preds, deps) -> let dep_str = String.concat "," (List.map (fun dep -> Libname.to_string dep) deps) in append (sprintf "%srequires%s = \"%s\"\n" indent_str (preds_to_string preds) dep_str)) pkg.requires; List.iter (fun (preds, v) -> append (sprintf "%sarchive%s = \"%s\"\n" indent_str (preds_to_string preds) v)) pkg.archives; List.iter (fun (preds, v) -> append (sprintf "%sarchive%s += \"%s\"\n" indent_str (preds_to_string preds) v)) pkg.append_archives; List.iter (fun (preds_opt, v) -> let preds_str = match preds_opt with | None -> "" | Some preds -> preds_to_string preds in append (sprintf "%slinkopts%s = \"%s\"\n" indent_str preds_str v)) pkg.linkopts; List.iter (fun spkg -> append (sprintf "%spackage \"%s\" (\n" indent_str spkg.name); write_one (indent + 2) spkg; append (sprintf "%s)\n" indent_str)) pkg.subs in write_one 0 package; Filesystem.write_file path (Buffer.contents out) end type t = filepath * Pkg.t let path_warning = ref false (** META File Tokenizer and Parser This module handles tokenizing and parsing OCamlfind META files. META files describe OCaml package metadata including dependencies, compilation flags, and library locations. *) module Token = struct (** Token types for META file lexer *) type t = | ID of string | S of string | LPAREN | RPAREN | MINUS | DOT | EQ | PLUSEQ | COMMA let to_string = function | ID s -> "ID[" ^ s ^ "]" | S s -> "\"" ^ s ^ "\"" | LPAREN -> "(" | RPAREN -> ")" | MINUS -> "-" | DOT -> "." | EQ -> "=" | PLUSEQ -> "+=" | COMMA -> "," let char_table = hashtbl_from_list [ ('(', LPAREN); (')', RPAREN); ('=', EQ); (',', COMMA); ('.', DOT); ('-', MINUS) ] let is_token_char c = Hashtbl.mem char_table c let get_token_char c = Hashtbl.find char_table c let is_ident_char c = char_is_alphanum c || c == '_' || c == '-' (** Tokenize META file content Converts META file string into a list of tokens. Handles comments, strings, identifiers, and operators. @param name Package name (for error messages) @param s META file content @return List of tokens *) let tokenize name s = let line = ref 1 in let lineoff = ref 0 in let len = String.length s in let eat_comment o = let i = ref (o + 1) in while !i < len && s.[!i] <> '\n' do i := !i + 1 done; line := !line + 1; lineoff := !i + 1; !i + 1 in let parse_ident o = let i = ref (o + 1) in while !i < len && is_ident_char s.[!i] do i := !i + 1 done; (String.sub s o (!i - o), !i) in let parse_string o = let i = ref (o + 1) in let buf = Buffer.create 32 in let in_escape = ref false in while !i < len && (!in_escape || s.[!i] <> '"') do (if (not !in_escape) && s.[!i] = '\\' then in_escape := true else let c = if !in_escape then match s.[!i] with | '\\' -> '\\' | 'n' -> '\n' | 't' -> '\t' | 'r' -> '\r' | '"' -> '"' | _ -> s.[!i] else s.[!i] in in_escape := false; Buffer.add_char buf c); i := !i + 1 done; (* Check if string was properly closed *) if !i >= len then let s = sprintf "%d.%d: meta lexing error: unclosed string literal" !line (o - !lineoff) in raise (MetaParseError (name, s)) else (Buffer.contents buf, !i + 1) in let rec loop o = if o >= len then [] else if s.[o] == ' ' || s.[o] == '\t' then loop (o + 1) else if s.[o] == '\n' then ( line := !line + 1; lineoff := o + 1; loop (o + 1)) else if s.[o] == '#' then loop (eat_comment o) else if s.[o] == '"' then let s, no = parse_string o in S s :: loop no else if is_token_char s.[o] then get_token_char s.[o] :: loop (o + 1) else if s.[o] == '+' && o + 1 < len && s.[o + 1] == '=' then PLUSEQ :: loop (o + 2) else if (s.[o] >= 'a' && s.[o] <= 'z') || (s.[o] >= 'A' && s.[o] <= 'Z') || s.[o] == '-' then let id, no = parse_ident o in ID id :: loop no else let s = sprintf "%d.%d: meta lexing error: undefined character '%c'" !line (o - !lineoff) s.[o] in raise (MetaParseError (name, s)) in loop 0 let rec parse_predicate = function | COMMA :: ID s :: xs -> let l, r = parse_predicate xs in (Predicate.of_string s :: l, r) | COMMA :: MINUS :: ID s :: xs -> let l, r = parse_predicate xs in (Predicate.Neg (Predicate.of_string s) :: l, r) | xs -> ([], xs) let parse_predicate_list name field = function | LPAREN :: RPAREN :: xs -> ([], xs) | LPAREN :: ID s :: xs -> ( let preds, xs2 = parse_predicate xs in match xs2 with | RPAREN :: xs3 -> (Predicate.of_string s :: preds, xs3) | _ -> raise (MetaParseError (name, "expecting ')' after " ^ field ^ "'s predicate"))) | LPAREN :: MINUS :: ID s :: xs -> ( let preds, xs2 = parse_predicate xs in match xs2 with | RPAREN :: xs3 -> (Predicate.Neg (Predicate.of_string s) :: preds, xs3) | _ -> raise (MetaParseError (name, "expecting ')' after " ^ field ^ "'s predicate"))) | xs -> ([], xs) let rec parse pkg_name acc expecting_rparen = function | [] -> if expecting_rparen then raise (MetaParseError (pkg_name, "unclosed package block (missing closing parenthesis)")) else (acc, []) | RPAREN :: xs -> (acc, xs) | ID "package" :: S name :: LPAREN :: xs -> let pkg, xs2 = parse pkg_name (Pkg.make name) true xs in let nacc = { acc with Pkg.subs = acc.Pkg.subs @ [ pkg ] } in parse pkg_name nacc expecting_rparen xs2 | ID "requires" :: xs -> ( let preds, xs2 = parse_predicate_list pkg_name "requires" xs in match xs2 with | PLUSEQ :: S reqs :: xs3 | EQ :: S reqs :: xs3 -> let deps = List.map (fun r -> Libname.of_string r) $ (List.filter (fun x -> x <> "") $ String_utils.split_pred (fun c -> match c with ',' | ' ' | '\n' | '\r' | '\t' -> true | _ -> false) reqs ) in parse pkg_name { acc with Pkg.requires = (preds, List.rev deps) :: acc.Pkg.requires } expecting_rparen xs3 | _ -> raise (MetaParseError ( pkg_name, "parsing requires failed: expected '=' or '+=' followed by quoted dependency \ list" ))) | ID "directory" :: EQ :: S dir :: xs -> parse pkg_name { acc with Pkg.directory = dir } expecting_rparen xs | ID "description" :: EQ :: S dir :: xs -> parse pkg_name { acc with Pkg.description = dir } expecting_rparen xs | ID "browse_interfaces" :: EQ :: S _ :: xs -> parse pkg_name acc expecting_rparen xs | ID "warning" :: xs -> ( let preds, xs2 = parse_predicate_list pkg_name "archive" xs in match xs2 with | EQ :: S v :: xs3 -> let nacc = { acc with Pkg.warning = acc.Pkg.warning @ [ (preds, v) ] } in parse pkg_name nacc expecting_rparen xs3 | _ -> raise (MetaParseError (pkg_name, "parsing warning failed: expected '=' followed by quoted string"))) | ID "archive" :: xs -> ( let preds, xs2 = parse_predicate_list pkg_name "archive" xs in match xs2 with | PLUSEQ :: S v :: xs3 -> let nacc = { acc with Pkg.append_archives = acc.Pkg.append_archives @ [ (preds, v) ] } in parse pkg_name nacc expecting_rparen xs3 | EQ :: S v :: xs3 -> let nacc = { acc with Pkg.archives = acc.Pkg.archives @ [ (preds, v) ] } in parse pkg_name nacc expecting_rparen xs3 | _ -> raise (MetaParseError (pkg_name, "parsing archive failed: expected '=' or '+=' followed by quoted string")) ) | ID "plugin" :: xs -> ( let preds, xs2 = parse_predicate_list pkg_name "plugin" xs in let preds = Predicate.Plugin :: preds in match xs2 with | PLUSEQ :: S v :: xs3 -> let nacc = { acc with Pkg.append_archives = acc.Pkg.append_archives @ [ (preds, v) ] } in parse pkg_name nacc expecting_rparen xs3 | EQ :: S v :: xs3 -> let nacc = { acc with Pkg.archives = acc.Pkg.archives @ [ (preds, v) ] } in parse pkg_name nacc expecting_rparen xs3 | _ -> raise (MetaParseError ( pkg_name, "parsing plugin failed: expected '=' or '+=' followed by quoted plugin path" ))) | ID "preprocessor" :: EQ :: S v :: xs -> parse pkg_name { acc with Pkg.preprocessor = v } expecting_rparen xs | ID "ppx" :: xs -> ( let preds, xs2 = parse_predicate_list pkg_name "ppx" xs in match xs2 with | EQ :: S v :: xs3 -> parse pkg_name { acc with Pkg.ppx = Some (preds, v) } expecting_rparen xs3 | _ -> raise (MetaParseError (pkg_name, "parsing ppx failed: expected '=' followed by quoted preprocessor path")) ) | ID "ppxopt" :: xs -> ( let preds, xs2 = parse_predicate_list pkg_name "ppxopt" xs in match xs2 with | PLUSEQ :: S v :: xs3 | EQ :: S v :: xs3 -> parse pkg_name { acc with Pkg.ppxopt = acc.Pkg.ppxopt @ [ (preds, v) ] } expecting_rparen xs3 | _ -> raise (MetaParseError (pkg_name, "parsing ppxopt failed: expected '=' or '+=' followed by quoted options")) ) | ID "version" :: EQ :: S v :: xs -> parse pkg_name { acc with Pkg.version = v } expecting_rparen xs | ID "exists_if" :: EQ :: S v :: xs -> parse pkg_name { acc with Pkg.exists_if = v } expecting_rparen xs | ID "error" :: LPAREN :: xs -> ( let rec consume = function | RPAREN :: zs -> zs | _ :: zs -> consume zs | [] -> raise (MetaParseError (pkg_name, "unexpected EOF in error field (missing closing parenthesis)")) in match consume xs with | EQ :: S _ :: xs2 -> parse pkg_name acc expecting_rparen xs2 | _ -> raise (MetaParseError (pkg_name, "parsing error field failed, expected '=' after closing parenthesis"))) | ID "linkopts" :: xs -> ( let preds, xs2 = parse_predicate_list pkg_name "linkopts" xs in match xs2 with | EQ :: S s :: xs3 -> parse pkg_name { acc with Pkg.linkopts = ((if preds = [] then None else Some preds), s) :: acc.Pkg.linkopts; } expecting_rparen xs3 | _ -> raise (MetaParseError (pkg_name, "parsing linkopts failed, expected '=' after predicates"))) | ID stuff :: EQ :: S stuffVal :: xs -> parse pkg_name { acc with Pkg.assignment = (stuff, stuffVal) :: acc.Pkg.assignment } expecting_rparen xs | x :: xs -> raise (MetaParseError ( pkg_name, "unknown token '" ^ to_string x ^ "' in meta file\n" ^ String.concat " " (List.map to_string xs) )) end (* meta files are supposed to be small, so don't bother with * a real efficient and incremental read/lex/parse routine. * * this can be improve later on-needed basis *) let parse name content pkg_name = fst (Token.parse name (Pkg.make pkg_name) false (Token.tokenize name content)) let read path name = let meta_content = Filesystem.read_file path in parse path meta_content name (* get the META file path associated to a library *) let find_lib_path name = if !path_warning then ( eprintf "warning: obuild META search paths and ocaml config mismatch\n\n"; eprintf " The ocamlfind configuration file used doesn't list the ocaml standard library \n"; eprintf " as part of his search paths. something fishy is going on\n"; eprintf " You can solve the issue by:\n"; eprintf " * pointing OCAMLFIND_CONF environment to the right configuration file\n"; eprintf " * making sure that the ocamlfind program in your path is the right one (ocamlfind \ printconf)\n"; eprintf "\n"; eprintf " this is likely to cause various compilation problems\n"; (* then we ignore further warnings *) path_warning := false); let rec find_ret l = match l with | [] -> raise (LibraryNotFound name) | p :: ps -> let inDir = p fn name fn "META" in let asMetaext = p (fn "META" <.> name) in if Filesystem.exists inDir then inDir else if Filesystem.exists asMetaext then asMetaext else find_ret ps in find_ret (FindlibConf.get_paths ()) let find_lib name : t = let path = find_lib_path name in (path, read path name) let resolve_directory stdlib basePath directory = match directory with | "" | "." -> basePath | "^" -> path_dirname basePath | o -> ( match o.[0] with | '^' -> path_dirname basePath fp (String_utils.drop 1 o) | '+' -> stdlib fp (String_utils.drop 1 o) | _ -> let fpo = fp o in if Filepath.is_absolute fpo then fpo else basePath fpo) let get_include_dir_with_subpath stdlib ((path, pkg) : t) subnames : filepath = let basePath = path_dirname path in let rec buildPath currentPath remainingSubnames currentPkg = match remainingSubnames with | [] -> currentPath | subname :: rest -> ( try let subpkg = List.find (fun spkg -> spkg.Pkg.name = subname) currentPkg.Pkg.subs in let newPath = resolve_directory stdlib currentPath subpkg.Pkg.directory in buildPath newPath rest subpkg with Not_found -> raise (SubpackageNotFound subname)) in buildPath basePath subnames pkg let get_include_dir stdlib ((path, pkg) : t) : filepath = resolve_directory stdlib (path_dirname path) pkg.Pkg.directory obuild-0.2.2/lib/core/meta.mli000066400000000000000000000153401515212760700161310ustar00rootroot00000000000000(** META file parsing for OCamlfind package metadata This module provides parsing and querying of OCamlfind META files, which describe OCaml library packages, their dependencies, and compilation flags. *) (** {1 Predicates} *) (** Compilation predicates used in META files to conditionally specify library properties based on compilation mode, threading model, etc. *) module Predicate : sig type t = | Byte (** Bytecode compilation *) | Native (** Native code compilation *) | Toploop (** Interactive toplevel *) | CreateToploop (** Creating custom toplevel *) | Plugin (** Dynamically loaded plugin *) | Mt (** Multi-threading *) | Mt_vm (** VM-level threading *) | Mt_posix (** POSIX threading *) | Gprof (** Profiling with gprof *) | Autolink (** Automatic linking *) | Syntax (** Syntax extension *) | Preprocessor (** Preprocessor *) | Camlp4o (** Camlp4 original syntax *) | Camlp4r (** Camlp4 revised syntax *) | Ppx_driver (** PPX driver *) | Neg of t (** Negated predicate *) | Unknown of string (** Unknown/custom predicate *) val to_string : t -> string (** Convert predicate to string representation *) val of_string : string -> t (** Parse predicate from string. Handles negation with '-' prefix *) end (** {1 Exceptions} *) exception LibraryNotFound of string (** Raised when a library cannot be found in the OCamlfind path *) exception SubpackageNotFound of string (** Raised when a subpackage cannot be found within a package *) exception ArchiveNotFound of Filepath.filepath * Libname.t * Predicate.t list (** Raised when no suitable archive is found for given predicates *) exception MetaParseError of Filepath.filepath * string (** Raised when META file parsing fails *) (** {1 Package Metadata} *) (** Package metadata structure and operations *) module Pkg : sig (** Package record containing all META file fields *) type t = { name : string; (** Package name *) requires : (Predicate.t list * Libname.t list) list; (** Dependencies with predicates *) directory : string; (** Package directory (can be relative, absolute, or use special prefixes) *) description : string; (** Human-readable description *) exists_if : string; (** Condition for package existence *) preprocessor : string; (** Preprocessor command *) ppx : (Predicate.t list * string) option; (** PPX rewriter with predicates *) ppxopt : (Predicate.t list * string) list; (** PPX options with predicates *) browse_interface : string; (** Interface browsing information *) type_of_threads : string; (** Threading type *) archives : (Predicate.t list * string) list; (** Archive files with predicates *) warning : (Predicate.t list * string) list; (** Warnings with predicates *) append_archives : (Predicate.t list * string) list; (** Additional archives to append *) version : string; (** Package version *) assignment : (string * string) list; (** Custom variable assignments *) linkopts : (Predicate.t list option * string) list; (** Linker options with optional predicates *) subs : t list; (** Subpackages *) } val make : string -> t (** [make name] creates an empty package with the given name *) val iter : (t -> unit) -> t -> unit (** [iter f pkg] applies [f] to [pkg] and all its subpackages recursively *) val find : string list -> t -> t (** [find subnames pkg] finds a subpackage by traversing the hierarchy. @raise SubpackageNotFound if subpackage not found *) val get_syntaxes : t -> (Predicate.t list * string) list (** [get_syntaxes pkg] extracts syntax extensions from package archives *) val satisfy : Predicate.t list -> Predicate.t list -> bool (** [satisfy preds constraints] checks if predicates satisfy constraints *) val is_syntax_ : t -> bool (** [is_syntax_ pkg] returns true if package defines syntax extensions *) val write : Filepath.filepath -> t -> unit (** [write path package] writes package to META file at path *) (** The following functions operate on the outer module's [t] type (filepath * Pkg.t), defined below *) type meta_t = Filepath.filepath * t (** Alias for the full META type to avoid forward reference *) val is_syntax : meta_t -> Libname.t -> bool (** [is_syntax meta dep] checks if dependency is a syntax extension *) val get_archive_with_filter : meta_t -> Libname.t -> Predicate.t list -> (Predicate.t list * string) list (** [get_archive_with_filter meta dep preds] gets archives matching predicates. Returns list of (predicates, archive_name) pairs *) val get_archive : meta_t -> Libname.t -> Predicate.t list -> string (** [get_archive meta dep preds] gets the first matching archive *) end (** {1 Main Types} *) (** A parsed META file with its location and package structure *) type t = Filepath.filepath * Pkg.t (** {1 META File Operations} *) val path_warning : bool ref (** Enable warnings for path resolution issues *) val parse : Filepath.filepath -> string -> string -> Pkg.t (** [parse filepath content pkg_name] parses META file content. @param filepath Source file path (for error messages) @param content The META file content @param pkg_name The package name @return Parsed package structure *) val find_lib_path : string -> Filepath.filepath (** [find_lib_path name] locates the META file for library [name]. Searches in OCamlfind paths for either: - [//META] - [/META.] @raise LibraryNotFound if library not found in any path *) val find_lib : string -> t (** [find_lib name] locates and parses the META file for library [name]. @raise LibraryNotFound if library not found @raise MetaParseError if parsing fails *) val resolve_directory : Filepath.filepath -> Filepath.filepath -> string -> Filepath.filepath (** [resolve_directory stdlib basePath directory] resolves META directory specifications: - [""] or ["."] -> basePath - ["^"] -> parent of basePath - ["^subdir"] -> parent/subdir - ["+stdlib"] -> stdlib/stdlib - absolute path -> as-is - relative path -> basePath/path *) val get_include_dir : Filepath.filepath -> t -> Filepath.filepath (** [get_include_dir stdlib (path, pkg)] resolves the include directory for a package *) val get_include_dir_with_subpath : Filepath.filepath -> t -> string list -> Filepath.filepath (** [get_include_dir_with_subpath stdlib (path, pkg) subnames] resolves the include directory for a subpackage by traversing the hierarchy. @raise SubpackageNotFound if subpackage not found *) obuild-0.2.2/lib/core/metacache.ml000066400000000000000000000017061515212760700167450ustar00rootroot00000000000000open Gconf open Helper let initial_cache_size = 128 let pkgs_cache : (string, Meta.t) Hashtbl.t = Hashtbl.create initial_cache_size let get_from_disk name = log Debug " fetching META %s\n%!" name; try Meta.find_lib name with Meta.LibraryNotFound n -> raise (Dependencies.DependencyMissing n) let get name = try Hashtbl.find pkgs_cache name with Not_found -> let r = get_from_disk name in Hashtbl.add pkgs_cache name r; r let get_from_cache lib = try let (fp,pkg) = Hashtbl.find pkgs_cache lib.Libname.main_name in (* Always return the root package - let callers do subpackage resolution *) (fp,pkg) with Not_found -> failwith (Printf.sprintf "package %s not found in the hashtbl: internal error" (Libname.to_string lib)) let add name meta = Hashtbl.add pkgs_cache name meta let find name = try Some (Hashtbl.find pkgs_cache name) with Not_found -> None let clear () = Hashtbl.clear pkgs_cache obuild-0.2.2/lib/core/metacache.mli000066400000000000000000000024171515212760700171160ustar00rootroot00000000000000(** META file caching for efficient library dependency resolution This module provides a caching layer for parsed META files, reducing redundant file I/O and parsing operations during dependency resolution. *) (** {1 Cache Operations} *) val get : string -> Meta.t (** [get name] retrieves the parsed META file for library [name]. If not cached, fetches from disk via {!Meta.find_lib} and caches the result. @raise Dependencies.DependencyMissing if library not found *) val get_from_cache : Libname.t -> Meta.t (** [get_from_cache lib] retrieves the ROOT package from cache for a library. IMPORTANT: This function always returns the root package, even if [lib] specifies subpackages via {!Libname.subnames}. Callers must use {!Meta.Pkg.find} to resolve subpackages themselves. @raise Failure if library not found in cache (indicates internal error) *) val add : string -> Meta.t -> unit (** [add name meta] adds a parsed META file to the cache. Typically used for synthetic META files (e.g., stdlib). *) val find : string -> Meta.t option (** [find name] looks up a library in the cache without fetching from disk. Returns [Some meta] if cached, [None] otherwise. *) val clear : unit -> unit (** [clear ()] removes all entries from the cache. *) obuild-0.2.2/lib/core/modname.ml000066400000000000000000000023661515212760700164560ustar00rootroot00000000000000open Filepath open Fugue open Compat type t = string exception InvalidModuleName of string exception EmptyModuleName exception ModuleFilenameNotValid of string let char_isalpha c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') let char_is_valid_modchar c = char_isalpha c || (c >= '0' && c <= '9') || c == '_' let string_all p s = let valid = ref true in for i = 0 to String.length s - 1 do valid := !valid && p s.[i] done; !valid let wrap x = if String.length x = 0 then raise EmptyModuleName else if not (string_all char_is_valid_modchar x) then raise (InvalidModuleName x) else if char_uppercase x.[0] <> x.[0] then raise (InvalidModuleName x) else x let of_string x = wrap x let to_string x = x let to_dir x = string_uncapitalize x let to_x ext modname = fn (string_uncapitalize modname ^ ext) let to_o = to_x ".o" let to_directory = to_x "" let to_filename = to_x ".ml" let of_directory filename = wrap (string_capitalize (fn_to_string filename)) let of_filename filename = try wrap (string_capitalize (Filename.chop_extension (fn_to_string filename))) with | EmptyModuleName -> raise (ModuleFilenameNotValid (fn_to_string filename)) | Invalid_argument _ -> raise (ModuleFilenameNotValid (fn_to_string filename)) obuild-0.2.2/lib/core/modname.mli000066400000000000000000000044121515212760700166210ustar00rootroot00000000000000(** Module name handling and validation This module provides types and functions for working with OCaml module names, ensuring they follow naming conventions (capitalized, valid characters). *) (** The type of a module name (internally represented as a string) *) type t (** {1 Exceptions} *) exception InvalidModuleName of string (** Raised when a string doesn't satisfy module name requirements *) exception EmptyModuleName (** Raised when attempting to create a module name from an empty string *) exception ModuleFilenameNotValid of string (** Raised when a filename cannot be converted to a valid module name *) (** {1 Validation Helpers} *) val char_is_valid_modchar : char -> bool (** [char_is_valid_modchar c] returns [true] if [c] is a valid character in a module name (letter, digit, or underscore) *) val string_all : (char -> bool) -> string -> bool (** [string_all p s] returns [true] if predicate [p] holds for all characters in string [s] *) (** {1 Construction and Conversion} *) val wrap : string -> t (** [wrap s] creates a module name from string [s]. @raise InvalidModuleName if [s] contains invalid characters or isn't capitalized @raise EmptyModuleName if [s] is empty *) val of_string : string -> t (** [of_string s] is an alias for [wrap s] *) val to_string : t -> string (** [to_string m] converts module name [m] to a string *) val of_directory : Filepath.filename -> t (** [of_directory fn] creates a module name from a directory name, capitalizing it appropriately. @raise InvalidModuleName if the filename is invalid @raise EmptyModuleName if the filename is empty *) val of_filename : Filepath.filename -> t (** [of_filename fn] creates a module name from a filename, removing the extension and capitalizing. @raise ModuleFilenameNotValid if the filename cannot be converted *) (** {1 File Extensions and Paths} *) val to_dir : t -> string (** [to_dir m] converts module name to directory name (uncapitalized) *) val to_o : t -> Filepath.filename (** [to_o m] converts module name to object file (.o) *) val to_directory : t -> Filepath.filename (** [to_directory m] converts module name to directory filename *) val to_filename : t -> Filepath.filename (** [to_filename m] converts module name to source file (.ml) *) obuild-0.2.2/lib/core/obuild_ast.ml000066400000000000000000000153411515212760700171600ustar00rootroot00000000000000(** Pure AST types for .obuild files These types represent the parsed structure without any validation or file system checks. Validation happens in a separate pass. *) open Location (** A located value - pairs a value with its source location *) type 'a located = 'a Location.located = { value: 'a; loc: loc; } (** Dependency with optional version constraint *) type dependency = { dep_name: string; dep_constraint: string option; (* e.g., ">= 1.0" *) } (** Extra dependency ordering: module A must be built before module B *) type extra_dep = { before: string; (* module name *) after: string; (* module name *) } (** Per-file settings *) type per_settings = { per_files: string list; (* file patterns this applies to *) per_build_deps: dependency list; per_oflags: string list; per_pp: string option; } (** Cstubs functor description: "Bindings.Types -> Types_gen" *) type cstubs_desc = { cstubs_functor: string; (* e.g., "Bindings.Types" *) cstubs_instance: string; (* e.g., "Types_gen" *) } (** Cstubs concurrency policy *) type cstubs_concurrency = | Cstubs_sequential (* Default: no special concurrency support *) | Cstubs_unlocked (* Release runtime lock during C calls *) | Cstubs_lwt_jobs (* Lwt jobs-based concurrency *) | Cstubs_lwt_preemptive (* Lwt preemptive threading *) (** Cstubs errno policy *) type cstubs_errno = | Cstubs_ignore_errno (* Default: errno not accessed *) | Cstubs_return_errno (* Functions return (retval, errno) pairs *) (** Cstubs configuration block *) type cstubs = { cstubs_external_lib_name: string; cstubs_type_desc: cstubs_desc option; cstubs_func_desc: cstubs_desc option; cstubs_generated_types: string; (* default: "Types_generated" *) cstubs_generated_entry: string; (* default: "C" *) cstubs_headers: string list; cstubs_concurrency: cstubs_concurrency; (* default: Cstubs_sequential *) cstubs_errno: cstubs_errno; (* default: Cstubs_ignore_errno *) } (** Stdlib choice *) type stdlib = | Stdlib_None | Stdlib_Standard | Stdlib_Core (** Runtime boolean - can be constant or a flag variable *) type runtime_bool = | Bool_const of bool | Bool_var of string (** C-related settings (shared by all target types) *) type c_settings = { c_dir: string option; c_sources: string list; c_flags: string list; c_libs: string list; c_lib_paths: string list; c_pkgs: dependency list; } (** OCaml-related settings (shared by all target types) *) type ocaml_settings = { src_dir: string list; build_deps: dependency list; pp: string option; extra_deps: extra_dep list; oflags: string list; stdlib: stdlib option; } (** Custom generator definition *) type generator = { gen_name: string; (** Generator name for reference *) gen_suffix: string option; (** File extension for automatic detection (e.g., "mly") *) gen_command: string; (** Command template with variables: ${src}, ${dest}, ${base}, ${sources} *) gen_outputs: string list; (** Output file patterns (e.g., ["${base}.ml", "${base}.mli"]) *) gen_module_name: string option; (** Module name pattern if different from base (e.g., "${base}_t") *) } (** Explicit generate block for multi-input generators or overrides *) type generate_block = { generate_module: string; (** Output module name *) generate_from: string list; (** Input file(s) *) generate_using: string; (** Generator name to use *) generate_args: string option; (** Additional command-line arguments *) } (** Common target settings *) type target_common = { buildable: runtime_bool; installable: runtime_bool; ocaml: ocaml_settings; c: c_settings; per: per_settings list; generates: generate_block list; (** Explicit generate blocks *) } (** Library-specific settings *) type library = { lib_name: string; lib_description: string; lib_modules: string list; lib_pack: bool; lib_syntax: bool; lib_cstubs: cstubs option; lib_target: target_common; lib_subs: library list; (* sub-libraries *) } (** Executable-specific settings *) type executable = { exe_name: string; exe_main: string; (* main-is *) exe_target: target_common; } (** Test settings (similar to executable) *) type test = { test_name: string; test_main: string; test_rundir: string option; test_run_params: string list; test_target: target_common; } (** Benchmark settings *) type benchmark = { bench_name: string; bench_main: string; bench_target: target_common; } (** Example settings *) type example = { example_name: string; example_main: string; example_target: target_common; } (** Flag definition *) type flag = { flag_name: string; flag_description: string; flag_default: bool; } (** Top-level project AST *) type project = { (* Required fields *) project_name: string located; project_version: string located; project_obuild_ver: int located; (* Optional metadata *) project_synopsis: string option; project_description: string option; project_license: string option; project_license_file: string option; project_homepage: string option; project_authors: string list; (* Build configuration *) project_extra_srcs: string list; project_extra_tools: string list; project_configure_script: string option; project_ocaml_ver: string option; (* version constraint expr *) project_ocaml_extra_args: string list; (* Flags, generators, and targets *) project_flags: flag list; project_generators: generator list; (* Custom code generators *) project_libs: library list; project_exes: executable list; project_tests: test list; project_benchs: benchmark list; project_examples: example list; } (** Default values *) let default_c_settings = { c_dir = None; c_sources = []; c_flags = []; c_libs = []; c_lib_paths = []; c_pkgs = []; } let default_ocaml_settings = { src_dir = []; build_deps = []; pp = None; extra_deps = []; oflags = []; stdlib = None; } let default_target_common = { buildable = Bool_const true; installable = Bool_const true; ocaml = default_ocaml_settings; c = default_c_settings; per = []; generates = []; } let default_cstubs = { cstubs_external_lib_name = ""; cstubs_type_desc = None; cstubs_func_desc = None; cstubs_generated_types = "Types_generated"; cstubs_generated_entry = "C"; cstubs_headers = []; cstubs_concurrency = Cstubs_sequential; cstubs_errno = Cstubs_ignore_errno; } let default_generator = { gen_name = ""; gen_suffix = None; gen_command = ""; gen_outputs = []; gen_module_name = None; } let default_generate_block = { generate_module = ""; generate_from = []; generate_using = ""; generate_args = None; } obuild-0.2.2/lib/core/obuild_lexer.ml000066400000000000000000000124541515212760700175120ustar00rootroot00000000000000(** Lexer for .obuild files Tokenizes the line-based, indentation-sensitive format. *) open Location (** Token types *) type token = | KEY_VALUE of string * string (* key: value or key = value *) | BLOCK of string * string list (* blockname arg1 arg2 ... *) | BLANK (* empty or comment line *) | EOF type located_token = { tok : token; loc : Location.loc; indent : int; } (** A token with its location and indentation level *) let new_located_token t l i = {tok = t; loc = l; indent = i} exception Lexer_error of loc * string (** Lexer error *) (** Check if a character is whitespace (space or tab) *) let is_whitespace c = c = ' ' || c = '\t' (** Count leading whitespace and return (indent_level, rest_of_string) *) let count_indent s = let len = String.length s in let rec loop i = if i >= len then (i, "") else if is_whitespace s.[i] then loop (i + 1) else (i, String.sub s i (len - i)) in loop 0 (** Strip trailing whitespace *) let strip_trailing s = let len = String.length s in let rec loop i = if i <= 0 then "" else if is_whitespace s.[i - 1] then loop (i - 1) else String.sub s 0 i in loop len (** Strip leading and trailing whitespace *) let strip s = let _, rest = count_indent s in strip_trailing rest (** Check if line is blank or a comment *) let is_blank_or_comment s = let s = strip s in s = "" || (String.length s > 0 && s.[0] = '#') (** Find separator (: or =) and split into key/value *) let find_key_value s = let len = String.length s in let rec loop i = if i >= len then None else match s.[i] with | ':' | '=' -> let key = strip (String.sub s 0 i) in let value = strip (String.sub s (i + 1) (len - i - 1)) in Some (key, value) | _ -> loop (i + 1) in loop 0 (** Split string into words *) let split_words s = let len = String.length s in let rec skip_ws i = if i >= len then i else if is_whitespace s.[i] then skip_ws (i + 1) else i in let rec read_word i acc = if i >= len then (i, acc) else if is_whitespace s.[i] then (i, acc) else read_word (i + 1) (acc ^ String.make 1 s.[i]) in let rec loop i words = let i = skip_ws i in if i >= len then List.rev words else let i', word = read_word i "" in loop i' (word :: words) in loop 0 [] (** Tokenize a single line *) let tokenize_line line_num line = let indent, content = count_indent line in let loc = new_location line_num (indent + 1) in if is_blank_or_comment line then { tok = BLANK; loc; indent } else match find_key_value content with | Some (key, value) -> { tok = KEY_VALUE (key, value); loc; indent } | None -> ( (* No separator - must be a block header *) let words = split_words content in match words with | [] -> { tok = BLANK; loc; indent } | keyword :: args -> { tok = BLOCK (keyword, args); loc; indent }) (** Merge BLOCK tokens that are continuations of a KEY_VALUE into it. A BLOCK token is a continuation when: - It immediately follows a KEY_VALUE token (with no intervening tokens) - Its indentation is strictly greater than the KEY_VALUE's indentation This handles multi-line field values like: modules: A, B, C, D <- tokenized as BLOCK("C,", ["D"]) but is really a continuation *) let merge_continuations tokens = let rec loop = function | [] -> [] | ({ tok = KEY_VALUE (k, v); indent = kv_indent; _ } as kv_tok) :: rest -> (* Greedily collect BLOCK tokens at strictly higher indentation *) let rec collect v = function | ({ tok = BLOCK (name, args); indent; _ }) :: more when indent > kv_indent -> let cont = String.concat " " (name :: args) in let v' = if v = "" then cont else v ^ " " ^ cont in collect v' more | remaining -> (v, remaining) in let full_v, remaining = collect v rest in { kv_tok with tok = KEY_VALUE (k, full_v) } :: loop remaining | t :: rest -> t :: loop rest in loop tokens (** Tokenize entire input string *) let tokenize input = let lines = String_utils.split '\n' input in let rec loop line_num acc = function | [] -> let loc = { line = line_num; col = 1 } in List.rev ({ tok = EOF; loc; indent = 0 } :: acc) | line :: rest -> let token = tokenize_line line_num line in (* Skip blank lines in token stream *) let acc' = if token.tok = BLANK then acc else token :: acc in loop (line_num + 1) acc' rest in let raw = loop 1 [] lines in merge_continuations raw (** Tokenize from a file *) let tokenize_file path = let ic = open_in path in let n = in_channel_length ic in let buf = Compat.bytes_create n in really_input ic buf 0 n; let s = Compat.bytes_to_string buf in close_in ic; tokenize s (** Pretty-print a token for debugging *) let token_to_string = function | KEY_VALUE (k, v) -> Printf.sprintf "KEY_VALUE(%s, %s)" k v | BLOCK (name, args) -> Printf.sprintf "BLOCK(%s, [%s])" name (String.concat "; " args) | BLANK -> "BLANK" | EOF -> "EOF" let located_token_to_string t = Printf.sprintf "%d:%d indent=%d %s" t.loc.line t.loc.col t.indent (token_to_string t.tok) obuild-0.2.2/lib/core/obuild_parser.ml000066400000000000000000000626171515212760700176750ustar00rootroot00000000000000(** Parser for .obuild files Consumes tokens from the lexer and builds the AST. No validation - just structural parsing. *) open Obuild_ast open Obuild_lexer open Location exception Parser_error of loc * string (** Parser error *) type state = { tokens : located_token list; mutable pos : int; } (** Parser state *) (** Create parser state from tokens *) let make_state tokens = { tokens; pos = 0 } (** Get current token *) let current st = if st.pos < List.length st.tokens then List.nth st.tokens st.pos else let loc = { line = 0; col = 0 } in new_located_token EOF loc 0 (** Advance to next token *) let advance st = st.pos <- st.pos + 1 (** Peek at current token without consuming *) let peek st = current st (** Check if at end *) let at_end st = (current st).tok = EOF (** Raise parser error at current location *) let error st msg = let (t : located_token) = current st in raise (Parser_error (t.Obuild_lexer.loc, msg)) (** Expect a specific indentation level, return tokens at that level *) let rec collect_block st base_indent = let t = peek st in if at_end st || t.indent <= base_indent then [] else ( advance st; t :: collect_block st base_indent) (** Parse a comma-separated list *) let parse_list s = let s = String_utils.strip_spaces s in if s = "" then [] else (* Split on commas first, then trim each *) let parts = String_utils.split ',' s in let parts = List.map String_utils.strip_spaces parts in (* Filter empty strings *) List.filter (fun s -> s <> "") parts (** Parse a whitespace-separated list (for flags/args) *) let parse_words s = let s = String_utils.strip_spaces s in if s = "" then [] else (* Split on spaces *) let parts = String_utils.split ' ' s in (* Filter empty strings *) List.filter (fun s -> s <> "") parts (** Parse a dependency: "name" or "name (>= 1.0)" *) let parse_dependency s = let s = String_utils.strip_spaces s in (* Look for opening paren *) match Compat.SafeString.index_opt s '(' with | None -> { dep_name = s; dep_constraint = None } | Some i -> let name = String_utils.strip_spaces (String.sub s 0 i) in let rest = String.sub s (i + 1) (String.length s - i - 1) in (* Find closing paren *) let constraint_str = match Compat.SafeString.index_opt rest ')' with | None -> String_utils.strip_spaces rest | Some j -> String_utils.strip_spaces (String.sub rest 0 j) in { dep_name = name; dep_constraint = Some constraint_str } (** Parse a list of dependencies *) let parse_dependencies s = List.map parse_dependency (parse_list s) (** Parse extra-dep: "A -> B" or "A before B" or "A then B" *) let parse_extra_dep s = let s = String_utils.strip_spaces s in (* Try different separators *) let try_split sep = match String_utils.split sep.[0] s with | [ a; b ] when String.length sep = 1 -> Some { before = String_utils.strip_spaces a; after = String_utils.strip_spaces b } | _ -> None in (* Try " -> " first by looking for it *) let arrow_pos = let rec find i = if i + 4 > String.length s then None else if String.sub s i 4 = " -> " then Some i else find (i + 1) in find 0 in match arrow_pos with | Some i -> let a = String_utils.strip_spaces (String.sub s 0 i) in let b = String_utils.strip_spaces (String.sub s (i + 4) (String.length s - i - 4)) in { before = a; after = b } | None -> ( (* Try "before" or "then" *) let words = String_utils.split ' ' s in let words = List.filter (fun w -> w <> "") words in match words with | [ a; "before"; b ] | [ a; "then"; b ] -> { before = a; after = b } | [ a; b ] -> { before = a; after = b } | _ -> { before = s; after = "" }) (* fallback, validation will catch it *) (** Parse stdlib value *) let parse_stdlib s = match Compat.string_lowercase (String_utils.strip_spaces s) with | "none" | "no" -> Some Stdlib_None | "standard" -> Some Stdlib_Standard | "core" -> Some Stdlib_Core | _ -> None (** Parse runtime bool *) let parse_runtime_bool s = match Compat.string_lowercase (String_utils.strip_spaces s) with | "true" -> Bool_const true | "false" -> Bool_const false | s when String.length s > 0 && s.[0] = '$' -> Bool_var (String.sub s 1 (String.length s - 1)) | s -> Bool_var s (** Parse cstubs description: "Functor.Path -> Instance" *) let parse_cstubs_desc s = let s = String_utils.strip_spaces s in let arrow = " -> " in let rec find_arrow i = if i + 4 > String.length s then None else if String.sub s i 4 = arrow then Some i else find_arrow (i + 1) in match find_arrow 0 with | Some i -> let functor_path = String_utils.strip_spaces (String.sub s 0 i) in let instance = String_utils.strip_spaces (String.sub s (i + 4) (String.length s - i - 4)) in Some { cstubs_functor = functor_path; cstubs_instance = instance } | None -> None (** Parse C settings from key-value pairs *) let parse_c_setting c key value = match Compat.string_lowercase key with | "cdir" | "c-dir" -> { c with c_dir = Some value } | "csources" | "c-sources" -> { c with c_sources = c.c_sources @ parse_list value } | "cflags" | "c-flags" | "ccopts" | "ccopt" | "c-opts" -> { c with c_flags = c.c_flags @ parse_words value } | "c-libs" -> { c with c_libs = c.c_libs @ parse_words value } | "c-libpaths" -> { c with c_lib_paths = c.c_lib_paths @ parse_words value } | "c-pkgs" -> { c with c_pkgs = c.c_pkgs @ parse_dependencies value } | _ -> c (** Parse OCaml settings from key-value pairs *) let parse_ocaml_setting o key value = match Compat.string_lowercase key with | "path" | "srcdir" | "src-dir" -> { o with src_dir = o.src_dir @ parse_list value } | "builddepends" | "builddeps" | "build-deps" -> { o with build_deps = o.build_deps @ parse_dependencies value } | "preprocessor" | "pp" -> { o with pp = Some value } | "extra-deps" -> { o with extra_deps = o.extra_deps @ List.map parse_extra_dep (parse_list value) } | "oflags" -> { o with oflags = o.oflags @ parse_words value } | "stdlib" -> { o with stdlib = parse_stdlib value } | _ -> o (** Parse common target setting *) let parse_target_setting target key value = match Compat.string_lowercase key with | "buildable" -> { target with buildable = parse_runtime_bool value } | "installable" -> { target with installable = parse_runtime_bool value } | _ -> let ocaml' = parse_ocaml_setting target.ocaml key value in let c' = parse_c_setting target.c key value in { target with ocaml = ocaml'; c = c' } (** Parse generator match type from key-value *) (** Parse generator block *) let parse_generator_block name tokens = let gen = { Obuild_ast.default_generator with gen_name = name } in let rec loop gen = function | [] -> gen | t :: rest -> ( match t.tok with | KEY_VALUE (key, value) -> let gen' = match Compat.string_lowercase key with | "suffix" -> { gen with gen_suffix = Some value } | "command" -> { gen with gen_command = value } | "outputs" -> { gen with gen_outputs = gen.gen_outputs @ parse_list value } | "module-name" -> { gen with gen_module_name = Some value } | _ -> gen in loop gen' rest | _ -> loop gen rest) in loop gen tokens (** Parse generate block (explicit generation for multi-input or overrides) *) let parse_generate_block module_name tokens = let gen = { Obuild_ast.default_generate_block with generate_module = module_name } in let rec loop gen = function | [] -> gen | t :: rest -> ( match t.tok with | KEY_VALUE (key, value) -> let gen' = match Compat.string_lowercase key with | "from" -> { gen with generate_from = gen.generate_from @ parse_list value } | "using" -> { gen with generate_using = value } | "args" | "arguments" | "command-args" -> { gen with generate_args = Some value } | _ -> gen in loop gen' rest | _ -> loop gen rest) in loop gen tokens (** Parse cstubs block *) let parse_cstubs_block tokens = let rec loop cstubs = function | [] -> cstubs | t :: rest -> ( match t.tok with | KEY_VALUE (key, value) -> let cstubs' = match Compat.string_lowercase key with | "external-library-name" -> { cstubs with cstubs_external_lib_name = value } | "type-description" -> { cstubs with cstubs_type_desc = parse_cstubs_desc value } | "function-description" -> { cstubs with cstubs_func_desc = parse_cstubs_desc value } | "generated-types" -> { cstubs with cstubs_generated_types = value } | "generated-entry-point" -> { cstubs with cstubs_generated_entry = value } | "headers" -> { cstubs with cstubs_headers = cstubs.cstubs_headers @ parse_list value } | "concurrency" -> let concurrency = match Compat.string_lowercase value with | "sequential" -> Obuild_ast.Cstubs_sequential | "unlocked" -> Obuild_ast.Cstubs_unlocked | "lwt_jobs" | "lwt-jobs" -> Obuild_ast.Cstubs_lwt_jobs | "lwt_preemptive" | "lwt-preemptive" -> Obuild_ast.Cstubs_lwt_preemptive | _ -> failwith (Printf.sprintf "Unknown concurrency policy: %s (expected: sequential, unlocked, \ lwt_jobs, lwt_preemptive)" value) in { cstubs with cstubs_concurrency = concurrency } | "errno" -> let errno = match Compat.string_lowercase value with | "ignore" | "ignore_errno" | "ignore-errno" -> Obuild_ast.Cstubs_ignore_errno | "return" | "return_errno" | "return-errno" -> Obuild_ast.Cstubs_return_errno | _ -> failwith (Printf.sprintf "Unknown errno policy: %s (expected: ignore_errno, return_errno)" value) in { cstubs with cstubs_errno = errno } | _ -> cstubs in loop cstubs' rest | _ -> loop cstubs rest) in loop default_cstubs tokens (** Parse per block *) let parse_per_block args tokens = let per = { per_files = args; per_build_deps = []; per_oflags = []; per_pp = None } in let rec loop per = function | [] -> per | t :: rest -> ( match t.tok with | KEY_VALUE (key, value) -> let per' = match Compat.string_lowercase key with | "builddepends" | "builddeps" | "build-deps" -> { per with per_build_deps = per.per_build_deps @ parse_dependencies value } | "oflags" -> { per with per_oflags = per.per_oflags @ parse_words value } | "pp" -> { per with per_pp = Some value } | _ -> per in loop per' rest | _ -> loop per rest) in loop per tokens (** Parse library block *) let rec parse_library_block name tokens = let lib = { lib_name = name; lib_description = ""; lib_modules = []; lib_pack = false; lib_syntax = false; lib_cstubs = None; lib_target = default_target_common; lib_subs = []; } in parse_library_tokens lib tokens and parse_library_tokens lib tokens = match tokens with | [] -> lib | t :: rest -> ( match t.tok with | KEY_VALUE (key, value) -> let lib' = match Compat.string_lowercase key with | "modules" -> { lib with lib_modules = lib.lib_modules @ parse_list value } | "pack" -> { lib with lib_pack = Compat.string_lowercase value = "true" } | "syntax" -> { lib with lib_syntax = Compat.string_lowercase value = "true" } | "description" -> { lib with lib_description = value } | _ -> { lib with lib_target = parse_target_setting lib.lib_target key value } in parse_library_tokens lib' rest | BLOCK (name, args) -> (* Collect nested block *) let base_indent = t.indent in let nested, remaining = collect_nested rest base_indent in let lib' = match Compat.string_lowercase name with | "cstubs" -> { lib with lib_cstubs = Some (parse_cstubs_block nested) } | "per" -> let per = parse_per_block args nested in { lib with lib_target = { lib.lib_target with per = lib.lib_target.per @ [ per ] } } | "sub" | "sublib" | "library" -> let subname = match args with | [ n ] -> n | _ -> "unknown" in let sublib = parse_library_block subname nested in { lib with lib_subs = lib.lib_subs @ [ sublib ] } | "generate" -> let module_name = match args with | [ n ] -> n | _ -> "" in let gen_block = parse_generate_block module_name nested in { lib with lib_target = { lib.lib_target with generates = lib.lib_target.generates @ [ gen_block ] } } | _ -> lib in parse_library_tokens lib' remaining | _ -> parse_library_tokens lib rest) (** Collect tokens belonging to a nested block *) and collect_nested tokens base_indent = let rec loop acc = function | [] -> (List.rev acc, []) | t :: rest as all -> if t.indent > base_indent then loop (t :: acc) rest else (List.rev acc, all) in loop [] tokens (** Parse executable block *) let parse_executable_block name tokens = let exe = { exe_name = name; exe_main = ""; exe_target = default_target_common } in let rec loop exe = function | [] -> exe | t :: rest -> ( match t.tok with | KEY_VALUE (key, value) -> let exe' = match Compat.string_lowercase key with | "main" | "mainis" | "main-is" -> { exe with exe_main = value } | _ -> { exe with exe_target = parse_target_setting exe.exe_target key value } in loop exe' rest | BLOCK (name, args) -> let base_indent = t.indent in let nested, remaining = collect_nested rest base_indent in let exe' = match Compat.string_lowercase name with | "per" -> let per = parse_per_block args nested in { exe with exe_target = { exe.exe_target with per = exe.exe_target.per @ [ per ] }; } | "generate" -> let module_name = match args with | [ n ] -> n | _ -> "" in let gen_block = parse_generate_block module_name nested in { exe with exe_target = { exe.exe_target with generates = exe.exe_target.generates @ [ gen_block ] } } | _ -> exe in loop exe' remaining | _ -> loop exe rest) in loop exe tokens (** Parse test block *) let parse_test_block name tokens = let test = { test_name = name; test_main = ""; test_rundir = None; test_run_params = []; test_target = default_target_common; } in let rec loop test = function | [] -> test | t :: rest -> ( match t.tok with | KEY_VALUE (key, value) -> let test' = match Compat.string_lowercase key with | "main" | "mainis" | "main-is" -> { test with test_main = value } | "rundir" | "run-dir" -> { test with test_rundir = Some value } | "runparams" | "run-params" -> { test with test_run_params = parse_list value } | _ -> { test with test_target = parse_target_setting test.test_target key value } in loop test' rest | BLOCK (name, args) -> let base_indent = t.indent in let nested, remaining = collect_nested rest base_indent in let test' = match Compat.string_lowercase name with | "per" -> let per = parse_per_block args nested in { test with test_target = { test.test_target with per = test.test_target.per @ [ per ] }; } | "generate" -> let module_name = match args with | [ n ] -> n | _ -> "" in let gen_block = parse_generate_block module_name nested in { test with test_target = { test.test_target with generates = test.test_target.generates @ [ gen_block ] } } | _ -> test in loop test' remaining | _ -> loop test rest) in loop test tokens (** Parse example block (same structure as executable) *) let parse_example_block name tokens = let example = { example_name = name; example_main = ""; example_target = default_target_common } in let rec loop example = function | [] -> example | t :: rest -> ( match t.tok with | KEY_VALUE (key, value) -> let example' = match Compat.string_lowercase key with | "main" | "mainis" | "main-is" -> { example with example_main = value } | _ -> { example with example_target = parse_target_setting example.example_target key value; } in loop example' rest | BLOCK (name, args) -> let base_indent = t.indent in let nested, remaining = collect_nested rest base_indent in let example' = match Compat.string_lowercase name with | "per" -> let per = parse_per_block args nested in { example with example_target = { example.example_target with per = example.example_target.per @ [ per ] }; } | "generate" -> let module_name = match args with | [ n ] -> n | _ -> "" in let gen_block = parse_generate_block module_name nested in { example with example_target = { example.example_target with generates = example.example_target.generates @ [ gen_block ] } } | _ -> example in loop example' remaining | _ -> loop example rest) in loop example tokens (** Parse benchmark block *) let parse_benchmark_block name tokens = let bench = { bench_name = name; bench_main = ""; bench_target = default_target_common } in let rec loop bench = function | [] -> bench | t :: rest -> ( match t.tok with | KEY_VALUE (key, value) -> let bench' = match Compat.string_lowercase key with | "main" | "mainis" | "main-is" -> { bench with bench_main = value } | _ -> { bench with bench_target = parse_target_setting bench.bench_target key value } in loop bench' rest | BLOCK (name, args) -> let base_indent = t.indent in let nested, remaining = collect_nested rest base_indent in let bench' = match Compat.string_lowercase name with | "per" -> let per = parse_per_block args nested in { bench with bench_target = { bench.bench_target with per = bench.bench_target.per @ [ per ] }; } | "generate" -> let module_name = match args with | [ n ] -> n | _ -> "" in let gen_block = parse_generate_block module_name nested in { bench with bench_target = { bench.bench_target with generates = bench.bench_target.generates @ [ gen_block ] } } | _ -> bench in loop bench' remaining | _ -> loop bench rest) in loop bench tokens (** Parse flag block *) let parse_flag_block name tokens = let flag = { flag_name = name; flag_description = ""; flag_default = false } in let rec loop flag = function | [] -> flag | t :: rest -> ( match t.tok with | KEY_VALUE (key, value) -> let flag' = match Compat.string_lowercase key with | "description" -> { flag with flag_description = value } | "default" -> { flag with flag_default = Compat.string_lowercase value = "true" } | _ -> flag in loop flag' rest | _ -> loop flag rest) in loop flag tokens (** Default empty project *) let empty_project loc = { project_name = { Obuild_ast.value = ""; loc }; project_version = { Obuild_ast.value = ""; loc }; project_obuild_ver = { Obuild_ast.value = 0; loc }; project_synopsis = None; project_description = None; project_license = None; project_license_file = None; project_homepage = None; project_authors = []; project_extra_srcs = []; project_extra_tools = []; project_configure_script = None; project_ocaml_ver = None; project_ocaml_extra_args = []; project_flags = []; project_generators = []; project_libs = []; project_exes = []; project_tests = []; project_benchs = []; project_examples = []; } (** Parse top-level project *) let parse_project tokens = let st = make_state tokens in let start_loc = (current st).Obuild_lexer.loc in let proj = ref (empty_project start_loc) in while not (at_end st) do let t = current st in advance st; match t.tok with | KEY_VALUE (key, value) -> ( let p = !proj in proj := match Compat.string_lowercase key with | "name" -> { p with project_name = { Obuild_ast.value; loc = t.Obuild_lexer.loc } } | "version" -> { p with project_version = { Obuild_ast.value; loc = t.Obuild_lexer.loc } } | "obuild-ver" -> { p with project_obuild_ver = { Obuild_ast.value = int_of_string value; loc = t.Obuild_lexer.loc }; } | "synopsis" -> { p with project_synopsis = Some value } | "description" -> { p with project_description = Some value } | "license" | "licence" -> { p with project_license = Some value } | "license-file" | "licence-file" -> { p with project_license_file = Some value } | "homepage" -> { p with project_homepage = Some value } | "authors" -> { p with project_authors = parse_list value } | "author" -> { p with project_authors = [ value ] } | "extra-srcs" -> { p with project_extra_srcs = p.project_extra_srcs @ parse_list value } | "tools" -> { p with project_extra_tools = p.project_extra_tools @ parse_list value } | "configure-script" -> { p with project_configure_script = Some value } | "ocamlversion" | "ocaml-version" -> { p with project_ocaml_ver = Some value } | "ocaml-extra-args" | "ocamlextraargs" -> { p with project_ocaml_extra_args = parse_words value } | _ -> p) | BLOCK (name, args) -> ( let block_tokens = collect_block st t.indent in let p = !proj in let block_name = match args with | [ n ] -> n | _ -> "" in proj := match Compat.string_lowercase name with | "library" -> let lib = parse_library_block block_name block_tokens in { p with project_libs = p.project_libs @ [ lib ] } | "executable" -> let exe = parse_executable_block block_name block_tokens in { p with project_exes = p.project_exes @ [ exe ] } | "test" -> let test = parse_test_block block_name block_tokens in { p with project_tests = p.project_tests @ [ test ] } | "bench" | "benchmark" -> let bench = parse_benchmark_block block_name block_tokens in { p with project_benchs = p.project_benchs @ [ bench ] } | "example" -> let example = parse_example_block block_name block_tokens in { p with project_examples = p.project_examples @ [ example ] } | "flag" -> let flag = parse_flag_block block_name block_tokens in { p with project_flags = p.project_flags @ [ flag ] } | "generator" -> let gen = parse_generator_block block_name block_tokens in { p with project_generators = p.project_generators @ [ gen ] } | _ -> p) | _ -> () done; !proj (** Main parsing function: string -> project *) let parse input = let tokens = Obuild_lexer.tokenize input in parse_project tokens (** Parse from file *) let parse_file path = let tokens = Obuild_lexer.tokenize_file path in parse_project tokens obuild-0.2.2/lib/core/obuild_validate.ml000066400000000000000000000363161515212760700201670ustar00rootroot00000000000000(** Validation and transformation from AST to Project types Converts the pure AST from the parser into the existing internal types (Project.t, Target.t, etc.) with validation. *) open Filepath open Obuild_lexer open Obuild_ast open Location exception Validation_error of loc * string (** Validation error with location *) (** Raise a validation error *) let error loc msg = raise (Validation_error (loc, msg)) (** Format location for error messages *) let loc_to_string loc = Printf.sprintf "%d:%d" loc.line loc.col (** Format validation error *) let error_to_string loc msg = Printf.sprintf "%s: %s" (loc_to_string loc) msg (* ============================================================ *) (* Helper conversions *) (* ============================================================ *) (** Convert AST stdlib to Target stdlib *) let convert_stdlib = function | Stdlib_None -> Target.Stdlib_None | Stdlib_Standard -> Target.Stdlib_Standard | Stdlib_Core -> Target.Stdlib_Core (** Convert AST runtime_bool to Target runtime_bool *) let convert_runtime_bool = function | Bool_const b -> Target.BoolConst b | Bool_var v -> Target.BoolVariable v (** Convert AST dependency to Dependencies.dependency *) let convert_dependency (dep : dependency) : Dependencies.dependency = let libname = Libname.of_string dep.dep_name in let constraint_expr = match dep.dep_constraint with | None -> None | Some s -> Expr.parse dep.dep_name s in (libname, constraint_expr) (** Convert AST dependency to C dependency (just string, constraint) *) let convert_cdependency (dep : dependency) : Dependencies.cdependency = let constraint_expr = match dep.dep_constraint with | None -> None | Some s -> Expr.parse dep.dep_name s in (dep.dep_name, constraint_expr) (** Convert AST extra_dep to (Hier.t * Hier.t) *) let convert_extra_dep (ed : extra_dep) : Hier.t * Hier.t = (Hier.of_string ed.before, Hier.of_string ed.after) (** Convert module name string to Hier.t *) let module_name_to_hier s = Hier.make [ Modname.wrap (Compat.string_capitalize s) ] (* ============================================================ *) (* Convert C settings *) (* ============================================================ *) let convert_c_settings ?(default_cdir=Filepath.current_dir) (c : c_settings) : Target.target_cbits = { Target.target_cdir = (match c.c_dir with | None -> default_cdir | Some s -> fp s); target_csources = List.map fn c.c_sources; target_cflags = c.c_flags; target_clibs = c.c_libs; target_clibpaths = List.map fp c.c_lib_paths; target_cpkgs = List.map convert_cdependency c.c_pkgs; } (* ============================================================ *) (* Convert OCaml settings *) (* ============================================================ *) let convert_ocaml_settings (o : ocaml_settings) : Target.target_obits = { Target.target_srcdir = (match o.src_dir with | [] -> [ Filepath.current_dir ] | dirs -> List.map fp dirs); target_builddeps = List.map convert_dependency o.build_deps; target_oflags = o.oflags; target_pp = (match o.pp with | None -> None | Some s -> Some (Pp.Type.of_string s)); target_extradeps = List.map convert_extra_dep o.extra_deps; target_stdlib = (match o.stdlib with | None -> Target.Stdlib_Standard | Some s -> convert_stdlib s); } (* ============================================================ *) (* Convert cstubs *) (* ============================================================ *) let convert_cstubs_desc (desc : cstubs_desc) : Target.cstubs_description = { Target.cstubs_functor = Hier.of_string desc.cstubs_functor; cstubs_instance = desc.cstubs_instance; } let convert_cstubs_concurrency = function | Cstubs_sequential -> Target.Cstubs_sequential | Cstubs_unlocked -> Target.Cstubs_unlocked | Cstubs_lwt_jobs -> Target.Cstubs_lwt_jobs | Cstubs_lwt_preemptive -> Target.Cstubs_lwt_preemptive let convert_cstubs_errno = function | Cstubs_ignore_errno -> Target.Cstubs_ignore_errno | Cstubs_return_errno -> Target.Cstubs_return_errno let convert_cstubs (cs : cstubs) : Target.target_cstubs = { Target.cstubs_external_library_name = cs.cstubs_external_lib_name; cstubs_type_description = Compat.Option.map convert_cstubs_desc cs.cstubs_type_desc; cstubs_function_description = Compat.Option.map convert_cstubs_desc cs.cstubs_func_desc; cstubs_generated_types = cs.cstubs_generated_types; cstubs_generated_entry_point = cs.cstubs_generated_entry; cstubs_headers = cs.cstubs_headers; cstubs_concurrency = convert_cstubs_concurrency cs.cstubs_concurrency; cstubs_errno = convert_cstubs_errno cs.cstubs_errno; } (* ============================================================ *) (* Convert generator types *) (* ============================================================ *) let convert_generator (gen : Obuild_ast.generator) : Project.Generator.t = { Project.Generator.name = gen.gen_name; suffix = gen.gen_suffix; command = gen.gen_command; outputs = gen.gen_outputs; module_name = gen.gen_module_name; } let convert_generate_block (gen : Obuild_ast.generate_block) : Target.target_generate = { Target.generate_module = Hier.of_string gen.generate_module; generate_from = List.map fp gen.generate_from; generate_using = gen.generate_using; generate_args = gen.generate_args; } (* ============================================================ *) (* Convert per block (target_extra) *) (* ============================================================ *) let convert_per (per : per_settings) : Target.target_extra = { Target.target_extra_objects = per.per_files; target_extra_builddeps = List.map convert_dependency per.per_build_deps; target_extra_oflags = per.per_oflags; target_extra_cflags = []; (* per blocks don't have cflags in AST *) target_extra_pp = Compat.Option.map Pp.Type.of_string per.per_pp; } (* ============================================================ *) (* Convert target_common to target *) (* ============================================================ *) let convert_target_common name typ ?cstubs (tc : target_common) : Target.target = (* Use src-dir as default for c-dir if c-dir is not specified *) let default_cdir = match tc.ocaml.src_dir with | [] -> Filepath.current_dir | dir :: _ -> fp dir in { Target.target_name = name; target_type = typ; target_cbits = convert_c_settings ~default_cdir tc.c; target_obits = convert_ocaml_settings tc.ocaml; target_cstubs = Compat.Option.map convert_cstubs cstubs; target_generates = List.map convert_generate_block tc.generates; target_extras = List.map convert_per tc.per; target_buildable = convert_runtime_bool tc.buildable; target_installable = convert_runtime_bool tc.installable; } (* ============================================================ *) (* Convert library *) (* ============================================================ *) let rec convert_library (lib : library) : Project.Library.t = let libname = Libname.of_string lib.lib_name in let target_name = Target.Name.Lib libname in let target = convert_target_common target_name Target.Typ.Lib ?cstubs:lib.lib_cstubs lib.lib_target in (* Auto-add cstubs generated modules if present *) let base_modules = List.map module_name_to_hier lib.lib_modules in let modules = match lib.lib_cstubs with | None -> base_modules | Some cs -> (* All three modules are derived from cstubs config: - _generated: the FOREIGN implementation - generated-types: type bindings (e.g., Types_generated) - generated-entry-point: entry module (e.g., C) *) let foreign_name = cs.cstubs_external_lib_name ^ "_generated" in let generated_modules = [ Hier.of_string (Compat.string_capitalize foreign_name); Hier.of_string (Compat.string_capitalize cs.cstubs_generated_types); Hier.of_string (Compat.string_capitalize cs.cstubs_generated_entry); ] in (* Add any that aren't already in the list *) List.fold_left (fun acc m -> if List.mem m acc then acc else m :: acc) base_modules generated_modules in { Project.Library.name = libname; description = lib.lib_description; target; modules; pack = lib.lib_pack; syntax = lib.lib_syntax; subs = List.map (convert_sublibrary libname) lib.lib_subs; } and convert_sublibrary parent_name (lib : library) : Project.Library.t = let libname = Libname.append parent_name lib.lib_name in let target_name = Target.Name.Lib libname in let target = convert_target_common target_name Target.Typ.Lib ?cstubs:lib.lib_cstubs lib.lib_target in (* Auto-add cstubs generated modules if present *) let base_modules = List.map module_name_to_hier lib.lib_modules in let modules = match lib.lib_cstubs with | None -> base_modules | Some cs -> let foreign_name = cs.cstubs_external_lib_name ^ "_generated" in let generated_modules = [ Hier.of_string (Compat.string_capitalize foreign_name); Hier.of_string (Compat.string_capitalize cs.cstubs_generated_types); Hier.of_string (Compat.string_capitalize cs.cstubs_generated_entry); ] in List.fold_left (fun acc m -> if List.mem m acc then acc else m :: acc) base_modules generated_modules in { Project.Library.name = libname; description = lib.lib_description; target; modules; pack = lib.lib_pack; syntax = lib.lib_syntax; subs = List.map (convert_sublibrary libname) lib.lib_subs; } (* ============================================================ *) (* Convert executable *) (* ============================================================ *) let convert_executable (exe : executable) : Project.Executable.t = let target_name = Target.Name.Exe exe.exe_name in let target = convert_target_common target_name Target.Typ.Exe exe.exe_target in { Project.Executable.name = exe.exe_name; main = fn exe.exe_main; target } (* ============================================================ *) (* Convert test *) (* ============================================================ *) let convert_test (t : test) : Project.Test.t = let target_name = Target.Name.Test t.test_name in let target = convert_target_common target_name Target.Typ.Test t.test_target in Project.Test.make ~name:t.test_name ~main:(fn t.test_main) ~target ~rundir:(Compat.Option.map fp t.test_rundir) ~runopt:t.test_run_params (* ============================================================ *) (* Convert benchmark *) (* ============================================================ *) let convert_benchmark (b : benchmark) : Project.Bench.t = let target_name = Target.Name.Bench b.bench_name in let target = convert_target_common target_name Target.Typ.Bench b.bench_target in Project.Bench.make ~name:b.bench_name ~main:(fn b.bench_main) ~target (* ============================================================ *) (* Convert example *) (* ============================================================ *) let convert_example (ex : example) : Project.Example.t = let target_name = Target.Name.Example ex.example_name in let target = convert_target_common target_name Target.Typ.Test ex.example_target in Project.Example.make ~name:ex.example_name ~main:(fn ex.example_main) ~target (* ============================================================ *) (* Convert flag *) (* ============================================================ *) let convert_flag (f : flag) : Project.Flag.t = { Project.Flag.name = f.flag_name; description = f.flag_description; default = (if f.flag_default then Some true else Some false); } (* ============================================================ *) (* Validation *) (* ============================================================ *) (** Validate required project fields *) let validate_required_fields (proj : project) = if proj.project_name.value = "" then error proj.project_name.loc "Missing required field: name"; if proj.project_version.value = "" then error proj.project_version.loc "Missing required field: version"; if proj.project_obuild_ver.value = 0 then error proj.project_obuild_ver.loc "Missing required field: obuild-ver"; if proj.project_obuild_ver.value > 1 then error proj.project_obuild_ver.loc (Printf.sprintf "Unsupported obuild version: %d (max supported: 1)" proj.project_obuild_ver.value) (** Validate library has modules *) let rec validate_library (lib : library) = if lib.lib_modules = [] then failwith (Printf.sprintf "Library '%s' has no modules" lib.lib_name); List.iter validate_library lib.lib_subs (** Validate executable has main *) let validate_executable (exe : executable) = if exe.exe_main = "" then failwith (Printf.sprintf "Executable '%s' has no main-is" exe.exe_name) (** Validate test has main *) let validate_test (t : test) = if t.test_main = "" then failwith (Printf.sprintf "Test '%s' has no main-is" t.test_name) (** Validate all targets *) let validate_targets (proj : project) = List.iter validate_library proj.project_libs; List.iter validate_executable proj.project_exes; List.iter validate_test proj.project_tests (* ============================================================ *) (* Main conversion function *) (* ============================================================ *) (** Convert and validate AST project to Project.t *) let convert (proj : project) : Project.t = (* Validate first *) validate_required_fields proj; validate_targets proj; (* Convert *) { Project.name = proj.project_name.value; version = proj.project_version.value; synopsis = Compat.Option.value ~default:"" proj.project_synopsis; description = Compat.Option.value ~default:"" proj.project_description; license = Compat.Option.value ~default:"" proj.project_license; license_file = Compat.Option.map fp proj.project_license_file; authors = proj.project_authors; obuild_ver = proj.project_obuild_ver.value; ocaml_ver = Compat.Option.bind proj.project_ocaml_ver (fun s -> Expr.parse "ocaml-version" s); homepage = Compat.Option.value ~default:"" proj.project_homepage; flags = List.map convert_flag proj.project_flags; generators = List.map convert_generator proj.project_generators; libs = List.map convert_library proj.project_libs; exes = List.map convert_executable proj.project_exes; tests = List.map convert_test proj.project_tests; benchs = List.map convert_benchmark proj.project_benchs; examples = List.map convert_example proj.project_examples; extra_srcs = List.map fp proj.project_extra_srcs; extra_tools = List.map fn proj.project_extra_tools; configure_script = Compat.Option.map fp proj.project_configure_script; ocaml_extra_args = (match proj.project_ocaml_extra_args with | [] -> None | args -> Some args); } (** Parse and convert from string *) let parse_and_convert input : Project.t = let ast = Obuild_parser.parse input in convert ast (** Parse and convert from file *) let parse_and_convert_file path : Project.t = let ast = Obuild_parser.parse_file path in convert ast obuild-0.2.2/lib/core/pp.ml000066400000000000000000000016231515212760700154500ustar00rootroot00000000000000open Fugue exception InvalidPreprocessor of string (* http://ocaml.org/tutorials/camlp4_3.10.html *) type package = string list module Type = struct type t = | CamlP4O | CamlP4R let of_string s = match Compat.string_lowercase s with | "p4o" | "camlp4o" -> CamlP4O | "p4r" | "camlp4r" -> CamlP4R | _ -> raise (InvalidPreprocessor s) let to_string = function | CamlP4O -> "camlp4o" | CamlP4R -> "camlp4r" end type desc = { camlp4 : string; packages : package list; } type t = desc option let some s pkgs = Some { camlp4 = s; packages = pkgs } let none = None let append pp pkgs = match pp with | None -> pp | Some d -> Some { d with packages = d.packages @ pkgs } let to_params pp = maybe [] (fun desc -> let s = desc.camlp4 ^ " " ^ String.concat " " (List.concat (List.map (fun x -> x) desc.packages)) in [ "-pp"; s ]) pp obuild-0.2.2/lib/core/pp.mli000066400000000000000000000020201515212760700156110ustar00rootroot00000000000000(** Preprocessor configuration *) exception InvalidPreprocessor of string (** Preprocessor package (list of package arguments) *) type package = string list (** Preprocessor type module *) module Type : sig type t = | CamlP4O (** Camlp4o preprocessor *) | CamlP4R (** Camlp4r (revised syntax) preprocessor *) val of_string : string -> t (** Parse preprocessor type from string *) val to_string : t -> string (** Convert preprocessor type to string *) end (** Preprocessor descriptor *) type desc = { camlp4 : string; (** Preprocessor command *) packages : package list; (** Package arguments *) } (** Preprocessor option (may be None if no preprocessing) *) type t = desc option val some : string -> package list -> t (** Create a preprocessor option with command and packages *) val none : t (** No preprocessor *) val append : t -> package list -> t (** Append packages to preprocessor configuration *) val to_params : t -> string list (** Convert preprocessor to command-line parameters *) obuild-0.2.2/lib/core/ppx_resolver.ml000066400000000000000000000066021515212760700175630ustar00rootroot00000000000000(** PPX and Syntax Preprocessor Resolution This module handles the resolution of PPX preprocessors and syntax extensions (like camlp4) for OCaml compilation targets. = Key Responsibilities = - Resolve camlp4/syntax preprocessor dependencies - Generate preprocessor flags for compilation - Handle both internal and external syntax packages - Support camlp4o and camlp4r syntax variants = Historical Context = OCaml has evolved through several preprocessing systems: - camlp4: Original extensible preprocessor (OCaml < 4.08) - PPX: Modern preprocessor system using AST transformations - This module supports both for compatibility *) open Fugue open Filepath open Analyze open Types open Helper open Gconf open Target open Prepare_types (* Camlp4 library identifier *) let camlp4Libname = Libname.of_string "camlp4" (* Common predicates for syntax preprocessing *) let syntaxPredsCommon = [Meta.Predicate.Syntax; Meta.Predicate.Preprocessor] (* Get the camlp4 predicate based on preprocessor type *) let get_p4pred = function | Pp.Type.CamlP4O -> Meta.Predicate.Camlp4o | Pp.Type.CamlP4R -> Meta.Predicate.Camlp4r (** Get syntax preprocessor flags for a list of build dependencies *) let get_syntax_pp bstate preprocessor buildDeps = let conf = bstate.bstate_config in let p4pred = get_p4pred preprocessor in let stdlib = fp (get_ocaml_config_key "standard_library" conf) in list_filter_map (fun spkg -> if Analyze.is_pkg_internal conf spkg then ( let lib = Project.find_lib bstate.bstate_config.project_file spkg in if lib.Project.Library.syntax then ( (* TODO need to make sure that the bytecode option has been enabled for the syntax library *) let dir = Dist.get_build_exn (Dist.Target (Name.Lib lib.Project.Library.name)) in Some [fp_to_string (dir Libname.to_cmca ByteCode Normal lib.Project.Library.name) ] ) else None ) else ( let meta = Metacache.get_from_cache spkg in let preds = if spkg = camlp4Libname then p4pred :: syntaxPredsCommon else syntaxPredsCommon in if Meta.Pkg.is_syntax meta spkg then ( let includePath = Meta.get_include_dir stdlib meta in Some ["-I"; fp_to_string includePath; Meta.Pkg.get_archive meta spkg preds] ) else None ) ) buildDeps (** Get target-specific preprocessor configuration *) let get_target_pp bstate target = function | None -> Pp.none | Some pp -> let conf = bstate.bstate_config in let nodes = List.rev (Taskdep.linearize conf.project_pkgdeps_dag Taskdep.FromParent [Analyze.Target target.target_name]) in let syntaxPkgs = list_filter_map (fun node -> match node with | Dependency dep -> Some dep | _ -> None ) nodes in log Verbose " all packages : [%s]\n%!" (Utils.showList "," Libname.to_string syntaxPkgs); let p4pred = get_p4pred pp in let p4Meta = Metacache.get_from_cache camlp4Libname in let preproc = (snd p4Meta).Meta.Pkg.preprocessor in let archive = [Meta.Pkg.get_archive p4Meta camlp4Libname (p4pred::syntaxPredsCommon)] in (*log Verbose " camlp4 strs: [%s]\n%!" (Utils.showList "] [" id camlp4Strs);*) let camlp4Strs = get_syntax_pp bstate pp syntaxPkgs in Pp.some preproc (archive :: camlp4Strs) obuild-0.2.2/lib/core/ppx_resolver.mli000066400000000000000000000026071515212760700177350ustar00rootroot00000000000000(** PPX and Syntax Preprocessor Resolution This module handles the resolution of PPX preprocessors and syntax extensions (like camlp4) for OCaml compilation targets. = Key Responsibilities = - Resolve camlp4/syntax preprocessor dependencies - Generate preprocessor flags for compilation - Handle both internal and external syntax packages - Support camlp4o and camlp4r syntax variants = Historical Context = OCaml has evolved through several preprocessing systems: - camlp4: Original extensible preprocessor (OCaml < 4.08) - PPX: Modern preprocessor system using AST transformations - This module supports both for compatibility *) open Prepare_types (** Get syntax preprocessor flags for a list of build dependencies @param bstate Build state containing configuration @param preprocessor The type of preprocessor (CamlP4O or CamlP4R) @param buildDeps List of build dependencies to process @return List of preprocessor flag lists *) val get_syntax_pp : build_state -> Pp.Type.t -> Libname.t list -> string list list (** Get target-specific preprocessor configuration @param bstate Build state containing configuration @param target The compilation target @param pp Optional preprocessor type @return Preprocessor configuration for the target *) val get_target_pp : build_state -> Target.target -> Pp.Type.t option -> Pp.t obuild-0.2.2/lib/core/prepare.ml000066400000000000000000001217161515212760700164750ustar00rootroot00000000000000open Fugue (** Dependency Analysis and Compilation State Preparation This module analyzes dependencies and creates the compilation state for build targets. It constructs two separate DAG structures that serve different purposes in the build system. = Two DAG Architecture = Obuild uses two distinct Directed Acyclic Graphs for dependency tracking: 1. Files DAG (filesDag): - Purpose: Track file-level dependencies for incremental builds - Nodes: Individual files (.ml, .mli, .c, .h, .cmi, .cmo, .cmx, .o) - Edges: "file A depends on file B" (based on content dependencies) - Usage: Modification time checking to determine what needs rebuilding - Example: bar.cmo → [bar.ml, bar.cmi, foo.cmi] (bar.cmo depends on these files; if any change, recompile) 2. Steps DAG (stepsDag / compilation_dag): - Purpose: Define task execution order for parallel builds - Nodes: Compilation tasks (CompileModule, CompileInterface, CompileC, LinkTarget) - Edges: "task A must complete before task B" (ordering constraints) - Usage: Topological sort for parallel scheduling, respecting dependencies - Example: CompileModule(Bar) → CompileInterface(Foo) (must compile Foo's interface before Bar's implementation) = Why Two DAGs? = The separation serves distinct build system needs: - Files DAG answers: "What changed?" (incremental build detection) - Steps DAG answers: "What order?" (parallel execution scheduling) Example: When foo.ml changes but foo.mli doesn't: - Files DAG: bar.cmo doesn't depend on foo.cmo (in bytecode), so bar doesn't rebuild - Steps DAG: CompileModule(Bar) still depends on CompileInterface(Foo) for ordering = Key Implementation Notes = - File dependencies are checked via mtime comparison (see build.ml:check_destination_valid) - Step dependencies ensure parallel builds respect compilation order - C object files are only in Files DAG (added in get_dags around line 518) - OCaml module dependencies populate both DAGs (around lines 436-494) = Historical Bug Fix = Prior to Phase 4 debugging, bytecode .cmo files incorrectly depended on other .cmo files in the Files DAG. This caused unnecessary rebuilds. Fixed in build.ml:230-237 to only add .cmx dependencies in Native mode, while bytecode depends only on .cmi files. *) open Filepath open Analyze open Types open Helper open Gconf open Target open Dependencies open Prepare_types (* Re-export types from Prepare_types for backwards compatibility *) type use_thread_flag = Prepare_types.use_thread_flag = | NoThread | WithThread type thread_type = Prepare_types.thread_type = | VMThread | PosixThread | DefaultThread | NoThreads type ocaml_file_type = Prepare_types.ocaml_file_type = | GeneratedModule | SimpleModule module Module = Prepare_types.Module (* Re-export types from Prepare_types *) type build_state = Prepare_types.build_state = { bstate_config : Analyze.project_config } type dir_spec = Prepare_types.dir_spec = { src_dir : Filepath.filepath; dst_dir : Filepath.filepath; include_dirs : Filepath.filepath list; } type compile_step = Prepare_types.compile_step = | CompileModule of Hier.t | CompileInterface of Hier.t | CompileDirectory of Hier.t | CompileC of Filepath.filename | GenerateCstubsTypes of Libname.t | GenerateCstubsFunctions of Libname.t | CompileCstubsC of Libname.t | RunGenerateBlock of Target.target_generate | LinkTarget of Target.target | CheckTarget of Target.target type compilation_state = Prepare_types.compilation_state = { compilation_modules : (Hier.t, Module.t) Hashtbl.t; compilation_csources : Filepath.filename list; compilation_dag : compile_step Dag.t; compilation_pp : Pp.t; compilation_filesdag : Filetype.id Dag.t; compilation_builddir_c : Filepath.filepath; compilation_builddir_ml : Types.ocaml_compilation_option -> Filepath.filepath; compilation_include_paths : Types.ocaml_compilation_option -> Hier.t -> Filepath.filepath list; compilation_linking_paths : Filepath.filepath list; compilation_linking_paths_d : Filepath.filepath list; compilation_linking_paths_p : Filepath.filepath list; compilation_c_include_paths : Filepath.filepath list; compilation_c_linking_paths : Filepath.filepath list; } let string_of_compile_step = Prepare_types.string_of_compile_step let init project = { bstate_config = project } let get_compilation_order cstate = let filter_modules t : Hier.t option = match t with | CompileC _ | CompileInterface _ | LinkTarget _ | CheckTarget _ -> None | GenerateCstubsTypes _ | GenerateCstubsFunctions _ | CompileCstubsC _ | RunGenerateBlock _ -> None | CompileDirectory m | CompileModule m -> if Hier.lvl m = 0 then Some m else None in list_filter_map filter_modules (Dagutils.linearize cstate.compilation_dag) (* PPX/Syntax preprocessing functions moved to Ppx_resolver module *) (** Helper: Resolve PPX flags for a specific module This complex logic handles PPX dependencies and options, ensuring only one PPX is used per module and that ppxopt arguments match. @param bstate build state @param target current target @return list of PPX flags to pass to the compiler *) let resolve_module_ppx_flags bstate target = let full_path include_path name = match name.[0] with | '.' -> fp_to_string include_path ^ "/" ^ name | _ -> name in let stdlib = fp (get_ocaml_config_key "standard_library" bstate.bstate_config) in let get_ppx_ppxopt fpath meta libname = let includePath = Meta.get_include_dir stdlib (fpath, meta) in let pkg = Meta.Pkg.find libname.Libname.subnames meta in let ppx = pkg.Meta.Pkg.ppx in let ppxopt = pkg.Meta.Pkg.ppxopt in (includePath, ppx, ppxopt) in let target_deps = get_all_builddeps target in let dag = bstate.bstate_config.project_pkgdeps_dag in let deps_lists = list_filter_map (fun (l, _) -> let dag_dep = Analyze.Dependency l in if Dag.exists_node dag_dep dag then begin let children = Dag.get_children_full dag dag_dep in let deps = list_filter_map (fun d -> match d with | Analyze.Target _ -> None | Analyze.Dependency l -> Some l) children in let uniq_deps = list_uniq deps in Some (l :: uniq_deps) end else None) target_deps in let ppx_list = List.map (fun l -> let ppxs, ppxopts = List.fold_left (fun (ppxs, ppxopts) d -> match Metacache.find d.Libname.main_name with | None -> (ppxs, ppxopts) | Some (fpath, meta) -> let includePath, ppx, ppxopt = get_ppx_ppxopt fpath meta d in let ppxs_ = match ppx with | None -> ppxs | Some (_, s) -> (includePath, s, d) :: ppxs in let ppxopts_ = ppxopts @ List.map (fun (_, s) -> let ppxargs = String_utils.split ',' s in (includePath, ppxargs)) ppxopt in (ppxs_, ppxopts_)) ([], []) (List.rev l) in let ppxs = list_uniq ppxs in match ppxs with | [] -> [] | _ :: _ :: _ -> failwith ("More than 1 ppx " ^ String.concat ", " (List.map (fun (_, s, _) -> s) ppxs)) | [includePath, ppx_name, ppx_lib] -> List.iter (fun (_, ss) -> let res = Libname.of_string (List.hd ss) = ppx_lib in if not res then failwith ("Different ppx " ^ ppx_name ^ " <> " ^ List.hd ss)) ppxopts; full_path includePath ppx_name :: List.map (fun (includePath, args) -> String.concat " " (List.map (fun a -> full_path includePath a) (List.tl args))) ppxopts) deps_lists in let ppx_list = no_empty [] ppx_list in List.flatten (List.map (fun l -> [ "-ppx"; String.concat " " l ]) ppx_list) (** Helper: Analyze module dependencies using ocamldep Runs ocamldep on the source file, then categorizes dependencies into: - Internal dependencies (within the same project/directory) - External dependencies (from other packages) Also detects thread library usage. @param srcFile source file to analyze @param hier module hierarchy @param pp preprocessor settings @param file_search_paths search paths for finding modules @return (internal_deps, external_deps, use_thread_flag) *) let analyze_module_dependencies srcFile hier pp file_search_paths = let dopt = { dep_includes = file_search_paths hier; dep_pp = pp } in let allDeps = match run_ocamldep dopt srcFile with | [] -> raise Module.DependencyNoOutput | ml :: mli :: _ -> list_uniq (ml @ mli) | x :: _ -> x in log Debug " %s depends on %s\n%!" (Hier.to_string hier) (String.concat "," (List.map Modname.to_string allDeps)); (* Partition dependencies into internal (same directory) vs external *) let cwdDepsInDir, otherDeps = List.partition (fun dep -> try let entry = Hier.get_file_entry (Hier.of_modname dep) (file_search_paths hier) in match entry with | Hier.DirectoryEntry (p, _) | Hier.FileEntry (p, _) | Hier.GeneratedFileEntry (p, _, _) -> List.mem p (file_search_paths hier) with Not_found -> false) allDeps in log Debug " %s internally depends on %s\n%!" (Hier.to_string hier) (String.concat "," (List.map Modname.to_string cwdDepsInDir)); (* Detect thread library usage *) let use_thread = if List.mem (Modname.wrap "Thread") otherDeps || List.mem (Modname.wrap "Condition") otherDeps || List.mem (Modname.wrap "Mutex") otherDeps then WithThread else NoThread in (* Convert internal deps to Hier.t with proper parent context *) let cwdDeps = List.map (fun x -> maybe (Hier.make [ x ]) (fun z -> Hier.append z x) (Hier.parent hier)) cwdDepsInDir in (* Check for self-dependency *) if List.mem hier cwdDeps then raise (Module.DependsItself hier); (cwdDeps, otherDeps, use_thread) (** Helper: Discover modules within a directory When a module is represented as a directory, this function scans the directory to find all sub-modules (both files and subdirectories). @param srcDir directory to scan @param hier parent module hierarchy @return Module.t descriptor for the directory *) let discover_directory_modules srcDir hier = let modules = Filesystem.list_dir_pred_map (fun f -> let fp = srcDir f in if Filesystem.is_dir fp then (* Avoid directories like .git/.svn etc. *) if not (Modname.string_all Modname.char_is_valid_modchar (fn_to_string f)) then None else Some (Modname.of_directory f) else match Filetype.of_filepath fp with | Filetype.FileML -> Some (Modname.of_filename f) | Filetype.FileMLI -> if Filesystem.exists (srcDir (chop_extension f <.> "ml")) then None (* Skip .mli if corresponding .ml exists *) else Some (Modname.of_filename f) (* Lonely .mli *) | Filetype.FileOther s -> if Generators.is_generator_ext s then Some (Modname.of_filename f) else None | _ -> None) srcDir in Module.make_dir current_dir (List.map (fun m -> Hier.append hier m) modules) (** Helper: Compute all dependency paths for compilation and linking Calculates include paths and linking paths for both OCaml and C compilation, handling internal and system dependencies, and different compilation modes (normal, debug, profiling). @param bstate build state @param target current target @return tuple of (depIncludePaths, depIncludePathsD, depIncludePathsP, depLinkingPaths, cdepsIncludePaths, cCamlIncludePath) *) let compute_dependency_paths bstate target = let conf = bstate.bstate_config in let stdlib = fp (get_ocaml_config_key "standard_library" conf) in let cbits = target.target_cbits in (* Get package dependencies and partition into internal vs system *) let depPkgs = Analyze.get_pkg_deps target conf in let depsInternal, depsSystem = List.partition (fun dep -> match Hashtbl.find conf.project_dep_data dep with | Internal -> true | _ -> false) depPkgs in (* Compute include paths for internal dependencies *) let depIncPathInter = List.map (fun dep -> Dist.get_build_exn (Dist.Target (Name.Lib dep))) depsInternal in (* Compute include paths for system dependencies *) let depIncPathSystem = List.map (fun dep -> let path, rootPkg = Metacache.get_from_cache dep in Meta.get_include_dir_with_subpath stdlib (path, rootPkg) dep.Libname.subnames) depsSystem in (* Combine and compute variants for different compilation modes *) let depIncludePaths = depIncPathInter @ depIncPathSystem in let depIncludePathsD = List.map (fun fp -> fp fn "opt-d") depIncPathInter @ depIncPathSystem in let depIncludePathsP = List.map (fun fp -> fp fn "opt-p") depIncPathInter @ depIncPathSystem in (* Compute linking paths *) let depLinkingPaths = List.map (fun dep -> match Hashtbl.find conf.project_dep_data dep with | Internal -> Dist.get_build_exn (Dist.Target (Name.Lib dep)) | System -> let path, rootPkg = Metacache.get_from_cache dep in Meta.get_include_dir_with_subpath stdlib (path, rootPkg) dep.Libname.subnames) depPkgs in (* Compute C include paths *) let cdepsIncludePaths : filepath list = cbits.target_clibpaths @ List.concat (List.map (fun (cpkg, _) -> (Hashtbl.find bstate.bstate_config.project_cpkgs cpkg).cpkg_conf_includes) cbits.target_cpkgs) in let cCamlIncludePath = fp (Analyze.get_ocaml_config_key "standard_library" bstate.bstate_config) in ( depIncludePaths, depIncludePathsD, depIncludePathsP, depLinkingPaths, cdepsIncludePaths, cCamlIncludePath ) (** Helper: Get the compile step for a module descriptor Determines whether a module needs interface compilation, module compilation, or directory packing based on its descriptor. *) let get_compile_step_for_module modulesDeps stepsDag hier mdep = match mdep with | Module.DescFile f -> (* if it is a .mli only module ... *) if Filetype.of_filepath f.Module.File.path = Filetype.FileMLI then CompileInterface hier else begin if Module.has_interface mdep then Dag.add_edge (CompileModule hier) (CompileInterface hier) stepsDag; CompileModule hier end | Module.DescDir descdir -> let mStep = CompileDirectory hier in List.iter (fun dirChild -> let depChild = Hashtbl.find modulesDeps dirChild in let cStep = match depChild with | Module.DescFile f -> (* if it is a .mli only module ... *) if Filetype.of_filepath f.Module.File.path = Filetype.FileMLI then CompileInterface dirChild else CompileModule dirChild | Module.DescDir _ -> CompileDirectory dirChild in Dag.add_edge mStep cStep stepsDag) descdir.Module.Dir.modules; mStep (** Helper: Build the module compilation steps DAG Processes module dependencies in topological order and builds the steps DAG. Uses a work queue to process modules with no dependencies first, then removes them and processes their dependents. *) let build_module_steps_dag modulesDeps target stepsDag = let h = hashtbl_map (fun dep -> match dep with | Module.DescDir _ -> [] | Module.DescFile dfile -> dfile.Module.File.dep_cwd_modules) modulesDeps in while Hashtbl.length h > 0 do let freeModules = Hashtbl.fold (fun k v acc -> if v = [] then k :: acc else acc) h [] in if freeModules = [] then raise (Module.DependenciesProblem (hashtbl_keys h)) else (); List.iter (fun m -> let mdep = Hashtbl.find modulesDeps m in let mStep = get_compile_step_for_module modulesDeps stepsDag m mdep in Dag.add_node mStep stepsDag; Hashtbl.iter (fun k v -> if k <> m then if List.mem m v then let kdep = Hashtbl.find modulesDeps k in match kdep with | Module.DescFile _ -> if Module.has_interface kdep then Dag.add_edges_connected [ CompileModule k; CompileInterface k; mStep ] stepsDag else Dag.add_edge (CompileModule k) mStep stepsDag | Module.DescDir _ -> Dag.add_edge (CompileDirectory k) mStep stepsDag) h) freeModules; let roots = Dag.get_roots stepsDag in List.iter (fun r -> match r with | CompileModule _ | CompileDirectory _ | CompileC _ -> Dag.add_edge (LinkTarget target) r stepsDag; Dag.add_edge (CheckTarget target) (LinkTarget target) stepsDag | _ -> ()) roots; let free_set = Hashtbl.create (List.length freeModules) in List.iter (fun m -> Hashtbl.replace free_set m ()) freeModules; hashtbl_modify_all (fun v -> List.filter (fun x -> not (Hashtbl.mem free_set x)) v) h; List.iter (Hashtbl.remove h) freeModules done (** Helper: Add C compilation tasks to the DAGs Processes C source files, determines their header dependencies, and adds compilation tasks to both the steps DAG and files DAG. *) let add_c_compilation_tasks cbits buildDir stepsDag filesDag = if cbits.target_csources <> [] then let objDeps = run_ccdep cbits.target_cdir cbits.target_csources in List.iter (fun cSource -> let (fps : filepath list) = try List.assoc (Filetype.replace_extension cSource Filetype.FileO) objDeps with Not_found -> failwith ("cannot find dependencies for " ^ fn_to_string cSource) in let cFile = cbits.target_cdir cSource in let hFiles = List.map (fun x -> Filetype.make_id (Filetype.FileH, x)) (List.filter (fun x -> Filetype.of_filepath x = Filetype.FileH) fps) in let oFile = buildDir (cSource <.> "o") in let cNode = Filetype.make_id (Filetype.FileC, cFile) in let oNode = Filetype.make_id (Filetype.FileO, oFile) in (* add C source information into the files DAG *) Dag.add_edge oNode cNode filesDag; Dag.add_children_edges oNode hFiles filesDag; (* add C source compilation task into the step DAG *) Dag.add_node (CompileC cSource) stepsDag) cbits.target_csources (** Helper: Add cstubs generation tasks to the DAG If the target has cstubs configuration, adds the generation tasks with proper ordering: 1. GenerateCstubsTypes - generates types_generated.ml (runs first) 2. GenerateCstubsFunctions - generates C.ml and stubs.c (after bindings compile) 3. CompileCstubsC - compiles generated stubs.c 4. All must complete before LinkTarget *) let add_cstubs_tasks target stepsDag = match target.target_cstubs with | None -> () | Some cstubs -> (* Get the library name from target *) let libname = match target.target_name with | Target.Name.Lib l -> l | _ -> failwith "cstubs can only be used with libraries" in (* Add cstubs tasks to DAG *) let types_task = GenerateCstubsTypes libname in let funcs_task = GenerateCstubsFunctions libname in let compile_task = CompileCstubsC libname in Dag.add_node types_task stepsDag; Dag.add_node funcs_task stepsDag; Dag.add_node compile_task stepsDag; (* Ordering: types -> funcs -> compile_c *) Dag.add_edge funcs_task types_task stepsDag; Dag.add_edge compile_task funcs_task stepsDag; (* The generated_types module depends on GenerateCstubsTypes *) let generated_types_hier = Hier.of_string cstubs.cstubs_generated_types in (try let _ = Dag.get_node stepsDag (CompileModule generated_types_hier) in Dag.add_edge (CompileModule generated_types_hier) types_task stepsDag with Dag.DagNodeNotFound -> ()); (* GenerateCstubsFunctions needs the compiled types_generated.cmo for stubgen *) (try let _ = Dag.get_node stepsDag (CompileModule generated_types_hier) in Dag.add_edge funcs_task (CompileModule generated_types_hier) stepsDag with Dag.DagNodeNotFound -> ()); (* The entry point module depends on GenerateCstubsFunctions *) let entry_point_hier = Hier.of_string cstubs.cstubs_generated_entry_point in (try let _ = Dag.get_node stepsDag (CompileModule entry_point_hier) in Dag.add_edge (CompileModule entry_point_hier) funcs_task stepsDag with Dag.DagNodeNotFound -> ()); (* The generated FOREIGN implementation module also depends on GenerateCstubsFunctions *) let generated_foreign_name = cstubs.cstubs_external_library_name ^ "_generated" in let generated_foreign_hier = Hier.of_string (Compat.string_capitalize generated_foreign_name) in (try let _ = Dag.get_node stepsDag (CompileModule generated_foreign_hier) in Dag.add_edge (CompileModule generated_foreign_hier) funcs_task stepsDag with Dag.DagNodeNotFound -> ()); (* Add inter-module dependencies between cstubs-generated modules for correct link order: entry_point (C) -> generated_foreign (Otreesitter_stubs_generated) -> generated_types (Types_generated) *) (try let _ = Dag.get_node stepsDag (CompileModule entry_point_hier) in let _ = Dag.get_node stepsDag (CompileModule generated_foreign_hier) in Dag.add_edge (CompileModule entry_point_hier) (CompileModule generated_foreign_hier) stepsDag with Dag.DagNodeNotFound -> ()); (try let _ = Dag.get_node stepsDag (CompileModule generated_foreign_hier) in let _ = Dag.get_node stepsDag (CompileModule generated_types_hier) in Dag.add_edge (CompileModule generated_foreign_hier) (CompileModule generated_types_hier) stepsDag with Dag.DagNodeNotFound -> ()); (* Helper: extract the top-level module from a functor path like "Bindings.Types" -> "Bindings" *) let get_module_from_functor_path hier = Hier.of_modname (Hier.root hier) in (* If there's a type description functor, both types_task and funcs_task depend on its module. types_task needs it to use Cstubs_structs.write_c with the Types functor for struct discovery. funcs_task needs it to use Cstubs.write_c/write_ml with the Functions functor. *) (match cstubs.cstubs_type_description with | Some desc -> ( let bindings_module = get_module_from_functor_path desc.cstubs_functor in try let _ = Dag.get_node stepsDag (CompileModule bindings_module) in (* types_task depends on Bindings for Cstubs_structs.write_c *) Dag.add_edge types_task (CompileModule bindings_module) stepsDag; (* funcs_task also depends on Bindings for Cstubs.write_c *) Dag.add_edge funcs_task (CompileModule bindings_module) stepsDag with Dag.DagNodeNotFound -> ()) | None -> ()); (* If there's a function description functor, funcs_task depends on its module *) (match cstubs.cstubs_function_description with | Some desc -> ( let bindings_module = get_module_from_functor_path desc.cstubs_functor in try let _ = Dag.get_node stepsDag (CompileModule bindings_module) in Dag.add_edge funcs_task (CompileModule bindings_module) stepsDag with Dag.DagNodeNotFound -> ()) | None -> ()); (* Link depends on CompileCstubsC *) Dag.add_edge (LinkTarget target) compile_task stepsDag; Dag.add_edge (CheckTarget target) (LinkTarget target) stepsDag (** Add generate block tasks to the DAG *) let add_generate_block_tasks target stepsDag = List.iter (fun (gen_block : Target.target_generate) -> let task = RunGenerateBlock gen_block in Dag.add_node task stepsDag; (* The generated module depends on the generate block running first *) let output_hier = gen_block.generate_module in (try let _ = Dag.get_node stepsDag (CompileModule output_hier) in Dag.add_edge (CompileModule output_hier) task stepsDag with Dag.DagNodeNotFound -> ()); (* Link depends on all generate blocks completing *) Dag.add_edge (LinkTarget target) task stepsDag ) target.Target.target_generates (** Register generator outputs and synthetic entries for build preparation *) let register_generator_outputs target = (* Register suffix-based and generate block modules *) Target.register_generator_outputs target; (* Additionally register synthetic entries for generate blocks (build-specific) *) let autogenDir = Dist.get_build_exn Dist.Autogen in List.iter (fun (gen_block : Target.target_generate) -> let module_name = Hier.to_string gen_block.Target.generate_module in let ml_filename = fn (Compat.string_lowercase module_name ^ ".ml") in let target_path = autogenDir ml_filename in log Verbose " Registering generate-block module %s (synthetic entry)\n%!" module_name; Hier.register_synthetic_entry gen_block.Target.generate_module autogenDir target_path ) target.Target.target_generates (* get every module description * and their relationship with each other *) let get_modules_desc bstate target toplevelModules = let autogenDir = Dist.get_build_exn Dist.Autogen in let modulesDeps = Hashtbl.create 64 in let file_search_paths hier = List.map (fun dir -> dir Hier.to_dirpath hier) target.target_obits.target_srcdir @ [ autogenDir ] in (* Check if a module is cstubs-generated (will be created during build) *) let is_cstubs_generated_module hier = match target.target_cstubs with | Some cstubs -> let module_name = Hier.to_string hier in (* All three modules are generated from cstubs config: - _generated: FOREIGN implementation - generated-types: type bindings - generated-entry-point: entry module *) let foreign_name = Compat.string_capitalize (cstubs.Target.cstubs_external_library_name ^ "_generated") in let types_name = Compat.string_capitalize cstubs.Target.cstubs_generated_types in let entry_name = Compat.string_capitalize cstubs.Target.cstubs_generated_entry_point in module_name = foreign_name || module_name = types_name || module_name = entry_name | None -> false in (* Check if a module is from a generate block (will be created during build) *) let find_generate_block_for_module hier = let module_name = Hier.to_string hier in try Some (List.find (fun (gen : Target.target_generate) -> Hier.to_string gen.generate_module = module_name ) target.Target.target_generates) with Not_found -> None in (* Check if module is generated by ANY target (not just current one) *) let is_globally_generated_module hier = Hier.is_generated_module (Hier.to_string hier) in let targetPP = Ppx_resolver.get_target_pp bstate target target.target_obits.target_pp in let get_one hier = let moduleName = Hier.to_string hier in log Verbose "Analysing %s\n%!" moduleName; (* For cstubs-generated modules, return a minimal description without file analysis *) if is_cstubs_generated_module hier then ( (* Get library-specific autogen dir for cstubs generated files *) let cstubs_autogen_dir = match target.target_name with | Target.Name.Lib libname -> autogenDir fn (Libname.to_string libname) | _ -> autogenDir in let ml_filename = fn (Compat.string_uncapitalize moduleName ^ ".ml") in let target_path = cstubs_autogen_dir ml_filename in log Verbose " %s is cstubs-generated, using synthetic description at %s\n%!" moduleName (fp_to_string target_path); (* Register the synthetic entry in Hier so get_dest_file can find it *) Hier.register_synthetic_entry hier cstubs_autogen_dir target_path; (* Return a minimal module description - the file will be created during build *) Module.make_file NoThread target_path 0.0 SimpleModule None Pp.none [] [] []) (* For generate-block modules, return a minimal description *) else if find_generate_block_for_module hier <> None || is_globally_generated_module hier then ( let ml_filename = fn (Compat.string_uncapitalize moduleName ^ ".ml") in let target_path = autogenDir ml_filename in log Verbose " %s is from generate block, using synthetic description at %s\n%!" moduleName (fp_to_string target_path); (* Register the synthetic entry in Hier so get_dest_file can find it *) Hier.register_synthetic_entry hier autogenDir target_path; (* Return a minimal module description - the file will be created during build *) Module.make_file NoThread target_path 0.0 SimpleModule None Pp.none [] [] []) else let file_entry = let paths = file_search_paths hier in try Hier.get_file_entry hier paths with Not_found -> raise (Module.NotFound (paths, hier)) in let _srcPath, srcDir = match file_entry with | Hier.FileEntry (s, d) | Hier.DirectoryEntry (s, d) | Hier.GeneratedFileEntry (s, d, _) -> (s, d) in let module_desc_ty = if Filesystem.is_dir srcDir then discover_directory_modules srcDir hier else let _srcPath, srcFile, intfFile = match file_entry with | Hier.FileEntry (path, file) -> (path, file, Hier.ml_to_ext file Filetype.FileMLI) | Hier.DirectoryEntry (path, file) -> (path, file, Hier.ml_to_ext file Filetype.FileMLI) | Hier.GeneratedFileEntry (_path, file, generated) -> let src_file = path_basename file in let actual_src_path = Dist.get_build_exn (Dist.Target target.target_name) in let full_dest_file = actual_src_path generated in let intf_file = Hier.ml_to_ext full_dest_file Filetype.FileMLI in if (not (Filesystem.exists full_dest_file)) || Filesystem.get_modification_time full_dest_file < Filesystem.get_modification_time file then Generators.run (actual_src_path chop_extension src_file) file moduleName; (actual_src_path, full_dest_file, intf_file) in let modTime = Filesystem.get_modification_time srcFile in let hasInterface = Filesystem.exists intfFile in let intfModTime = Filesystem.get_modification_time intfFile in (* augment pp if needed with per-file dependencies *) let per_settings = find_extra_matching target (Hier.to_string hier) in let per_pp = match List.filter (fun x -> x.target_extra_pp <> None) per_settings with | x :: _ -> x.target_extra_pp | [] -> None in let pp = match (target.target_obits.target_pp, per_pp) with | None, None -> Pp.none | None, Some preprocessor | Some _, Some preprocessor -> let perPP = Ppx_resolver.get_target_pp bstate target per_pp in let extraDeps = List.concat (List.map (fun x -> x.target_extra_builddeps) per_settings) in Pp.append perPP (Ppx_resolver.get_syntax_pp bstate preprocessor (List.map fst extraDeps)) | Some preprocessor, None -> (* FIXME: we should re-use the dependency DAG here, otherwise we might end up in the case * where the extra dependencies are depending not in the correct order *) let extraDeps = List.concat (List.map (fun x -> x.target_extra_builddeps) per_settings) in Pp.append targetPP (Ppx_resolver.get_syntax_pp bstate preprocessor (List.map fst extraDeps)) in (* Resolve PPX flags for this module *) let ppx = resolve_module_ppx_flags bstate target in log Debug " %s has mtime %f\n%!" moduleName modTime; if hasInterface then log Debug " %s has interface (mtime=%f)\n%!" moduleName intfModTime; (* Analyze module dependencies *) let cwdDeps, otherDeps, use_thread = analyze_module_dependencies srcFile hier pp file_search_paths in (* Filter out modules that are generated by OTHER targets - they come from library deps. Inter-target ordering ensures the library is built first, and include paths provide the .cmi files. *) let cwdDeps = List.filter (fun dep -> not (is_globally_generated_module dep && find_generate_block_for_module dep = None) ) cwdDeps in let intfDesc = if hasInterface then Some (Module.Intf.make intfModTime intfFile) else None in Module.make_file use_thread srcFile modTime (match file_entry with | Hier.FileEntry _ -> SimpleModule | Hier.GeneratedFileEntry _ -> GeneratedModule | Hier.DirectoryEntry _ -> failwith "unexpected DirectoryEntry in get_modules_desc") intfDesc pp ((target.target_obits.target_oflags @ List.concat (List.map (fun x -> x.target_extra_oflags) (find_extra_matching target (Hier.to_string hier)))) @ ppx) cwdDeps otherDeps in module_desc_ty in let rec loop modname = if Hashtbl.mem modulesDeps modname then () (* Skip modules that are generated by OTHER targets - they come from library dependencies *) else if is_globally_generated_module modname && find_generate_block_for_module modname = None then ( log Verbose " Skipping %s - generated by another target (external dependency)\n%!" (Hier.to_string modname); ()) else let mdesc = get_one modname in Hashtbl.add modulesDeps modname mdesc; (* TODO: don't query single modules at time, where ocamldep supports M modules. tricky with single file syntax's pragma. *) match mdesc with | Module.DescFile dfile -> List.iter loop dfile.Module.File.dep_cwd_modules | Module.DescDir ddir -> List.iter loop ddir.Module.Dir.modules in List.iter (fun m -> loop m) toplevelModules; modulesDeps (* Global registry mapping source file paths to (first_target_name, hier_in_that_target). * Used to warn when the same source file would be compiled with different -for-pack * flags across multiple targets (e.g., once flat and once inside a directory module). *) let source_registry : (string, string * Hier.t) Hashtbl.t = Hashtbl.create 64 let warn_source_overlap target modulesDeps = let target_name = Target.get_target_name target in Hashtbl.iter (fun hier mdesc -> match mdesc with | Module.DescFile dfile -> let src_path = fp_to_string dfile.Module.File.path in (match Hashtbl.find_opt source_registry src_path with | Some (other_name, other_hier) when other_name <> target_name -> (* Only warn when the -for-pack context differs: one target nests the file * inside a directory module (Hier.parent <> None) while another doesn't, * or both use different pack parents. Flat-to-flat sharing is harmless. *) if Hier.parent hier <> Hier.parent other_hier then ( log Report "warning: source file '%s' is compiled for both '%s' (as %s) and '%s' (as %s).\n" src_path other_name (Hier.to_string other_hier) target_name (Hier.to_string hier); log Report " These targets use different -for-pack flags, which may cause build failures.\n" ) | None -> Hashtbl.add source_registry src_path (target_name, hier) | Some _ -> ()) | Module.DescDir _ -> () ) modulesDeps (* prepare modules dependencies and various compilation state * that is going to be required for compilation and linking. *) let prepare_target_ bstate buildDir target toplevelModules = let autogenDir = Dist.get_build_exn Dist.Autogen in let buildDirP = buildDir fn "opt-p" in let buildDirD = buildDir fn "opt-d" in let cbits = target.target_cbits in let obits = target.target_obits in log Verbose "preparing compilation for %s\n%!" (Target.get_target_name target); (* Register output modules from generators before module discovery *) register_generator_outputs target; let modulesDeps = get_modules_desc bstate target toplevelModules in warn_source_overlap target modulesDeps; (* create 2 dags per target * - stepsDag is a DAG of all the tasks to achieve the target (compilation only, not linking yet) * - filesDag is a DAG of all the files dependencies (C files & H files) *) let get_dags () = let filesDag = Dag.init () in let stepsDag = Dag.init () in (* Build the module dependency DAG *) build_module_steps_dag modulesDeps target stepsDag; (* Add C compilation tasks and connect them to the link step. CompileC nodes must be dependencies of LinkTarget; otherwise the parallel scheduler can dispatch LinkTarget concurrently with C compilation and check_needs_relink will see stale .o mtimes. *) add_c_compilation_tasks cbits buildDir stepsDag filesDag; List.iter (fun cSource -> Dag.add_edge (LinkTarget target) (CompileC cSource) stepsDag; Dag.add_edge (CheckTarget target) (LinkTarget target) stepsDag ) cbits.target_csources; (* Add cstubs generation tasks if configured *) add_cstubs_tasks target stepsDag; (* Add generate block tasks *) add_generate_block_tasks target stepsDag; (stepsDag, filesDag) in let dag, fdag = get_dags () in if gconf.dump_dot then ( let dotDir = Dist.create_build Dist.Dot in let path = dotDir fn (Target.get_target_name target ^ ".dot") in let reducedDag = Dag.transitive_reduction dag in let dotContent = Dag.to_dot string_of_compile_step (Target.get_target_name target) true reducedDag in Filesystem.write_file path dotContent; let path = dotDir fn (Target.get_target_name target ^ ".files.dot") in let dotContent = Dag.to_dot (fun fdep -> Filetype.to_string (Filetype.get_type fdep) ^ " " ^ fp_to_string (Filetype.get_path fdep)) (Target.get_target_name target) true fdag in Filesystem.write_file path dotContent); (* Compute all dependency paths for compilation and linking *) let ( depIncludePaths, depIncludePathsD, depIncludePathsP, depLinkingPaths, cdepsIncludePaths, cCamlIncludePath ) = compute_dependency_paths bstate target in { compilation_modules = modulesDeps; compilation_csources = cbits.target_csources; compilation_dag = dag; compilation_pp = Pp.none; compilation_filesdag = fdag; compilation_builddir_c = buildDir; compilation_builddir_ml = (fun m -> match m with | Normal -> buildDir | WithDebug -> buildDirD | WithProf -> buildDirP) (* Add library-specific autogen dir for cstubs-generated modules *); compilation_include_paths = (fun m hier -> let cstubs_autogen_dir = match (target.target_cstubs, target.target_name) with | Some _, Target.Name.Lib libname -> [ autogenDir fn (Libname.to_string libname) ] | _ -> [] in ((match m with | Normal -> buildDir | WithDebug -> buildDirD | WithProf -> buildDirP) Hier.to_dirpath hier) :: cstubs_autogen_dir @ [ autogenDir ] @ List.map (fun dir -> dir Hier.to_dirpath hier) obits.target_srcdir @ match m with | Normal -> depIncludePaths | WithDebug -> depIncludePathsD | WithProf -> depIncludePathsP); compilation_linking_paths = [ buildDir ] @ depLinkingPaths; compilation_linking_paths_p = [ buildDirP; buildDir ] @ depLinkingPaths; compilation_linking_paths_d = [ buildDirD; buildDir ] @ depLinkingPaths; compilation_c_include_paths = [ cbits.target_cdir ] @ cdepsIncludePaths @ [ cCamlIncludePath; autogenDir ]; compilation_c_linking_paths = [ buildDir ]; } let prepare_target bstate buildDir target toplevelModules = try prepare_target_ bstate buildDir target toplevelModules with exn -> log Verbose "Prepare.target : uncaught exception %s\n%!" (Printexc.to_string exn); raise exn obuild-0.2.2/lib/core/prepare.mli000066400000000000000000000117621515212760700166450ustar00rootroot00000000000000(** Build preparation - dependency gathering and compilation state *) (** Thread usage flag *) type use_thread_flag = NoThread | WithThread (** Thread implementation type *) type thread_type = VMThread | PosixThread | DefaultThread | NoThreads (** OCaml file type classification *) type ocaml_file_type = | GeneratedModule (** Auto-generated module *) | SimpleModule (** Regular source module *) (** Module description and dependency information *) module Module : sig (** Exception raised when a module depends on itself *) exception DependsItself of Hier.t (** Exception raised when there are dependency problems *) exception DependenciesProblem of Hier.t list (** Exception raised when a dependency has no output *) exception DependencyNoOutput (** Exception raised when a module is not found *) exception NotFound of (Filepath.filepath list * Hier.t) (** Interface file descriptor *) module Intf : sig type t = { mtime : float; path : Filepath.filepath } val make : float -> Filepath.filepath -> t end (** Source file descriptor *) module File : sig type t = { use_threads : use_thread_flag; path : Filepath.filepath; mtime : float; type_ : ocaml_file_type; intf_desc : Intf.t option; use_pp : Pp.t; oflags : string list; dep_cwd_modules : Hier.t list; dep_other_modules : Modname.t list; } val make : use_thread_flag -> Filepath.filepath -> float -> ocaml_file_type -> Intf.t option -> Pp.t -> string list -> Hier.t list -> Modname.t list -> t end (** Directory descriptor *) module Dir : sig type t = { path : Filepath.filepath; modules : Hier.t list } val make : Filepath.filepath -> Hier.t list -> t end (** Module descriptor - either file or directory *) type t = DescFile of File.t | DescDir of Dir.t val file_has_interface : File.t -> bool (** Check if file module has an interface file *) val has_interface : t -> bool (** Check if module has an interface file *) val make_dir : Filepath.filepath -> Hier.t list -> t (** Create directory module descriptor *) val make_file : use_thread_flag -> Filepath.filepath -> float -> ocaml_file_type -> Intf.t option -> Pp.t -> string list -> Hier.t list -> Modname.t list -> t (** Create file module descriptor *) end (** Global build state persisting across all compilations *) type build_state = { bstate_config : Analyze.project_config } (** Directory specification for compilation *) type dir_spec = { src_dir : Filepath.filepath; dst_dir : Filepath.filepath; include_dirs : Filepath.filepath list; } (** Compilation step types *) type compile_step = | CompileModule of Hier.t | CompileInterface of Hier.t | CompileDirectory of Hier.t | CompileC of Filepath.filename | GenerateCstubsTypes of Libname.t (** Generate types_generated.ml *) | GenerateCstubsFunctions of Libname.t (** Generate C.ml and stubs.c *) | CompileCstubsC of Libname.t (** Compile generated C stubs *) | RunGenerateBlock of Target.target_generate (** Run explicit generate block *) | LinkTarget of Target.target | CheckTarget of Target.target val string_of_compile_step : compile_step -> string (** Convert compilation step to human-readable string *) (** Compilation state for a single target *) type compilation_state = { compilation_modules : (Hier.t, Module.t) Hashtbl.t; compilation_csources : Filepath.filename list; compilation_dag : compile_step Dag.t; compilation_pp : Pp.t; compilation_filesdag : Filetype.id Dag.t; compilation_builddir_c : Filepath.filepath; compilation_builddir_ml : Types.ocaml_compilation_option -> Filepath.filepath; compilation_include_paths : Types.ocaml_compilation_option -> Hier.t -> Filepath.filepath list; compilation_linking_paths : Filepath.filepath list; compilation_linking_paths_d : Filepath.filepath list; compilation_linking_paths_p : Filepath.filepath list; compilation_c_include_paths : Filepath.filepath list; compilation_c_linking_paths : Filepath.filepath list; } val init : Analyze.project_config -> build_state (** [init project] initializes build state from analyzed project configuration *) val prepare_target : build_state -> Filepath.filepath -> Target.target -> Hier.t list -> compilation_state (** [prepare_target bstate build_dir target modules] prepares compilation for a target Creates compilation state including: - Module dependency DAG - File dependency DAG - Include and linking paths - C compilation paths @param bstate global build state @param build_dir target build directory @param target the target to prepare @param modules top-level modules for this target @return compilation state for this target *) val get_compilation_order : compilation_state -> Hier.t list (** [get_compilation_order cstate] returns modules in compilation order Returns top-level modules in dependency order *) obuild-0.2.2/lib/core/prepare_types.ml000066400000000000000000000105601515212760700177130ustar00rootroot00000000000000(** Shared type definitions for the prepare module and its sub-modules This module contains type definitions used across the preparation phase, including module descriptions, compilation state, and build steps. *) open Filepath open Analyze open Target (** Thread usage flag for modules *) type use_thread_flag = | NoThread | WithThread (** Thread implementation type *) type thread_type = | VMThread | PosixThread | DefaultThread | NoThreads (** OCaml file classification *) type ocaml_file_type = | GeneratedModule | SimpleModule type build_state = { bstate_config : project_config } (** Build state persists for the entire build process *) type dir_spec = { src_dir : filepath; dst_dir : filepath; include_dirs : filepath list; } (** Directory specification for compilation *) (** Compilation step in the build DAG *) type compile_step = | CompileModule of Hier.t | CompileInterface of Hier.t | CompileDirectory of Hier.t | CompileC of filename | GenerateCstubsTypes of Libname.t (* Generate types_generated.ml *) | GenerateCstubsFunctions of Libname.t (* Generate C.ml and stubs.c *) | CompileCstubsC of Libname.t (* Compile generated C stubs *) | RunGenerateBlock of Target.target_generate (* Run explicit generate block *) | LinkTarget of Target.target | CheckTarget of Target.target (** Module descriptor system *) module Module = struct exception DependsItself of Hier.t exception DependenciesProblem of Hier.t list exception DependencyNoOutput exception NotFound of (filepath list * Hier.t) module Intf = struct type t = { mtime : float; path : filepath; } let make mtime path = { mtime; path } end module File = struct type t = { use_threads : use_thread_flag; path : filepath; mtime : float; type_ : ocaml_file_type; intf_desc : Intf.t option; use_pp : Pp.t; oflags : string list; dep_cwd_modules : Hier.t list; dep_other_modules : Modname.t list; } let make use_threads path mtime type_ intf_desc use_pp oflags dep_cwd_modules dep_other_modules = { use_threads; path; mtime; type_; intf_desc; use_pp; oflags; dep_cwd_modules; dep_other_modules; } end module Dir = struct type t = { path : filepath; modules : Hier.t list; } let make path modules = { path; modules } end type t = | DescFile of File.t | DescDir of Dir.t let file_has_interface mdescfile = Fugue.maybe false (fun _ -> true) mdescfile.File.intf_desc let has_interface = function | DescFile dfile -> file_has_interface dfile | DescDir _ -> false let make_dir path modules = DescDir (Dir.make path modules) let make_file use_threads path mtime type_ intf_desc use_pp oflags dep_cwd_modules dep_other_modules = DescFile (File.make use_threads path mtime type_ intf_desc use_pp oflags dep_cwd_modules dep_other_modules) end type compilation_state = { compilation_modules : (Hier.t, Module.t) Hashtbl.t; compilation_csources : filename list; compilation_dag : compile_step Dag.t; compilation_pp : Pp.t; compilation_filesdag : Filetype.id Dag.t; compilation_builddir_c : filepath; compilation_builddir_ml : Types.ocaml_compilation_option -> filepath; compilation_include_paths : Types.ocaml_compilation_option -> Hier.t -> filepath list; compilation_linking_paths : filepath list; compilation_linking_paths_d : filepath list; compilation_linking_paths_p : filepath list; compilation_c_include_paths : filepath list; compilation_c_linking_paths : filepath list; } (** Compilation state - represents a single compilation target *) (** Convert compile step to string for debugging *) let string_of_compile_step cs = match cs with | CompileDirectory x -> "dir " ^ Hier.to_string x | CompileModule x -> "mod " ^ Hier.to_string x | CompileInterface x -> "intf " ^ Hier.to_string x | CompileC x -> "C " ^ Filepath.fn_to_string x | GenerateCstubsTypes x -> "cstubs-types " ^ Libname.to_string x | GenerateCstubsFunctions x -> "cstubs-funcs " ^ Libname.to_string x | CompileCstubsC x -> "cstubs-c " ^ Libname.to_string x | RunGenerateBlock x -> "generate " ^ Hier.to_string x.Target.generate_module | LinkTarget x -> "link " ^ Target.get_target_name x | CheckTarget x -> "check " ^ Target.get_target_name x obuild-0.2.2/lib/core/prepare_types.mli000066400000000000000000000070061515212760700200650ustar00rootroot00000000000000(** Shared type definitions for the prepare module and its sub-modules This module contains type definitions used across the preparation phase, including module descriptions, compilation state, and build steps. *) open Filepath open Types open Analyze (** Thread usage flag for modules *) type use_thread_flag = | NoThread | WithThread (** Thread implementation type *) type thread_type = | VMThread | PosixThread | DefaultThread | NoThreads (** OCaml file classification *) type ocaml_file_type = | GeneratedModule | SimpleModule type build_state = { bstate_config : project_config } (** Build state persists for the entire build process *) type dir_spec = { src_dir : filepath; dst_dir : filepath; include_dirs : filepath list; } (** Directory specification for compilation *) (** Compilation step in the build DAG *) type compile_step = | CompileModule of Hier.t | CompileInterface of Hier.t | CompileDirectory of Hier.t | CompileC of filename | GenerateCstubsTypes of Libname.t (** Generate types_generated.ml *) | GenerateCstubsFunctions of Libname.t (** Generate C.ml and stubs.c *) | CompileCstubsC of Libname.t (** Compile generated C stubs *) | RunGenerateBlock of Target.target_generate (** Run explicit generate block *) | LinkTarget of Target.target | CheckTarget of Target.target (** Module descriptor system *) module Module : sig exception DependsItself of Hier.t exception DependenciesProblem of Hier.t list exception DependencyNoOutput exception NotFound of (filepath list * Hier.t) module Intf : sig type t = { mtime : float; path : filepath; } val make : float -> filepath -> t end module File : sig type t = { use_threads : use_thread_flag; path : filepath; mtime : float; type_ : ocaml_file_type; intf_desc : Intf.t option; use_pp : Pp.t; oflags : string list; dep_cwd_modules : Hier.t list; dep_other_modules : Modname.t list; } val make : use_thread_flag -> filepath -> float -> ocaml_file_type -> Intf.t option -> Pp.t -> string list -> Hier.t list -> Modname.t list -> t end module Dir : sig type t = { path : filepath; modules : Hier.t list; } val make : filepath -> Hier.t list -> t end type t = | DescFile of File.t | DescDir of Dir.t val file_has_interface : File.t -> bool val has_interface : t -> bool val make_dir : filepath -> Hier.t list -> t val make_file : use_thread_flag -> filepath -> float -> ocaml_file_type -> Intf.t option -> Pp.t -> string list -> Hier.t list -> Modname.t list -> t end type compilation_state = { compilation_modules : (Hier.t, Module.t) Hashtbl.t; compilation_csources : filename list; compilation_dag : compile_step Dag.t; compilation_pp : Pp.t; compilation_filesdag : Filetype.id Dag.t; compilation_builddir_c : filepath; compilation_builddir_ml : Types.ocaml_compilation_option -> filepath; compilation_include_paths : Types.ocaml_compilation_option -> Hier.t -> filepath list; compilation_linking_paths : filepath list; compilation_linking_paths_d : filepath list; compilation_linking_paths_p : filepath list; compilation_c_include_paths : filepath list; compilation_c_linking_paths : filepath list; } (** Compilation state - represents a single compilation target *) val string_of_compile_step : compile_step -> string (** Convert compile step to string for debugging *) obuild-0.2.2/lib/core/process.ml000066400000000000000000000063461515212760700165160ustar00rootroot00000000000000open Helper open Gconf open Compat type output = { buf : Buffer.t; fd : Unix.file_descr; mutable closed : bool; } let create_output fd = { buf = Buffer.create 1024; fd = fd; closed = false; } type t = { _args : string list; (* command args - kept for documentation *) pid : int; (* process PID *) time : float; (* Process starting time *) out : output; err : output; } (* create a new process with stdout and stderr redirected * and returns a new process_state *) let make args = let escape s = try let _ = String.index s ' ' in "\"" ^ s ^ "\"" with Not_found -> s in if Gconf.gconf.Gconf.verbosity >= Gconf.Trace then log Trace " [CMD]: %s\n%!" (String.concat " " (List.map escape args)); let (r1,w1) = Unix.pipe () in let (r2,w2) = Unix.pipe () in let argv = Array.of_list args in let pid = Unix.create_process argv.(0) argv Unix.stdin w1 w2 in List.iter Unix.close [w1;w2]; { _args = args; out = create_output r1; err = create_output r2; pid = pid; time = Unix.gettimeofday (); } type result = Success of string (* stdout *) * string (* stderr *) * float (* duration *) | Failure of string (* sterr *) type call = unit -> t (* process a list of processes until one finish. * The finishing 'signal' is when both stdout * and stderr are eofed. *) let wait processes = let is_finished (_, p) = p.err.closed && p.out.closed in let remove_from_list e list = List.filter (fun x -> x <> e) list in let process_loop () = let b = bytes_create 1024 in let live_processes = ref processes in let done_processes = ref None in let read_fds () = List.fold_left (fun acc (_, p) -> let res = if p.out.closed then acc else p.out.fd :: acc in if p.err.closed then res else p.err.fd :: res) [] !live_processes in let fds = ref (read_fds ()) in (* process until at least one process terminate *) while !done_processes = None do let (reads, _, _) = Unix.select !fds [] [] 2.0 in let check_fd out = if not out.closed && List.mem out.fd reads then let nb = Unix.read out.fd b 0 1024 in if nb > 0 then buffer_add_subbytes out.buf b 0 nb else (Unix.close out.fd; out.closed <- true; fds := read_fds ()) in List.iter (fun (task, p) -> check_fd p.out; check_fd p.err; if !done_processes = None && is_finished (task, p) then done_processes := Some (task, p) ) !live_processes; done; match !done_processes with | None -> assert false | Some finished -> (finished, remove_from_list finished !live_processes) in try let finished = List.find is_finished processes in (finished, remove_from_list finished processes) with Not_found -> process_loop () (* cleanup a process and return a Success|Failure value. *) let terminate (_, p) = let (_, pstat) = Unix.waitpid [] p.pid in match pstat with | Unix.WEXITED 0 -> Success (Buffer.contents p.out.buf, Buffer.contents p.err.buf, Unix.gettimeofday () -. p.time) | _ -> Failure (Buffer.contents p.err.buf) (* simple helper for a single process spawn|process|terminate *) let run args = let p = make args in let (p2, _) = wait [((), p)] in terminate p2 obuild-0.2.2/lib/core/process.mli000066400000000000000000000027171515212760700166650ustar00rootroot00000000000000(** Process execution and management *) (** Process state *) type t (** Process execution result *) type result = | Success of string * string * float (** stdout, stderr, duration *) | Failure of string (** stderr *) (** Delayed process creation *) type call = unit -> t val make : string list -> t (** [make args] creates and starts a new process Creates a subprocess with stdout and stderr redirected to pipes. The first element of args is the program to execute. @param args command line arguments (program + args) @return process state *) val wait : ('a * t) list -> ('a * t) * ('a * t) list (** [wait processes] waits for one process to finish Monitors multiple processes and returns when one completes, reading from stdout and stderr until both are closed. @param processes list of (task, process) pairs @return ((task, finished_process), remaining_processes) *) val terminate : ('a * t) -> result (** [terminate (task, process)] cleans up process and returns result Waits for process to terminate and collects exit status. @param task process pair @return Success with outputs and duration, or Failure with stderr *) val run : string list -> result (** [run args] executes a single process synchronously Convenience function that combines make, wait, and terminate for simple single-process execution. @param args command line arguments (program + args) @return execution result *) obuild-0.2.2/lib/core/prog.ml000066400000000000000000000076431515212760700160100ustar00rootroot00000000000000open Fugue open Filepath exception OCamlProgramError of string exception TarError of string exception PkgConfigError of string exception PkgConfigVersionNotFound exception PkgConfigUnexpectedOutput of string exception ProgramNotFound of string let get_cache prog names = let res = Gconf.get_env prog in match res with | Some p -> p | None -> ( try let syspath = Utils.get_system_paths () in let found = list_find_map (fun n -> let n = if Utils.isWindows then n ^ ".exe" else n in if Filename.is_implicit n then try let found_path = Utils.find_in_paths syspath (fn n) in Some (fp_to_string (found_path fn n)) with Utils.FileNotFoundInPaths _ -> None else if Filesystem.exists (fp n) then Some n else None) names in Gconf.set_env prog found; found with Not_found -> raise (ProgramNotFound prog)) let get_ocamlopt () = get_cache "ocamlopt" [ "ocamlopt.opt"; "ocamlopt" ] let get_ocamlc () = get_cache "ocamlc" [ "ocamlc.opt"; "ocamlc" ] let get_ocamldep () = get_cache "ocamldep" [ "ocamldep.opt"; "ocamldep" ] let get_ocamldoc () = get_cache "ocamldoc" [ "ocamldoc.opt"; "ocamldoc" ] let get_ocamlmklib () = get_cache "ocamlmklib" [ "ocamlmklib" ] let get_camlp4 () = get_cache "camlp4" [ "camlp4" ] let get_cc () = get_cache "cc" [ "cc"; "gcc"; "clang" ] let get_ranlib () = get_cache "ranlib" [ "ranlib" ] let get_ar () = get_cache "ar" [ "ar" ] let get_ld () = get_cache "ld" [ "ld" ] let get_pkg_config () = get_cache "pkg-config" [ "pkg-config" ] let get_ocaml () = get_cache "ocaml" [ "ocaml" ] let get_ocamlmktop () = get_cache "ocamlmktop" [ "ocamlmktop" ] let get_ocaml_version cfg = let ver = Hashtbl.find cfg "version" in match String_utils.split ~limit:3 '.' ver with | [ major; minor; other ] -> (major, minor, other) | _ -> raise (OCamlProgramError ("ocaml return an unknown version " ^ ver)) let ocaml_config = ref None let get_ocaml_config () = match !ocaml_config with | None -> ( match Process.run [ get_ocamlc (); "-config" ] with | Process.Success (s, _, _) -> let lines = String_utils.lines_noempty s in let h = Hashtbl.create 32 in List.iter (fun l -> let k, v = Utils.toKV l in Hashtbl.add h k (default "" v)) lines; ocaml_config := Some h; h | Process.Failure err -> raise (OCamlProgramError ("ocamlc cannot get config " ^ err))) | Some h -> h let get_camlp4_config () = match Process.run [ get_camlp4 (); "-where" ] with | Process.Success (s, _, _) -> let (l : _) = String_utils.lines_noempty s in l | Process.Failure err -> raise (OCamlProgramError ("ocamlopt cannot get config " ^ err)) let get_tar () = get_cache "tar" [ "tar"; "gtar" ] let run_tar output dir = match Process.run [ get_tar (); "czf"; output; dir ] with | Process.Success _ -> () | Process.Failure err -> raise (TarError err) let run_pkg_config typ name = match Process.run [ get_pkg_config (); typ; name ] with | Process.Success (s, _, _) -> s | Process.Failure err -> raise (PkgConfigError err) let run_pkg_config_version name = let output = run_pkg_config "--version" name in match String_utils.words_noempty output with | [ ver ] -> ver | [] -> raise PkgConfigVersionNotFound | _ -> raise (PkgConfigUnexpectedOutput ("version: " ^ output)) let run_pkg_config_includes name = let output = run_pkg_config "--cflags" name in (* FIXME check if every items actually got -L as expected *) List.map (String_utils.drop 2) (String_utils.words_noempty output) let run_pkg_config_libs name = let output = run_pkg_config "--libs" name in (* FIXME check if every items actually got -l as expected *) List.map (String_utils.drop 2) (String_utils.words_noempty output) obuild-0.2.2/lib/core/prog.mli000066400000000000000000000067671515212760700161670ustar00rootroot00000000000000(** OCaml toolchain and external program paths *) (** Exception raised when an OCaml program fails *) exception OCamlProgramError of string (** Exception raised when tar command fails *) exception TarError of string (** Exception raised when pkg-config command fails *) exception PkgConfigError of string (** Exception raised when pkg-config doesn't return version *) exception PkgConfigVersionNotFound (** Exception raised when pkg-config output is unexpected *) exception PkgConfigUnexpectedOutput of string (** Exception raised when a required program is not found *) exception ProgramNotFound of string (** OCaml toolchain program getters *) val get_ocamlopt : unit -> string (** Get path to ocamlopt (native compiler) *) val get_ocamlc : unit -> string (** Get path to ocamlc (bytecode compiler) *) val get_ocamldep : unit -> string (** Get path to ocamldep (dependency analyzer) *) val get_ocamldoc : unit -> string (** Get path to ocamldoc (documentation generator) *) val get_ocamlmklib : unit -> string (** Get path to ocamlmklib (library linker) *) val get_camlp4 : unit -> string (** Get path to camlp4 (preprocessor) *) val get_cc : unit -> string (** Get path to C compiler (gcc) *) val get_ranlib : unit -> string (** Get path to ranlib *) val get_ar : unit -> string (** Get path to ar (archiver) *) val get_ld : unit -> string (** Get path to ld (linker) *) val get_pkg_config : unit -> string (** Get path to pkg-config *) val get_ocaml : unit -> string (** Get path to ocaml (toplevel) *) val get_ocamlmktop : unit -> string (** Get path to ocamlmktop (custom toplevel builder) *) (** OCaml configuration *) val get_ocaml_version : (string, string) Hashtbl.t -> string * string * string (** [get_ocaml_version cfg] extracts OCaml version as (major, minor, other) @param cfg OCaml configuration hashtable @return (major, minor, other) version components @raise OCamlProgramError if version format is unexpected *) val get_ocaml_config : unit -> (string, string) Hashtbl.t (** [get_ocaml_config ()] retrieves OCaml compiler configuration Runs "ocamlc -config" and caches the result. @return configuration hashtable @raise OCamlProgramError if ocamlc fails *) val get_camlp4_config : unit -> string list (** [get_camlp4_config ()] retrieves camlp4 library paths Runs "camlp4 -where" to get the installation directories. @return list of camlp4 library paths @raise OCamlProgramError if camlp4 fails *) (** External tool invocations *) val run_tar : string -> string -> unit (** [run_tar output dir] creates a tar.gz archive @param output output filename @param dir directory to archive @raise TarError if tar command fails *) val run_pkg_config_version : string -> string (** [run_pkg_config_version name] gets package version from pkg-config @param name package name @return version string @raise PkgConfigError if pkg-config fails @raise PkgConfigVersionNotFound if no version returned @raise PkgConfigUnexpectedOutput if output format is unexpected *) val run_pkg_config_includes : string -> string list (** [run_pkg_config_includes name] gets include flags from pkg-config @param name package name @return list of include paths (without -I prefix) @raise PkgConfigError if pkg-config fails *) val run_pkg_config_libs : string -> string list (** [run_pkg_config_libs name] gets library flags from pkg-config @param name package name @return list of library names (without -l prefix) @raise PkgConfigError if pkg-config fails *) obuild-0.2.2/lib/core/project.ml000066400000000000000000000330561515212760700165040ustar00rootroot00000000000000(** Project configuration file (.obuild) types and utilities This module defines the types for representing obuild project files. Parsing is handled by obuild_parser and obuild_validate modules. Use Project_read.read() to parse project files. *) open Fugue open Filepath open Printf open Target exception NoConfFile exception MultipleConfFiles exception InvalidConfFile of string exception MissingField of string exception UnknownDependencyName of string exception UnsupportedFutureVersion of int exception ModuleNotFound of target * Hier.t exception ModuleListEmpty of Libname.t exception FileNotFound of target * filename exception LicenseFileNotFound of filepath exception BlockSectionAsValue of string exception ExecutableWithNoMain of string exception UnknownStdlib of string exception UnknownExtraDepFormat of string exception UnknownFlag of string exception BadOcamlVersion of (string * Expr.t) exception LibraryNotFound of Libname.t exception ExecutableNotFound of string exception BenchNotFound of string exception TestNotFound of string exception ExampleNotFound of string module Library = struct type t = { name : Libname.t; description : string; target : target; modules : Hier.t list; pack : bool; syntax : bool; subs : t list; } let make name = { name; description = ""; modules = []; pack = false; syntax = false; target = new_target (Name.Lib name) Typ.Lib true true; subs = []; } let make_prefix libname subname = make (Libname.append libname subname) let make_from_string libname = make (Libname.of_string libname) let to_target obj = obj.target let rec to_targets lib = lib.target :: List.concat (List.map to_targets lib.subs) let rec flatten lib : t list = lib :: List.concat (List.map flatten lib.subs) let find libs name = try List.find (fun l -> l.name = name) (List.concat (List.map flatten libs)) with Not_found -> raise (LibraryNotFound name) let check_modules_not_empty lib = if lib.modules = [] then raise (ModuleListEmpty lib.name) let rec show add show_target section lib = add "\n"; add (sprintf "%slibrary %s\n" section (Libname.to_string lib.name)); let iStr = section ^ " " in add (sprintf "%smodules: %s\n" iStr (Utils.showList "," Hier.to_string lib.modules)); if lib.pack then add (sprintf "%spack: %b\n" iStr lib.pack); if lib.syntax then add (sprintf "%ssyntax: %b\n" iStr lib.syntax); show_target iStr lib.target; List.iter (fun sub -> show add show_target iStr sub) lib.subs end module Executable = struct type t = { name : string; main : filename; target : target; } let make name = { name; main = empty_fn; target = new_target (Name.Exe name) Typ.Exe true true } let to_target obj = obj.target let find exes name = try List.find (fun e -> e.name = name) exes with Not_found -> raise (ExecutableNotFound name) end module Test = struct type test_type = ExitCode type t = { name : string; main : filename; target : target; rundir : filepath option; runopt : string list; type_ : test_type; } let make ~name ~main ~target ~rundir ~runopt = (* For tests, buildable defaults to CLI option "build-tests" *) let buildable = match target.target_buildable with | BoolConst true -> BoolConst (Gconf.get_target_option_typed Gconf.Build_tests) | other -> other in { name; main; target = { target with target_buildable = buildable; target_installable = BoolConst false }; rundir; runopt; type_ = ExitCode; } let to_target obj = obj.target let find tests name = try List.find (fun b -> b.name = name) tests with Not_found -> raise (TestNotFound name) end module Bench = struct type t = { name : string; main : filename; target : target; } let make ~name ~main ~target = (* For benchmarks, buildable defaults to CLI option "build-benchs" *) let buildable = match target.target_buildable with | BoolConst true -> BoolConst (Gconf.get_target_option_typed Gconf.Build_benchs) | other -> other in { name; main; target = { target with target_buildable = buildable; target_installable = BoolConst false }; } let to_target obj = obj.target let find benchs name = try List.find (fun b -> b.name = name) benchs with Not_found -> raise (BenchNotFound name) end module Example = struct type t = { name : string; main : filename; target : target; } let to_target obj = obj.target let make ~name ~main ~target = (* For examples, buildable defaults to CLI option "build-examples" *) let buildable = match target.target_buildable with | BoolConst true -> BoolConst (Gconf.get_target_option_typed Gconf.Build_examples) | other -> other in { name; main; target = { target with target_buildable = buildable; target_installable = BoolConst false }; } let find examples name = try List.find (fun b -> b.name = name) examples with Not_found -> raise (ExampleNotFound name) end module Flag = struct type t = { name : string; description : string; default : bool option; } end module Generator = struct type t = { name : string; (** Generator name for reference *) suffix : string option; (** File extension for automatic detection (e.g., "mly") *) command : string; (** Command template with variables: ${src}, ${dest}, ${base}, ${sources} *) outputs : string list; (** Output file patterns *) module_name : string option; (** Module name pattern if different from base *) } let make name = { name; suffix = None; command = ""; outputs = []; module_name = None; } end type t = { name : string; version : string; synopsis : string; description : string; license : string; license_file : filepath option; authors : string list; obuild_ver : int; ocaml_ver : Expr.t option; homepage : string; flags : Flag.t list; generators : Generator.t list; libs : Library.t list; exes : Executable.t list; tests : Test.t list; benchs : Bench.t list; examples : Example.t list; extra_srcs : filepath list; extra_tools : filename list; configure_script : filepath option; ocaml_extra_args : string list option; } let make = { name = ""; version = ""; synopsis = ""; description = ""; license = ""; license_file = None; authors = []; obuild_ver = 0; ocaml_ver = None; homepage = ""; extra_tools = []; flags = []; generators = []; libs = []; exes = []; tests = []; benchs = []; examples = []; extra_srcs = []; configure_script = None; ocaml_extra_args = None; } let findPath () = let ents = List.fast_sort String.compare (Array.to_list (Sys.readdir ".")) in match List.find_all (fun ent -> (not (String_utils.startswith "." ent)) && String_utils.endswith ".obuild" ent) ents with | [] -> raise NoConfFile | [ x ] -> fp x | _ -> raise MultipleConfFiles let digest () = let path = findPath () in Digest.to_hex (Digest.file (fp_to_string path)) (** Helper: Validate that files exist in target source directories *) let check_files_exists target names = let srcdir = target.target_obits.target_srcdir in List.iter (fun n -> ignore (Utils.find_in_paths srcdir n)) names (** Helper: Validate that modules exist in target source directories Skips modules that will be auto-generated by cstubs *) let check_modules_exists target modules = let srcdir = target.target_obits.target_srcdir in (* Register generator outputs first so they can be found *) Target.register_generator_outputs target; (* Get list of cstubs-generated modules to skip - all three are generated: - _generated: FOREIGN implementation - generated-types: type bindings - generated-entry-point: entry module *) let cstubs_generated_modules = match target.target_cstubs with | Some cstubs -> let foreign_name = Compat.string_capitalize (cstubs.cstubs_external_library_name ^ "_generated") in let types_name = Compat.string_capitalize cstubs.cstubs_generated_types in let entry_name = Compat.string_capitalize cstubs.cstubs_generated_entry_point in [ Hier.of_string foreign_name; Hier.of_string types_name; Hier.of_string entry_name ] | None -> [] in List.iter (fun m -> (* Skip validation for cstubs-generated modules *) if not (List.mem m cstubs_generated_modules) then try ignore (Hier.get_file_entry m srcdir) with Not_found -> raise (ModuleNotFound (target, m))) modules (** Validate project configuration Checks for required fields, file existence, module existence, and OCaml version compatibility. *) let check proj = if proj.name = "" then raise (MissingField "name"); if proj.version = "" then raise (MissingField "version"); if proj.obuild_ver = 0 then raise (MissingField "obuild-ver"); if proj.obuild_ver > 1 then raise (UnsupportedFutureVersion proj.obuild_ver); maybe_unit (fun x -> if not (Filesystem.exists x) then raise (LicenseFileNotFound x)) proj.license_file; maybe_unit (fun x -> let ocaml_ver = Hashtbl.find (Prog.get_ocaml_config ()) "version" in if not (Expr.eval ocaml_ver x) then raise (BadOcamlVersion (ocaml_ver, x))) proj.ocaml_ver; (* check sublibs in libs *) List.iter (fun rootlib -> Library.check_modules_not_empty rootlib; let sublibs = Library.flatten rootlib in List.iter (fun lib -> Library.check_modules_not_empty lib; check_modules_exists lib.Library.target lib.Library.modules) sublibs) proj.libs; List.iter (fun exe -> if fn_to_string exe.Executable.main = "" then raise (ExecutableWithNoMain exe.Executable.name); check_files_exists exe.Executable.target [ exe.Executable.main ]) proj.exes; () let write file proj = Utils.generateFile file (fun add -> let add_string k s = if s <> "" then add (sprintf "%s: %s\n" k s) in add (sprintf "name: %s\n" proj.name); add (sprintf "version: %s\n" proj.version); add_string "synopsis" proj.synopsis; add_string "description" proj.description; add_string "license" proj.license; add_string "homepage" proj.homepage; maybe () (fun x -> add_string "license-file" (fp_to_string x)) proj.license_file; add_string "authors" (Utils.showList ", " id proj.authors); add (sprintf "obuild-ver: %d\n" proj.obuild_ver); maybe () (fun x -> add_string "ocaml-version" (Expr.to_string x)) proj.ocaml_ver; maybe () (fun x -> add_string "ocaml-extra-args" (String.concat " " x)) proj.ocaml_extra_args; let show_target iStr target = let obits = target.target_obits in let cbits = target.target_cbits in add (sprintf "%ssrc-dir: %s\n" iStr (String.concat "," (List.map fp_to_string obits.target_srcdir))); add_string (iStr ^ "build-deps") (Utils.showList ", " (fun (l, _) -> Libname.to_string l) obits.target_builddeps); add_string (iStr ^ "oflags") (Utils.showList " " id obits.target_oflags); add_string (iStr ^ "pp") (maybe "" (fun ppty -> Pp.Type.to_string ppty) obits.target_pp); add (sprintf "%sc-dir: %s\n" iStr (fp_to_string cbits.target_cdir)); add_string (iStr ^ "c-sources") (Utils.showList ", " fn_to_string cbits.target_csources); add_string (iStr ^ "c-flags") (Utils.showList " " id cbits.target_cflags); add_string (iStr ^ "c-libs") (Utils.showList "," id cbits.target_clibs); add_string (iStr ^ "c-libpaths") (Utils.showList "," fp_to_string cbits.target_clibpaths); add_string (iStr ^ "c-pkgs") (Utils.showList ", " (fun (l, _) -> l) cbits.target_cpkgs) in List.iter (Library.show add show_target "") proj.libs; List.iter (fun exe -> add "\n"; add (sprintf "executable %s\n" exe.Executable.name); add (sprintf " main: %s\n" (fn_to_string exe.Executable.main)); show_target " " exe.Executable.target; ()) proj.exes) let get_all_targets projFile = List.concat (List.map Library.to_targets projFile.libs) @ List.map Executable.to_target projFile.exes @ List.map Test.to_target projFile.tests @ List.map Bench.to_target projFile.benchs @ List.map Example.to_target projFile.examples let get_all_targets_filter projFile f = List.filter (fun target -> f target) (get_all_targets projFile) let get_val_const_or_var user_flags = function | BoolConst t -> t | BoolVariable v -> ( try List.assoc v user_flags with Not_found -> raise (UnknownFlag v)) let get_all_buildable_targets proj_file user_flags = get_all_targets_filter proj_file (fun target -> get_val_const_or_var user_flags target.target_buildable) let get_all_installable_targets proj_file user_flags = get_all_targets_filter proj_file (fun target -> let install = get_val_const_or_var user_flags target.target_installable in let build = get_val_const_or_var user_flags target.target_buildable in Printf.printf "target %s install %b build %b\n" (Target.Name.to_string target.target_name) install build; install) let find_lib proj_file name = Library.find proj_file.libs name let find_exe proj_file name = Executable.find proj_file.exes name let find_test proj_file name = Test.find proj_file.tests name let find_bench proj_file name = Bench.find proj_file.benchs name let find_example proj_file name = Example.find proj_file.examples name obuild-0.2.2/lib/core/project.mli000066400000000000000000000222621515212760700166520ustar00rootroot00000000000000(** Project configuration file (.obuild) parsing and representation This module handles parsing and representation of obuild project files, which define libraries, executables, tests, and build configuration. *) (** {1 Exceptions} *) exception NoConfFile (** Raised when no .obuild configuration file is found *) exception MultipleConfFiles (** Raised when multiple .obuild files exist in the same directory *) exception InvalidConfFile of string (** Raised when configuration file has invalid syntax or structure *) exception MissingField of string (** Raised when a required field is missing *) exception UnknownDependencyName of string (** Raised when a dependency name cannot be resolved *) exception UnsupportedFutureVersion of int (** Raised when .obuild file uses a newer format version *) exception ModuleNotFound of Target.target * Hier.t (** Raised when a declared module file doesn't exist *) exception ModuleListEmpty of Libname.t (** Raised when a library has no modules defined *) exception FileNotFound of Target.target * Filepath.filename (** Raised when a referenced file doesn't exist *) exception LicenseFileNotFound of Filepath.filepath (** Raised when the declared license file doesn't exist *) exception BlockSectionAsValue of string (** Raised when trying to use a block section as a simple value *) exception ExecutableWithNoMain of string (** Raised when an executable has no main file defined *) exception UnknownStdlib of string (** Raised when an unknown stdlib is specified *) exception UnknownExtraDepFormat of string (** Raised when extra dependency format is invalid *) exception UnknownFlag of string (** Raised when an unknown flag is referenced *) exception BadOcamlVersion of (string * Expr.t) (** Raised when OCaml version constraint is invalid *) exception LibraryNotFound of Libname.t (** Raised when a library cannot be found in the project *) exception ExecutableNotFound of string (** Raised when an executable cannot be found in the project *) exception BenchNotFound of string (** Raised when a benchmark cannot be found in the project *) exception TestNotFound of string (** Raised when a test cannot be found in the project *) exception ExampleNotFound of string (** Raised when an example cannot be found in the project *) (** {1 Library Configuration} *) module Library : sig type t = { name : Libname.t; description : string; target : Target.target; modules : Hier.t list; pack : bool; syntax : bool; subs : t list; } (** Library configuration with optional sublibraries *) val make : Libname.t -> t (** Create a new library with default settings *) val make_prefix : Libname.t -> string -> t (** Create a sublibrary with prefixed name *) val make_from_string : string -> t (** Create a library from string name *) val to_target : t -> Target.target (** Extract target from library *) val to_targets : t -> Target.target list (** Get all targets (library + sublibraries) *) val flatten : t -> t list (** Flatten library hierarchy into list *) val find : t list -> Libname.t -> t (** Find library by name in list @raise LibraryNotFound if not found *) val check_modules_not_empty : t -> unit (** Verify library has modules defined @raise ModuleListEmpty if empty *) end (** {1 Executable Configuration} *) module Executable : sig type t = { name : string; main : Filepath.filename; target : Target.target; } (** Executable configuration *) val make : string -> t (** Create new executable with default settings *) val to_target : t -> Target.target (** Extract target from executable *) val find : t list -> string -> t (** Find executable by name in list @raise ExecutableNotFound if not found *) end (** {1 Test Configuration} *) module Test : sig type test_type = ExitCode (** Test type - currently only exit code tests supported *) type t = { name : string; main : Filepath.filename; target : Target.target; rundir : Filepath.filepath option; runopt : string list; type_ : test_type; } (** Test configuration *) val make : name:string -> main:Filepath.filename -> target:Target.target -> rundir:Filepath.filepath option -> runopt:string list -> t (** Create test from parameters. Buildable defaults to CLI option "build-tests". *) val to_target : t -> Target.target (** Extract target from test *) val find : t list -> string -> t (** Find test by name in list @raise TestNotFound if not found *) end (** {1 Benchmark Configuration} *) module Bench : sig type t = { name : string; main : Filepath.filename; target : Target.target; } (** Benchmark configuration *) val make : name:string -> main:Filepath.filename -> target:Target.target -> t (** Create benchmark from parameters. Buildable defaults to CLI option "build-benchs". *) val to_target : t -> Target.target (** Extract target from benchmark *) val find : t list -> string -> t (** Find benchmark by name in list @raise BenchNotFound if not found *) end (** {1 Example Configuration} *) module Example : sig type t = { name : string; main : Filepath.filename; target : Target.target; } (** Example executable configuration *) val make : name:string -> main:Filepath.filename -> target:Target.target -> t (** Create example from parameters. Buildable defaults to CLI option "build-examples". *) val to_target : t -> Target.target (** Extract target from example *) val find : t list -> string -> t (** Find example by name in list @raise ExampleNotFound if not found *) end (** {1 Flag Configuration} *) module Flag : sig type t = { name : string; description : string; default : bool option; } (** Compile-time flag configuration *) end (** {1 Generator Configuration} *) module Generator : sig type t = { name : string; (** Generator name for reference *) suffix : string option; (** File extension for automatic detection (e.g., "mly") *) command : string; (** Command template with variables: ${src}, ${dest}, ${base}, ${sources} *) outputs : string list; (** Output file patterns *) module_name : string option; (** Module name pattern if different from base *) } (** Custom generator configuration. Generators with a suffix are automatically triggered during module discovery. Generators without a suffix must be used via explicit generate blocks. *) val make : string -> t (** Create a new generator with default settings *) end (** {1 Main Project Type} *) type t = { name : string; version : string; synopsis : string; description : string; license : string; license_file : Filepath.filepath option; authors : string list; obuild_ver : int; ocaml_ver : Expr.t option; homepage : string; flags : Flag.t list; generators : Generator.t list; libs : Library.t list; exes : Executable.t list; tests : Test.t list; benchs : Bench.t list; examples : Example.t list; extra_srcs : Filepath.filepath list; extra_tools : Filepath.filename list; configure_script : Filepath.filepath option; ocaml_extra_args : string list option; } (** Project configuration structure *) val make : t (** Empty project with default values *) (** {1 Project File Operations} *) val findPath : unit -> Filepath.filepath (** Find .obuild configuration file in current directory. @raise NoConfFile if no .obuild file found @raise MultipleConfFiles if multiple .obuild files found *) val digest : unit -> Digest.t (** Compute digest of project configuration file *) val write : Filepath.filepath -> t -> unit (** [write file proj] writes project configuration to file *) val check : t -> unit (** [check proj] validates the project configuration. Checks that required files and modules exist on disk. @raise ModuleNotFound if a declared module doesn't exist @raise FileNotFound if a referenced file doesn't exist @raise LicenseFileNotFound if license file is missing @raise ExecutableWithNoMain if executable has no main file @raise BadOcamlVersion if OCaml version constraint fails *) (** {1 Target Operations} *) val get_all_buildable_targets : t -> (string * bool) list -> Target.target list (** [get_all_buildable_targets proj user_flags] returns all buildable targets given user-specified flags *) val get_all_installable_targets : t -> (string * bool) list -> Target.target list (** [get_all_installable_targets proj user_flags] returns all installable targets given user-specified flags *) (** {1 Lookup Functions} *) val find_lib : t -> Libname.t -> Library.t (** Find library in project by name @raise LibraryNotFound if not found *) val find_exe : t -> string -> Executable.t (** Find executable in project by name @raise ExecutableNotFound if not found *) val find_test : t -> string -> Test.t (** Find test in project by name @raise TestNotFound if not found *) val find_bench : t -> string -> Bench.t (** Find benchmark in project by name @raise BenchNotFound if not found *) val find_example : t -> string -> Example.t (** Find example in project by name @raise ExampleNotFound if not found *) obuild-0.2.2/lib/core/project_read.ml000066400000000000000000000035241515212760700174740ustar00rootroot00000000000000(** New parser integration for Project reading This module provides an alternative to Project.read that uses the new parser (obuild_lexer -> obuild_parser -> obuild_validate). It's in a separate module to avoid cyclic dependencies between Project and Obuild_validate. *) open Filepath (** Convert Project.Generator.t to Generators.custom *) let convert_generator_to_custom (gen : Project.Generator.t) : Generators.custom = { Generators.custom_name = gen.Project.Generator.name; custom_suffix = gen.Project.Generator.suffix; custom_command = gen.Project.Generator.command; custom_outputs = gen.Project.Generator.outputs; custom_module_name = gen.Project.Generator.module_name; } (** Register custom generators from project *) let register_generators proj = (* Clear any previously registered custom generators *) Generators.clear_custom_generators (); (* Register new ones *) List.iter (fun gen -> Generators.register_custom (convert_generator_to_custom gen) ) proj.Project.generators (** Read project file using the new parser *) let read () = let path = Project.findPath () in let proj = try Obuild_validate.parse_and_convert_file (fp_to_string path) with | Obuild_validate.Validation_error (loc, msg) -> raise (Project.InvalidConfFile (Printf.sprintf "%d:%d: %s" loc.Location.line loc.Location.col msg)) | Obuild_parser.Parser_error (loc, msg) -> raise (Project.InvalidConfFile (Printf.sprintf "%d:%d: %s" loc.Location.line loc.Location.col msg)) in (* Apply ocaml_extra_args side effect *) (match proj.Project.ocaml_extra_args with | Some args -> Gconf.gconf.Gconf.ocaml_extra_args <- args | None -> ()); (* Register custom generators *) register_generators proj; (* Validate file existence *) Project.check proj; proj obuild-0.2.2/lib/core/scheduler.ml000066400000000000000000000114401515212760700170050ustar00rootroot00000000000000type call = unit -> Process.t (* this is used to control the scheduler behavior * from the idle function *) type 'a t = Terminate | WaitingTask | AddProcess of ('a * Process.t) | AddTask of ('a * (call list list)) | Retry | FinishTask of 'a let to_string = function | Terminate -> "terminate" | WaitingTask -> "waiting-task" | AddProcess (_,_) -> "add-process" | AddTask (_,_) -> "add-task" | Retry -> "retry" | FinishTask _ -> "finish-task" type 'a task_group = { mutable completion : int; mutable next : ('a * call) list list; } type stats = { mutable max_runqueue : int; mutable nb_processes : int; } type 'a state = { mutable runqueue : ('a * Process.t) list; mutable runqueue_len : int; mutable waitqueue : ('a * call) list; mutable terminate : bool; mutable waiting_task : bool; mutable tasks : ('a * 'a task_group) list; } (* wait until a process finish. *) let wait_process state = let (proc_done, processes) = Process.wait state.runqueue in let (task_done,_) = proc_done in let finished_task = try let tg = List.assoc task_done state.tasks in tg.completion <- tg.completion - 1; if tg.completion = 0 then ( match tg.next with | [] -> state.tasks <- List.filter (fun (t,_) -> t <> task_done) state.tasks; true | g :: gs -> tg.completion <- List.length g; tg.next <- gs; state.waitqueue <- g @ state.waitqueue; false ) else false with Not_found -> true in state.runqueue <- processes; state.runqueue_len <- state.runqueue_len - 1; (proc_done, finished_task) let rec idle_loop idle_fun on_task_finish_fun state = match idle_fun () with | Retry -> idle_loop idle_fun on_task_finish_fun state | AddProcess p -> state.runqueue <- p :: state.runqueue; state.runqueue_len <- state.runqueue_len + 1 | WaitingTask -> state.waiting_task <- true | Terminate -> state.terminate <- true | FinishTask t -> on_task_finish_fun t; (* retry *) idle_loop idle_fun on_task_finish_fun state | AddTask (t,ps) -> (match List.map (List.map (fun p -> (t, p))) ps with | [] -> failwith "internal error: empty task added to the scheduler" | first::pss -> let tg = { completion = List.length first; next = pss } in state.tasks <- (t,tg) :: state.tasks; state.waitqueue <- first @ state.waitqueue; ) (* when the scheduler has some room, we get the next task from * taskdep and either start a process or call retry. * * Retry is returned when no process need to be spawned for the next task * since the dependencies have not changed and thus the cache still have * valid target file. Instead of returning retry, we could just go get * the next task ourself. *) let schedule_idle taskdep dispatch_fun () = if Taskdep.is_complete taskdep then Terminate else ( match Taskdep.get_next taskdep with | None -> WaitingTask | Some task -> dispatch_fun task ) (* this is a simple one thread loop to schedule * multiple tasks (forked) until they terminate * * the idle_fun function is called when there's capacity in the runqueue for * another task. * * the finish function is called when a subtask of the task has finished. * if all the subtasks in the task are done then the second value is set * to true. **) let schedule j taskdep dispatch_fun finish_fun = let st = { runqueue = []; runqueue_len = 0; waitqueue = []; terminate = false; waiting_task = false; tasks = []; } in let on_task_finish task = Taskdep.mark_done taskdep task in let stats = { max_runqueue = 0; nb_processes = 0 } in let pick_process (task, process) remaining_processes = stats.nb_processes <- stats.nb_processes + 1; st.runqueue <- (task,process ()) :: st.runqueue; st.runqueue_len <- st.runqueue_len + 1; st.waitqueue <- remaining_processes in let set_max () = if stats.max_runqueue < st.runqueue_len then stats.max_runqueue <- st.runqueue_len in (* add more bulletproofing to prevent busy looping for no reason * if user of this api is not behaving properly *) while not st.terminate || st.runqueue <> [] || st.waitqueue <> [] do while not st.terminate && not st.waiting_task && st.runqueue_len < j do match st.waitqueue with | [] -> idle_loop (schedule_idle taskdep dispatch_fun) on_task_finish st | (t,p)::procs -> pick_process (t,p) procs done; set_max (); if st.runqueue_len > 0 then let (proc_done, finished_task) = wait_process st in st.waiting_task <- false; finish_fun proc_done finished_task else assert (st.terminate) done; stats obuild-0.2.2/lib/core/scheduler.mli000066400000000000000000000027041515212760700171610ustar00rootroot00000000000000(** Task scheduler for parallel build execution *) (** Delayed process call *) type call = unit -> Process.t (** Scheduler control actions returned by idle/dispatch functions *) type 'a t = | Terminate (** Terminate scheduling *) | WaitingTask (** Waiting for a task to become available *) | AddProcess of ('a * Process.t) (** Add a process to the run queue *) | AddTask of ('a * (call list list)) (** Add a new task with process groups *) | Retry (** Retry scheduling *) | FinishTask of 'a (** Mark task as finished *) val to_string : 'a t -> string (** Convert scheduler action to human-readable string *) (** Scheduler statistics *) type stats = { mutable max_runqueue : int; (** Maximum run queue size reached *) mutable nb_processes : int; (** Total number of processes executed *) } val schedule : int -> 'a Taskdep.t -> (int * 'a -> 'a t) -> (('a * Process.t) -> bool -> unit) -> stats (** [schedule j taskdep dispatch_fun finish_fun] runs the parallel scheduler The scheduler manages parallel execution of tasks using a simple multi-process model with configurable parallelism. @param j maximum number of parallel jobs @param taskdep task dependency tracker @param dispatch_fun function to dispatch next task (returns control action) @param finish_fun function called when a process completes @return scheduler statistics *) obuild-0.2.2/lib/core/target.ml000066400000000000000000000215001515212760700163130ustar00rootroot00000000000000open Filepath open Fugue open Types open Dependencies module Typ = struct type t = | Lib | Exe | Test | Bench let is_lib t = t = Lib end exception TargetNameNoType of string exception TargetUnknownType of string * string exception TargetNotRecognized of string module Name = struct type t = | Lib of Libname.t | Exe of string | Test of string | Bench of string | Example of string let to_string = function | Exe e -> "exe-" ^ e | Bench e -> "bench-" ^ e | Test e -> "test-" ^ e | Example e -> "example-" ^ e | Lib l -> "lib-" ^ Libname.to_string l let of_string name = match String_utils.split ~limit:2 '-' name with | [ "exe"; n ] -> Exe n | [ "lib"; n ] -> Lib (Libname.of_string n) | [ "test"; n ] -> Test n | [ "bench"; n ] -> Bench n | [ "example"; n ] -> Example n | [ prefix; n ] -> raise (TargetUnknownType (prefix, n)) | [ _ ] -> raise (TargetNameNoType name) | _ -> raise (TargetNotRecognized name) let to_dirname = function | Exe e | Bench e | Test e | Example e -> fn e | Lib l -> fn ("lib-" ^ Libname.to_string l) let get_clibname = function | Exe e -> "stubs_" ^ e | Bench e -> "stubs_" ^ e | Test e -> "stubs_" ^ e | Example e -> "stubs_" ^ e | Lib l -> "stubs_" ^ list_last (Libname.to_string_nodes l) (* get the core name of the final object representing the object * for an executable/test/bench it will be the name of the executable apart from the extension * for a test it will be the name of the library created (.cmxa/.cma) apart from the extension *) let get_dest_name = function | Exe e -> e | Bench e -> "bench-" ^ e | Test e -> "test-" ^ e | Example e -> "example-" ^ e | Lib l -> String.concat "_" (Libname.to_string_nodes l) end type target_stdlib = | Stdlib_None | Stdlib_Standard | Stdlib_Core type runtime_bool = | BoolConst of bool | BoolVariable of string let runtime_def v = BoolConst v type target_cbits = { target_cdir : filepath; target_csources : filename list; target_cflags : string list (* CFLAGS *); target_clibs : string list; target_clibpaths : filepath list; target_cpkgs : cdependency list (* pkg-config name *); } type target_obits = { target_srcdir : filepath list; target_builddeps : dependency list; target_oflags : string list; target_pp : Pp.Type.t option; target_extradeps : (Hier.t * Hier.t) list; target_stdlib : target_stdlib; } type target_extra = { target_extra_objects : string list; (* targets of those extra settings *) target_extra_builddeps : dependency list; target_extra_oflags : string list; target_extra_cflags : string list; target_extra_pp : Pp.Type.t option; } (* Ctypes.cstubs support: pair of functor module -> generated instance name *) type cstubs_description = { cstubs_functor : Hier.t; (* User's functor module, e.g., Bindings.Types *) cstubs_instance : string; (* Generated instance name, e.g., Types_gen *) } (* Ctypes.cstubs concurrency policy *) type cstubs_concurrency = | Cstubs_sequential (* Default: no special concurrency support *) | Cstubs_unlocked (* Release runtime lock during C calls *) | Cstubs_lwt_jobs (* Lwt jobs-based concurrency *) | Cstubs_lwt_preemptive (* Lwt preemptive threading *) (* Ctypes.cstubs errno policy *) type cstubs_errno = | Cstubs_ignore_errno (* Default: errno not accessed *) | Cstubs_return_errno (* Functions return (retval, errno) pairs *) (* Ctypes.cstubs configuration for a library *) type target_cstubs = { cstubs_external_library_name : string; (* Name for generated C library *) cstubs_type_description : cstubs_description option; (* Types functor -> instance *) cstubs_function_description : cstubs_description option; (* Functions functor -> instance *) cstubs_generated_types : string; (* Intermediate types module name *) cstubs_generated_entry_point : string; (* Main entry module (e.g., "C") *) cstubs_headers : string list; (* C headers to include *) cstubs_concurrency : cstubs_concurrency; (* Concurrency policy *) cstubs_errno : cstubs_errno; (* Errno handling policy *) } (* Explicit generate block for multi-input generators or overrides *) type target_generate = { generate_module : Hier.t; (* Output module name *) generate_from : filepath list; (* Input file(s) *) generate_using : string; (* Generator name to use *) generate_args : string option; (* Additional command-line arguments *) } type target = { target_name : Name.t; target_type : Typ.t; target_cbits : target_cbits; target_obits : target_obits; target_cstubs : target_cstubs option; target_generates : target_generate list; target_extras : target_extra list; target_buildable : runtime_bool; target_installable : runtime_bool; } let new_target_cbits = { target_cdir = current_dir; target_csources = []; target_cflags = []; target_clibs = []; target_clibpaths = []; target_cpkgs = []; } let new_target_obits = { target_oflags = []; target_builddeps = []; target_pp = None; target_srcdir = [ current_dir ]; target_extradeps = []; target_stdlib = Stdlib_Standard; } let new_target_cstubs = { cstubs_external_library_name = ""; cstubs_type_description = None; cstubs_function_description = None; cstubs_generated_types = "Types_generated"; cstubs_generated_entry_point = "C"; cstubs_headers = []; cstubs_concurrency = Cstubs_sequential; cstubs_errno = Cstubs_ignore_errno; } let new_target n ty buildable installable = { target_name = n; target_buildable = runtime_def buildable; target_installable = runtime_def installable; target_type = ty; target_extras = []; target_cbits = new_target_cbits; target_obits = new_target_obits; target_cstubs = None; target_generates = []; } let new_target_extra objs = { target_extra_objects = objs; target_extra_builddeps = []; target_extra_oflags = []; target_extra_cflags = []; target_extra_pp = None; } let get_target_name target = Name.to_string target.target_name let get_target_dest_name target = Name.get_dest_name target.target_name let get_target_clibname target = Name.get_clibname target.target_name let is_lib target = Typ.is_lib target.target_type let get_ocaml_compiled_types target = let nat, byte = if is_lib target then (Gconf.get_target_option_typed Library_native, Gconf.get_target_option_typed Library_bytecode) else (Gconf.get_target_option_typed Executable_native, Gconf.get_target_option_typed Executable_bytecode) in (if nat then [ Native ] else []) @ if byte then [ ByteCode ] else [] let get_debug_profile target = if is_lib target then (Gconf.get_target_option_typed Library_debugging, Gconf.get_target_option_typed Library_profiling) else (Gconf.get_target_option_typed Executable_debugging, Gconf.get_target_option_typed Executable_profiling) let get_compilation_opts target = let debug, prof = get_debug_profile target in (Normal :: (if debug then [ WithDebug ] else [])) @ if prof then [ WithProf ] else [] let get_all_builddeps target = let targetWideDeps = target.target_obits.target_builddeps in let fileSpecificDeps = List.map (fun extra -> extra.target_extra_builddeps) target.target_extras in targetWideDeps @ List.concat fileSpecificDeps let find_extra_matching target s = List.filter (fun extra -> List.mem s extra.target_extra_objects) target.target_extras (** Register output modules from generators so they can be found during validation and build. Handles both suffix-based generators (e.g., atdgen) and explicit generate blocks. *) let register_generator_outputs target = let generators = Generators.get_all () in let src_dirs = target.target_obits.target_srcdir in (* Register suffix-based generator outputs *) List.iter (fun src_dir -> List.iter (fun (gen : Generators.t) -> if gen.Generators.suffix <> "" then begin let suffix = gen.Generators.suffix in let files = Filesystem.list_dir_pred (fun f -> String_utils.endswith suffix (fn_to_string f) ) src_dir in List.iter (fun src_file -> let src_path = src_dir src_file in let base = fn_to_string (chop_extension src_file) in let output_file = gen.Generators.generated_files src_file base in let output_base = fn_to_string (chop_extension output_file) in let module_name = Compat.string_capitalize output_base in let hier = Hier.of_string module_name in Hier.register_generated_entry hier src_dir src_path output_file ) files end ) generators ) src_dirs; (* Register generate block modules *) List.iter (fun (gen_block : target_generate) -> let module_name = Hier.to_string gen_block.generate_module in Hier.register_generated_module module_name ) target.target_generates obuild-0.2.2/lib/core/target.mli000066400000000000000000000154441515212760700164760ustar00rootroot00000000000000(** Build target definitions and utilities *) (** Exception raised when a target name lacks a type prefix *) exception TargetNameNoType of string (** Exception raised when a target has an unknown type prefix *) exception TargetUnknownType of string * string (** Exception raised when a target name cannot be recognized *) exception TargetNotRecognized of string (** Target types *) module Typ : sig type t = Lib | Exe | Test | Bench val is_lib : t -> bool (** Check if target type is a library *) end (** Target name representation with type prefixes *) module Name : sig type t = | Lib of Libname.t | Exe of string | Test of string | Bench of string | Example of string val to_string : t -> string (** Convert target name to string with type prefix (e.g., "exe-foo", "lib-bar") *) val of_string : string -> t (** Parse target name from string @raise TargetNameNoType if name has no type prefix @raise TargetUnknownType if type prefix is not recognized @raise TargetNotRecognized if name format is invalid *) val to_dirname : t -> Filepath.filename (** Convert target name to directory name for build output *) val get_clibname : t -> string (** Get C library stub name for this target *) val get_dest_name : t -> string (** Get destination file name (without extension) for this target *) end (** Standard library usage mode *) type target_stdlib = Stdlib_None | Stdlib_Standard | Stdlib_Core (** Runtime-evaluated boolean (constant or variable reference) *) type runtime_bool = | BoolConst of bool | BoolVariable of string val runtime_def : bool -> runtime_bool (** Create runtime boolean from constant value *) (** C compilation bits for a target *) type target_cbits = { target_cdir : Filepath.filepath; target_csources : Filepath.filename list; target_cflags : string list; target_clibs : string list; target_clibpaths : Filepath.filepath list; target_cpkgs : Dependencies.cdependency list; } (** OCaml compilation bits for a target *) type target_obits = { target_srcdir : Filepath.filepath list; target_builddeps : Dependencies.dependency list; target_oflags : string list; target_pp : Pp.Type.t option; target_extradeps : (Hier.t * Hier.t) list; target_stdlib : target_stdlib; } (** Extra per-file compilation settings *) type target_extra = { target_extra_objects : string list; target_extra_builddeps : Dependencies.dependency list; target_extra_oflags : string list; target_extra_cflags : string list; target_extra_pp : Pp.Type.t option; } (** Ctypes.cstubs description: pair of functor module -> generated instance name *) type cstubs_description = { cstubs_functor : Hier.t; (** User's functor module, e.g., Bindings.Types *) cstubs_instance : string; (** Generated instance name, e.g., Types_gen *) } (** Ctypes.cstubs concurrency policy *) type cstubs_concurrency = | Cstubs_sequential (** Default: no special concurrency support *) | Cstubs_unlocked (** Release runtime lock during C calls *) | Cstubs_lwt_jobs (** Lwt jobs-based concurrency *) | Cstubs_lwt_preemptive (** Lwt preemptive threading *) (** Ctypes.cstubs errno policy *) type cstubs_errno = | Cstubs_ignore_errno (** Default: errno not accessed *) | Cstubs_return_errno (** Functions return (retval, errno) pairs *) (** Ctypes.cstubs configuration for a library *) type target_cstubs = { cstubs_external_library_name : string; (** Name for generated C library *) cstubs_type_description : cstubs_description option; (** Types functor -> instance *) cstubs_function_description : cstubs_description option; (** Functions functor -> instance *) cstubs_generated_types : string; (** Intermediate types module name *) cstubs_generated_entry_point : string; (** Main entry module (e.g., "C") *) cstubs_headers : string list; (** C headers to include *) cstubs_concurrency : cstubs_concurrency; (** Concurrency policy *) cstubs_errno : cstubs_errno; (** Errno handling policy *) } (** Explicit generate block for multi-input generators or overrides *) type target_generate = { generate_module : Hier.t; (** Output module name *) generate_from : Filepath.filepath list; (** Input file(s) *) generate_using : string; (** Generator name to use *) generate_args : string option; (** Additional command-line arguments *) } (** Complete build target definition *) type target = { target_name : Name.t; target_type : Typ.t; target_cbits : target_cbits; target_obits : target_obits; target_cstubs : target_cstubs option; target_generates : target_generate list; target_extras : target_extra list; target_buildable : runtime_bool; target_installable : runtime_bool; } val new_target_cbits : target_cbits (** Empty C compilation bits with default values *) val new_target_obits : target_obits (** Empty OCaml compilation bits with default values *) val new_target_cstubs : target_cstubs (** Default cstubs configuration with empty values *) val new_target : Name.t -> Typ.t -> bool -> bool -> target (** [new_target name typ buildable installable] creates a new target @param name target name @param typ target type @param buildable whether target can be built @param installable whether target can be installed *) val new_target_extra : string list -> target_extra (** Create extra compilation settings for specific object files *) val get_target_name : target -> string (** Get target name as string with type prefix *) val get_target_dest_name : target -> string (** Get destination file name (without extension) *) val get_target_clibname : target -> string (** Get C library stub name *) val is_lib : target -> bool (** Check if target is a library *) val get_ocaml_compiled_types : target -> Types.ocaml_compiled_type list (** Get OCaml compilation types (Native/ByteCode) based on target type and global config *) val get_debug_profile : target -> bool * bool (** Get (debugging, profiling) flags based on target type and global config *) val get_compilation_opts : target -> Types.ocaml_compilation_option list (** Get compilation options (Normal/WithDebug/WithProf) based on target config *) val get_all_builddeps : target -> Dependencies.dependency list (** Get all build dependencies including target-wide and file-specific deps *) val find_extra_matching : target -> string -> target_extra list (** Find extra compilation settings for a specific object file *) val register_generator_outputs : target -> unit (** Register output modules from generators so they can be found during validation and build. Handles both suffix-based generators (e.g., atdgen) and explicit generate blocks. *) obuild-0.2.2/lib/core/taskdep.ml000066400000000000000000000053001515212760700164600ustar00rootroot00000000000000open Printf open Fugue type direction = FromChildren | FromParent (* this is a simple task dependency 'scheduler' *) type 'a t = { dag : 'a Dag.t; nb_steps : int; steps_done : ('a, unit) Hashtbl.t; direction : direction; mutable current_step : int; mutable next_tasks : 'a list; next_tasks_set : ('a, unit) Hashtbl.t; } (* init a new taskdep from a dag *) let init_with dag direction nodes = let set = Hashtbl.create 16 in List.iter (fun n -> Hashtbl.replace set n ()) nodes; { dag = dag; nb_steps = Dag.length dag; current_step = 1; direction = direction; steps_done = Hashtbl.create 16; next_tasks = nodes; next_tasks_set = set; } let init ?(direction=FromChildren) dag = init_with dag direction (if direction = FromChildren then Dag.get_leaves dag else Dag.get_roots dag) let next_index taskdep = let c = taskdep.current_step in taskdep.current_step <- taskdep.current_step + 1; c (* get next task from the task dependency, and removes it from the next list *) let get_next taskdep = let nexts = taskdep.next_tasks in match nexts with | [] -> None | task::xs -> taskdep.next_tasks <- xs; Hashtbl.remove taskdep.next_tasks_set task; Some (next_index taskdep, task) let mark_done taskdep step = Hashtbl.add taskdep.steps_done step (); (* check if any parents is now free to complete *) let parents = if taskdep.direction = FromChildren then Dag.get_parents taskdep.dag step else Dag.get_children taskdep.dag step in List.iter (fun parent -> let children = if taskdep.direction = FromChildren then Dag.get_children taskdep.dag parent else Dag.get_parents taskdep.dag parent in let allDone = List.for_all (fun child -> Hashtbl.mem taskdep.steps_done child) children in if allDone && not (Hashtbl.mem taskdep.next_tasks_set parent) then ( Hashtbl.replace taskdep.next_tasks_set parent (); taskdep.next_tasks <- taskdep.next_tasks @ [parent]) ) parents let is_complete taskdep = Hashtbl.length taskdep.steps_done = taskdep.nb_steps let linearize dag direction nodes = let l = ref [] in let visited = Hashtbl.create 16 in let rec visit n = if not (Hashtbl.mem visited n) then ( Hashtbl.add visited n (); List.iter visit ((if direction = FromParent then Dag.get_children else Dag.get_parents) dag n); l := n :: !l; ) in List.iter visit nodes; !l let dump a_to_string taskdep = printf "tasks steps done: [%s]\n" (String.concat "," (List.map a_to_string (hashtbl_keys taskdep.steps_done))); printf "tasks next: [%s]\n" (String.concat "," (List.map a_to_string taskdep.next_tasks)) obuild-0.2.2/lib/core/taskdep.mli000066400000000000000000000045071515212760700166410ustar00rootroot00000000000000(** Task dependency tracking for build scheduling *) (** Dependency traversal direction *) type direction = | FromChildren (** Start from leaves, move toward roots *) | FromParent (** Start from roots, move toward leaves *) (** Task dependency tracker *) type 'a t val init : ?direction:direction -> 'a Dag.t -> 'a t (** [init ~direction dag] initializes task dependency tracker from DAG Creates a tracker that will iterate through the DAG in the specified direction. Defaults to FromChildren (bottom-up). @param direction traversal direction (default: FromChildren) @param dag dependency graph @return task dependency tracker *) val init_with : 'a Dag.t -> direction -> 'a list -> 'a t (** [init_with dag direction nodes] initializes tracker with specific starting nodes @param dag dependency graph @param direction traversal direction @param nodes initial tasks to process @return task dependency tracker *) val get_next : 'a t -> (int * 'a) option (** [get_next taskdep] retrieves next task ready for execution Returns the next task whose dependencies are satisfied. The int is a sequential task index for tracking. @param taskdep task tracker @return Some (task_index, task) if available, None if no tasks ready *) val mark_done : 'a t -> 'a -> unit (** [mark_done taskdep task] marks task as completed Updates the tracker to record task completion and makes dependent tasks available if their dependencies are now satisfied. @param taskdep task tracker @param task completed task *) val is_complete : 'a t -> bool (** [is_complete taskdep] checks if all tasks are done @param taskdep task tracker @return true if all tasks in DAG are completed *) val linearize : 'a Dag.t -> direction -> 'a list -> 'a list (** [linearize dag direction nodes] computes linear execution order Performs topological sort of the DAG from specified nodes in the given direction. @param dag dependency graph @param direction traversal direction @param nodes starting nodes @return tasks in linear execution order *) val dump : ('a -> string) -> 'a t -> unit (** [dump to_string taskdep] prints debug information Outputs completed tasks and pending tasks for debugging. @param to_string function to convert task to string @param taskdep task tracker *) obuild-0.2.2/lib/core/types.ml000066400000000000000000000004131515212760700161710ustar00rootroot00000000000000type ocaml_compilation_option = Normal | WithDebug | WithProf type ocaml_compiled_type = ByteCode | Native type ocaml_compilation_mode = Interface | Compiled of ocaml_compiled_type let extDP = function | Normal -> "" | WithDebug -> ".d" | WithProf -> ".p" obuild-0.2.2/lib/core/types.mli000066400000000000000000000015631515212760700163510ustar00rootroot00000000000000(** Core type definitions for OCaml compilation modes and options *) (** Compilation optimization option *) type ocaml_compilation_option = | Normal (** Standard compilation *) | WithDebug (** Compilation with debugging symbols *) | WithProf (** Compilation with profiling instrumentation *) (** Compilation target type *) type ocaml_compiled_type = | ByteCode (** OCaml bytecode compilation *) | Native (** Native code compilation *) (** Compilation mode - interface or compiled code *) type ocaml_compilation_mode = | Interface (** Interface files (.mli/.cmi) *) | Compiled of ocaml_compiled_type (** Compiled implementation *) (** [extDP opt] returns the file extension suffix for a compilation option. - [Normal] -> "" - [WithDebug] -> ".d" - [WithProf] -> ".p" *) val extDP : ocaml_compilation_option -> string obuild-0.2.2/lib/core/utils.ml000066400000000000000000000110471515212760700161720ustar00rootroot00000000000000open Fugue open Filepath open Types let read_file_with f filename = let lines = ref [] in let chan = open_in filename in try while true do let z = f (input_line chan) in match z with | None -> () | Some z' -> lines := z' :: !lines done; [] with End_of_file -> close_in chan; List.rev !lines let toKV line = match String_utils.split ~limit:2 ':' line with | [ k ] -> (String_utils.strip_spaces k, None) | [ k; v ] -> (String_utils.strip_spaces k, Some (String_utils.strip_spaces v)) | _ -> assert false let toKVeq line = match String_utils.split ~limit:2 '=' line with | [ k ] -> (String_utils.strip_spaces k, None) | [ k; v ] -> (String_utils.strip_spaces k, Some (String_utils.strip_spaces v)) | _ -> assert false let parseCSV value = List.filter (fun s -> String.length s > 0) (List.map String_utils.strip_spaces (String_utils.split ',' value)) let to_include_path_options paths = let ss = ref StringSet.empty in List.concat $ list_filter_map (fun p -> let ps = fp_to_string p in if ps = "" || StringSet.mem ps !ss || not (Filesystem.exists p) then None else ( ss := StringSet.add ps !ss; Some [ "-I"; ps ])) paths let showList sep f l = String.concat sep (List.map f l) let isWindows = Sys.os_type = "Win32" (* Platform-aware C library naming. OCaml's convention uses dll*.so even on macOS for stub libraries. *) let shared_lib_name clib_name = if isWindows then clib_name ^ ".dll" else "dll" ^ clib_name ^ ".so" let static_lib_name clib_name = if isWindows then clib_name ^ ".lib" else "lib" ^ clib_name ^ ".a" let to_exe_name mode build name = let ext = extDP mode in let ext2 = match build with | ByteCode -> ".byte" | Native -> if Gconf.get_target_option_typed Gconf.Executable_as_obj then ".o" else "" in fn (name ^ ext ^ ext2 ^ if isWindows then ".exe" else "") exception FileNotFoundInPaths of (filepath list * filename) exception FilesNotFoundInPaths of (filepath list * filepath list) let get_system_paths () = let sep = if isWindows then ';' else ':' in try List.map fp (String_utils.split sep (Sys.getenv "PATH")) with Not_found -> if isWindows then let sysroot = try Sys.getenv "SystemRoot" with Not_found -> "C:\\Windows" in List.map fp [ sysroot ^ "\\System32" ] else List.map fp [ "/usr/bin"; "/usr/local/bin" ] let find_in_paths paths name = try List.find (fun p -> Filesystem.exists (p name)) paths with Not_found -> raise (FileNotFoundInPaths (paths, name)) let find_choice_in_paths paths names = try List.find (fun p -> try ignore (List.find (fun n -> Filesystem.exists (n p)) names); true with Not_found -> false) paths with Not_found -> let sample_path = match paths with p :: _ -> p | [] -> fp "." in raise (FilesNotFoundInPaths (paths, List.map (fun n -> n sample_path) names)) let exist_choice_in_paths paths names = try let _ = find_choice_in_paths paths names in true with FilesNotFoundInPaths _ -> false let find_in_system_path name = find_in_paths (get_system_paths ()) name let generateFile file f = let buffer = Buffer.create 1024 in f (Buffer.add_string buffer); Filesystem.write_file file (Buffer.contents buffer) let get_cpu_count () = let read_command cmd = try let ic = Unix.open_process_in cmd in let line = input_line ic in let status = Unix.close_process_in ic in match status with | Unix.WEXITED 0 -> Some (int_of_string (String_utils.strip_spaces line)) | _ -> None with _ -> None in let detected = match Sys.os_type with | "Unix" | "Cygwin" -> ( (* Try different commands in order of preference *) match read_command "nproc 2>/dev/null" with (* Linux *) | Some n -> Some n | None -> ( match read_command "sysctl -n hw.ncpu 2>/dev/null" with (* macOS, BSD *) | Some n -> Some n | None -> ( match read_command "getconf _NPROCESSORS_ONLN 2>/dev/null" with (* POSIX *) | Some n -> Some n | None -> None))) | "Win32" -> ( (* Windows: use NUMBER_OF_PROCESSORS environment variable *) try Some (int_of_string (Sys.getenv "NUMBER_OF_PROCESSORS")) with _ -> None) | _ -> None (* Unknown OS *) in match detected with | Some n when n > 0 && n <= 128 -> n (* Sanity check: reasonable CPU count *) | _ -> 2 (* Default fallback *) obuild-0.2.2/lib/core/utils.mli000066400000000000000000000057241515212760700163500ustar00rootroot00000000000000(** Utility functions *) exception FileNotFoundInPaths of (Filepath.filepath list * Filepath.filename) exception FilesNotFoundInPaths of (Filepath.filepath list * Filepath.filepath list) val read_file_with : (string -> 'a option) -> string -> 'a list (** Read file line by line, applying function to each line @param f Function to transform each line (None skips the line) @param filename File to read @return List of transformed lines *) val toKV : string -> string * string option (** Parse line as colon-separated key-value pair *) val toKVeq : string -> string * string option (** Parse line as equals-separated key-value pair *) val parseCSV : string -> string list (** Parse comma-separated values *) val to_include_path_options : Filepath.filepath list -> string list (** Convert filepaths to -I include options, removing duplicates *) val showList : string -> ('a -> string) -> 'a list -> string (** Convert list to string with separator @param sep Separator string @param f Function to convert element to string @param l List to convert *) val isWindows : bool (** True if running on Windows platform *) val shared_lib_name : string -> string (** [shared_lib_name clib_name] returns platform-appropriate shared library filename *) val static_lib_name : string -> string (** [static_lib_name clib_name] returns platform-appropriate static library filename *) val to_exe_name : Types.ocaml_compilation_option -> Types.ocaml_compiled_type -> string -> Filepath.filename (** Generate executable filename with appropriate extensions @param mode Compilation option (Normal, WithDebug, WithProf) @param build Build type (ByteCode, Native) @param name Base name *) val get_system_paths : unit -> Filepath.filepath list (** Get system PATH directories *) val find_in_paths : Filepath.filepath list -> Filepath.filename -> Filepath.filepath (** Find file in directory paths @raise FileNotFoundInPaths if not found *) val find_choice_in_paths : Filepath.filepath list -> (Filepath.filepath -> Filepath.filepath) list -> Filepath.filepath (** Find first path where one of the filename generators succeeds @raise FilesNotFoundInPaths if none found *) val exist_choice_in_paths : Filepath.filepath list -> (Filepath.filepath -> Filepath.filepath) list -> bool (** Check if any filename generator succeeds in any path *) val find_in_system_path : Filepath.filename -> Filepath.filepath (** Find file in system PATH @raise FileNotFoundInPaths if not found *) val generateFile : Filepath.filepath -> ((string -> unit) -> unit) -> unit (** Generate file using buffer-based writer @param file Output filepath @param f Function receiving string appender *) val get_cpu_count : unit -> int (** Detect number of CPU cores available on the system. Uses platform-specific commands (nproc on Linux, sysctl on macOS/BSD, NUMBER_OF_PROCESSORS on Windows). Returns 2 as safe default if detection fails. @return Number of CPU cores (range: 1-128) *) obuild-0.2.2/lib/doc.ml000066400000000000000000000005121515212760700146420ustar00rootroot00000000000000open Fugue exception DocumentationBuildingFailed of string let runOcamldoc pp = let args = [ Prog.get_ocamldoc (); "-html" ] @ maybe [] (fun s -> [ "-pp"; s ]) pp @ [] in match Process.run args with | Process.Failure er -> raise (DocumentationBuildingFailed er) | Process.Success (_, _, _) -> () let run _projFile = () obuild-0.2.2/lib/doc.mli000066400000000000000000000005441515212760700150200ustar00rootroot00000000000000(** Documentation generation *) exception DocumentationBuildingFailed of string (** Raised when documentation building fails with an error message *) val run : Project.t -> unit (** [run proj_file] generates documentation for the project. Currently a stub implementation. @raise DocumentationBuildingFailed if documentation generation fails *) obuild-0.2.2/lib/help.ml000066400000000000000000000021771515212760700150360ustar00rootroot00000000000000 let help_configure = [ "Configure --- Prepare to build the package" ; "" ; "Configure verify that the environment is able to compile the project" ; "and this is where the user can tell obuild options to build" ; "" ; "System settings and user settings are cached, to provide faster" ; "access for building task" ] let help_clean = [ "Clean --- Cleanup after obuild" ; "" ; "Remove all by-product of compilation (.cmx, .cmi, .cmo, etc)" ; "and remove the dist directory." ] let help_build = [ "Build --- Build every buildable bits" ; "" ; "Build all your different targets (library, executable," ; "tests, benchmarks, example) that are marked as buildable." ] let help_sdist = [ "Sdist --- Create a source distribution file (.tar.gz)" ; "" ; "generate a source distribution file .tar.gz that contains" ; "all the necessary bits to distribute to someone else" ; "and being able to build and install the package" ] let help_messages = [ "clean", help_clean ; "configure", help_configure ; "build", help_build ; "sdist", help_sdist ] obuild-0.2.2/lib/help.mli000066400000000000000000000006621515212760700152040ustar00rootroot00000000000000(** Help messages for obuild commands *) val help_configure : string list (** Help text for the configure command *) val help_clean : string list (** Help text for the clean command *) val help_build : string list (** Help text for the build command *) val help_sdist : string list (** Help text for the sdist command *) val help_messages : (string * string list) list (** Association list of command names to their help text *) obuild-0.2.2/lib/init.ml000066400000000000000000000073351515212760700150520ustar00rootroot00000000000000open Printf open Fugue open Filepath open Compat open Helper open Target open Project exception ProjectAlreadyExists exception CannotRunNotInteractive exception AbortedByUser let rec ask v x = printf "%s\n> %!" x; let r = try read_line () with End_of_file -> raise AbortedByUser in match v r with | None -> r | Some vp -> printf "error: %s\n" vp; ask v x let rec ask_many v x = let r = ask v x in if r = "" then [] else r :: ask_many v x let run () = (* check if a project file already exists and that we run in a interactive windows *) (try let _ = Project.findPath () in raise ProjectAlreadyExists with Project.NoConfFile -> ()); if not (Unix.isatty Unix.stdout) then raise CannotRunNotInteractive; printf " %swelcome to the obuild wizard%s\n" (color_green ()) (color_white ()); printf " ============================\n"; let expecting_output l s = if List.mem s l then None else Some (sprintf "expecting one of the following: %s" (Utils.showList ", " (fun s -> "\"" ^ s ^ "\"") l)) in (* strip [ext] from the the end of [s] only if it's there *) let strip_ext s ~ext = try let l = String.length s in let ext_l = String.length ext in if String.sub s (l - ext_l) ext_l = ext then String.sub s 0 (l - ext_l) else s with Invalid_argument _ -> s (* in case out of bounds above *) in let invalid ~x = function | true -> None | false -> Some ("invalid " ^ x) in let valid_name n = invalid ~x:"name" (String_utils.all char_is_alphanum n) in let valid_fp _ = None in (* FIXME *) let valid_fn n = invalid ~x:"filename" (Filepath.valid_fn n) in let valid_modname n = invalid ~x:"module name" (String_utils.all Modname.char_is_valid_modchar (strip_ext n ~ext:".ml")) in let name = ask valid_name "What is the name of your project ?" in let obuild = { Project.make with Project.name; Project.version = "0.0.0"; Project.synopsis = "my new project"; Project.obuild_ver = 1; } in let ty = ask (expecting_output [ "1"; "2" ]) "What do you want to build ? 1: executable, 2: library" in let question_obits obits = let dir = ask valid_fp "What is the directory name where to find the source ? (default .)" in { obits with target_srcdir = [ fp dir ] } in let question_cbits cbits = cbits in let project = let compose f g x = f (g x) in match ty with | "1" -> let main = ask valid_fn "What is the name of your main ?" in let nexe = Executable.make name in let itarget = nexe.Executable.target in let target = { itarget with target_obits = question_obits itarget.target_obits; target_cbits = question_cbits itarget.target_cbits; } in { obuild with exes = [ { nexe with Executable.main = fn main; Executable.target } ] } | "2" -> let modules = List.map (fun m -> string_capitalize $ strip_ext ~ext:".ml" m) (ask_many valid_modname "Add a module ? (enter to terminate)") in let nlib = Library.make_from_string name in let itarget = nlib.Library.target in let target = { itarget with target_obits = question_obits itarget.target_obits; target_cbits = question_cbits itarget.target_cbits; } in { obuild with libs = [ { nlib with Library.modules = List.map (compose Hier.of_modname Modname.wrap) modules; Library.target; }; ]; } | _ -> assert false in project obuild-0.2.2/lib/init.mli000066400000000000000000000013151515212760700152130ustar00rootroot00000000000000(** Project initialization wizard *) exception ProjectAlreadyExists (** Raised when a project file already exists in the current directory *) exception CannotRunNotInteractive (** Raised when trying to run the wizard in a non-interactive terminal *) exception AbortedByUser (** Raised when the user aborts the wizard (e.g., EOF on input) *) val run : unit -> Project.t (** [run ()] runs the interactive project initialization wizard. Prompts the user for project details and returns a configured Project.t. @raise ProjectAlreadyExists if a project file already exists @raise CannotRunNotInteractive if not running in an interactive terminal @raise AbortedByUser if the user aborts the wizard *) obuild-0.2.2/lib/install.ml000066400000000000000000000123771515212760700155570ustar00rootroot00000000000000open Fugue open Filepath open Printf open Project open Types open Target open Helper open Gconf let list_target_files_pred target pred = let build_dir = Dist.get_build_exn (Dist.Target target.Target.target_name) in Build.sanity_check build_dir target; (* don't play with matches *) let matches = Filesystem.list_dir_pred pred build_dir in (build_dir, matches) let list_lib_files lib build_dir = list_target_files_pred lib (fun f -> if fn_to_string f = "META" then true else match Filetype.of_filepath (build_dir f) with | Filetype.FileCMX | Filetype.FileCMI | Filetype.FileA | Filetype.FileCMXS | Filetype.FileCMXA | Filetype.FileCMA | Filetype.FileCMT | Filetype.FileCMTI -> true | _ -> false) let list_exe_files lib build_dir = list_target_files_pred lib (fun f -> match Filetype.of_filepath (build_dir f) with | Filetype.FileEXE -> true | _ -> false) let opam_install_file proj_file flags = let install_path = fp (proj_file.name ^ ".install") in Utils.generateFile install_path (fun add -> let all_targets = Project.get_all_installable_targets proj_file flags in let print_target_files target list_files_fun = let build_dir = Dist.get_build_exn (Dist.Target target.Target.target_name) in let _, files = list_files_fun target build_dir in List.iter (fun file -> let file_str = fn_to_string file in add (sprintf " \"%s/%s\" {\"%s\"}\n" (fp_to_string build_dir) file_str file_str)) files in add (sprintf "%s: [\n" "lib"); List.iter (fun target -> match target.target_name with | Name.Lib _ -> print_target_files target list_lib_files | _ -> ()) all_targets; add "]\n"; add (sprintf "%s: [\n" "bin"); List.iter (fun target -> match target.target_name with | Name.Exe _ -> print_target_files target list_exe_files | _ -> ()) all_targets; add "]\n") let lib_to_meta proj_file lib = let requires_of_lib lib = let deps = lib.Library.target.target_obits.target_builddeps in [ ([], List.map (fun d -> fst d) deps) ] in let set_meta_field_from_lib pkg lib = let linkopts_of_lib lib = match lib.Library.target.Target.target_cstubs with | Some _ -> (* The installed stubs library is named libstubs_.a *) (* Use -cclib to wrap C linker flags for ocamlfind/ocamlopt compatibility *) let lib_name = Libname.to_string lib.Library.name in [(None, "-cclib -lstubs_" ^ lib_name)] | None -> [] in { pkg with Meta.Pkg.requires = requires_of_lib lib; Meta.Pkg.description = (if lib.Library.description <> "" then lib.Library.description else proj_file.description); Meta.Pkg.linkopts = linkopts_of_lib lib; Meta.Pkg.archives = ([ ([ Meta.Predicate.Byte ], fn_to_string (Libname.to_cmca ByteCode Normal lib.Library.name)); ( [ Meta.Predicate.Byte; Meta.Predicate.Plugin ], fn_to_string (Libname.to_cmca ByteCode Normal lib.Library.name) ); ([ Meta.Predicate.Native ], fn_to_string (Libname.to_cmca Native Normal lib.Library.name)); ] @ if Gconf.get_target_option_typed Gconf.Library_plugin then [ ( [ Meta.Predicate.Native; Meta.Predicate.Plugin ], fn_to_string (Libname.to_cmxs Normal lib.Library.name) ); ] else []); } in let subPkgs = List.map (fun sub -> let npkg = Meta.Pkg.make (list_last (Libname.to_string_nodes sub.Library.name)) in set_meta_field_from_lib npkg sub) lib.Library.subs in let pkg = set_meta_field_from_lib (Meta.Pkg.make "") lib in { pkg with Meta.Pkg.version = proj_file.version; Meta.Pkg.subs = subPkgs } let write_lib_meta projFile lib = let dir = Dist.get_build_exn (Dist.Target lib.Library.target.target_name) in let metadir_path = dir fn "META" in let pkg = lib_to_meta projFile lib in Meta.Pkg.write metadir_path pkg let copy_files files dest_dir dir_name = List.iter (fun (build_dir, build_files) -> List.iter (fun build_file -> Filesystem.copy_file (build_dir build_file) (dest_dir dir_name build_file)) build_files) files let install_lib proj_file lib dest_dir = write_lib_meta proj_file lib; let all_files = List.map (fun target -> let build_dir = Dist.get_build_exn (Dist.Target target.Target.target_name) in Build.sanity_check build_dir target; list_lib_files target build_dir) (Project.Library.to_targets lib) in let dir_name = fn (Libname.to_string lib.Project.Library.name) in log Report "installing library %s\n" (Libname.to_string lib.Project.Library.name); log Debug "installing files: %s\n" (Utils.showList "," fn_to_string (List.concat (List.map snd all_files))); copy_files all_files dest_dir dir_name let install_libs proj_file destdir opam = if not opam then List.iter (fun lib -> install_lib proj_file lib destdir) proj_file.Project.libs else List.iter (fun lib -> write_lib_meta proj_file lib) proj_file.Project.libs obuild-0.2.2/lib/install.mli000066400000000000000000000014331515212760700157170ustar00rootroot00000000000000(** Library and executable installation *) val opam_install_file : Project.t -> (string * bool) list -> unit (** [opam_install_file proj_file flags] generates an OPAM .install file. Creates a .install file listing all files to be installed. @param proj_file the project configuration @param flags configuration flags for determining which targets are installable *) val install_libs : Project.t -> Filepath.filepath -> bool -> unit (** [install_libs proj_file dest_dir opam] installs libraries to the destination directory. Copies compiled library files and META files to the installation directory. @param proj_file the project configuration @param dest_dir destination directory for installation @param opam whether to use OPAM-style installation *) obuild-0.2.2/lib/sdist.ml000066400000000000000000000036241515212760700152320ustar00rootroot00000000000000open Fugue open Filepath open Helper open Target open Gconf let run projFile _isSnapshot = let name = projFile.Project.name in let ver = projFile.Project.version in let sdistDir = name ^ "-" ^ ver in let sdistName = fn (sdistDir ^ ".tar.gz") in let dest = Dist.get_path () fn sdistDir in let current_dir = Unix.getcwd () in let _ = Filesystem.mkdir_safe dest 0o755 in (* copy project file and extra source files *) Filesystem.copy_to_dir (Project.findPath ()) dest; maybe_unit (fun src -> Filesystem.copy_to_dir src dest) projFile.Project.license_file; (* copy all libs modules *) let copy_obits obits = List.iter (fun dir -> Filesystem.iterate (fun ent -> let fpath = dir ent in match Filetype.of_filepath fpath with | Filetype.FileML | Filetype.FileMLI -> Filesystem.copy_to_dir fpath dest | _ -> ()) dir) obits.target_srcdir in let copy_cbits cbits = Filesystem.iterate (fun ent -> let fpath = cbits.target_cdir ent in match Filetype.of_filepath fpath with | Filetype.FileC | Filetype.FileH -> Filesystem.copy_to_dir fpath dest | _ -> ()) cbits.target_cdir in let copy_target target = copy_obits target.target_obits; copy_cbits target.target_cbits; () in let copy_lib lib = List.iter copy_target (Project.Library.to_targets lib) in List.iter copy_lib projFile.Project.libs; List.iter (fun exe -> copy_target (Project.Executable.to_target exe)) projFile.Project.exes; List.iter (fun extra -> Filesystem.copy_to_dir extra dest) projFile.Project.extra_srcs; finally (fun () -> Unix.chdir (fp_to_string (Dist.get_path ())); Prog.run_tar (fn_to_string sdistName) sdistDir) (fun () -> Unix.chdir current_dir); log Report "Source tarball created: %s\n" (fp_to_string (Dist.get_path () sdistName)); () obuild-0.2.2/lib/sdist.mli000066400000000000000000000005421515212760700153770ustar00rootroot00000000000000(** Source distribution creation *) val run : Project.t -> bool -> unit (** [run proj_file is_snapshot] creates a source distribution tarball. Creates a .tar.gz file containing all project sources in the dist directory. @param proj_file the project configuration @param is_snapshot whether this is a snapshot release (currently unused) *) obuild-0.2.2/obuild.install000066400000000000000000000000461515212760700156450ustar00rootroot00000000000000bin: [ "dist/build/obuild/obuild" ] obuild-0.2.2/obuild.obuild000066400000000000000000000070361515212760700154630ustar00rootroot00000000000000name: obuild version: 0.2.2 synopsis: Simple declarative build system for OCaml. description: o'build o'build ye source . simple declarative build system for OCaml license: BSD license-file: LICENSE authors: Vincent Hanquez , Jerome Maloberti obuild-ver: 1 configure-script: configure.ml homepage: http://github.com/ocaml-obuild/obuild ocaml-extra-args: -w A extra-srcs: bootstrap , tests/full/dep-uri/p2.obuild , tests/full/autogenerated/p3.obuild , tests/full/autopack/autopack.obuild , tests/full/with-c/ccall.obuild , tests/full/with-c/cbits.c , tests/full/with-c/ccall.ml , tests/full/dep-uri/p2.ml , tests/full/autogenerated/p3.ml , tests/full/autopack/src/main.ml , tests/full/autopack/src/b/a.ml , tests/full/autopack/src/b/c.ml , tests/full/autopack/src/a.ml , tests/full/parser/main.ml , tests/full/parser/parser.obuild , tests/full/parser/rpncalc.mly , tests/full/parser/lexer.mll , tests/full/simple/p1.obuild , tests/full/simple/p1.ml , tests/full/run , tests/simple/gtk.ml , tests/simple/z.ml , tests/simple/hello_world.ml , tests/simple/run , tests/simple/z.build , tests/simple/gtk.build , tests/simple/hello_world.build , tests/simple/z_stubs.c , tests/simple/gtk_stubs.c , README.md , DESIGN.md , TODO.md library obuild_base modules: compat, location, filepath, filesystem, fugue, string_utils, cli src-dir: lib/base build-deps: unix library obuild_core modules: analyze, build, build_cstubs, buildprogs, configure, dag, dagutils, dependencies, dist, exception, expr, filetype, findlibConf, gconf, generators, helper, hier, libname, meta, metacache, modname, obuild_lexer, obuild_ast, obuild_parser, obuild_validate, pp, prepare_types, ppx_resolver, prepare, process, prog, project, project_read, scheduler, target, taskdep, types, utils src-dir: lib/core build-deps: unix, obuild_base library obuild modules: doc, help, init, install, sdist src-dir: lib build-deps: unix, obuild_base, obuild_core # a comment executable obuild main-is: main.ml src-dir: src build-deps: unix, obuild test dag src-dir: tests main-is: test_dag.ml build-deps: obuild, str test path src-dir: tests main-is: test_path.ml build-deps: obuild, obuild_base, str test expr src-dir: tests main-is: test_expr.ml build-deps: obuild, obuild_base, str test find src-dir: tests main-is: test_find.ml build-deps: obuild, obuild_base, str test meta src-dir: tests main-is: test_meta.ml build-deps: obuild, obuild_base, str test framework-demo src-dir: tests main-is: test_framework_demo.ml build-deps: obuild, obuild_base, str test meta-errors src-dir: tests main-is: test_meta_errors.ml build-deps: obuild, obuild_base, str test project-errors src-dir: tests main-is: test_project_errors.ml build-deps: obuild, obuild_base, str test validate-real-world src-dir: tests main-is: validate_real_world.ml build-deps: obuild, obuild_base, str test build-logic src-dir: tests main-is: test_build_logic.ml build-deps: obuild, obuild_base, str, unix test build-debug src-dir: tests main-is: test_build_debug.ml build-deps: obuild, obuild_base, str, unix test new-parser src-dir: tests main-is: test_new_parser.ml build-deps: obuild_core test validate src-dir: tests main-is: test_validate.ml build-deps: obuild_core test generators src-dir: tests main-is: test_generators.ml build-deps: obuild, obuild_base, str obuild-0.2.2/opam000066400000000000000000000015461515212760700136640ustar00rootroot00000000000000opam-version: "2.0" name: "obuild" version: "0.2.2" homepage: "https://github.com/ocaml-obuild/obuild" bug-reports: "https://github.com/ocaml-obuild/obuild/issues" dev-repo: "git+https://github.com/ocaml-obuild/obuild.git" authors: ["Vincent Hanquez" "Jerome Maloberti"] synopsis: "Simple package build system for OCaml" license: "BSD-2-Clause" description: """ The goal is to make a very simple build system for users and developers of OCaml libraries and programs. Obuild acts as a building black box: users only declare what they want to build and with which sources; the build system will consistently build it. The design is based on Haskell's Cabal and borrows most of the layout and way of working, adapting parts where necessary to fully support OCaml.""" maintainer: "jmaloberti@gmail.com" build: [ ["./bootstrap"] ] depends: ["ocaml" "ocamlfind" {build}] obuild-0.2.2/src/000077500000000000000000000000001515212760700135665ustar00rootroot00000000000000obuild-0.2.2/src/main.ml000066400000000000000000000577101515212760700150560ustar00rootroot00000000000000open Printf open Fugue open Filepath open Types open Helper open Gconf open Cli (* Pipe operator for OCaml < 4.01 compatibility *) let ( |> ) x f = f x (* ===== Helper Functions ===== *) let read_setup () = FindlibConf.load (); let setup = Dist.read_setup () in Configure.set_opts setup; setup let project_read () = try Project_read.read () with exn -> log Verbose "exception during project read: %s\n" (Printexc.to_string exn); raise exn let collect_all_targets proj_file = List.map (fun lib -> lib.Project.Library.target) proj_file.Project.libs @ List.map (fun exe -> exe.Project.Executable.target) proj_file.Project.exes @ List.map (fun test -> test.Project.Test.target) proj_file.Project.tests @ List.map (fun bench -> bench.Project.Bench.target) proj_file.Project.benchs @ List.map (fun ex -> ex.Project.Example.target) proj_file.Project.examples let collect_all_deps proj_file = let targets = collect_all_targets proj_file in list_uniq (List.sort compare (List.concat (List.map (fun t -> t.Target.target_obits.Target.target_builddeps) targets))) (* ===== Configure Command ===== *) let cmd_configure = let cmd = Cli.command "configure" ~doc:"Prepare to build the package" ~description: "Configures the build system and detects dependencies. Sets up compilation flags and \ options." ~run:(fun ctx -> (* Collect user flags and options from context *) let user_flags = ref [] in let user_opts = ref [] in (* Process flag options *) let flags_str = Cli.get_strings ctx "flag" in List.iter (fun s -> let tweak = if String_utils.startswith "-" s then Configure.ClearFlag (String_utils.drop 1 s) else Configure.SetFlag s in user_flags := tweak :: !user_flags) flags_str; (* Process all boolean options *) let add_opt name value = user_opts := (name, value) :: !user_opts in let add_bool_opt cli_name opt_name = match Cli.get_bool_opt ctx cli_name with | Some value -> add_opt opt_name value | None -> () in add_bool_opt "library-bytecode" "library-bytecode"; add_bool_opt "library-native" "library-native"; add_bool_opt "library-plugin" "library-plugin"; add_bool_opt "executable-bytecode" "executable-bytecode"; add_bool_opt "executable-native" "executable-native"; add_bool_opt "library-profiling" "library-profiling"; add_bool_opt "library-debugging" "library-debugging"; add_bool_opt "executable-profiling" "executable-profiling"; add_bool_opt "executable-debugging" "executable-debugging"; add_bool_opt "build-examples" "build-examples"; add_bool_opt "build-benchs" "build-benchs"; add_bool_opt "build-tests" "build-tests"; (* Handle shorthand flags *) if Cli.get_flag ctx "executable-as-obj" then add_opt "executable-as-obj" true; if Cli.get_flag ctx "annot" then add_opt "annot" true; if Cli.get_flag ctx "g" then ( add_opt "library-debugging" true; add_opt "executable-debugging" true); if Cli.get_flag ctx "pg" then ( add_opt "library-profiling" true; add_opt "executable-profiling" true); (* Run configuration *) FindlibConf.load (); let proj_file = Project_read.read () in log Report "Configuring %s-%s...\n" proj_file.Project.name proj_file.Project.version; Configure.run proj_file !user_flags !user_opts) () in cmd |> Cli.help_flag |> Cli.option_strings "flag" ~doc:"Enable or disable a project flag (can be repeated)" |> Cli.option_bool "library-bytecode" ~doc:"Compile libraries as bytecode" |> Cli.option_bool "library-native" ~doc:"Compile libraries as native" |> Cli.option_bool "library-plugin" ~doc:"Compile libraries as native plugin" |> Cli.option_bool "executable-bytecode" ~doc:"Compile executables as bytecode" |> Cli.option_bool "executable-native" ~doc:"Compile executables as native" |> Cli.option_bool "library-profiling" ~doc:"Enable library profiling" |> Cli.option_bool "library-debugging" ~doc:"Enable library debugging" |> Cli.option_bool "executable-profiling" ~doc:"Enable executable profiling" |> Cli.option_bool "executable-debugging" ~doc:"Enable executable debugging" |> Cli.option_bool "build-examples" ~doc:"Build examples" |> Cli.option_bool "build-benchs" ~doc:"Build benchmarks" |> Cli.option_bool "build-tests" ~doc:"Build tests" |> Cli.flag "executable-as-obj" ~doc:"Output executable as obj file" |> Cli.flag "annot" ~doc:"Generate .annot files" |> Cli.flag "g" ~short:'g' ~doc:"Compilation with debugging" |> Cli.flag "pg" ~doc:"Compilation with profiling" (* ===== Build Command ===== *) let cmd_build = let cmd = Cli.command "build" ~doc:"Make this package ready for installation" ~description:"Compiles all or specified targets in the project using parallel compilation." ~run:(fun ctx -> (* Set parallel jobs *) gconf.parallel_jobs <- Cli.get_int ctx "jobs" ~default:gconf.parallel_jobs; (* Set other options *) if Cli.get_flag ctx "dot" then gconf.dump_dot <- true; if Cli.get_flag ctx "noocamlmklib" then gconf.ocamlmklib <- false; (* Get target names *) let targets = Cli.get_positionals ctx in (* Build *) Dist.exist (); let setup = read_setup () in let proj_file = project_read () in let flags = Configure.check proj_file true setup in let project = Analyze.prepare proj_file flags in let bstate = Prepare.init project in let dag = match targets with | [] -> project.Analyze.project_targets_dag | _ -> let target_names = List.map Target.Name.of_string targets in Dag.subset project.Analyze.project_targets_dag target_names in Build.build_dag bstate proj_file dag) () in cmd |> Cli.help_flag |> Cli.option_int "jobs" ~short:'j' ~placeholder:"N" ~default:gconf.parallel_jobs ~doc:"Maximum number of jobs in parallel" |> Cli.flag "dot" ~doc:"Dump dependencies dot files during build" |> Cli.flag "noocamlmklib" ~doc:"Do not use ocamlmklib when linking C code" |> Cli.positionals "targets" ~placeholder:"TARGET..." ~doc:"Optional list of targets to build" (* ===== Clean Command ===== *) let cmd_clean = let cmd = Cli.command "clean" ~doc:"Clean up after a build" ~description:"Removes all build artifacts and the dist directory." ~run:(fun _ctx -> if Filesystem.exists (Dist.get_path ()) then ( Filesystem.remove_dir (Dist.get_path ()); Dist.remove_dead_links ())) () in cmd |> Cli.help_flag (* ===== Sdist Command ===== *) let cmd_sdist = let cmd = Cli.command "sdist" ~doc:"Generate a source distribution file (.tar.gz)" ~description:"Creates a tarball of the source code for distribution." ~run:(fun ctx -> let is_snapshot = Cli.get_flag ctx "snapshot" in Dist.check_exn (fun () -> ()); let proj_file = project_read () in Sdist.run proj_file is_snapshot) () in cmd |> Cli.help_flag |> Cli.flag "snapshot" ~doc:"Build a snapshot of the project" (* ===== Install Command ===== *) let cmd_install = let cmd = Cli.command "install" ~doc:"Install this package" ~description:"Installs compiled libraries and executables to the system." ~run:(fun ctx -> let dest_dir_str = Cli.get_string_opt ctx "destdir" in let opam_install = Cli.get_flag ctx "opam" in Dist.exist (); let setup = read_setup () in let proj_file = project_read () in let flags = Configure.check proj_file false setup in let dest_dir = match dest_dir_str with | Some d -> fp d | None -> ( match FindlibConf.get_destdir () with | None -> failwith "no destdir specified, and no findlib default found" | Some p -> p) in Install.install_libs proj_file dest_dir opam_install; if opam_install then Install.opam_install_file proj_file flags) () in cmd |> Cli.help_flag |> Cli.option_string "destdir" ~placeholder:"DIR" ~doc:"Override destination where to install" |> Cli.flag "opam" ~doc:"Only create the .install file for opam" (* ===== Test Command ===== *) let cmd_test = let cmd = Cli.command "test" ~doc:"Run the tests" ~description:"Executes all test targets and reports results." ~run:(fun ctx -> let show_test = Cli.get_flag ctx "output" in let setup = read_setup () in let proj_file = project_read () in let _ = Configure.check proj_file false setup in if not (Gconf.get_target_option_typed Build_tests) then ( eprintf "error: building tests are disabled, re-configure with --build-tests=true\n"; exit 1); let test_targets = List.map Project.Test.to_target proj_file.Project.tests in if test_targets <> [] then ( let results = List.map (fun test -> let test_target = Project.Test.to_target test in let output_name = Utils.to_exe_name Normal Native (Target.get_target_dest_name test_target) in let dir = Dist.get_build_exn (Dist.Target test_target.Target.target_name) in let exe_path = dir output_name in if not (Filesystem.exists exe_path) then ( eprintf "error: %s doesn't appear built, make sure 'obuild build' is run first\n" (Target.get_target_name test_target); exit 1); match Process.run [ fp_to_string exe_path ] with | Process.Success (out, _, _) -> if show_test then print_warnings out; (test.Project.Test.name, true) | Process.Failure err -> print_warnings err; (test.Project.Test.name, false)) proj_file.Project.tests in let failed = List.filter (fun (_, x) -> not x) results in let successes = List.filter (fun (_, x) -> x) results in let total = List.length failed + List.length successes in printf "%sSUCCESS%s: %d/%d\n" (color_green ()) (color_white ()) (List.length successes) total; printf "%sFAILED%s : %d/%d\n" (color_red ()) (color_white ()) (List.length failed) total; List.iter (fun (n, _) -> printf " %s\n" n) failed; if failed <> [] then exit 1) else printf "warning: no tests defined: not doing anything.\n") () in cmd |> Cli.help_flag |> Cli.flag "output" ~doc:"Show test outputs" (* ===== Init Command ===== *) let cmd_init = let cmd = Cli.command "init" ~doc:"Initialize a new project" ~description:"Creates a new obuild project file interactively." ~run:(fun _ctx -> let project = Init.run () in let name = fn project.Project.name <.> "obuild" in Project.write (in_current_dir name) project) () in cmd |> Cli.help_flag (* ===== Doc Command ===== *) let cmd_doc = let cmd = Cli.command "doc" ~doc:"Generate documentation" ~description:"Generates OCamldoc documentation for the project." ~run:(fun _ctx -> eprintf "error: the 'doc' command is not yet implemented.\n"; eprintf " You can use ocamldoc directly on your source files.\n"; exit 1) () in cmd |> Cli.help_flag (* ===== Get Command ===== *) let cmd_get = let cmd = Cli.command "get" ~doc:"Get project metadata field" ~description:"Retrieve specific fields from the project file (name, version, license)." ~run:(fun ctx -> let proj_file = project_read () in let positionals = Cli.get_positionals ctx in match positionals with | [] -> eprintf "usage: obuild get \n\n"; exit 1 | [ field ] -> ( match field with | "name" -> printf "%s\n" proj_file.Project.name | "version" -> printf "%s\n" proj_file.Project.version | "license" -> printf "%s\n" proj_file.Project.license | _ -> eprintf "error: unknown field %s\n" field; exit 1) | _ -> eprintf "usage: obuild get \n"; exit 1) () in cmd |> Cli.help_flag |> Cli.positionals "field" ~placeholder:"FIELD" ~doc:"Field to retrieve (name, version, license)" (* ===== Infer Command ===== *) let cmd_infer = let cmd = Cli.command "infer" ~doc:"Infer module dependencies (unimplemented)" ~description:"Analyzes source files to infer module dependencies." ~run:(fun _ctx -> eprintf "error: the 'infer' command is not yet implemented.\n"; exit 1) () in cmd |> Cli.help_flag |> Cli.positionals "modules" ~placeholder:"MODULE..." ~doc:"Modules to infer" (* ===== Completion Command ===== *) (* ===== Generate Command (with subcommands) ===== *) (* We'll fill in the app reference after obuild_app is defined *) let completion_app_ref = ref None (* Subcommand: generate completion *) let cmd_generate_completion = let cmd = Cli.command "completion" ~doc:"Generate shell completion scripts" ~description:"Generates completion scripts for bash, zsh, or fish shells." ~run:(fun ctx -> let shell = Cli.get_positionals ctx in let app = match !completion_app_ref with | Some a -> a | None -> failwith "Internal error: app not initialized" in match shell with | [] -> eprintf "Usage: obuild generate completion \n\n"; eprintf "Supported shells: bash, zsh, fish\n"; exit 1 | [ "bash" ] -> printf "%s\n" (Cli.generate_bash_completion app) | [ "zsh" ] -> printf "%s\n" (Cli.generate_zsh_completion app) | [ "fish" ] -> printf "%s\n" (Cli.generate_fish_completion app) | [ shell ] -> eprintf "Unsupported shell: %s\n" shell; eprintf "Supported shells: bash, zsh, fish\n"; exit 1 | _ -> eprintf "Usage: obuild generate completion \n"; exit 1) () in cmd |> Cli.help_flag |> Cli.positionals "shell" ~placeholder:"SHELL" ~doc:"Shell to generate completion for (bash, zsh, fish)" (* Subcommand: generate merlin *) let cmd_generate_merlin = let cmd = Cli.command "merlin" ~doc:"Generate .merlin file for IDE support" ~description:"Generates a .merlin configuration file from the project definition." ~run:(fun ctx -> Dist.exist (); let proj_file = project_read () in (* Generate .merlin file *) let merlin_content = Buffer.create 256 in (* Add source directories for libraries *) List.iter (fun lib -> List.iter (fun src_dir -> Buffer.add_string merlin_content (Printf.sprintf "S %s\n" (fp_to_string src_dir))) lib.Project.Library.target.Target.target_obits.Target.target_srcdir; Buffer.add_string merlin_content (Printf.sprintf "B %s\n" (fp_to_string (current_dir fn "dist" fn "build" fn ("lib-" ^ Libname.to_string lib.Project.Library.name))))) proj_file.Project.libs; (* Add source directories for executables *) List.iter (fun exe -> List.iter (fun src_dir -> Buffer.add_string merlin_content (Printf.sprintf "S %s\n" (fp_to_string src_dir))) exe.Project.Executable.target.Target.target_obits.Target.target_srcdir; Buffer.add_string merlin_content (Printf.sprintf "B %s\n" (fp_to_string (current_dir fn "dist" fn "build" fn exe.Project.Executable.name)))) proj_file.Project.exes; (* Collect all package dependencies *) let unique_deps = collect_all_deps proj_file in List.iter (fun (libname, _) -> Buffer.add_string merlin_content (Printf.sprintf "PKG %s\n" (Libname.to_string libname))) unique_deps; (* Write .merlin file *) let oc = open_out ".merlin" in output_string oc (Buffer.contents merlin_content); close_out oc; printf "Generated .merlin file\n") () in cmd |> Cli.help_flag (* Subcommand: generate opam *) let cmd_generate_opam = let cmd = Cli.command "opam" ~doc:"Generate .opam file from project definition" ~description:"Generates an OPAM package file from the .obuild project definition." ~run:(fun ctx -> let proj_file = project_read () in (* Generate .opam file *) let opam_content = Buffer.create 512 in Buffer.add_string opam_content (Printf.sprintf "opam-version: \"2.0\"\n"); Buffer.add_string opam_content (Printf.sprintf "name: \"%s\"\n" proj_file.Project.name); Buffer.add_string opam_content (Printf.sprintf "version: \"%s\"\n" proj_file.Project.version); (* Synopsis and description *) if proj_file.Project.synopsis <> "" then Buffer.add_string opam_content (Printf.sprintf "synopsis: \"%s\"\n" proj_file.Project.synopsis); if proj_file.Project.description <> "" then ( Buffer.add_string opam_content "description: \"\"\"\n"; Buffer.add_string opam_content proj_file.Project.description; Buffer.add_string opam_content "\n\"\"\"\n"); (* Authors *) if proj_file.Project.authors <> [] then ( Buffer.add_string opam_content "authors: [\n"; List.iter (fun author -> Buffer.add_string opam_content (Printf.sprintf " \"%s\"\n" author)) proj_file.Project.authors; Buffer.add_string opam_content "]\n"); (* License *) if proj_file.Project.license <> "" then Buffer.add_string opam_content (Printf.sprintf "license: \"%s\"\n" proj_file.Project.license); (* Homepage *) if proj_file.Project.homepage <> "" then Buffer.add_string opam_content (Printf.sprintf "homepage: \"%s\"\n" proj_file.Project.homepage); (* Collect all dependencies from all target types *) let unique_deps = collect_all_deps proj_file in if unique_deps <> [] then ( Buffer.add_string opam_content "depends: [\n"; Buffer.add_string opam_content " \"ocaml\"\n"; Buffer.add_string opam_content " \"obuild\" {build}\n"; List.iter (fun (libname, _) -> Buffer.add_string opam_content (Printf.sprintf " \"%s\"\n" (Libname.to_string libname))) unique_deps; Buffer.add_string opam_content "]\n"); (* Build instructions *) Buffer.add_string opam_content "build: [\n"; Buffer.add_string opam_content " [\"obuild\" \"configure\"]\n"; Buffer.add_string opam_content " [\"obuild\" \"build\"]\n"; Buffer.add_string opam_content "]\n"; (* Install instructions *) Buffer.add_string opam_content "install: [\n"; Buffer.add_string opam_content " [\"obuild\" \"install\"]\n"; Buffer.add_string opam_content "]\n"; (* Write .opam file *) let filename = proj_file.Project.name ^ ".opam" in let oc = open_out filename in output_string oc (Buffer.contents opam_content); close_out oc; printf "Generated %s\n" filename) () in cmd |> Cli.help_flag (* Main generate command with subcommands *) let cmd_generate = Cli.command_with_subcommands "generate" ~doc:"Generate configuration files (merlin, opam, completions)" ~description:"Generate various configuration and helper files from the project definition." ~commands:[ cmd_generate_merlin; cmd_generate_opam; cmd_generate_completion ] (* ===== Global Args Handler ===== *) let process_global_args ctx = (* Process global flags *) if Cli.get_flag ctx "verbose" then gconf.verbosity <- Verbose; if Cli.get_flag ctx "quiet" then gconf.verbosity <- Silent; if Cli.get_flag ctx "debug" then gconf.verbosity <- Debug; if Cli.get_flag ctx "debug+" then gconf.verbosity <- Trace; if Cli.get_flag ctx "color" then gconf.color <- true; (* Process global options *) (match Cli.get_string_opt ctx "findlib-conf" with | Some p -> Gconf.set_env "findlib-path" p | None -> ()); (match Cli.get_string_opt ctx "ocamlopt" with | Some p -> Gconf.set_env "ocamlopt" p | None -> ()); (match Cli.get_string_opt ctx "ocamldep" with | Some p -> Gconf.set_env "ocamldep" p | None -> ()); (match Cli.get_string_opt ctx "ocamlc" with | Some p -> Gconf.set_env "ocamlc" p | None -> ()); (match Cli.get_string_opt ctx "cc" with | Some p -> Gconf.set_env "cc" p | None -> ()); (match Cli.get_string_opt ctx "ar" with | Some p -> Gconf.set_env "ar" p | None -> ()); (match Cli.get_string_opt ctx "pkg-config" with | Some p -> Gconf.set_env "pkgconfig" p | None -> ()); (match Cli.get_string_opt ctx "ranlib" with | Some p -> Gconf.set_env "ranlib" p | None -> ()); (match Cli.get_string_opt ctx "ocamldoc" with | Some p -> Gconf.set_env "ocamldoc" p | None -> ()); match Cli.get_string_opt ctx "ld" with | Some p -> Gconf.set_env "ld" p | None -> () (* ===== Application Definition ===== *) let obuild_app = Cli.app "obuild" ~version:Path_generated.project_version ~doc:"Simple, declarative build system for OCaml" ~description:"obuild is a parallel, incremental build system for OCaml projects." ~global_args: [ Cli.help_flag; Cli.version_flag; Cli.verbose_flag; Cli.quiet_flag; (fun cmd -> Cli.flag "debug" ~short:'d' ~doc:"Enable debug output" cmd); (fun cmd -> Cli.flag "debug+" ~doc:"Enable debug output with commands" cmd); (fun cmd -> Cli.flag "color" ~doc:"Enable colored output" cmd); (fun cmd -> Cli.option_string "findlib-conf" ~placeholder:"PATH" ~doc:"Path to findlib configuration" cmd); (fun cmd -> Cli.option_string "ocamlopt" ~placeholder:"PATH" ~doc:"Path to ocamlopt compiler" cmd); (fun cmd -> Cli.option_string "ocamldep" ~placeholder:"PATH" ~doc:"Path to ocamldep tool" cmd); (fun cmd -> Cli.option_string "ocamlc" ~placeholder:"PATH" ~doc:"Path to ocamlc compiler" cmd); (fun cmd -> Cli.option_string "cc" ~placeholder:"PATH" ~doc:"Path to C compiler" cmd); (fun cmd -> Cli.option_string "ar" ~placeholder:"PATH" ~doc:"Path to ar archiver" cmd); (fun cmd -> Cli.option_string "pkg-config" ~placeholder:"PATH" ~doc:"Path to pkg-config tool" cmd); (fun cmd -> Cli.option_string "ranlib" ~placeholder:"PATH" ~doc:"Path to ranlib tool" cmd); (fun cmd -> Cli.option_string "ocamldoc" ~placeholder:"PATH" ~doc:"Path to ocamldoc tool" cmd); (fun cmd -> Cli.option_string "ld" ~placeholder:"PATH" ~doc:"Path to linker" cmd); ] ~on_global_args:process_global_args ~commands: [ cmd_configure; cmd_build; cmd_clean; cmd_sdist; cmd_install; cmd_test; cmd_init; cmd_doc; cmd_get; cmd_infer; cmd_generate; ] () (* Initialize the completion app reference *) let () = completion_app_ref := Some obuild_app (* ===== Main Entry Point ===== *) let () = try (* Load config from default locations (~/.obuildrc and ./.obuildrc) *) let config = Cli.load_config () in Cli.run_with_config ~config obuild_app with | Init.ProjectAlreadyExists -> eprintf "error: found another project file in this directory. cannot run init in an already \ existing project\n"; exit 12 | Init.AbortedByUser -> eprintf "init aborted. nothing written\n"; exit 0 | exn -> Exception.show exn obuild-0.2.2/src/main.mli000066400000000000000000000004411515212760700152140ustar00rootroot00000000000000(** Main entry point for the obuild executable This module implements the command-line interface for obuild, including all command handlers (configure, build, clean, etc.) and the main dispatch logic. No public interface is exposed - this module executes on startup. *) obuild-0.2.2/tests/000077500000000000000000000000001515212760700141415ustar00rootroot00000000000000obuild-0.2.2/tests/dependencies/000077500000000000000000000000001515212760700165675ustar00rootroot00000000000000obuild-0.2.2/tests/dependencies/camlp4/000077500000000000000000000000001515212760700177475ustar00rootroot00000000000000obuild-0.2.2/tests/dependencies/camlp4/main.ml000066400000000000000000000001621515212760700212240ustar00rootroot00000000000000module Test = struct type t = { t1 : string; t2 : int option; t3 : float; } with fields end obuild-0.2.2/tests/dependencies/camlp4/test.obuild000066400000000000000000000002171515212760700221260ustar00rootroot00000000000000name: test version: 0.1.0 synopsis: Demo obuild-ver: 1 executable test main: main.ml src-dir: . pp: camlp4o build-deps: pa_fields_convobuild-0.2.2/tests/dependencies/cohttp_test/000077500000000000000000000000001515212760700211275ustar00rootroot00000000000000obuild-0.2.2/tests/dependencies/cohttp_test/main.ml000066400000000000000000000000731515212760700224050ustar00rootroot00000000000000let () = print_endline "Testing cohttp-lwt-unix dependency"obuild-0.2.2/tests/dependencies/cohttp_test/test_cohttp.obuild000066400000000000000000000001701515212760700246650ustar00rootroot00000000000000name: test_cohttp version: 1.0 obuild-ver: 1 executable test_cohttp_main main: main.ml build-deps: cohttp-lwt-unix obuild-0.2.2/tests/dependencies/ctypes_test/000077500000000000000000000000001515212760700211355ustar00rootroot00000000000000obuild-0.2.2/tests/dependencies/ctypes_test/bin/000077500000000000000000000000001515212760700217055ustar00rootroot00000000000000obuild-0.2.2/tests/dependencies/ctypes_test/bin/main.ml000066400000000000000000000014151515212760700231640ustar00rootroot00000000000000(* Test executable for ctypes_test *) let () = (* Show the size of size_t type using Ctypes.sizeof *) Printf.printf "size_t size: %d bytes\n" (Ctypes.sizeof C.Types.size_t); (* Show the timespec struct layout - demonstrates struct support *) Printf.printf "timespec struct size: %d bytes\n" (Ctypes.sizeof C.Types.timespec); Printf.printf " tv_sec offset: %d\n" (Ctypes.offsetof C.Types.tv_sec); Printf.printf " tv_nsec offset: %d\n" (Ctypes.offsetof C.Types.tv_nsec); (* Test the strlen binding - with errno: return, functions return (result, errno) pairs *) let test_string = "Hello, ctypes!" in let (result, _errno) = C.C_Functions.strlen test_string in let len = Unsigned.Size_t.to_int result in Printf.printf "strlen(\"%s\") = %d\n" test_string len obuild-0.2.2/tests/dependencies/ctypes_test/ctypes_test.obuild000066400000000000000000000010061515212760700247000ustar00rootroot00000000000000name: ctypes_test version: 0.1.0 obuild-ver: 1 library mylib modules: Bindings build-deps: ctypes, ctypes.stubs src-dir: lib cstubs external-library-name: mylib type-description: Bindings.Types -> Types_gen function-description: Bindings.Functions -> Funcs_gen generated-types: Types_generated generated-entry-point: C headers: string.h, time.h concurrency: unlocked errno: return executable test_mylib main-is: main.ml src-dir: bin build-deps: mylib, integers, ctypes obuild-0.2.2/tests/dependencies/ctypes_test/lib/000077500000000000000000000000001515212760700217035ustar00rootroot00000000000000obuild-0.2.2/tests/dependencies/ctypes_test/lib/bindings.ml000066400000000000000000000015241515212760700240340ustar00rootroot00000000000000(* Bindings module for ctypes.cstubs test *) (* This module defines the C types and functions we want to bind *) open Ctypes (* Type descriptions - defines C types we need using Cstubs_structs.TYPE for proper struct layout discovery *) module Types (T : Cstubs_structs.TYPE) = struct open T (* size_t type - used by strlen *) let size_t = typedef size_t "size_t" (* timespec struct - demonstrates struct binding *) type timespec let timespec : timespec structure typ = structure "timespec" let tv_sec = field timespec "tv_sec" long let tv_nsec = field timespec "tv_nsec" long let () = seal timespec end (* Function descriptions - defines C functions we want to call *) module Functions (F : Ctypes.FOREIGN) = struct open F (* Bind the C strlen function *) let strlen = foreign "strlen" (string @-> returning size_t) end obuild-0.2.2/tests/dependencies/ppx_sexp/000077500000000000000000000000001515212760700204355ustar00rootroot00000000000000obuild-0.2.2/tests/dependencies/ppx_sexp/binprot.ml000066400000000000000000000003571515212760700224510ustar00rootroot00000000000000open Bin_prot.Std type t = { i: int; f: float } [@@deriving bin_io] let () = let x = { i = 2048 ; f = 3.1415 } in let buff = Bin_prot.Utils.bin_dump bin_writer_t x in let y = bin_read_t buff ~pos_ref:(ref 0) in assert(x = y) obuild-0.2.2/tests/dependencies/ppx_sexp/both.ml000066400000000000000000000002241515212760700217210ustar00rootroot00000000000000open Lwt let test () = let%lwt x = return 3 in return (x + 1 = 4) let _ = let a = [%sexp { msg = "hi there!" }] in Printf.printf "done\n" obuild-0.2.2/tests/dependencies/ppx_sexp/deriving.ml000066400000000000000000000001621515212760700225750ustar00rootroot00000000000000 type test = S of string [@@deriving show] let () = let t = S "string" in Printf.printf "%s\n" (show_test t) obuild-0.2.2/tests/dependencies/ppx_sexp/hello.ml000066400000000000000000000001141515212760700220660ustar00rootroot00000000000000let _ = let a = [%sexp { msg = "hi there!" }] in Printf.printf "done\n" obuild-0.2.2/tests/dependencies/ppx_sexp/hello.obuild000066400000000000000000000011731515212760700227420ustar00rootroot00000000000000name: hello version: 1.0 obuild-ver: 1 executable hello src-dir: . main-is: hello.ml build-deps: ppx_sexp_value executable hello_lwt src-dir: . main-is: hello_lwt.ml build-deps: lwt_ppx executable both src-dir: . main-is: both.ml build-deps: lwt_ppx, ppx_sexp_value executable show src-dir: . main-is: show.ml build-deps: ppx_deriving.show Executable deriving src-dir: . build-deps: ppx_deriving.std main-is: deriving.ml Executable sexp src-dir: . build-deps: ppx_sexp_conv, sexplib main-is: sexp.ml Executable binprot src-dir: . build-deps: ppx_bin_prot, bin_prot main-is: binprot.ml obuild-0.2.2/tests/dependencies/ppx_sexp/hello_lwt.ml000066400000000000000000000001561515212760700227620ustar00rootroot00000000000000open Lwt let test () = let%lwt x = return 3 in return (x + 1 = 4) let _ = Printf.printf "Done\n" obuild-0.2.2/tests/dependencies/ppx_sexp/main.ml000066400000000000000000000103621515212760700217150ustar00rootroot00000000000000open Test open Lwt let suite = suite "ppx" [ test "let" (fun () -> let%lwt x = return 3 in return (x + 1 = 4) ) ; test "nested let" (fun () -> let%lwt x = return 3 in let%lwt y = return 4 in return (x + y = 7) ) ; test "and let" (fun () -> let%lwt x = return 3 and y = return 4 in return (x + y = 7) ) ; test "match" (fun () -> let x = Lwt.return (Some 3) in match%lwt x with | Some x -> return (x + 1 = 4) | None -> return false ) ; test "match-exn" (fun () -> let x = Lwt.return (Some 3) in let x' = Lwt.fail Not_found in let%lwt a = match%lwt x with | exception Not_found -> return false | Some x -> return (x = 3) | None -> return false and b = match%lwt x' with | exception Not_found -> return true | _ -> return false in Lwt.return (a && b) ) ; test "if" (fun () -> let x = Lwt.return true in let%lwt a = if%lwt x then Lwt.return_true else Lwt.return_false in let%lwt b = if%lwt x>|= not then Lwt.return_false else Lwt.return_true in (if%lwt x >|= not then Lwt.return_unit) >>= fun () -> Lwt.return (a && b) ) ; test "for" (* Test for proper sequencing *) (fun () -> let r = ref [] in let f x = let%lwt () = Lwt_unix.sleep 0.2 in Lwt.return (r := x :: !r) in let%lwt () = for%lwt x = 3 to 5 do f x done in return (!r = [5 ; 4 ; 3]) ) ; test "while" (* Test for proper sequencing *) (fun () -> let r = ref [] in let f x = let%lwt () = Lwt_unix.sleep 0.2 in Lwt.return (r := x :: !r) in let%lwt () = let c = ref 2 in while%lwt !c < 5 do incr c ; f !c done in return (!r = [5 ; 4 ; 3]) ) ; test "assert" (fun () -> let%lwt () = assert%lwt true in return true ) ; test "raise" (fun () -> Lwt.catch (fun () -> [%lwt raise Not_found]) (fun exn -> return (exn = Not_found)) ) ; test "try" (fun () -> try%lwt Lwt.fail Not_found with _ -> return true ) [@warning("@8@11")] ; test "try raise" (fun () -> try%lwt raise Not_found with _ -> return true ) [@warning("@8@11")] ; test "try fallback" (fun () -> try%lwt try%lwt Lwt.fail Not_found with Failure _ -> return false with Not_found -> return true ) [@warning("@8@11")] ; test "finally body" (fun () -> let x = ref false in begin (try%lwt return_unit with | _ -> return_unit ) [%finally x := true; return_unit] end >>= fun () -> return !x ) ; test "finally exn" (fun () -> let x = ref false in begin (try%lwt raise Not_found with | _ -> return_unit ) [%finally x := true; return_unit] end >>= fun () -> return !x ) ; test "finally exn default" (fun () -> let x = ref false in try%lwt ( raise Not_found )[%finally x := true; return_unit] >>= fun () -> return false with Not_found -> return !x ) ; test "sequence" (fun () -> let lst = ref [] in (lst := 2 :: !lst; Lwt.return_unit) >> (lst := 1 :: !lst; Lwt.return_unit) >> (Lwt.return (!lst = [1;2])) ) ; test "log" (fun () -> Lwt_log.ign_debug "bar"; Lwt_log.debug "foo" >>= fun () -> Lwt_log.info_f "baz" >>= fun () -> return_true ) ; test "structure let" (fun () -> let module M = struct let%lwt result = Lwt.return_true end in Lwt.return M.result ) ; ] let _ = Test.run "ppx" [ suite ] obuild-0.2.2/tests/dependencies/ppx_sexp/sexp.ml000066400000000000000000000002741515212760700217510ustar00rootroot00000000000000open Sexplib.Std type t = { i : int; f : float; } [@@deriving sexp] let () = let x = { i = 2048; f = 3.1415 } in let s = sexp_of_t x in let y = t_of_sexp s in assert (x = y) obuild-0.2.2/tests/dependencies/ppx_sexp/show.ml000066400000000000000000000001541515212760700217470ustar00rootroot00000000000000type point2d = float * float [@@deriving show] let _ = Printf.printf "%s\n" (show_point2d (1.1,2.2)); obuild-0.2.2/tests/full/000077500000000000000000000000001515212760700151035ustar00rootroot00000000000000obuild-0.2.2/tests/full/autogenerated/000077500000000000000000000000001515212760700177325ustar00rootroot00000000000000obuild-0.2.2/tests/full/autogenerated/p3.ml000066400000000000000000000001411515212760700206020ustar00rootroot00000000000000open Path_generated open Printf let () = printf "project version is : %s\n" project_version obuild-0.2.2/tests/full/autogenerated/p3.obuild000066400000000000000000000001071515212760700214520ustar00rootroot00000000000000name: p3 version: 9.1.23 obuild-ver: 1 executable p3 main-is: p3.ml obuild-0.2.2/tests/full/autopack/000077500000000000000000000000001515212760700167125ustar00rootroot00000000000000obuild-0.2.2/tests/full/autopack/autopack.obuild000066400000000000000000000001411515212760700217150ustar00rootroot00000000000000name: autopack version: 1.0 obuild-ver: 1 executable autopack src-dir: src main-is: main.ml obuild-0.2.2/tests/full/autopack/src/000077500000000000000000000000001515212760700175015ustar00rootroot00000000000000obuild-0.2.2/tests/full/autopack/src/a.ml000066400000000000000000000000221515212760700202450ustar00rootroot00000000000000let foo = "A.foo" obuild-0.2.2/tests/full/autopack/src/b/000077500000000000000000000000001515212760700177225ustar00rootroot00000000000000obuild-0.2.2/tests/full/autopack/src/b/a.ml000066400000000000000000000000241515212760700204700ustar00rootroot00000000000000let foo = "B.A.foo" obuild-0.2.2/tests/full/autopack/src/b/c.ml000066400000000000000000000000511515212760700204720ustar00rootroot00000000000000let foo = "B.C.foo" let test = "B.A.foo" obuild-0.2.2/tests/full/autopack/src/main.ml000066400000000000000000000002051515212760700207540ustar00rootroot00000000000000open Printf let () = printf "A.foo: %s\n" A.foo; printf "B.A.foo: %s\n" B.A.foo; printf "B.C.foo: %s\n" B.C.foo; () obuild-0.2.2/tests/full/autopack2/000077500000000000000000000000001515212760700167745ustar00rootroot00000000000000obuild-0.2.2/tests/full/autopack2/autopack2.obuild000066400000000000000000000001431515212760700220630ustar00rootroot00000000000000name: autopack2 version: 1.0 obuild-ver: 1 executable autopack2 src-dir: src main-is: main.ml obuild-0.2.2/tests/full/autopack2/src/000077500000000000000000000000001515212760700175635ustar00rootroot00000000000000obuild-0.2.2/tests/full/autopack2/src/a.ml000066400000000000000000000000221515212760700203270ustar00rootroot00000000000000let foo = "A.foo" obuild-0.2.2/tests/full/autopack2/src/b/000077500000000000000000000000001515212760700200045ustar00rootroot00000000000000obuild-0.2.2/tests/full/autopack2/src/b/a.ml000066400000000000000000000000241515212760700205520ustar00rootroot00000000000000let foo = "B.A.foo" obuild-0.2.2/tests/full/autopack2/src/b/abc/000077500000000000000000000000001515212760700205315ustar00rootroot00000000000000obuild-0.2.2/tests/full/autopack2/src/b/abc/foo.ml000066400000000000000000000000321515212760700216410ustar00rootroot00000000000000let foo = "B.Abc.Foo.foo" obuild-0.2.2/tests/full/autopack2/src/b/c.ml000066400000000000000000000000241515212760700205540ustar00rootroot00000000000000let foo = "B.C.foo" obuild-0.2.2/tests/full/autopack2/src/main.ml000066400000000000000000000002651515212760700210440ustar00rootroot00000000000000open Printf let () = printf "A.foo: %s\n" A.foo; printf "B.A.foo: %s\n" B.A.foo; printf "B.Abc.Foo.foo: %s\n" B.Abc.Foo.foo; printf "B.C.foo: %s\n" B.C.foo; () obuild-0.2.2/tests/full/complex/000077500000000000000000000000001515212760700165525ustar00rootroot00000000000000obuild-0.2.2/tests/full/complex/complex.obuild000066400000000000000000000005261515212760700214240ustar00rootroot00000000000000name: complex version: 1.0 obuild-ver: 1 library complex src-dir: lib modules: Math, Imaginary sub real src-dir: lib_real modules: Foo, Bar build-deps: complex executable complex src-dir: src main-is: main1.ml build-deps: complex.real executable complex2 src-dir: src main-is: main.ml build-deps: complex obuild-0.2.2/tests/full/complex/lib/000077500000000000000000000000001515212760700173205ustar00rootroot00000000000000obuild-0.2.2/tests/full/complex/lib/imaginary.ml000066400000000000000000000002661515212760700216360ustar00rootroot00000000000000 let imaginary_plus t1 t2 = { Math.Types.real = Math.Accessor.get_real t1 + t2.Math.Types.real ; Math.Types.imag = t1.Math.Types.imag + Math.Accessor.get_imag t2 } obuild-0.2.2/tests/full/complex/lib/math/000077500000000000000000000000001515212760700202515ustar00rootroot00000000000000obuild-0.2.2/tests/full/complex/lib/math/accessor.ml000066400000000000000000000001221515212760700224000ustar00rootroot00000000000000let get_real (t: Types.t) = t.Types.real let get_imag (t: Types.t) = t.Types.imag obuild-0.2.2/tests/full/complex/lib/math/types.ml000066400000000000000000000000451515212760700217460ustar00rootroot00000000000000type t = { real : int ; imag : int } obuild-0.2.2/tests/full/complex/lib_real/000077500000000000000000000000001515212760700203235ustar00rootroot00000000000000obuild-0.2.2/tests/full/complex/lib_real/bar.ml000066400000000000000000000000541515212760700214200ustar00rootroot00000000000000 let real_list l = List.map Foo.make_real l obuild-0.2.2/tests/full/complex/lib_real/foo.ml000066400000000000000000000000721515212760700214370ustar00rootroot00000000000000open Math.Types let make_real x = { real = x; imag = 0 } obuild-0.2.2/tests/full/complex/src/000077500000000000000000000000001515212760700173415ustar00rootroot00000000000000obuild-0.2.2/tests/full/complex/src/main.ml000066400000000000000000000003551515212760700206220ustar00rootroot00000000000000open Imaginary open Math let () = let t1 = { Types.real = 0; Types.imag = 1 } in let t2 = { Types.real = 1; Types.imag = 2 } in let t3 = imaginary_plus t1 t2 in Printf.printf "real = %d\n" (Accessor.get_real t3); () obuild-0.2.2/tests/full/complex/src/main1.ml000066400000000000000000000003101515212760700206720ustar00rootroot00000000000000open Bar let () = let l = real_list [1;2;3] in List.iter (fun i -> Printf.printf "%d.%d\n" (Math.Accessor.get_real i) (Math.Accessor.get_imag i)) l obuild-0.2.2/tests/full/complex2/000077500000000000000000000000001515212760700166345ustar00rootroot00000000000000obuild-0.2.2/tests/full/complex2/complex.obuild000066400000000000000000000005401515212760700215020ustar00rootroot00000000000000name: complex version: 1.0 obuild-ver: 1 library complex src-dir: lib,lib2 modules: Math, Imaginary sub real src-dir: lib_real modules: Foo, Bar build-deps: complex executable complex src-dir: src main-is: main1.ml build-deps: complex.real executable complex2 src-dir: src,src2 main-is: main.ml build-deps: complex obuild-0.2.2/tests/full/complex2/lib/000077500000000000000000000000001515212760700174025ustar00rootroot00000000000000obuild-0.2.2/tests/full/complex2/lib/math/000077500000000000000000000000001515212760700203335ustar00rootroot00000000000000obuild-0.2.2/tests/full/complex2/lib/math/accessor.ml000066400000000000000000000001221515212760700224620ustar00rootroot00000000000000let get_real (t: Types.t) = t.Types.real let get_imag (t: Types.t) = t.Types.imag obuild-0.2.2/tests/full/complex2/lib/math/types.ml000066400000000000000000000000451515212760700220300ustar00rootroot00000000000000type t = { real : int ; imag : int } obuild-0.2.2/tests/full/complex2/lib2/000077500000000000000000000000001515212760700174645ustar00rootroot00000000000000obuild-0.2.2/tests/full/complex2/lib2/imaginary.ml000066400000000000000000000002661515212760700220020ustar00rootroot00000000000000 let imaginary_plus t1 t2 = { Math.Types.real = Math.Accessor.get_real t1 + t2.Math.Types.real ; Math.Types.imag = t1.Math.Types.imag + Math.Accessor.get_imag t2 } obuild-0.2.2/tests/full/complex2/lib_real/000077500000000000000000000000001515212760700204055ustar00rootroot00000000000000obuild-0.2.2/tests/full/complex2/lib_real/bar.ml000066400000000000000000000000541515212760700215020ustar00rootroot00000000000000 let real_list l = List.map Foo.make_real l obuild-0.2.2/tests/full/complex2/lib_real/foo.ml000066400000000000000000000000721515212760700215210ustar00rootroot00000000000000open Math.Types let make_real x = { real = x; imag = 0 } obuild-0.2.2/tests/full/complex2/src/000077500000000000000000000000001515212760700174235ustar00rootroot00000000000000obuild-0.2.2/tests/full/complex2/src/main1.ml000066400000000000000000000003101515212760700207540ustar00rootroot00000000000000open Bar let () = let l = real_list [1;2;3] in List.iter (fun i -> Printf.printf "%d.%d\n" (Math.Accessor.get_real i) (Math.Accessor.get_imag i)) l obuild-0.2.2/tests/full/complex2/src2/000077500000000000000000000000001515212760700175055ustar00rootroot00000000000000obuild-0.2.2/tests/full/complex2/src2/main.ml000066400000000000000000000003551515212760700207660ustar00rootroot00000000000000open Imaginary open Math let () = let t1 = { Types.real = 0; Types.imag = 1 } in let t2 = { Types.real = 1; Types.imag = 2 } in let t3 = imaginary_plus t1 t2 in Printf.printf "real = %d\n" (Accessor.get_real t3); () obuild-0.2.2/tests/full/dep-uri/000077500000000000000000000000001515212760700164505ustar00rootroot00000000000000obuild-0.2.2/tests/full/dep-uri/p2.ml000066400000000000000000000001761515212760700173270ustar00rootroot00000000000000open Uri open Printf let () = let u = Uri.make ~scheme:"http" ~host:"foo!.com" () in printf "%s\n" (Uri.to_string u) obuild-0.2.2/tests/full/dep-uri/p2.obuild000066400000000000000000000001551515212760700201720ustar00rootroot00000000000000name: p2 version: 1.0 obuild-ver: 1 ocaml-version: >=3.12.1 executable p2 main-is: p2.ml build-deps: uri obuild-0.2.2/tests/full/embed/000077500000000000000000000000001515212760700161575ustar00rootroot00000000000000obuild-0.2.2/tests/full/embed/assets/000077500000000000000000000000001515212760700174615ustar00rootroot00000000000000obuild-0.2.2/tests/full/embed/assets/greeting.txt000066400000000000000000000000221515212760700220200ustar00rootroot00000000000000Welcome to obuild!obuild-0.2.2/tests/full/embed/assets/hello.txt000066400000000000000000000000161515212760700213220ustar00rootroot00000000000000Hello, World! obuild-0.2.2/tests/full/embed/assets/info.txt000066400000000000000000000000311515212760700211470ustar00rootroot00000000000000This is embedded content.obuild-0.2.2/tests/full/embed/embed.obuild000066400000000000000000000005631515212760700204370ustar00rootroot00000000000000name: embed-test version: 1.0 obuild-ver: 1 # Generator for embedding files - no suffix means it must be used via generate block generator embed command: sh ./embed.sh -o ${dest}.ml ${sources} outputs: ${base}.ml executable main main-is: main.ml # Generate Assets module from all .txt files in assets/ generate Assets from: assets/*.txt using: embed obuild-0.2.2/tests/full/embed/embed.sh000077500000000000000000000017261515212760700176000ustar00rootroot00000000000000#!/bin/sh # Simple embed script: generates OCaml module from text files # Usage: embed.sh -o output.ml file1.txt file2.txt ... OUTPUT="" FILES="" while [ $# -gt 0 ]; do case "$1" in -o) OUTPUT="$2" shift 2 ;; *) FILES="$FILES $1" shift ;; esac done if [ -z "$OUTPUT" ]; then echo "Usage: embed.sh -o output.ml file1.txt ..." >&2 exit 1 fi # Generate OCaml module cat > "$OUTPUT" << 'HEADER' (* Auto-generated by embed.sh *) let files = [ HEADER for f in $FILES; do if [ -f "$f" ]; then basename=$(basename "$f") content=$(cat "$f" | sed 's/\\/\\\\/g' | sed 's/"/\\"/g') echo " (\"$basename\", \"$content\");" >> "$OUTPUT" fi done cat >> "$OUTPUT" << 'FOOTER' ] let get name = try Some (List.assoc name files) with Not_found -> None let list () = List.map fst files FOOTER echo "Generated $OUTPUT with $(echo $FILES | wc -w) files" obuild-0.2.2/tests/full/embed/main.ml000066400000000000000000000021121515212760700174310ustar00rootroot00000000000000(* Test for pattern-based generate blocks *) let () = (* List all embedded files *) Printf.printf "Embedded files:\n"; List.iter (fun name -> Printf.printf " - %s\n" name ) (Assets.list ()); (* Print contents of each file *) Printf.printf "\nContents:\n"; List.iter (fun name -> match Assets.get name with | Some content -> Printf.printf "%s: %s\n" name content | None -> Printf.printf "%s: \n" name ) (Assets.list ()); (* Verify expected files are present *) let expected = ["hello.txt"; "greeting.txt"; "info.txt"] in let all_present = List.for_all (fun name -> match Assets.get name with | Some _ -> true | None -> Printf.printf "ERROR: Missing expected file: %s\n" name; false ) expected in if all_present && List.length (Assets.list ()) = 3 then begin Printf.printf "\nSUCCESS: All %d files embedded correctly!\n" (List.length expected); exit 0 end else begin Printf.printf "\nFAILURE: Expected %d files, got %d\n" (List.length expected) (List.length (Assets.list ())); exit 1 end obuild-0.2.2/tests/full/parser/000077500000000000000000000000001515212760700163775ustar00rootroot00000000000000obuild-0.2.2/tests/full/parser/lexer.mll000066400000000000000000000013361515212760700202270ustar00rootroot00000000000000(* file: lexer.mll *) (* Lexical analyzer returns one of the tokens: the token NUM of a floating point number, operators (PLUS, MINUS, MULTIPLY, DIVIDE, CARET, UMINUS), or NEWLINE. It skips all blanks and tabs, unknown characters and raises End_of_file on EOF. *) { open Rpncalc (* Assumes the parser file is "rpncalc.mly". *) } let digit = ['0'-'9'] rule token = parse | [' ' '\t'] { token lexbuf } | '\n' { NEWLINE } | digit+ | "." digit+ | digit+ "." digit* as num { NUM (float_of_string num) } | '+' { PLUS } | '-' { MINUS } | '*' { MULTIPLY } | '/' { DIVIDE } | '^' { CARET } | 'n' { UMINUS } | _ { token lexbuf } | eof { raise End_of_file } obuild-0.2.2/tests/full/parser/main.ml000066400000000000000000000004551515212760700176610ustar00rootroot00000000000000(* file: main.ml *) (* Assumes the parser file is "rpncalc.mly" and the lexer file is "lexer.mll". *) let main () = try let lexbuf = Lexing.from_channel stdin in while true do Rpncalc.input Lexer.token lexbuf done with End_of_file -> exit 0 let _ = Printexc.print main () obuild-0.2.2/tests/full/parser/parser.obuild000066400000000000000000000005431515212760700210750ustar00rootroot00000000000000name: parser version: 1.0 obuild-ver: 1 # Port ocamllex to custom generator generator ocamllex suffix: mll command: ocamllex -o ${dest}.ml ${src} outputs: ${base}.ml # Port ocamlyacc to custom generator generator ocamlyacc suffix: mly command: ocamlyacc -b ${dest} ${src} outputs: ${base}.ml, ${base}.mli executable main main-is: main.ml obuild-0.2.2/tests/full/parser/rpncalc.mly000066400000000000000000000013621515212760700205460ustar00rootroot00000000000000/* file: rpcalc.mly */ /* Reverse polish notation calculator. */ %{ open Printf %} %token NUM %token PLUS MINUS MULTIPLY DIVIDE CARET UMINUS %token NEWLINE %start input %type input %% /* Grammar rules and actions follow */ input: /* empty */ { } | input line { } ; line: NEWLINE { } | exp NEWLINE { printf "\t%.10g\n" $1; flush stdout } ; exp: NUM { $1 } | exp exp PLUS { $1 +. $2 } | exp exp MINUS { $1 -. $2 } | exp exp MULTIPLY { $1 *. $2 } | exp exp DIVIDE { $1 /. $2 } /* Exponentiation */ | exp exp CARET { $1 ** $2 } /* Unary minus */ | exp UMINUS { -. $1 } ; %% obuild-0.2.2/tests/full/run000077500000000000000000000016051515212760700156370ustar00rootroot00000000000000#!/bin/bash OBUILD=$(pwd)/../../dist/build/obuild/obuild if [ ! -x ${OBUILD} ]; then echo "obuild has not been built" exit 1 fi TESTS="simple autogenerated with-c dep-uri autopack autopack2 complex complex2" if [ $# -gt 0 ]; then TESTS="$1" DEBUG="--debug+" else DEBUG="" fi RED="\033[1;31m" GREEN="\033[1;32m" BLUE="\033[1;34m" WHITE="\033[0m" for t in ${TESTS} do cd ${t} echo -e "$BLUE ==== test ${t} ====${WHITE}" ${OBUILD} clean ${OBUILD} configure --library-bytecode=1 --executable-bytecode=1 --library-debugging=1 --executable-debugging=1 --annot if [ $? -ne 0 ]; then echo -e "${RED}ERROR${WHITE}: configure failed" cd .. continue fi ${OBUILD} ${DEBUG} build if [ $? -ne 0 ]; then echo -e "${RED}ERROR${WHITE}: build failed" cd .. continue fi echo -e "${GREEN}SUCCESS${WHITE}: $t passed" cd .. done for t in ${TESTS} do cd ${t} ${OBUILD} clean cd .. done obuild-0.2.2/tests/full/simple/000077500000000000000000000000001515212760700163745ustar00rootroot00000000000000obuild-0.2.2/tests/full/simple/p1.ml000066400000000000000000000000221515212760700172400ustar00rootroot00000000000000let inc a = a + 1 obuild-0.2.2/tests/full/simple/p1.obuild000066400000000000000000000000761515212760700201170ustar00rootroot00000000000000name: p1 version: 1.0 obuild-ver: 1 library p1 modules: P1 obuild-0.2.2/tests/full/test/000077500000000000000000000000001515212760700160625ustar00rootroot00000000000000obuild-0.2.2/tests/full/test/test.obuild000066400000000000000000000001601515212760700202360ustar00rootroot00000000000000name: test version: 0.1 obuild-ver: 1 library abc modules: X test abc main-is: testX.ml build-deps: abc obuild-0.2.2/tests/full/test/testX.ml000066400000000000000000000003701515212760700175230ustar00rootroot00000000000000let failed = ref false let runTest name f = let v = f () in if not v then failed := true; Printf.printf "test %s: %b\n" name v let () = runTest "foo works" (fun () -> X.foo 12 12 = 12 + 12); if !failed then exit 1 else exit 0 obuild-0.2.2/tests/full/test/x.ml000066400000000000000000000000241515212760700166570ustar00rootroot00000000000000let foo a b = a + b obuild-0.2.2/tests/full/with-c/000077500000000000000000000000001515212760700162765ustar00rootroot00000000000000obuild-0.2.2/tests/full/with-c/cbits.c000066400000000000000000000003341515212760700175460ustar00rootroot00000000000000#include #include #include #include #include CAMLexport value stub_geti(value unit) { CAMLparam1(unit); CAMLreturn(Val_int(10)); } obuild-0.2.2/tests/full/with-c/ccall.ml000066400000000000000000000001761515212760700177120ustar00rootroot00000000000000open Printf external geti : unit -> int = "stub_geti" let inc a = a + 1 let () = printf "%d\n" (inc (geti ())); () obuild-0.2.2/tests/full/with-c/ccall.obuild000066400000000000000000000001431515212760700205520ustar00rootroot00000000000000name: with-c version: 1.0 obuild-ver: 1 executable withc main-is: ccall.ml c-sources: cbits.c obuild-0.2.2/tests/simple/000077500000000000000000000000001515212760700154325ustar00rootroot00000000000000obuild-0.2.2/tests/simple/deps.build000066400000000000000000000000621515212760700174040ustar00rootroot00000000000000#!/bin/sh ${OBUILDSIMPLE} --deps unix,str deps.ml obuild-0.2.2/tests/simple/deps.ml000066400000000000000000000001421515212760700167140ustar00rootroot00000000000000 let main () = let _s = Str.quote "toto" in let _t = Unix.gettimeofday () in () ;; main () obuild-0.2.2/tests/simple/gtk.build000066400000000000000000000001061515212760700172350ustar00rootroot00000000000000#!/bin/sh ${OBUILDSIMPLE} --cfile gtk_stubs.c --cpkg gtk+-2.0 gtk.ml obuild-0.2.2/tests/simple/gtk.ml000066400000000000000000000001601515212760700165460ustar00rootroot00000000000000external gtk_true : unit -> bool = "stub_gtk_true" let () = Printf.printf "gtk_true(): %b\n" (gtk_true ()) obuild-0.2.2/tests/simple/gtk_stubs.c000066400000000000000000000004221515212760700176010ustar00rootroot00000000000000#include #include #include #include #include #include CAMLexport value stub_gtk_true(value unit) { CAMLparam1(unit); int b = gtk_true(); CAMLreturn(Val_int(b ? 1 : 0)); } obuild-0.2.2/tests/simple/hello_world.build000066400000000000000000000000511515212760700207610ustar00rootroot00000000000000#!/bin/sh ${OBUILDSIMPLE} hello_world.ml obuild-0.2.2/tests/simple/hello_world.ml000066400000000000000000000000631515212760700202750ustar00rootroot00000000000000let () = Printf.printf "hello world\n"; () obuild-0.2.2/tests/simple/run000077500000000000000000000004621515212760700161660ustar00rootroot00000000000000#!/bin/bash export OBUILDSIMPLE=$(pwd)/../../dist/build/obuild-simple/obuild-simple for BUILD in *.build do name=${BUILD/.build/} echo "======== $name =========================" sh ./${BUILD} if [ ! -f $name ]; then echo "[FAILED] building $name " else echo "[SUCCESS] building $name " fi done obuild-0.2.2/tests/simple/z.build000066400000000000000000000000731515212760700167240ustar00rootroot00000000000000#!/bin/sh ${OBUILDSIMPLE} --cfile z_stubs.c --clib z z.ml obuild-0.2.2/tests/simple/z.ml000066400000000000000000000001721515212760700162350ustar00rootroot00000000000000external adler32 : int -> int = "stub_adler32" let () = let v = adler32 10 in Printf.printf "zerror 10 = %x\n" v obuild-0.2.2/tests/simple/z_stubs.c000066400000000000000000000004651515212760700172740ustar00rootroot00000000000000#include #include #include #include #include #include CAMLexport value stub_adler32(value i) { CAMLparam1(i); /* wrong but that's fine */ unsigned int adler = adler32(0L, Z_NULL, 0); CAMLreturn(Val_int(adler)); } obuild-0.2.2/tests/test_build.ml000066400000000000000000000035641515212760700166410ustar00rootroot00000000000000open Test_framework (* Test incremental builds and dependency tracking *) (* Test 1: Verify .mli change triggers .cmi rebuild *) let test_mli_triggers_cmi_rebuild ~name = (* This is a regression test for the .cmi dependency bug *) (* When a .mli file changes, the .cmi should be rebuilt *) (* and the .ml file should be recompiled *) Success (* Test 2: Verify .ml change triggers only that module *) let test_ml_incremental_rebuild ~name = (* When a .ml file changes, only that module should rebuild *) (* Dependencies should not rebuild unless their interface changed *) Success (* Test 3: Verify C file changes trigger recompilation *) let test_c_file_rebuild ~name = (* When a .c file changes, the .o should be rebuilt *) (* and the executable/library should be re-linked *) Success (* Test 4: Verify parallel build scheduling *) let test_parallel_scheduling ~name = (* Multiple independent modules should build in parallel *) (* Dependencies should respect the DAG ordering *) Success (* Test 5: Verify clean build removes all artifacts *) let test_clean_build ~name = (* Clean should remove all dist/ contents *) (* Subsequent build should rebuild everything *) Success (* Test 6: Verify configure changes trigger rebuild *) let test_configure_change_rebuild ~name = (* Changing configure options should trigger full rebuild *) (* e.g., --enable-debugging should add -g flag *) Success let () = print_endline "Build Logic Tests"; print_endline "=================="; print_endline ""; print_endline "Note: These are placeholder tests for Phase 4."; print_endline "Full implementation requires:"; print_endline " - Temporary project creation"; print_endline " - Build invocation and mtime checking"; print_endline " - Artifact verification"; print_endline ""; print_endline "All 6 placeholder tests: PASS (to be implemented)"; exit 0 obuild-0.2.2/tests/test_build_debug.ml000066400000000000000000000227211515212760700200030ustar00rootroot00000000000000open Test_build_helpers (** Debug version of failing tests with verbose output *) (** Test: ML change and incremental rebuild - with debug output *) let test_ml_incremental_debug () = with_temp_build_project ~name:"ml_incremental_debug" ~files:[ ("src/foo.ml", "let x = 42\n"); ("src/bar.ml", "let y = Foo.x + 1\n"); ("src/baz.ml", "let z = Bar.y * 2\n"); ] ~obuild_content:"name: incremental-test\nversion: 1.0\nobuild-ver: 1\n\nlibrary test\n modules: Foo, Bar, Baz\n src-dir: src\n" ~test_fn:(fun dir -> Printf.printf "Project directory: %s\n" dir; (* Initial build *) Printf.printf "\n=== Initial Configure ===\n"; let (success, output) = run_obuild_command ~project_dir:dir ~command:"configure" ~args:[] in if not success then failwith ("Configure failed: " ^ output); Printf.printf "%s\n" output; Printf.printf "\n=== Initial Build ===\n"; let (success, output) = run_obuild_command ~project_dir:dir ~command:"build" ~args:[] in if not success then failwith ("Initial build failed: " ^ output); Printf.printf "%s\n" output; (* Get initial mtimes *) let foo_cmo = dir ^ "/dist/build/lib-test/foo.cmo" in let bar_cmo = dir ^ "/dist/build/lib-test/bar.cmo" in let baz_cmo = dir ^ "/dist/build/lib-test/baz.cmo" in let foo_mtime1 = get_mtime foo_cmo in let bar_mtime1 = get_mtime bar_cmo in let baz_mtime1 = get_mtime baz_cmo in Printf.printf "\n=== Initial Mtimes ===\n"; Printf.printf "foo.cmo: %s\n" (match foo_mtime1 with Some t -> string_of_float t | None -> "missing"); Printf.printf "bar.cmo: %s\n" (match bar_mtime1 with Some t -> string_of_float t | None -> "missing"); Printf.printf "baz.cmo: %s\n" (match baz_mtime1 with Some t -> string_of_float t | None -> "missing"); Printf.printf "\nSleeping 1.1 seconds...\n"; short_sleep (); (* Modify only foo.ml (no interface change) *) Printf.printf "\n=== Modifying foo.ml ===\n"; write_file_with_dirs (dir ^ "/src/foo.ml") "let x = 99\n"; Printf.printf "Changed foo.ml from 'let x = 42' to 'let x = 99'\n"; (* Rebuild with verbose output *) Printf.printf "\n=== Rebuild ===\n"; let (success, output) = run_obuild_command ~project_dir:dir ~command:"build" ~args:[] in if not success then failwith ("Rebuild failed: " ^ output); Printf.printf "%s\n" output; (* Get new mtimes *) let foo_mtime2 = get_mtime foo_cmo in let bar_mtime2 = get_mtime bar_cmo in let baz_mtime2 = get_mtime baz_cmo in Printf.printf "\n=== New Mtimes ===\n"; Printf.printf "foo.cmo: %s\n" (match foo_mtime2 with Some t -> string_of_float t | None -> "missing"); Printf.printf "bar.cmo: %s\n" (match bar_mtime2 with Some t -> string_of_float t | None -> "missing"); Printf.printf "baz.cmo: %s\n" (match baz_mtime2 with Some t -> string_of_float t | None -> "missing"); Printf.printf "\n=== Mtime Changes ===\n"; (match (foo_mtime1, foo_mtime2) with | (Some t1, Some t2) -> Printf.printf "foo.cmo: %s (%.2f seconds)\n" (if t2 > t1 then "REBUILT" else "unchanged") (t2 -. t1) | _ -> Printf.printf "foo.cmo: error getting mtimes\n"); (match (bar_mtime1, bar_mtime2) with | (Some t1, Some t2) -> Printf.printf "bar.cmo: %s (%.2f seconds)\n" (if t2 > t1 then "REBUILT" else "unchanged") (t2 -. t1) | _ -> Printf.printf "bar.cmo: error getting mtimes\n"); (match (baz_mtime1, baz_mtime2) with | (Some t1, Some t2) -> Printf.printf "baz.cmo: %s (%.2f seconds)\n" (if t2 > t1 then "REBUILT" else "unchanged") (t2 -. t1) | _ -> Printf.printf "baz.cmo: error getting mtimes\n"); Printf.printf "\n=== Analysis ===\n"; Printf.printf "Expected: foo.cmo REBUILT, bar.cmo unchanged, baz.cmo unchanged\n"; Printf.printf "Reason: foo.ml implementation changed, but interface did not change\n"; Printf.printf "bar.ml depends on Foo's interface, not implementation\n"; ) (** Test: C file rebuild - with debug output *) let test_c_file_rebuild_debug () = with_temp_build_project ~name:"c_rebuild_debug" ~files:[ ("src/cbits.c", "int add(int a, int b) { return a + b; }\n"); ("src/cbits.h", "int add(int a, int b);\n"); ("src/main.ml", "external add : int -> int -> int = \"add\"\nlet () = Printf.printf \"%d\\n\" (add 1 2)\n"); ] ~obuild_content:"name: c-test\nversion: 1.0\nobuild-ver: 1\n\nexecutable ctest\n main-is: main.ml\n src-dir: src\n c-sources: cbits.c\n c-dir: src\n" ~test_fn:(fun dir -> Printf.printf "Project directory: %s\n" dir; (* Initial build *) Printf.printf "\n=== Initial Build ===\n"; let (success, output) = run_obuild_command ~project_dir:dir ~command:"configure" ~args:[] in if not success then failwith ("Configure failed: " ^ output); let (success, output) = run_obuild_command ~project_dir:dir ~command:"build" ~args:[] in if not success then failwith ("Initial build failed: " ^ output); Printf.printf "%s\n" output; (* Find C object and executable *) Printf.printf "\n=== Finding Build Artifacts ===\n"; let dist_contents = Sys.readdir (dir ^ "/dist/build") in Printf.printf "dist/build contents: %s\n" (String.concat ", " (Array.to_list dist_contents)); (* List all files in ctest directory *) let ctest_dir = dir ^ "/dist/build/ctest" in if Sys.file_exists ctest_dir && Sys.is_directory ctest_dir then ( let ctest_contents = Sys.readdir ctest_dir in Printf.printf "dist/build/ctest contents: %s\n" (String.concat ", " (Array.to_list ctest_contents)); ) else ( Printf.printf "dist/build/ctest: NOT FOUND\n"; ); (* Try different possible locations for C object *) let possible_c_obj_paths = [ dir ^ "/dist/build/ctest/cbits.c.o"; dir ^ "/dist/build/exe-ctest/cbits.c.o"; dir ^ "/dist/build/lib-test/cbits.c.o"; ] in let c_obj = Compat.SafeList.find_opt Sys.file_exists possible_c_obj_paths in let exe = dir ^ "/dist/build/ctest/ctest" in Printf.printf "\nC object file: %s\n" (match c_obj with Some p -> p ^ " (found)" | None -> "NOT FOUND"); Printf.printf "Executable: %s\n" (if Sys.file_exists exe then exe ^ " (found)" else "NOT FOUND"); (match c_obj with | None -> Printf.printf "\nERROR: Could not find C object file in any expected location\n"; Printf.printf "Checked:\n"; List.iter (fun p -> Printf.printf " - %s\n" p) possible_c_obj_paths; failwith "C object file not found" | Some c_obj_path -> let obj_mtime1 = get_mtime c_obj_path in let exe_mtime1 = get_mtime exe in Printf.printf "\n=== Initial Mtimes ===\n"; Printf.printf "C object: %s\n" (match obj_mtime1 with Some t -> string_of_float t | None -> "missing"); Printf.printf "Executable: %s\n" (match exe_mtime1 with Some t -> string_of_float t | None -> "missing"); Printf.printf "\nSleeping 1.1 seconds...\n"; short_sleep (); (* Modify C file *) Printf.printf "\n=== Modifying C file ===\n"; write_file_with_dirs (dir ^ "/src/cbits.c") "int add(int a, int b) { return a + b + 1; }\n"; Printf.printf "Changed: return a + b; -> return a + b + 1;\n"; (* Rebuild *) Printf.printf "\n=== Rebuild ===\n"; let (success, output) = run_obuild_command ~project_dir:dir ~command:"build" ~args:[] in if not success then failwith ("Rebuild failed: " ^ output); Printf.printf "%s\n" output; (* Get new mtimes *) let obj_mtime2 = get_mtime c_obj_path in let exe_mtime2 = get_mtime exe in Printf.printf "\n=== New Mtimes ===\n"; Printf.printf "C object: %s\n" (match obj_mtime2 with Some t -> string_of_float t | None -> "missing"); Printf.printf "Executable: %s\n" (match exe_mtime2 with Some t -> string_of_float t | None -> "missing"); Printf.printf "\n=== Mtime Changes ===\n"; (match (obj_mtime1, obj_mtime2) with | (Some t1, Some t2) -> Printf.printf "C object: %s (%.2f seconds)\n" (if t2 > t1 then "REBUILT" else "unchanged") (t2 -. t1) | _ -> Printf.printf "C object: error getting mtimes\n"); (match (exe_mtime1, exe_mtime2) with | (Some t1, Some t2) -> Printf.printf "Executable: %s (%.2f seconds)\n" (if t2 > t1 then "RELINKED" else "unchanged") (t2 -. t1) | _ -> Printf.printf "Executable: error getting mtimes\n"); Printf.printf "\n=== Analysis ===\n"; Printf.printf "Expected: C object REBUILT, Executable RELINKED\n"; ) ) let () = print_endline ""; print_endline "Build Logic Debug Tests"; print_endline "======================="; print_endline ""; print_endline "============================================================="; print_endline "TEST 1: ML Incremental Rebuild"; print_endline "============================================================="; test_ml_incremental_debug (); print_endline ""; print_endline "============================================================="; print_endline "TEST 2: C File Rebuild"; print_endline "============================================================="; test_c_file_rebuild_debug (); print_endline ""; print_endline "Debug tests completed!"; obuild-0.2.2/tests/test_build_helpers.ml000066400000000000000000000117731515212760700203640ustar00rootroot00000000000000open Filepath open Filesystem (** Build testing helper functions *) (** Create a temporary directory for testing *) let create_temp_dir prefix = let temp_base = try Sys.getenv "TMPDIR" with Not_found -> "/tmp" in let rec try_create n = if n > 100 then failwith "Could not create temporary directory after 100 attempts" else let dir_name = Printf.sprintf "%s/%s_%d_%d" temp_base prefix (Unix.getpid ()) n in try Unix.mkdir dir_name 0o755; dir_name with Unix.Unix_error (Unix.EEXIST, _, _) -> try_create (n + 1) in try_create 0 (** Remove directory recursively *) let rec remove_dir_recursive dir = if Sys.file_exists dir then ( if Sys.is_directory dir then ( let entries = Sys.readdir dir in Array.iter (fun entry -> remove_dir_recursive (Filename.concat dir entry) ) entries; Unix.rmdir dir ) else Unix.unlink dir ) (** Write content to file, creating parent directories if needed *) let write_file_with_dirs filepath content = let dir = Filename.dirname filepath in (* Create parent directories *) let rec create_parents path = if not (Sys.file_exists path) then ( create_parents (Filename.dirname path); if not (Sys.file_exists path) then Unix.mkdir path 0o755 ) in create_parents dir; (* Write file *) let oc = open_out filepath in output_string oc content; close_out oc (** Create temporary project with files and obuild config *) let with_temp_build_project ~name ~files ~obuild_content ~test_fn = let temp_dir = create_temp_dir ("obuild_test_" ^ name) in try (* Write all project files *) List.iter (fun (filename, content) -> let filepath = Filename.concat temp_dir filename in write_file_with_dirs filepath content ) files; (* Write .obuild file *) let obuild_file = Filename.concat temp_dir (name ^ ".obuild") in write_file_with_dirs obuild_file obuild_content; (* Run the test function *) test_fn temp_dir; (* Cleanup *) remove_dir_recursive temp_dir with e -> (* Cleanup on error *) remove_dir_recursive temp_dir; raise e (** Run obuild command and capture output *) let run_obuild_command ~project_dir ~command ~args = let obuild_exe = Filename.concat (Unix.getcwd ()) "dist/build/obuild/obuild" in (* Build command line *) let cmd_args = obuild_exe :: command :: args in let cmd_line = String.concat " " (List.map Filename.quote cmd_args) in (* Save current directory *) let orig_dir = Unix.getcwd () in try (* Change to project directory *) Unix.chdir project_dir; (* Execute command and capture output *) let ic = Unix.open_process_in (cmd_line ^ " 2>&1") in let output = ref [] in (try while true do output := input_line ic :: !output done with End_of_file -> ()); let status = Unix.close_process_in ic in (* Return to original directory *) Unix.chdir orig_dir; (* Check exit status *) let success = match status with | Unix.WEXITED 0 -> true | _ -> false in let output_str = String.concat "\n" (List.rev !output) in (success, output_str) with e -> (* Make sure we return to original directory *) Unix.chdir orig_dir; raise e (** Get file modification time, returns None if file doesn't exist *) let get_mtime filepath = try let stats = Unix.stat filepath in Some stats.Unix.st_mtime with Unix.Unix_error (Unix.ENOENT, _, _) -> None (** Touch file to update its modification time *) let touch_file filepath = let now = Unix.time () in Unix.utimes filepath now now (** Sleep for a short duration (for mtime differences) *) (** Use 2 seconds to ensure filesystem mtime resolution *) let short_sleep () = ignore (Unix.select [] [] [] 1.1) (** Assert that file exists *) let assert_file_exists filepath = if not (Sys.file_exists filepath) then failwith (Printf.sprintf "Expected file to exist: %s" filepath) (** Assert that file does not exist *) let assert_file_not_exists filepath = if Sys.file_exists filepath then failwith (Printf.sprintf "Expected file to not exist: %s" filepath) (** Assert that mtime1 < mtime2 *) let assert_mtime_newer ~msg mtime1_opt mtime2_opt = match (mtime1_opt, mtime2_opt) with | (Some mtime1, Some mtime2) -> if not (mtime2 > mtime1) then failwith (Printf.sprintf "%s (mtime1=%.2f, mtime2=%.2f)" msg mtime1 mtime2) | (None, _) -> failwith (Printf.sprintf "%s (first file doesn't exist)" msg) | (_, None) -> failwith (Printf.sprintf "%s (second file doesn't exist)" msg) (** Assert that mtime is unchanged *) let assert_mtime_unchanged ~msg mtime1_opt mtime2_opt = match (mtime1_opt, mtime2_opt) with | (Some mtime1, Some mtime2) -> if mtime1 <> mtime2 then failwith (Printf.sprintf "%s (mtime changed from %.2f to %.2f)" msg mtime1 mtime2) | (None, _) -> failwith (Printf.sprintf "%s (first file doesn't exist)" msg) | (_, None) -> failwith (Printf.sprintf "%s (second file doesn't exist)" msg) obuild-0.2.2/tests/test_build_logic.ml000066400000000000000000000333131515212760700200110ustar00rootroot00000000000000open Test_framework open Test_build_helpers (* Pipe operator for OCaml < 4.01 compatibility *) let (|>) x f = f x (** Test 1: MLI change triggers CMI and ML rebuild *) let test_mli_triggers_rebuild () = with_temp_build_project ~name:"mli_rebuild" ~files:[ ("src/foo.mli", "val x : int\n"); ("src/foo.ml", "let x = 42\n"); ("src/bar.ml", "let y = Foo.x + 1\n"); ] ~obuild_content:"name: mli-test\nversion: 1.0\nobuild-ver: 1\n\nlibrary foo\n modules: Foo, Bar\n src-dir: src\n" ~test_fn:(fun dir -> (* Initial build *) let (success, output) = run_obuild_command ~project_dir:dir ~command:"configure" ~args:[] in if not success then failwith ("Configure failed: " ^ output); let (success, output) = run_obuild_command ~project_dir:dir ~command:"build" ~args:[] in if not success then failwith ("Initial build failed: " ^ output); (* Get initial mtimes *) let foo_cmi = dir ^ "/dist/build/lib-foo/foo.cmi" in let foo_cmo = dir ^ "/dist/build/lib-foo/foo.cmo" in let bar_cmo = dir ^ "/dist/build/lib-foo/bar.cmo" in assert_file_exists foo_cmi; assert_file_exists foo_cmo; assert_file_exists bar_cmo; let cmi_mtime1 = get_mtime foo_cmi in let foo_mtime1 = get_mtime foo_cmo in let bar_mtime1 = get_mtime bar_cmo in (* Sleep to ensure different mtime *) short_sleep (); (* Modify .mli file content (add comment) *) write_file_with_dirs (dir ^ "/src/foo.mli") "(* changed *)\nval x : int\n"; (* Rebuild *) let (success, output) = run_obuild_command ~project_dir:dir ~command:"build" ~args:[] in if not success then failwith ("Rebuild after mli change failed: " ^ output); (* Verify .cmi was rebuilt *) let cmi_mtime2 = get_mtime foo_cmi in assert_mtime_newer ~msg:"foo.cmi should be rebuilt when foo.mli changes" cmi_mtime1 cmi_mtime2; (* Verify .ml was recompiled (depends on own .cmi) *) let foo_mtime2 = get_mtime foo_cmo in assert_mtime_newer ~msg:"foo.ml should be recompiled when foo.mli changes" foo_mtime1 foo_mtime2; (* Verify dependent module was recompiled *) let bar_mtime2 = get_mtime bar_cmo in assert_mtime_newer ~msg:"bar.ml should be recompiled when dependency interface changes" bar_mtime1 bar_mtime2; ) (** Test 2: ML change only rebuilds that module (not dependencies) *) (** Note: Tests bytecode mode - native code rebuilds are expected due to .cmx inlining *) let test_ml_incremental_rebuild () = with_temp_build_project ~name:"ml_incremental" ~files:[ ("src/foo.mli", "val x : int\n"); (* Explicit interface prevents .cmi regeneration *) ("src/foo.ml", "let x = 42\n"); ("src/bar.ml", "let y = Foo.x + 1\n"); ("src/baz.ml", "let z = Bar.y * 2\n"); ] ~obuild_content:"name: incremental-test\nversion: 1.0\nobuild-ver: 1\n\nlibrary test\n modules: Foo, Bar, Baz\n src-dir: src\n" ~test_fn:(fun dir -> (* Configure for bytecode only to test incremental compilation *) let (success, _) = run_obuild_command ~project_dir:dir ~command:"configure" ~args:["--library-bytecode=true"; "--library-native=false"] in if not success then failwith "configure should succeed"; let (success, _) = run_obuild_command ~project_dir:dir ~command:"build" ~args:[] in if not success then failwith "initial build should succeed"; (* Get initial mtimes - check bytecode (.cmo) files *) let foo_cmo = dir ^ "/dist/build/lib-test/foo.cmo" in let bar_cmo = dir ^ "/dist/build/lib-test/bar.cmo" in let baz_cmo = dir ^ "/dist/build/lib-test/baz.cmo" in let foo_mtime1 = get_mtime foo_cmo in let bar_mtime1 = get_mtime bar_cmo in let baz_mtime1 = get_mtime baz_cmo in short_sleep (); (* Modify only foo.ml (no interface change) *) write_file_with_dirs (dir ^ "/src/foo.ml") "let x = 99\n"; (* Rebuild *) let (success, _) = run_obuild_command ~project_dir:dir ~command:"build" ~args:[] in if not success then failwith "rebuild should succeed"; (* Verify only foo.ml was rebuilt *) let foo_mtime2 = get_mtime foo_cmo in assert_mtime_newer ~msg:"foo.ml should be rebuilt" foo_mtime1 foo_mtime2; (* In bytecode mode, bar and baz should NOT rebuild (no interface change) *) let bar_mtime2 = get_mtime bar_cmo in let baz_mtime2 = get_mtime baz_cmo in assert_mtime_unchanged ~msg:"bar.ml should NOT rebuild in bytecode (foo interface unchanged)" bar_mtime1 bar_mtime2; assert_mtime_unchanged ~msg:"baz.ml should NOT rebuild in bytecode (foo interface unchanged)" baz_mtime1 baz_mtime2; ) (** Test 3: C file change triggers recompilation and relinking *) let test_c_file_rebuild () = with_temp_build_project ~name:"c_rebuild" ~files:[ ("src/cbits.c", "int add(int a, int b) { return a + b; }\n"); ("src/cbits.h", "int add(int a, int b);\n"); ("src/main.ml", "external add : int -> int -> int = \"add\"\nlet () = Printf.printf \"%d\\n\" (add 1 2)\n"); ] ~obuild_content:"name: c-test\nversion: 1.0\nobuild-ver: 1\n\nexecutable ctest\n main-is: main.ml\n src-dir: src\n c-sources: cbits.c\n c-dir: src\n" ~test_fn:(fun dir -> (* Initial build *) let (success, _) = run_obuild_command ~project_dir:dir ~command:"configure" ~args:[] in if not success then failwith "configure should succeed"; let (success, _) = run_obuild_command ~project_dir:dir ~command:"build" ~args:[] in if not success then failwith "initial build should succeed"; (* Get initial mtimes *) (* C objects are stored in the target's build directory *) let c_obj = dir ^ "/dist/build/ctest/cbits.c.o" in let exe = dir ^ "/dist/build/ctest/ctest" in assert_file_exists c_obj; assert_file_exists exe; let obj_mtime1 = get_mtime c_obj in let exe_mtime1 = get_mtime exe in short_sleep (); (* Modify C file *) write_file_with_dirs (dir ^ "/src/cbits.c") "int add(int a, int b) { return a + b + 1; }\n"; (* Rebuild *) let (success, _) = run_obuild_command ~project_dir:dir ~command:"build" ~args:[] in if not success then failwith "rebuild should succeed"; (* Verify .o was rebuilt *) let obj_mtime2 = get_mtime c_obj in assert_mtime_newer ~msg:"C object file should be rebuilt" obj_mtime1 obj_mtime2; (* Verify executable was relinked *) let exe_mtime2 = get_mtime exe in assert_mtime_newer ~msg:"Executable should be relinked" exe_mtime1 exe_mtime2; ) (** Test 4: Clean removes all build artifacts *) let test_clean_build () = with_temp_build_project ~name:"clean_test" ~files:[ ("src/foo.ml", "let x = 42\n"); ] ~obuild_content:"name: clean-test\nversion: 1.0\nobuild-ver: 1\n\nlibrary foo\n modules: Foo\n src-dir: src\n" ~test_fn:(fun dir -> (* Build *) let (success, _) = run_obuild_command ~project_dir:dir ~command:"configure" ~args:[] in if not success then failwith "configure should succeed"; let (success, _) = run_obuild_command ~project_dir:dir ~command:"build" ~args:[] in if not success then failwith "build should succeed"; (* Verify artifacts exist *) let dist_dir = dir ^ "/dist" in assert_file_exists dist_dir; assert_file_exists (dir ^ "/dist/build/lib-foo/foo.cmi"); (* Clean *) let (success, _) = run_obuild_command ~project_dir:dir ~command:"clean" ~args:[] in if not success then failwith "clean should succeed"; (* Verify dist directory is cleaned *) (* Note: dist/ itself may still exist but should be empty or only contain setup *) let artifacts = [ dir ^ "/dist/build/lib-foo/foo.cmi"; dir ^ "/dist/build/lib-foo/foo.cmo"; dir ^ "/dist/build/lib-foo/foo.cmx"; ] in List.iter (fun artifact -> if Sys.file_exists artifact then failwith (Printf.sprintf "Artifact should be removed by clean: %s" artifact) ) artifacts; ) (** Test 5: Configure change triggers rebuild *) let test_configure_rebuild () = with_temp_build_project ~name:"config_rebuild" ~files:[ ("src/foo.ml", "let x = 42\n"); ] ~obuild_content:"name: config-test\nversion: 1.0\nobuild-ver: 1\n\nlibrary foo\n modules: Foo\n src-dir: src\n" ~test_fn:(fun dir -> (* Initial build *) let (success, _) = run_obuild_command ~project_dir:dir ~command:"configure" ~args:[] in if not success then failwith "configure should succeed"; let (success, _) = run_obuild_command ~project_dir:dir ~command:"build" ~args:[] in if not success then failwith "build should succeed"; let foo_cmo = dir ^ "/dist/build/lib-foo/foo.cmo" in let mtime1 = get_mtime foo_cmo in short_sleep (); (* Reconfigure with different options *) let (success, _) = run_obuild_command ~project_dir:dir ~command:"configure" ~args:["--library-debugging=true"] in if not success then failwith "reconfigure should succeed"; (* Build again *) let (success, _) = run_obuild_command ~project_dir:dir ~command:"build" ~args:[] in if not success then failwith "rebuild should succeed"; (* Verify module was rebuilt with new flags *) let mtime2 = get_mtime foo_cmo in assert_mtime_newer ~msg:"Module should rebuild after configure change" mtime1 mtime2; ) (** Test 6: Parallel build with dependencies *) let test_parallel_build () = with_temp_build_project ~name:"parallel_build" ~files:[ ("src/a.ml", "let a = 1\n"); ("src/b.ml", "let b = 2\n"); ("src/c.ml", "let c = A.a + B.b\n"); ] ~obuild_content:"name: parallel-test\nversion: 1.0\nobuild-ver: 1\n\nlibrary test\n modules: A, B, C\n src-dir: src\n" ~test_fn:(fun dir -> (* Build with parallelism *) let (success, _) = run_obuild_command ~project_dir:dir ~command:"configure" ~args:[] in if not success then failwith "configure should succeed"; let (success, output) = run_obuild_command ~project_dir:dir ~command:"build" ~args:["-j"; "2"] in if not success then failwith ("Parallel build failed: " ^ output); (* Verify all artifacts exist (build completed successfully) *) assert_file_exists (dir ^ "/dist/build/lib-test/a.cmo"); assert_file_exists (dir ^ "/dist/build/lib-test/b.cmo"); assert_file_exists (dir ^ "/dist/build/lib-test/c.cmo"); (* If parallel build succeeded, dependencies were respected *) (* (C couldn't build before A and B) *) ) (** Test 7: Source file overlap between libraries emits a warning *) (** Regression test: reproduces the obuild self-build bug on macOS/OCaml 5.x * where library obuild had 'modules: lib' (directory module) causing it to * claim the same .ml files as library obuild_base (flat), leading to * conflicting -for-pack flags and a hard error in OCaml 5.x. *) let test_source_overlap_warning () = with_temp_build_project ~name:"overlap_warning" ~files:[ ("helper/utils.ml", "let x = 42\n"); ] ~obuild_content:"name: overlap-warning\nversion: 1.0\nobuild-ver: 1\n\nlibrary base_lib\n modules: Utils\n src-dir: helper\n\nlibrary top_lib\n modules: helper\n" ~test_fn:(fun dir -> let (success, _) = run_obuild_command ~project_dir:dir ~command:"configure" ~args:[] in if not success then failwith "configure should succeed"; (* Build should still succeed: the overlap is a warning, not an error *) let (success, output) = run_obuild_command ~project_dir:dir ~command:"build" ~args:[] in if not success then failwith ("Build should succeed despite overlap warning: " ^ output); (* Verify the source overlap warning was emitted *) let string_contains s sub = let n = String.length sub in let m = String.length s in if n = 0 then true else if m < n then false else begin let found = ref false in for i = 0 to m - n do if String.sub s i n = sub then found := true done; !found end in if not (string_contains output "warning: source file") then failwith ("Expected source overlap warning in build output, but got:\n" ^ output); ) (** Run all build logic tests *) let () = print_endline ""; print_endline "Build Logic Tests"; print_endline "================="; print_endline ""; let tests = [ ("mli_triggers_rebuild", test_mli_triggers_rebuild, "MLI change triggers CMI and dependent ML rebuilds"); ("ml_incremental_rebuild", test_ml_incremental_rebuild, "ML change only rebuilds that module (incremental)"); ("c_file_rebuild", test_c_file_rebuild, "C file change triggers recompilation and relinking"); ("clean_build", test_clean_build, "Clean removes all build artifacts"); ("configure_rebuild", test_configure_rebuild, "Configure change triggers rebuild"); ("parallel_build", test_parallel_build, "Parallel build respects dependencies"); ("source_overlap_warning", test_source_overlap_warning, "Source file overlap between libraries emits warning"); ] in let run_test (name, test_fn, description) = Printf.printf "Running test: %s... " description; flush stdout; try test_fn (); print_endline "PASS"; true with | Failure msg -> Printf.printf "FAIL\n %s\n" msg; false | e -> Printf.printf "ERROR\n %s\n" (Printexc.to_string e); false in let results = List.map run_test tests in let passed = List.filter (fun x -> x) results |> List.length in let total = List.length tests in print_endline ""; Printf.printf "Results: %d/%d tests passed\n" passed total; if passed = total then exit 0 else exit 1 obuild-0.2.2/tests/test_dag.ml000066400000000000000000000146251515212760700162750ustar00rootroot00000000000000let err = ref 0 (* simple dag: a -> b -> c *) let d1 = let d = Dag.init () in Dag.add_edge "A" "B" d; Dag.add_edge "B" "C" d; d (* DAG with a fork * * A -> B -> C -> D -> E -> F * \> C'-> D'-/ *) let d2 = let d = Dag.init () in Dag.add_edges_connected [ "A"; "B"; "C"; "D"; "E"; "F" ] d; Dag.add_edges [ ("B", "C'"); ("C'", "D'"); ("D'", "E") ] d; d (* DAG * A --------> C * \-> B --/ *) let d3 = let d = Dag.init () in Dag.add_edges [ ("A", "C"); ("A", "B"); ("B", "C") ] d; d (* DAG * A \ /-> C * -> B * A' / \-> C' *) let d4 = let d = Dag.init () in Dag.add_edges [ ("A", "B"); ("A'", "B"); ("B", "C"); ("B", "C'") ] d; d let showDeps prefix l = Printf.printf "%s%s\n" prefix (String.concat " -> " l) let assumeEqF f testname expected got = if f expected got then Printf.printf "SUCCESS %s\n" testname else ( Printf.printf "FAILED %s\n" testname; showDeps "expected:" (List.concat expected); showDeps "got :" got; err := !err + 1) let assumeEq testname expected got = if expected = got then Printf.printf "SUCCESS %s\n" testname else ( Printf.printf "FAILED %s\n" testname; showDeps "expected:" expected; showDeps "got :" got; err := !err + 1) let assumeBool testname expected got = if expected = got then Printf.printf "SUCCESS %s\n" testname else ( Printf.printf "FAILED %s (expected: %b, got: %b)\n" testname expected got; err := !err + 1) let assumeInt testname expected got = if expected = got then Printf.printf "SUCCESS %s\n" testname else ( Printf.printf "FAILED %s (expected: %d, got: %d)\n" testname expected got; err := !err + 1) let listEq a b = let rec loopElem l r = match l with | [] -> (true, r) | _ -> ( match r with | [] -> (false, r) | e :: es -> if List.mem e l then loopElem (List.filter (fun z -> z <> e) l) es else (false, r)) in let rec loopGroup l r = match l with | [] -> if r = [] then true else false | g :: gs -> let e, r2 = loopElem g r in if e = true then loopGroup gs r2 else false in loopGroup a b let () = let l1 = Taskdep.linearize d1 Taskdep.FromParent [ "A" ] in let l2 = Taskdep.linearize d2 Taskdep.FromParent [ "A" ] in let l2' = Taskdep.linearize d2 Taskdep.FromParent [ "C'" ] in let l3 = Taskdep.linearize d3 Taskdep.FromParent [ "A" ] in let l3' = Taskdep.linearize (Dag.transitive_reduction d3) Taskdep.FromParent [ "A" ] in let l4 = Taskdep.linearize d4 Taskdep.FromParent [ "A"; "A'" ] in assumeEq "linearization A->B->C" [ "A"; "B"; "C" ] l1; assumeEq "linearization A->B->(C,C')->(D,D')->E->F" [ "A"; "B"; "C"; "D"; "C'"; "D'"; "E"; "F" ] l2; assumeEq "linearization C'->D'->E->F" [ "C'"; "D'"; "E"; "F" ] l2'; assumeEq "linearization A->(B->C)" [ "A"; "B"; "C" ] l3; assumeEq "linearization A->(B->C)" [ "A"; "B"; "C" ] l3'; assumeEqF listEq "linearization (A,A')->B->(C,C')" [ [ "A"; "A'" ]; [ "B" ]; [ "C"; "C'" ] ] l4; (* Test basic DAG operations *) let d_basic = Dag.init () in Dag.add_node "X" d_basic; assumeBool "add_node creates node" true (Dag.exists_node "X" d_basic); assumeBool "exists_node returns false for missing" false (Dag.exists_node "Y" d_basic); Dag.add_edge "X" "Y" d_basic; assumeBool "add_edge creates nodes and edge" true (Dag.has_edge "X" "Y" d_basic); assumeBool "has_edge returns false for missing edge" false (Dag.has_edge "Y" "X" d_basic); assumeInt "length counts nodes" 2 (Dag.length d_basic); (* Test get_children and get_parents *) let children_x = Dag.get_children d_basic "X" in assumeEq "get_children returns children" ["Y"] children_x; let parents_y = Dag.get_parents d_basic "Y" in assumeEq "get_parents returns parents" ["X"] parents_y; (* Test del_edge *) Dag.del_edge "X" "Y" d_basic; assumeBool "del_edge removes edge" false (Dag.has_edge "X" "Y" d_basic); (* Test get_leaves and get_roots *) let d_tree = Dag.init () in Dag.add_edges [("root", "a"); ("root", "b"); ("a", "c"); ("a", "d")] d_tree; let leaves = List.sort String.compare (Dag.get_leaves d_tree) in let roots = List.sort String.compare (Dag.get_roots d_tree) in assumeEq "get_leaves returns leaf nodes" ["b"; "c"; "d"] leaves; assumeEq "get_roots returns root nodes" ["root"] roots; (* Test get_children_full *) let all_children = List.sort String.compare (Dag.get_children_full d_tree "root") in assumeEq "get_children_full returns all descendants" ["a"; "b"; "c"; "d"] all_children; (* Test is_children and is_children_full *) assumeBool "is_children detects direct child" true (Dag.is_children d_tree "root" "a"); assumeBool "is_children returns false for non-child" false (Dag.is_children d_tree "root" "c"); assumeBool "is_children_full detects descendant" true (Dag.is_children_full d_tree "root" "c"); assumeBool "is_children_full returns false for non-descendant" false (Dag.is_children_full d_tree "b" "c"); (* Test copy *) let d_copy = Dag.copy d_tree in assumeBool "copy creates equivalent DAG" true (Dag.has_edge "root" "a" d_copy); assumeInt "copy length matches original" (Dag.length d_tree) (Dag.length d_copy); (* Test subset *) let d_subset = Dag.subset d_tree ["a"] in let subset_nodes = List.sort String.compare (Dag.get_nodes d_subset) in assumeEq "subset extracts subgraph" ["a"; "c"; "d"] subset_nodes; (* Test merge *) let d_merge1 = Dag.init () in let d_merge2 = Dag.init () in Dag.add_edge "A" "B" d_merge1; Dag.add_edge "B" "C" d_merge2; let dups = Dag.merge d_merge1 d_merge2 in assumeBool "merge combines DAGs" true (Dag.has_edge "B" "C" d_merge1); assumeEq "merge detects duplicates" ["B"] (List.sort String.compare dups); (* Test add_node_exclusive *) let d_excl = Dag.init () in Dag.add_node_exclusive "E" d_excl; assumeBool "add_node_exclusive adds node" true (Dag.exists_node "E" d_excl); (* Test exception handling *) let exc_raised = try Dag.add_node_exclusive "E" d_excl; false with Dag.DagNodeAlreadyExists -> true in assumeBool "add_node_exclusive raises on duplicate" true exc_raised; let not_found_raised = try let _ = Dag.get_node d_excl "NONEXISTENT" in false with Dag.DagNodeNotFound -> true in assumeBool "get_node raises on missing node" true not_found_raised; if !err > 0 then exit 1 else exit 0 obuild-0.2.2/tests/test_expr.ml000066400000000000000000000052521515212760700165140ustar00rootroot00000000000000let err = ref 0 let assumeEq testname expected got = if expected = got then Printf.printf "SUCCESS %s\n" testname else ( Printf.printf "FAILED %s Expected %b Got %b\n" testname expected got; err := !err + 1) let expr_to_string = function | None -> "" | Some expr -> Expr.to_string expr let eval version = function | None -> true | Some expr -> Expr.eval version expr let () = let version1 = "1.7" in let version2 = "1.7.2" in let version3 = "2.0.0.0" in let version4 = "1.12.1alpha" in let name, expr_ge = Expr.parse_builddep "uri (>=1.7.2)" in Printf.printf "pkg %s constraint %s\n" name (expr_to_string expr_ge); assumeEq ">= false" false (eval version1 expr_ge); assumeEq ">= true" true (eval version2 expr_ge); assumeEq ">= true" true (eval version3 expr_ge); assumeEq ">= true" true (eval version4 expr_ge); let name, expr_lt = Expr.parse_builddep "uri (<1.7.2)" in Printf.printf "pkg %s constraint %s\n" name (expr_to_string expr_ge); assumeEq "< true" true (eval version1 expr_lt); assumeEq "< false" false (eval version2 expr_lt); assumeEq "< false" false (eval version3 expr_lt); assumeEq "< false" false (eval version4 expr_lt); let name, expr_ne = Expr.parse_builddep "uri (!=1.7.2)" in Printf.printf "pkg %s constraint %s\n" name (expr_to_string expr_ne); assumeEq "!= true" true (eval version1 expr_ne); assumeEq "!= false" false (eval version2 expr_ne); assumeEq "!= true" true (eval version3 expr_ne); assumeEq "!= true" true (eval version4 expr_ne); let name, expr_not_eq = Expr.parse_builddep "uri !(=1.7.2)" in Printf.printf "pkg %s constraint %s\n" name (expr_to_string expr_not_eq); assumeEq "! = true" true (eval version1 expr_ne); assumeEq "! = false" false (eval version2 expr_ne); assumeEq "! = true" true (eval version3 expr_ne); assumeEq "! = true" true (eval version4 expr_ne); let name, expr_comp = Expr.parse_builddep "uri (<1.7.2) || (>=2.0)" in Printf.printf "pkg %s constraint %s\n" name (expr_to_string expr_comp); assumeEq "< | >= = true" true (eval version1 expr_comp); assumeEq "< | >= = false" false (eval version2 expr_comp); assumeEq "< | >= = true" true (eval version3 expr_comp); assumeEq "< | >= = false" false (eval version4 expr_comp); let name, expr_comp2 = Expr.parse_builddep "uri ((<1.7.2) || (>=2.0) || (=1.7.2))" in Printf.printf "pkg %s constraint %s\n" name (expr_to_string expr_comp2); assumeEq "< | >= = true" true (eval version1 expr_comp2); assumeEq "< | >= = true" true (eval version2 expr_comp2); assumeEq "< | >= = true" true (eval version3 expr_comp2); assumeEq "< | >= = false" false (eval version4 expr_comp2); if !err > 1 then exit 1 else exit 0 obuild-0.2.2/tests/test_find.ml000066400000000000000000000274371515212760700164670ustar00rootroot00000000000000let err = ref 0 let assumeEq testname expected got = if expected = got then Printf.printf "SUCCESS %s\n" testname else ( Printf.printf "FAILED %s Expected %s Got %s\n" testname expected got; err := !err + 1) let assumeTrue testname v = if v then Printf.printf "SUCCESS %s\n" testname else ( Printf.printf "FAILED %s Expected true Got false\n" testname; err := !err + 1) let assumeRaises testname f = let raised = (try f (); false with _ -> true) in if raised then Printf.printf "SUCCESS %s\n" testname else ( Printf.printf "FAILED %s Expected exception\n" testname; err := !err + 1) let archive_to_string (ps, n) = let pres = List.map (fun p -> Meta.Predicate.to_string p) ps in Printf.sprintf "archive(%s) = [%s]" (String.concat "," pres) n let archives_to_string l = String.concat "\n" (List.map (fun a -> archive_to_string a) l) let () = (* --- Original tests --- *) let meta_unix = "requires = \"\"\n" ^ "description = \"Unix system calls\"\n" ^ "version = \"[distributed with Ocaml]\"\n" ^ "directory = \"^\"\n" ^ "browse_interfaces = \" Unit name: Unix Unit name: UnixLabels \"\n" ^ "archive(byte) = \"unix.cma\"\n" ^ "archive(native) = \"unix.cmxa\"\n" ^ "archive(byte,mt_vm) = \"vmthreads/unix.cma\"\n" in let unix = Meta.parse (Filepath.fp "unix") meta_unix "unix" in let unix_answer = Meta.Pkg.get_archive_with_filter (Filepath.fp "unix", unix) (Libname.of_string "unix") [ Meta.Predicate.Byte; Meta.Predicate.Gprof; Meta.Predicate.Mt ] in assumeEq "unix description" "Unix system calls" unix.Meta.Pkg.description; assumeEq "unix byte" "archive(byte) = [unix.cma]" (archives_to_string unix_answer); let meta_netstring = "version = \"4.0.2\"\n" ^ "requires = \"str unix netsys \"\n" ^ "description = \"Ocamlnet - String processing library\"\n" ^ "\n" ^ "archive(byte) = \n" ^ " \"netstring.cma\"\n" ^ "archive(byte,toploop) = \n" ^ " \"netstring.cma netstring_top.cmo\"\n" ^ "archive(native) = \n" ^ " \"netstring.cmxa\"\n" ^ "archive(native,gprof) = \n" ^ " \"netstring.p.cmxa\"\n" ^ "archive(byte,-nonetaccel) +=\n" ^ " \"netaccel.cma netaccel_link.cmo\"" in let netstring = Meta.parse (Filepath.fp "netstring") meta_netstring "netstring" in assumeEq "netstring description" "Ocamlnet - String processing library" netstring.Meta.Pkg.description; let netstring_byte = Meta.Pkg.get_archive_with_filter (Filepath.fp "netstring", netstring) (Libname.of_string "netstring") [ Meta.Predicate.Byte ] in assumeEq "netstring byte" "archive(byte) = [netstring.cma]\narchive(byte,-nonetaccel) = [netaccel.cma netaccel_link.cmo]" (archives_to_string netstring_byte); let netstring_byte_nonetaccel = Meta.Pkg.get_archive_with_filter (Filepath.fp "netstring", netstring) (Libname.of_string "netstring") [ Meta.Predicate.Byte; Meta.Predicate.Unknown "nonetaccel" ] in assumeEq "netstring byte nonetaccel" "archive(byte) = [netstring.cma]" (archives_to_string netstring_byte_nonetaccel); let meta_num = "# Specification for the \"num\" library:\n\ requires = \"num.core\"\n\ requires(toploop) = \"num.core,num-top\"\n\ version = \"[distributed with Ocaml]\"\n\ description = \"Arbitrary-precision rational arithmetic\"\n\ package \"core\" (\n\ \ directory = \"^\"\n\ \ version = \"[internal]\"\n\ \ browse_interfaces = \" Unit name: Arith_flags Unit name: Arith_status Unit name: Big_int \ Unit name: Int_misc Unit name: Nat Unit name: Num Unit name: Ratio \"\n\ \ archive(byte) = \"nums.cma\"\n\ \ archive(native) = \"nums.cmxa\"\n\ \ plugin(byte) = \"nums.cma\"\n\ \ plugin(native) = \"nums.cmxs\"\n\ )\n" in let num = Meta.parse (Filepath.fp "num") meta_num "num" in let num_answer = Meta.Pkg.get_archive_with_filter (Filepath.fp "num", num) (Libname.of_string "num.core") [ Meta.Predicate.Native; Meta.Predicate.Plugin ] in assumeEq "num plugin native" "archive(plugin,native) = [nums.cmxs]" (archives_to_string num_answer); let meta_threads = "# Specifications for the \"threads\" library:\n\ version = \"[distributed with Ocaml]\"\n\ description = \"Multi-threading\"\n\ requires(mt,mt_vm) = \"threads.vm\"\n\ requires(mt,mt_posix) = \"threads.posix\"\n\ directory = \"^\"\n\ type_of_threads = \"posix\"\n\n\ browse_interfaces = \" Unit name: Condition Unit name: Event Unit name: Mutex Unit name: \ Thread Unit name: ThreadUnix \"\n\n\ warning(-mt) = \"Linking problems may arise because of the missing -thread or -vmthread \ switch\"\n\ warning(-mt_vm,-mt_posix) = \"Linking problems may arise because of the missing -thread or \ -vmthread switch\"\n\n\ package \"vm\" (\n\ \ # --- Bytecode-only threads:\n\ \ requires = \"unix\"\n\ \ directory = \"+vmthreads\"\n\ \ exists_if = \"threads.cma\"\n\ \ archive(byte,mt,mt_vm) = \"threads.cma\"\n\ \ version = \"[internal]\"\n\ )\n\n\ package \"posix\" (\n\ \ # --- POSIX-threads:\n\ \ requires = \"unix\"\n\ \ directory = \"+threads\"\n\ \ exists_if = \"threads.cma\"\n\ \ archive(byte,mt,mt_posix) = \"threads.cma\"\n\ \ archive(native,mt,mt_posix) = \"threads.cmxa\"\n\ \ version = \"[internal]\"\n\ )\n" in let threads = Meta.parse (Filepath.fp "threads") meta_threads "threads" in let threads_answer = Meta.Pkg.get_archive_with_filter (Filepath.fp "threads", threads) (Libname.of_string "threads.posix") [ Meta.Predicate.Native; Meta.Predicate.Mt; Meta.Predicate.Mt_posix ] in assumeEq "threads native" "archive(native,mt,mt_posix) = [threads.cmxa]" (archives_to_string threads_answer); let meta_ctypes = "version = \"0.4\"\n\ description = \"Combinators for binding to C libraries without writing any C.\"\n\ requires = \"unix bigarray str bytes\"\n\ archive(byte) = \"ctypes.cma\"\n\ archive(byte, plugin) = \"ctypes.cma\"\n\ archive(native) = \"ctypes.cmxa\"\n\ archive(native, plugin) = \"ctypes.cmxs\"\n\ exists_if = \"ctypes.cma\"\n\n\ package \"top\" (\n\ \ version = \"0.4\"\n\ \ description = \"Toplevel printers for C types\"\n\ \ requires = \"ctypes\"\n\ \ archive(byte) = \"ctypes-top.cma\"\n\ \ archive(byte, plugin) = \"ctypes-top.cma\"\n\ \ archive(native) = \"ctypes-top.cmxa\"\n\ \ archive(native, plugin) = \"ctypes-top.cmxs\"\n\ \ exists_if = \"ctypes-top.cma\"\n\ )\n\n\ package \"stubs\" (\n\ \ version = \"0.4\"\n\ \ description = \"Stub generation from C types\"\n\ \ requires = \"ctypes\"\n\ \ archive(byte) = \"cstubs.cma\"\n\ \ archive(byte, plugin) = \"cstubs.cma\"\n\ \ archive(native) = \"cstubs.cmxa\"\n\ \ archive(native, plugin) = \"cstubs.cmxs\"\n\ \ xen_linkopts = \"-lctypes_stubs_xen\"\n\ \ exists_if = \"cstubs.cma\"\n\ )\n\n\ package \"foreign\" (\n\ \ version = \"0.4\"\n\ \ description = \"Dynamic linking of C functions\"\n\ \ requires(-mt) = \"ctypes.foreign.unthreaded\"\n\ \ requires(mt) = \"ctypes.foreign.threaded\"\n\n\ \ package \"base\" (\n\ \ version = \"0.4\"\n\ \ description = \"Dynamic linking of C functions (base package)\"\n\ \ requires = \"ctypes\"\n\ \ archive(byte) = \"ctypes-foreign-base.cma\"\n\ \ archive(byte, plugin) = \"ctypes-foreign-base.cma\"\n\ \ archive(native) = \"ctypes-foreign-base.cmxa\"\n\ \ archive(native, plugin) = \"ctypes-foreign-base.cmxs\"\n\ \ exists_if = \"ctypes-foreign-base.cma\"\n\ \ )\n\n\ \ package \"threaded\" (\n\ \ version = \"0.4\"\n\ \ description = \"Dynamic linking of C functions (for use in threaded programs)\"\n\ \ requires = \"threads ctypes ctypes.foreign.base\"\n\ \ archive(byte) = \"ctypes-foreign-threaded.cma\"\n\ \ archive(byte, plugin) = \"ctypes-foreign-threaded.cma\"\n\ \ archive(native) = \"ctypes-foreign-threaded.cmxa\"\n\ \ archive(native, plugin) = \"ctypes-foreign-threaded.cmxs\"\n\ \ exists_if = \"ctypes-foreign-threaded.cma\"\n\ \ )\n\n\ \ package \"unthreaded\" (\n\ \ version = \"0.4\"\n\ \ description = \"Dynamic linking of C functions (for use in unthreaded programs)\"\n\ \ requires = \"ctypes ctypes.foreign.base\"\n\ \ archive(byte) = \"ctypes-foreign-unthreaded.cma\"\n\ \ archive(byte, plugin) = \"ctypes-foreign-unthreaded.cma\"\n\ \ archive(native) = \"ctypes-foreign-unthreaded.cmxa\"\n\ \ archive(native, plugin) = \"ctypes-foreign-unthreaded.cmxs\"\n\ \ exists_if = \"ctypes-foreign-unthreaded.cma\"\n\ \ )\n\ )\n" in let _ctypes = Meta.parse (Filepath.fp "ctypes") meta_ctypes "ctypes" in (* --- New tests: version field extraction --- *) assumeEq "unix version" "[distributed with Ocaml]" unix.Meta.Pkg.version; assumeEq "netstring version" "4.0.2" netstring.Meta.Pkg.version; (* --- New tests: requires field parsing --- *) let requires_to_string reqs = String.concat "; " (List.map (fun (_, libs) -> String.concat " " (List.map Libname.to_string libs) ) reqs) in assumeEq "netstring requires" "netsys unix str" (requires_to_string netstring.Meta.Pkg.requires); (* --- New tests: subpackage navigation --- *) let num_core = Meta.Pkg.find ["core"] num in assumeEq "num.core version" "[internal]" num_core.Meta.Pkg.version; let threads_posix = Meta.Pkg.find ["posix"] threads in assumeEq "threads.posix requires" "unix" (requires_to_string threads_posix.Meta.Pkg.requires); (* --- New tests: deep subpackage navigation --- *) let ctypes = Meta.parse (Filepath.fp "ctypes") meta_ctypes "ctypes" in let ctypes_foreign_base = Meta.Pkg.find ["foreign"; "base"] ctypes in assumeEq "ctypes.foreign.base description" "Dynamic linking of C functions (base package)" ctypes_foreign_base.Meta.Pkg.description; let ctypes_stubs = Meta.Pkg.find ["stubs"] ctypes in assumeEq "ctypes.stubs description" "Stub generation from C types" ctypes_stubs.Meta.Pkg.description; (* --- New tests: archive selection with multiple predicates --- *) let ctypes_native = Meta.Pkg.get_archive_with_filter (Filepath.fp "ctypes", ctypes) (Libname.of_string "ctypes") [ Meta.Predicate.Native ] in assumeEq "ctypes native archive" "archive(native) = [ctypes.cmxa]" (archives_to_string ctypes_native); let ctypes_native_plugin = Meta.Pkg.get_archive_with_filter (Filepath.fp "ctypes", ctypes) (Libname.of_string "ctypes") [ Meta.Predicate.Native; Meta.Predicate.Plugin ] in assumeEq "ctypes native plugin archive" "archive(native,plugin) = [ctypes.cmxs]" (archives_to_string ctypes_native_plugin); (* --- New tests: empty META fields --- *) let meta_minimal = "version = \"1.0\"\n\ description = \"\"\n" in let minimal = Meta.parse (Filepath.fp "minimal") meta_minimal "minimal" in assumeEq "minimal version" "1.0" minimal.Meta.Pkg.version; assumeEq "minimal empty description" "" minimal.Meta.Pkg.description; (* --- New tests: META with comments --- *) let meta_comments = "# This is a comment\n\ version = \"2.0\"\n\ # Another comment\n\ description = \"Test package\"\n" in let comments_pkg = Meta.parse (Filepath.fp "comments") meta_comments "comments" in assumeEq "comments version" "2.0" comments_pkg.Meta.Pkg.version; assumeEq "comments description" "Test package" comments_pkg.Meta.Pkg.description; (* --- New tests: directory field --- *) assumeEq "unix directory" "^" unix.Meta.Pkg.directory; assumeEq "threads.vm directory" "+vmthreads" (Meta.Pkg.find ["vm"] threads).Meta.Pkg.directory; (* --- New tests: subpackage not found --- *) assumeRaises "subpackage not found" (fun () -> ignore (Meta.Pkg.find ["nonexistent"] unix)); if !err > 0 then exit 1 else exit 0 obuild-0.2.2/tests/test_framework.ml000066400000000000000000000055641515212760700175410ustar00rootroot00000000000000open Printf (* Simple unit test framework *) type test_result = | Success | TestFailure of string type test_case = { name: string; test_func: unit -> test_result; } let test_count = ref 0 let failed_count = ref 0 let failed_tests = ref [] let assert_equal ~expected ~actual ~name = if expected = actual then Success else TestFailure (sprintf "Expected: %s, Got: %s" expected actual) let assert_true ~actual ~name = if actual then Success else TestFailure "Expected true, got false" let assert_false ~actual ~name = if actual then TestFailure "Expected false, got true" else Success let assert_raises ~expected_exn ~test_func ~name = try let _ = test_func () in TestFailure (sprintf "Expected exception %s, but no exception was raised" (Printexc.to_string expected_exn)) with | exn when exn = expected_exn -> Success | exn -> TestFailure (sprintf "Expected exception %s, got %s" (Printexc.to_string expected_exn) (Printexc.to_string exn)) let assert_string_contains ~haystack ~needle ~name = try let _ = Str.search_forward (Str.regexp_string needle) haystack 0 in Success with Not_found -> TestFailure (sprintf "Expected string to contain '%s', but it didn't.\nActual: %s" needle haystack) let assert_no_exception ~test_func ~name = try let _ = test_func () in Success with exn -> TestFailure (sprintf "Expected no exception, but got: %s" (Printexc.to_string exn)) let assert_exception_message ~test_func ~expected_substring ~name = try let _ = test_func () in TestFailure "Expected exception to be raised, but no exception was raised" with exn -> let msg = Printexc.to_string exn in try let _ = Str.search_forward (Str.regexp_string expected_substring) msg 0 in Success with Not_found -> TestFailure (sprintf "Expected exception message to contain '%s', but got: %s" expected_substring msg) let run_test test_case = incr test_count; printf "Running test: %s... " test_case.name; flush stdout; try match test_case.test_func () with | Success -> printf "PASS\n" | TestFailure msg -> printf "FAIL: %s\n" msg; incr failed_count; failed_tests := test_case.name :: !failed_tests with | exn -> printf "ERROR: %s\n" (Printexc.to_string exn); incr failed_count; failed_tests := test_case.name :: !failed_tests let run_tests tests = printf "Running %d tests...\n\n" (List.length tests); List.iter run_test tests; printf "\n"; if !failed_count = 0 then begin printf "All %d tests passed!\n" !test_count; exit 0 end else begin printf "%d of %d tests failed:\n" !failed_count !test_count; List.iter (printf " - %s\n") (List.rev !failed_tests); exit 1 end let make_test name test_func = { name; test_func }obuild-0.2.2/tests/test_framework_demo.ml000066400000000000000000000041761515212760700205430ustar00rootroot00000000000000open Test_framework open Test_helpers (** Demo tests showing the new test framework capabilities *) let test_string_contains_success () = assert_string_contains ~haystack:"Hello, World!" ~needle:"World" ~name:"string contains" let test_string_contains_failure () = let result = assert_string_contains ~haystack:"Hello, World!" ~needle:"Missing" ~name:"string missing" in match result with | TestFailure _ -> Success (* We expect this to fail *) | Success -> TestFailure "Should have failed" let test_no_exception_success () = assert_no_exception ~test_func:(fun () -> 1 + 1) ~name:"simple math" let test_exception_message () = assert_exception_message ~test_func:(fun () -> failwith "custom error message") ~expected_substring:"custom error" ~name:"exception contains message" let test_meta_parse_minimal () = assert_meta_parses ~content:minimal_meta ~name:"minimal meta parses" let test_meta_parse_field () = assert_meta_field ~content:minimal_meta ~pkg_name:"test" ~field_name:"version" ~expected_value:"1.0.0" ~test_name:"meta version field" let test_meta_parse_error_demo () = assert_meta_parse_error ~content:"archive(byte \"missing equals\"" ~expected_msg:"expecting ')'" ~name:"meta parse error" let test_expr_parse_demo () = assert_expr_parses ~content:"(>= 1.0)" ~name:"expr parses" let test_libname_parse_demo () = assert_libname_parse ~input:"foo.bar.baz" ~expected_main:"foo" ~expected_subs:["bar"; "baz"] ~name:"libname parse" let all_tests = [ make_test "string_contains_success" test_string_contains_success; make_test "string_contains_failure" test_string_contains_failure; make_test "no_exception_success" test_no_exception_success; make_test "exception_message" test_exception_message; make_test "meta_parse_minimal" test_meta_parse_minimal; make_test "meta_parse_field" test_meta_parse_field; make_test "meta_parse_error_demo" test_meta_parse_error_demo; make_test "expr_parse_demo" test_expr_parse_demo; make_test "libname_parse_demo" test_libname_parse_demo; ] let () = run_tests all_tests obuild-0.2.2/tests/test_generators.ml000066400000000000000000000171461515212760700177140ustar00rootroot00000000000000let err = ref 0 let test_count = ref 0 let assumeEq testname expected got = incr test_count; if expected = got then Printf.printf "SUCCESS %s\n" testname else ( Printf.printf "FAILED %s Expected %s Got %s\n" testname expected got; err := !err + 1) let assumeTrue testname v = incr test_count; if v then Printf.printf "SUCCESS %s\n" testname else ( Printf.printf "FAILED %s Expected true Got false\n" testname; err := !err + 1) let assumeRaises testname f = incr test_count; let raised = (try f (); false with _ -> true) in if raised then Printf.printf "SUCCESS %s\n" testname else ( Printf.printf "FAILED %s Expected exception\n" testname; err := !err + 1) let () = (* Clean state before each run *) Generators.clear_custom_generators (); (* --- substitute_variables tests --- *) let src = Filepath.fp "src/parser.mly" in let dest = Filepath.fp "dist/build/lib/parser" in let result = Generators.substitute_variables ~src ~dest ~sources:[src] "${src}" in assumeEq "subst src" "src/parser.mly" result; let result = Generators.substitute_variables ~src ~dest ~sources:[src] "${dest}" in assumeEq "subst dest" "dist/build/lib/parser" result; let result = Generators.substitute_variables ~src ~dest ~sources:[src] "${base}" in assumeEq "subst base" "parser" result; let result = Generators.substitute_variables ~src ~dest ~sources:[src] "${srcdir}" in assumeEq "subst srcdir" "src" result; let result = Generators.substitute_variables ~src ~dest ~sources:[src] "${destdir}" in assumeEq "subst destdir" "dist/build/lib" result; let result = Generators.substitute_variables ~src ~dest ~sources:[src; Filepath.fp "src/tokens.mly"] "${sources}" in assumeEq "subst sources" "src/parser.mly src/tokens.mly" result; (* Multiple variables in one string *) let result = Generators.substitute_variables ~src ~dest ~sources:[src] "menhir --base ${dest} ${src}" in assumeEq "subst multiple" "menhir --base dist/build/lib/parser src/parser.mly" result; (* No variables *) let result = Generators.substitute_variables ~src ~dest ~sources:[src] "echo hello" in assumeEq "subst no vars" "echo hello" result; (* Repeated variable *) let result = Generators.substitute_variables ~src ~dest ~sources:[src] "${base}-${base}" in assumeEq "subst repeated" "parser-parser" result; (* --- substitute_output_pattern tests --- *) let result = Generators.substitute_output_pattern ~src:(Filepath.fp "parser.mly") "${base}.ml" in assumeEq "output pattern ml" "parser.ml" result; let result = Generators.substitute_output_pattern ~src:(Filepath.fp "parser.mly") "${base}.mli" in assumeEq "output pattern mli" "parser.mli" result; let result = Generators.substitute_output_pattern ~src:(Filepath.fp "lexer.mll") "${base}.ml" in assumeEq "output pattern lexer" "lexer.ml" result; (* No substitution *) let result = Generators.substitute_output_pattern ~src:(Filepath.fp "foo.atd") "version_info.ml" in assumeEq "output pattern literal" "version_info.ml" result; (* --- register_custom / get_all / find_generator_by_name tests --- *) Generators.clear_custom_generators (); let gen_menhir : Generators.custom = { custom_name = "menhir"; custom_suffix = Some "mly"; custom_command = "menhir --base ${dest} ${src}"; custom_outputs = ["${base}.ml"; "${base}.mli"]; custom_module_name = None; } in Generators.register_custom gen_menhir; let gen_lex : Generators.custom = { custom_name = "ocamllex"; custom_suffix = Some "mll"; custom_command = "ocamllex -o ${dest}.ml ${src}"; custom_outputs = ["${base}.ml"]; custom_module_name = None; } in Generators.register_custom gen_lex; let all = Generators.get_all () in assumeEq "get_all count" "2" (string_of_int (List.length all)); (* --- is_generator_ext tests --- *) assumeTrue "is_generator_ext mly" (Generators.is_generator_ext "mly"); assumeTrue "is_generator_ext mll" (Generators.is_generator_ext "mll"); assumeTrue "is_generator_ext unknown" (not (Generators.is_generator_ext "xyz")); assumeTrue "is_generator_ext ml" (not (Generators.is_generator_ext "ml")); (* --- find_generator_by_name tests --- *) (match Generators.find_generator_by_name "menhir" with | Some g -> assumeEq "find_by_name menhir" "menhir" g.Generators.custom_name | None -> Printf.printf "FAILED find_by_name menhir: Expected Some, Got None\n"; incr test_count; err := !err + 1); (match Generators.find_generator_by_name "nonexistent" with | None -> Printf.printf "SUCCESS find_by_name nonexistent\n"; incr test_count | Some _ -> Printf.printf "FAILED find_by_name nonexistent: Expected None, Got Some\n"; incr test_count; err := !err + 1); (* --- Generator without suffix (generate-block-only) --- *) Generators.clear_custom_generators (); let gen_no_suffix : Generators.custom = { custom_name = "embed-version"; custom_suffix = None; custom_command = "echo 'let version = \"1.0\"' > ${dest}.ml"; custom_outputs = ["version_info.ml"]; custom_module_name = Some "version_info"; } in Generators.register_custom gen_no_suffix; (* Generator without suffix should not appear in get_all (auto-detection) *) let all_no_suffix = Generators.get_all () in assumeEq "no suffix not in get_all" "0" (string_of_int (List.length all_no_suffix)); (* But should be findable by name *) (match Generators.find_generator_by_name "embed-version" with | Some _ -> Printf.printf "SUCCESS find no-suffix by name\n"; incr test_count | None -> Printf.printf "FAILED find no-suffix by name: Expected Some, Got None\n"; incr test_count; err := !err + 1); (* --- get_all returns builtin type with correct suffix --- *) Generators.clear_custom_generators (); Generators.register_custom gen_menhir; let builtin = List.hd (Generators.get_all ()) in assumeEq "builtin suffix" "mly" builtin.Generators.suffix; (* modname identity (no custom_module_name) *) let m = Modname.of_string "Parser" in assumeEq "builtin modname identity" "Parser" (Modname.to_string (builtin.Generators.modname m)); (* generated_files from outputs *) let gen_file = builtin.Generators.generated_files (Filepath.fn "parser.mly") "parser" in assumeEq "builtin generated_files" "parser.ml" (Filepath.fn_to_string gen_file); (* --- get_custom_outputs tests --- *) let outputs = Generators.get_custom_outputs gen_menhir ~src:(Filepath.fp "parser.mly") in assumeEq "custom_outputs count" "2" (string_of_int (List.length outputs)); assumeEq "custom_outputs first" "parser.ml" (Filepath.fn_to_string (List.hd outputs)); assumeEq "custom_outputs second" "parser.mli" (Filepath.fn_to_string (List.nth outputs 1)); (* --- clear_custom_generators test --- *) Generators.register_custom gen_menhir; Generators.register_custom gen_lex; Generators.clear_custom_generators (); let all_after_clear = Generators.get_all () in assumeEq "clear generators" "0" (string_of_int (List.length all_after_clear)); (* --- get_generator raises on unknown extension --- *) Generators.clear_custom_generators (); assumeRaises "get_generator not found" (fun () -> ignore (Generators.get_generator (Filepath.fp "foo.xyz"))); (* --- register_customs (batch registration) --- *) Generators.clear_custom_generators (); Generators.register_customs [gen_menhir; gen_lex]; let all_batch = Generators.get_all () in assumeEq "register_customs count" "2" (string_of_int (List.length all_batch)); (* --- Summary --- *) Printf.printf "\n%d tests run, %d failures\n" !test_count !err; if !err > 0 then exit 1 else exit 0 obuild-0.2.2/tests/test_helpers.ml000066400000000000000000000140501515212760700171740ustar00rootroot00000000000000open Test_framework open Printf (** Test helpers for parser testing *) (** {1 META Parser Helpers} *) let parse_meta_string content name = Meta.parse (Filepath.fp name) content name let assert_meta_parses ~content ~name = try let _ = parse_meta_string content name in Success with exn -> TestFailure (sprintf "META parsing failed: %s\nInput:\n%s" (Printexc.to_string exn) content) let assert_meta_parse_error ~content ~expected_msg ~name = try let _ = parse_meta_string content name in TestFailure (sprintf "Expected META parse error, but parsing succeeded.\nInput:\n%s" content) with | Meta.MetaParseError (_, msg) -> assert_string_contains ~haystack:msg ~needle:expected_msg ~name | exn -> TestFailure (sprintf "Expected MetaParseError containing '%s', got: %s" expected_msg (Printexc.to_string exn)) let assert_meta_field ~content ~pkg_name ~field_name ~expected_value ~test_name = try let pkg = parse_meta_string content pkg_name in let actual = match field_name with | "version" -> pkg.Meta.Pkg.version | "description" -> pkg.Meta.Pkg.description | "directory" -> pkg.Meta.Pkg.directory | _ -> failwith ("Unknown field: " ^ field_name) in assert_equal ~expected:expected_value ~actual ~name:test_name with exn -> TestFailure (sprintf "Failed to get field '%s': %s" field_name (Printexc.to_string exn)) (** {1 Expression Parser Helpers} *) let parse_expr_string name expr_str = Expr.parse name expr_str let assert_expr_parses ~content ~name = try let _ = parse_expr_string name content in Success with exn -> TestFailure (sprintf "Expression parsing failed: %s\nInput: %s" (Printexc.to_string exn) content) let assert_expr_parse_error ~content ~expected_msg ~name = try let _ = parse_expr_string name content in TestFailure (sprintf "Expected expression parse error, but parsing succeeded.\nInput: %s" content) with | Expr.CannotParseConstraints (_, msg) -> assert_string_contains ~haystack:msg ~needle:expected_msg ~name | exn -> TestFailure (sprintf "Expected CannotParseConstraints containing '%s', got: %s" expected_msg (Printexc.to_string exn)) let assert_expr_eval ~expr ~version ~expected ~name = match expr with | None -> if expected then Success else TestFailure "Expression is None but expected to evaluate to false" | Some e -> let actual = Expr.eval version e in if actual = expected then Success else TestFailure (sprintf "Expected %b, got %b for version %s" expected actual version) (** {1 Project Parser Helpers} *) (* Note: Project parser needs special handling because it reads from files. We'll create temporary files for testing. *) let with_temp_project_file content test_func = (* Use a unique temp directory so findPath() sees exactly one .obuild file *) let temp_base = Filename.temp_file "test_project_dir" "" in Sys.remove temp_base; Unix.mkdir temp_base 0o700; let temp_file = Filename.concat temp_base "test.obuild" in let old_dir = Sys.getcwd () in try let oc = open_out temp_file in output_string oc content; close_out oc; Sys.chdir temp_base; let result = test_func () in Sys.chdir old_dir; Sys.remove temp_file; Unix.rmdir temp_base; result with exn -> (try Sys.chdir old_dir with _ -> ()); (try Sys.remove temp_file with _ -> ()); (try Unix.rmdir temp_base with _ -> ()); raise exn let assert_project_parses ~content ~name = try with_temp_project_file content (fun () -> let _ = Project_read.read () in Success) with exn -> TestFailure (sprintf "Project parsing failed: %s\nInput:\n%s" (Printexc.to_string exn) content) let assert_project_parse_error ~content ~expected_msg ~name = try with_temp_project_file content (fun () -> let _ = Project_read.read () in TestFailure (sprintf "Expected project parse error, but parsing succeeded.\nInput:\n%s" content)) with | Project.MissingField field -> assert_string_contains ~haystack:("Missing field: " ^ field) ~needle:expected_msg ~name | Project.InvalidConfFile msg -> assert_string_contains ~haystack:msg ~needle:expected_msg ~name | Project.BlockSectionAsValue field -> assert_string_contains ~haystack:("Block section as value: " ^ field) ~needle:expected_msg ~name | exn -> let msg = Printexc.to_string exn in assert_string_contains ~haystack:msg ~needle:expected_msg ~name (** {1 Libname Helpers} *) let assert_libname_parse ~input ~expected_main ~expected_subs ~name = try let libname = Libname.of_string input in let main_ok = libname.Libname.main_name = expected_main in let subs_ok = libname.Libname.subnames = expected_subs in if main_ok && subs_ok then Success else TestFailure (sprintf "Libname parse mismatch.\nExpected: %s.%s\nGot: %s.%s" expected_main (String.concat "." expected_subs) libname.Libname.main_name (String.concat "." libname.Libname.subnames)) with exn -> TestFailure (sprintf "Libname parsing failed: %s" (Printexc.to_string exn)) (** {1 Common Test Data} *) (** Minimal valid META file *) let minimal_meta = "\ version = \"1.0.0\"\n\ description = \"Test package\"\n" (** Minimal valid .obuild file *) let minimal_project = "\ name: test\n\ version: 1.0.0\n\ obuild-ver: 1\n" (** Complete example META file *) let example_meta = "\ version = \"2.0.0\"\n\ description = \"Example package with all features\"\n\ requires = \"unix, str\"\n\ directory = \"^\"\n\ archive(byte) = \"example.cma\"\n\ archive(native) = \"example.cmxa\"\n\ archive(byte,mt) = \"example_mt.cma\"\n\ package \"sub\" (\n\ description = \"Subpackage\"\n\ archive(byte) = \"sub.cma\"\n\ )\n" (** Complete example .obuild file *) let example_project = "name = example\nversion = 2.0.0\nobuild-ver = 1\nsynopsis = \"An example project\"\ndescription = \"This is a complete example project\"\n\nlibrary mylib\n modules: Foo, Bar\n build-deps: unix\n\nexecutable myexe\n main-is: main.ml\n build-deps: mylib\n" obuild-0.2.2/tests/test_meta.ml000066400000000000000000000273131515212760700164660ustar00rootroot00000000000000open Test_framework open Printf (* Helper functions *) let parse_meta_string content name = Meta.parse (Filepath.fp name) content name let archive_to_string (preds, archive) = let pred_strs = List.map Meta.Predicate.to_string preds in sprintf "archive(%s) = %s" (String.concat "," pred_strs) archive let archives_to_string archives = String.concat "; " (List.map archive_to_string archives) (* Compat helpers for old OCaml *) let list_find_opt pred lst = try Some (List.find pred lst) with Not_found -> None (* Easy test cases *) let test_basic_meta () = let content = "\ version = \"1.0.0\"\n\ description = \"A simple package\"\n\ requires = \"unix\"\n\ archive(byte) = \"simple.cma\"\n\ archive(native) = \"simple.cmxa\"\n" in let pkg = parse_meta_string content "simple" in let tests = [ assert_equal ~expected:"1.0.0" ~actual:pkg.Meta.Pkg.version ~name:"version"; assert_equal ~expected:"A simple package" ~actual:pkg.Meta.Pkg.description ~name:"description"; ] in match list_find_opt (function | TestFailure _ -> true | Success -> false) tests with | Some (TestFailure msg) -> TestFailure msg | _ -> Success let test_empty_fields () = let content = "\ version = \"\"\n\ description = \"\"\n\ requires = \"\"\n" in let pkg = parse_meta_string content "empty" in assert_equal ~expected:"" ~actual:pkg.Meta.Pkg.version ~name:"empty version" let test_simple_archive () = let content = "\ archive(byte) = \"test.cma\"\n\ archive(native) = \"test.cmxa\"\n" in let pkg = parse_meta_string content "test" in let has_byte = List.exists (fun (preds, _) -> List.mem Meta.Predicate.Byte preds) pkg.Meta.Pkg.archives in let has_native = List.exists (fun (preds, _) -> List.mem Meta.Predicate.Native preds) pkg.Meta.Pkg.archives in if has_byte && has_native then Success else TestFailure "Missing byte or native archives" let test_basic_package () = let content = "\ version = \"1.0\"\n\ package \"sub\" (\n\ description = \"Subpackage\"\n\ archive(byte) = \"sub.cma\"\n\ )\n" in let pkg = parse_meta_string content "parent" in match pkg.Meta.Pkg.subs with | [ sub ] -> assert_equal ~expected:"Subpackage" ~actual:sub.Meta.Pkg.description ~name:"subpackage description" | _ -> TestFailure "Expected exactly one subpackage" (* Difficult test cases *) let test_multiline_values () = let content = "\ requires =\n\ \"unix\n\ str \n\ bigarray\"\n\ description = \"Multi\n\ line\n\ description\"\n" in try let _pkg = parse_meta_string content "multiline" in (* If parsing succeeds, check if requires were parsed *) Success with | Meta.MetaParseError _ -> TestFailure "Failed to parse multiline values (expected to fail with current parser)" | _ -> TestFailure "Unexpected error parsing multiline values" let test_negated_predicates () = let content = "\ requires(-mt) = \"single_threaded_lib\"\n\ requires(mt) = \"threaded_lib\"\n\ archive(byte,-debug) = \"release.cma\"\n\ archive(byte,debug) = \"debug.cma\"\n" in try let _pkg = parse_meta_string content "negated" in Success with | Meta.MetaParseError (_, msg) -> TestFailure ("Negated predicates failed: " ^ msg) | exn -> TestFailure ("Unexpected error: " ^ Printexc.to_string exn) let test_unknown_fields () = let content = "\ version = \"1.0\"\n\ library_kind = \"ppx_rewriter\"\n\ custom_field = \"custom_value\"\n\ xen_linkopts = \"-lxen\"\n\ browse_interfaces = \"Unit name: Test\"\n" in try let pkg = parse_meta_string content "unknown" in (* Check that unknown fields were stored in assignments *) let has_library_kind = List.exists (fun (field, _) -> field = "library_kind") pkg.Meta.Pkg.assignment in let has_custom_field = List.exists (fun (field, _) -> field = "custom_field") pkg.Meta.Pkg.assignment in if has_library_kind || has_custom_field then Success else TestFailure "Unknown fields not stored in assignments" with | Meta.MetaParseError (_, msg) -> TestFailure ("Unknown fields failed: " ^ msg) | exn -> TestFailure ("Unexpected error: " ^ Printexc.to_string exn) let test_complex_predicates () = let content = "\ archive(byte,mt,mt_posix) = \"threads_posix.cma\"\n\ archive(native,mt,mt_vm) = \"threads_vm.cmxa\"\n\ requires(ppx_driver,byte) = \"ppx_lib\"\n\ warning(-mt,-debug) = \"Missing thread support\"\n" in try let _pkg = parse_meta_string content "complex" in Success with | Meta.MetaParseError (_, msg) -> TestFailure ("Complex predicates failed: " ^ msg) | exn -> TestFailure ("Unexpected error: " ^ Printexc.to_string exn) let test_plugin_syntax () = let content = "\ plugin(byte) = \"test.cma\"\n\ plugin(native) = \"test.cmxs\"\n\ archive(byte,plugin) = \"test_plugin.cma\"\n" in try let _pkg = parse_meta_string content "plugin" in Success with | Meta.MetaParseError (_, msg) -> TestFailure ("Plugin syntax failed: " ^ msg) | exn -> TestFailure ("Unexpected error: " ^ Printexc.to_string exn) let test_ppx_syntax () = let content = "\ ppx(-ppx_driver,-custom_ppx) = \"./ppx.exe --as-ppx\"\n\ ppx(ppx_driver) = \"ppx_driver.exe\"\n\ ppxopt(-ppx_driver) = \"-package deriving\"\n" in try let _pkg = parse_meta_string content "ppx" in Success with | Meta.MetaParseError (_, msg) -> TestFailure ("PPX syntax failed: " ^ msg) | exn -> TestFailure ("Unexpected error: " ^ Printexc.to_string exn) let test_nested_packages () = let content = "\ version = \"1.0\"\n\ package \"level1\" (\n\ version = \"1.1\"\n\ package \"level2\" (\n\ version = \"1.2\"\n\ archive(byte) = \"deep.cma\"\n\ package \"level3\" (\n\ description = \"Deep nesting\"\n\ )\n\ )\n\ )\n" in try let pkg = parse_meta_string content "nested" in (* Navigate to level3 package *) match pkg.Meta.Pkg.subs with | [ level1 ] -> ( match level1.Meta.Pkg.subs with | [ level2 ] -> ( match level2.Meta.Pkg.subs with | [ level3 ] -> assert_equal ~expected:"Deep nesting" ~actual:level3.Meta.Pkg.description ~name:"nested package" | _ -> TestFailure "Expected level3 package") | _ -> TestFailure "Expected level2 package") | _ -> TestFailure "Expected level1 package" with | Meta.MetaParseError (_, msg) -> TestFailure ("Nested packages failed: " ^ msg) | exn -> TestFailure ("Unexpected error: " ^ Printexc.to_string exn) (* Edge cases that should break current parser *) let test_append_operator () = let content = "\ archive(byte) = \"base.cma\"\n\ archive(byte) += \"extra.cma\"\n\ requires = \"unix\"\n\ requires += \"str\"\n" in try let pkg = parse_meta_string content "append" in (* Check if append archives were created *) let has_append = List.length pkg.Meta.Pkg.append_archives > 0 in if has_append then Success else TestFailure "Append operator not working correctly" with | Meta.MetaParseError (_, msg) -> TestFailure ("Append operator failed: " ^ msg) | exn -> TestFailure ("Unexpected error: " ^ Printexc.to_string exn) let test_comments_and_whitespace () = let content = "\ # This is a comment\n\ version = \"1.0\" # End of line comment\n\ \n\ # Empty lines and spacing\n\ description = \"Test\"\n\ \n\ # Indented comment\n\ archive(byte) = \"test.cma\"\n" in try let pkg = parse_meta_string content "comments" in assert_equal ~expected:"1.0" ~actual:pkg.Meta.Pkg.version ~name:"version with comments" with | Meta.MetaParseError (_, msg) -> TestFailure ("Comments failed: " ^ msg) | exn -> TestFailure ("Unexpected error: " ^ Printexc.to_string exn) let test_real_world_ppxlib () = (* Based on actual ppxlib META file *) let content = "\ version = \"0.36.0\"\n\ description = \"\"\n\ requires =\n\ \"compiler-libs.common\n\ ocaml-compiler-libs.shadow\n\ ppx_derivers\"\n\ archive(byte) = \"ppxlib.cma\"\n\ archive(native) = \"ppxlib.cmxa\"\n\ plugin(byte) = \"ppxlib.cma\"\n\ plugin(native) = \"ppxlib.cmxs\"\n" in try let _pkg = parse_meta_string content "ppxlib" in Success with | Meta.MetaParseError (_, msg) -> TestFailure ("Real ppxlib META failed: " ^ msg) | exn -> TestFailure ("Unexpected error: " ^ Printexc.to_string exn) let test_malformed_syntax () = let content = "\ version = \"1.0\"\n\ broken_field_no_value =\n\ archive(byte) =\n\ requires = unix str\n" in (* This should fail to parse *) try let _ = parse_meta_string content "malformed" in TestFailure "Expected malformed syntax to fail, but it succeeded" with | Meta.MetaParseError _ -> Success | exn -> TestFailure ("Expected MetaParseError, got: " ^ Printexc.to_string exn) let test_libname_parsing () = let libname_str = "ppx_stable_witness.stable_witness" in let libname = Libname.of_string libname_str in printf "Testing libname: %s\n" libname_str; printf " main_name: %s\n" libname.Libname.main_name; printf " subnames: [%s]\n" (String.concat "; " libname.Libname.subnames); printf " full string: %s\n" (Libname.to_string libname); if libname.Libname.main_name = "ppx_stable_witness" && libname.Libname.subnames = [ "stable_witness" ] then Success else TestFailure "Libname parsing incorrect" let test_ppx_stable_witness_findlib () = FindlibConf.load (); try let path, pkg = Meta.find_lib "ppx_stable_witness" in let stable_witness_libname = Libname.of_string "ppx_stable_witness.stable_witness" in let resolved_pkg = Meta.Pkg.find stable_witness_libname.Libname.subnames pkg in if resolved_pkg.Meta.Pkg.name = "stable_witness" then Success else TestFailure ("Expected stable_witness package, got: " ^ resolved_pkg.Meta.Pkg.name) with | Meta.LibraryNotFound name -> TestFailure ("LibraryNotFound: " ^ name) | exn -> TestFailure ("Unexpected error: " ^ Printexc.to_string exn) let test_metacache_consistency () = FindlibConf.load (); try (* First populate cache using Metacache.get *) let libname = Libname.of_string "ppx_stable_witness.stable_witness" in let _, cached_meta = Metacache.get libname.Libname.main_name in (* Then try to get subpackage *) let cached_pkg = Meta.Pkg.find libname.Libname.subnames cached_meta in if cached_pkg.Meta.Pkg.name = "stable_witness" then Success else TestFailure ("Expected stable_witness from cache, got: " ^ cached_pkg.Meta.Pkg.name) with | Meta.LibraryNotFound name -> TestFailure ("LibraryNotFound in cache test: " ^ name) | Dependencies.DependencyMissing name -> TestFailure ("DependencyMissing in cache test: " ^ name) | exn -> TestFailure ("Cache test error: " ^ Printexc.to_string exn) (* Test suite *) let all_tests = [ (* Easy cases *) make_test "basic_meta" test_basic_meta; make_test "empty_fields" test_empty_fields; make_test "simple_archive" test_simple_archive; make_test "basic_package" test_basic_package; (* Difficult cases *) make_test "multiline_values" test_multiline_values; make_test "negated_predicates" test_negated_predicates; make_test "unknown_fields" test_unknown_fields; make_test "complex_predicates" test_complex_predicates; make_test "plugin_syntax" test_plugin_syntax; make_test "ppx_syntax" test_ppx_syntax; make_test "nested_packages" test_nested_packages; (* Edge cases *) make_test "append_operator" test_append_operator; make_test "comments_and_whitespace" test_comments_and_whitespace; make_test "real_world_ppxlib" test_real_world_ppxlib; make_test "malformed_syntax" test_malformed_syntax; (* Real library resolution *) make_test "libname_parsing" test_libname_parsing; make_test "ppx_stable_witness_findlib" test_ppx_stable_witness_findlib; make_test "metacache_consistency" test_metacache_consistency; ] let () = run_tests all_tests obuild-0.2.2/tests/test_meta_errors.ml000066400000000000000000000252161515212760700200620ustar00rootroot00000000000000open Test_framework open Test_helpers (** Comprehensive META parser error tests These tests systematically verify error handling for: - Predicate syntax errors - Field syntax errors - String literal errors - Package block errors - Semantic errors *) (** {1 Predicate Syntax Errors} *) let test_unclosed_predicate_paren () = assert_meta_parse_error ~content:"archive(byte = \"foo.cma\"" ~expected_msg:"expecting ')'" ~name:"unclosed predicate parenthesis" let test_missing_predicate_close () = assert_meta_parse_error ~content:"archive(byte,native = \"foo.cma\"" ~expected_msg:"expecting ')'" ~name:"missing close paren in predicate list" let test_empty_predicate_parens () = (* This should actually work - empty predicates are valid *) assert_meta_parses ~content:"archive() = \"foo.cma\"" ~name:"empty predicate parens" let test_predicate_without_field () = assert_meta_parse_error ~content:"(byte) = \"foo.cma\"" ~expected_msg:"unknown token" ~name:"predicate without field name" let test_malformed_predicate () = assert_meta_parse_error ~content:"archive(byte,) = \"foo.cma\"" ~expected_msg:"expecting ')'" ~name:"malformed predicate with trailing comma" (** {1 Field Syntax Errors} *) let test_missing_equals () = assert_meta_parse_error ~content:"version \"1.0.0\"" ~expected_msg:"unknown token" ~name:"missing equals after field" let test_missing_value () = assert_meta_parse_error ~content:"version =" ~expected_msg:"unknown token" ~name:"missing value after equals" let test_field_without_value () = assert_meta_parse_error ~content:"version\narchive(byte) = \"foo.cma\"" ~expected_msg:"unknown token" ~name:"field name without equals or value" let test_duplicate_equals () = assert_meta_parse_error ~content:"version = = \"1.0.0\"" ~expected_msg:"unknown token" ~name:"duplicate equals" let test_invalid_field_chars () = (* Field names with special chars - lexer catches this *) assert_meta_parse_error ~content:"my-field! = \"value\"" ~expected_msg:"meta lexing error" ~name:"field name with invalid characters" (** {1 String Literal Errors} *) let test_unclosed_string () = (* FIXED: Lexer now detects unclosed strings with position *) assert_meta_parse_error ~content:"version = \"1.0.0" ~expected_msg:"1.10: meta lexing error: unclosed string literal" ~name:"unclosed string literal with position" let test_string_without_quotes () = (* Lexer error, not parser error *) assert_meta_parse_error ~content:"version = 1.0.0" ~expected_msg:"meta lexing error" ~name:"string value without quotes" let test_empty_string () = (* Empty strings should be valid *) assert_meta_parses ~content:"version = \"\"" ~name:"empty string value" (** {1 Package Block Errors} *) let test_unclosed_package_block () = (* FIXED: Unclosed package blocks now detected *) assert_meta_parse_error ~content:"\ version = \"1.0\"\n\ package \"sub\" (\n\ version = \"1.1\"\n" ~expected_msg:"unclosed package block" ~name:"unclosed package block" let test_package_without_name () = assert_meta_parse_error ~content:"\ package (\n\ version = \"1.0\"\n\ )\n" ~expected_msg:"unknown token" ~name:"package without name" let test_package_without_paren () = assert_meta_parse_error ~content:"\ package \"sub\"\n\ version = \"1.0\"\n" ~expected_msg:"unknown token" ~name:"package without opening paren" let test_nested_package_error () = (* FIXED: Unclosed strings now detected even in nested packages *) assert_meta_parse_error ~content:"\ version = \"1.0\"\n\ package \"outer\" (\n\ package \"inner\" (\n\ version = \"1.1\n\ )\n\ )\n" ~expected_msg:"unclosed string literal" ~name:"nested package with unclosed string" (** {1 Append Operator Errors} *) let test_append_without_value () = assert_meta_parse_error ~content:"archive(byte) += " ~expected_msg:"parsing archive failed" ~name:"append operator without value" let test_append_to_nonexistent () = (* Appending to a field that wasn't defined - should this work? *) assert_meta_parses ~content:"archive(byte) += \"extra.cma\"" ~name:"append to nonexistent field" (** {1 Specific Field Errors} *) let test_requires_invalid_syntax () = assert_meta_parse_error ~content:"requires(byte) == \"unix\"" ~expected_msg:"parsing requires failed" ~name:"requires with double equals" let test_archive_missing_predicate_close () = assert_meta_parse_error ~content:"archive(byte,native = \"foo.cma\"" ~expected_msg:"expecting ')'" ~name:"archive missing predicate close" let test_ppx_invalid_syntax () = assert_meta_parse_error ~content:"ppx(byte) \"./ppx.exe\"" ~expected_msg:"parsing ppx failed" ~name:"ppx without equals" let test_linkopts_invalid () = (* FIXED: linkopts now uses MetaParseError instead of failwith *) assert_exception_message ~test_func:(fun () -> parse_meta_string "linkopts(byte) \"invalid\"" "test") ~expected_substring:"parsing linkopts failed" ~name:"linkopts without equals" (** {1 Complex Error Cases} *) let test_multiple_errors () = (* Multiple errors - which one gets reported? *) assert_meta_parse_error ~content:"\ version = \"1.0\n\ archive(byte = \"foo.cma\n" ~expected_msg:"unknown token" ~name:"multiple syntax errors" let test_error_after_valid_content () = assert_meta_parse_error ~content:"\ version = \"1.0\"\n\ description = \"Valid package\"\n\ archive(byte \"broken\"\n" ~expected_msg:"expecting ')'" ~name:"error after valid content" let test_invalid_escape_sequence () = (* Testing escape sequences in strings *) assert_meta_parses ~content:"description = \"Line 1\\nLine 2\\ttab\"" ~name:"valid escape sequences" (** {1 Lexer Error Cases} *) let test_location_tracking () = (* Comprehensive test: Lexer errors include line.column position *) assert_meta_parse_error ~content:"\ version = \"1.0\"\n\ requires = \"unix\"\n\ $invalid_token\n" ~expected_msg:"3.0: meta lexing error: undefined character '$'" ~name:"location tracking in lexer errors" let test_invalid_character () = assert_meta_parse_error ~content:"version = \"1.0\"\n@invalid" ~expected_msg:"2.0: meta lexing error: undefined character '@'" ~name:"invalid character with position" let test_unexpected_eof () = assert_meta_parse_error ~content:"version = " ~expected_msg:"unknown token" ~name:"unexpected end of file" (** {1 Edge Cases with Comments} *) let test_comment_in_string () = (* Comments inside strings should be literal *) assert_meta_parses ~content:"description = \"Text with # not a comment\"" ~name:"hash inside string is not comment" let test_unclosed_after_comment () = (* FIXED: Unclosed strings now detected after comments with position *) assert_meta_parse_error ~content:"\ # This is a comment\n\ version = \"1.0\n" ~expected_msg:"2.10: meta lexing error: unclosed string literal" ~name:"unclosed string after comment with position" (** {1 Predicate Combination Errors} *) let test_conflicting_predicates () = (* Conflicting predicates - should this be allowed? *) assert_meta_parses ~content:"archive(byte,native) = \"impossible.cma\"" ~name:"conflicting predicates allowed" let test_duplicate_predicates () = assert_meta_parses ~content:"archive(byte,byte) = \"foo.cma\"" ~name:"duplicate predicates allowed" let test_negated_and_positive () = assert_meta_parses ~content:"requires(mt,-mt) = \"impossible\"" ~name:"negated and positive predicate" (** {1 Real-World Error Cases} *) let test_missing_quotes_on_deps () = assert_meta_parse_error ~content:"requires = unix,str" ~expected_msg:"parsing requires failed" ~name:"requires without quotes" let test_malformed_directory () = (* Directory field with special syntax *) assert_meta_parses ~content:"directory = \"^\"" ~name:"caret directory syntax" let test_plugin_without_predicate () = assert_meta_parses ~content:"plugin = \"foo.cma\"" ~name:"plugin field without predicate" (** {1 Test Suite} *) let all_tests = [ (* Predicate errors *) make_test "unclosed_predicate_paren" test_unclosed_predicate_paren; make_test "missing_predicate_close" test_missing_predicate_close; make_test "empty_predicate_parens" test_empty_predicate_parens; make_test "predicate_without_field" test_predicate_without_field; make_test "malformed_predicate" test_malformed_predicate; (* Field syntax errors *) make_test "missing_equals" test_missing_equals; make_test "missing_value" test_missing_value; make_test "field_without_value" test_field_without_value; make_test "duplicate_equals" test_duplicate_equals; make_test "invalid_field_chars" test_invalid_field_chars; (* String errors *) make_test "unclosed_string" test_unclosed_string; make_test "string_without_quotes" test_string_without_quotes; make_test "empty_string" test_empty_string; (* Package errors *) make_test "unclosed_package_block" test_unclosed_package_block; make_test "package_without_name" test_package_without_name; make_test "package_without_paren" test_package_without_paren; make_test "nested_package_error" test_nested_package_error; (* Append operator *) make_test "append_without_value" test_append_without_value; make_test "append_to_nonexistent" test_append_to_nonexistent; (* Specific fields *) make_test "requires_invalid_syntax" test_requires_invalid_syntax; make_test "archive_missing_predicate_close" test_archive_missing_predicate_close; make_test "ppx_invalid_syntax" test_ppx_invalid_syntax; make_test "linkopts_invalid" test_linkopts_invalid; (* Complex cases *) make_test "multiple_errors" test_multiple_errors; make_test "error_after_valid_content" test_error_after_valid_content; make_test "invalid_escape_sequence" test_invalid_escape_sequence; (* Lexer errors *) make_test "location_tracking" test_location_tracking; make_test "invalid_character" test_invalid_character; make_test "unexpected_eof" test_unexpected_eof; (* Comments *) make_test "comment_in_string" test_comment_in_string; make_test "unclosed_after_comment" test_unclosed_after_comment; (* Predicate combinations *) make_test "conflicting_predicates" test_conflicting_predicates; make_test "duplicate_predicates" test_duplicate_predicates; make_test "negated_and_positive" test_negated_and_positive; (* Real-world cases *) make_test "missing_quotes_on_deps" test_missing_quotes_on_deps; make_test "malformed_directory" test_malformed_directory; make_test "plugin_without_predicate" test_plugin_without_predicate; ] let () = run_tests all_tests obuild-0.2.2/tests/test_new_parser.ml000066400000000000000000000613141515212760700177040ustar00rootroot00000000000000(** Comprehensive tests for the new obuild parser *) open Obuild_lexer open Obuild_parser open Obuild_ast (** Test result tracking *) let tests_run = ref 0 let tests_passed = ref 0 let tests_failed = ref 0 let test name f = incr tests_run; try f (); incr tests_passed; Printf.printf " [PASS] %s\n" name with e -> incr tests_failed; Printf.printf " [FAIL] %s: %s\n" name (Printexc.to_string e) let assert_eq msg expected actual = if expected <> actual then failwith (Printf.sprintf "%s: expected %s, got %s" msg (if expected = "" then "(empty)" else expected) (if actual = "" then "(empty)" else actual)) let assert_eq_int msg expected actual = if expected <> actual then failwith (Printf.sprintf "%s: expected %d, got %d" msg expected actual) let assert_eq_bool msg expected actual = if expected <> actual then failwith (Printf.sprintf "%s: expected %b, got %b" msg expected actual) let assert_true msg cond = if not cond then failwith msg let assert_some msg = function | Some _ -> () | None -> failwith (msg ^ ": expected Some, got None") let assert_none msg = function | None -> () | Some _ -> failwith (msg ^ ": expected None, got Some") (* Compat helpers for old OCaml *) let option_get = function | Some x -> x | None -> failwith "option_get: None" (* ============================================================ *) (* LEXER TESTS *) (* ============================================================ *) let test_lexer () = Printf.printf "\n=== Lexer Tests ===\n"; test "empty input" (fun () -> let tokens = tokenize "" in assert_eq_int "token count" 1 (List.length tokens); assert_true "should be EOF" ((List.hd tokens).tok = EOF)); test "blank lines only" (fun () -> let tokens = tokenize "\n\n \n" in assert_eq_int "token count" 1 (List.length tokens); assert_true "should be EOF" ((List.hd tokens).tok = EOF)); test "comment lines" (fun () -> let tokens = tokenize "# this is a comment\n# another comment" in assert_eq_int "token count" 1 (List.length tokens)); test "simple key-value with colon" (fun () -> let tokens = tokenize "name: myproject" in assert_eq_int "token count" 2 (List.length tokens); match (List.hd tokens).tok with | KEY_VALUE (k, v) -> assert_eq "key" "name" k; assert_eq "value" "myproject" v | _ -> failwith "expected KEY_VALUE"); test "key-value with equals" (fun () -> let tokens = tokenize "version = 1.0.0" in match (List.hd tokens).tok with | KEY_VALUE (k, v) -> assert_eq "key" "version" k; assert_eq "value" "1.0.0" v | _ -> failwith "expected KEY_VALUE"); test "key-value with spaces" (fun () -> let tokens = tokenize " description: some text here " in let t = List.hd tokens in assert_eq_int "indent" 2 t.indent; match t.tok with | KEY_VALUE (k, v) -> assert_eq "key" "description" k; assert_eq "value" "some text here" v | _ -> failwith "expected KEY_VALUE"); test "block header no args" (fun () -> let tokens = tokenize "library" in match (List.hd tokens).tok with | BLOCK (name, args) -> assert_eq "name" "library" name; assert_eq_int "args count" 0 (List.length args) | _ -> failwith "expected BLOCK"); test "block header with one arg" (fun () -> let tokens = tokenize "library mylib" in match (List.hd tokens).tok with | BLOCK (name, args) -> assert_eq "name" "library" name; assert_eq_int "args count" 1 (List.length args); assert_eq "arg" "mylib" (List.hd args) | _ -> failwith "expected BLOCK"); test "block header with multiple args" (fun () -> let tokens = tokenize "per file1.ml file2.ml" in match (List.hd tokens).tok with | BLOCK (name, args) -> assert_eq "name" "per" name; assert_eq_int "args count" 2 (List.length args) | _ -> failwith "expected BLOCK"); test "indentation tracking" (fun () -> let tokens = tokenize "library mylib\n modules: A, B\n src-dir: lib" in assert_eq_int "token count" 4 (List.length tokens); (* 3 + EOF *) let t0 = List.nth tokens 0 in let t1 = List.nth tokens 1 in let t2 = List.nth tokens 2 in assert_eq_int "t0 indent" 0 t0.indent; assert_eq_int "t1 indent" 2 t1.indent; assert_eq_int "t2 indent" 2 t2.indent); test "mixed indentation" (fun () -> let input = "library mylib\n modules: A\n nested: value\n back: here" in let tokens = tokenize input in let indents = List.map (fun t -> t.indent) (List.filter (fun t -> t.tok <> EOF) tokens) in assert_true "indents" (indents = [ 0; 2; 4; 2 ])); test "line numbers" (fun () -> let tokens = tokenize "line1: a\n\nline3: b\nline4: c" in let lines = List.map (fun t -> t.Obuild_lexer.loc.Location.line) (List.filter (fun t -> t.Obuild_lexer.tok <> EOF) tokens) in assert_true "line numbers" (lines = [ 1; 3; 4 ])); () (* ============================================================ *) (* PARSER BASIC TESTS *) (* ============================================================ *) let test_parser_basic () = Printf.printf "\n=== Parser Basic Tests ===\n"; test "minimal project" (fun () -> let input = "name: test\nversion: 1.0\nobuild-ver: 1" in let proj = parse input in assert_eq "name" "test" proj.project_name.value; assert_eq "version" "1.0" proj.project_version.value; assert_eq_int "obuild-ver" 1 proj.project_obuild_ver.value); test "project metadata" (fun () -> let input = "name: myproject\n\ version: 2.0.0\n\ obuild-ver: 1\n\ synopsis: A test project\n\ description: This is a longer description\n\ license: MIT\n\ license-file: LICENSE\n\ homepage: https://example.com\n\ authors: Alice, Bob\n" in let proj = parse input in assert_eq "name" "myproject" proj.project_name.value; assert_eq "synopsis" "A test project" (option_get proj.project_synopsis); assert_eq "license" "MIT" (option_get proj.project_license); assert_eq "license-file" "LICENSE" (option_get proj.project_license_file); assert_eq "homepage" "https://example.com" (option_get proj.project_homepage); assert_eq_int "authors count" 2 (List.length proj.project_authors)); test "single author" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\nauthor: Alice" in let proj = parse input in assert_eq_int "authors count" 1 (List.length proj.project_authors); assert_eq "author" "Alice" (List.hd proj.project_authors)); test "extra-srcs and tools" (fun () -> let input = "name: x\n\ version: 1\n\ obuild-ver: 1\n\ extra-srcs: file1.txt, file2.txt\n\ tools: tool1, tool2\n" in let proj = parse input in assert_eq_int "extra-srcs" 2 (List.length proj.project_extra_srcs); assert_eq_int "tools" 2 (List.length proj.project_extra_tools)); test "configure-script" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\nconfigure-script: configure.sh" in let proj = parse input in assert_eq "configure-script" "configure.sh" (option_get proj.project_configure_script)); test "ocaml-version" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\nocaml-version: >= 4.08" in let proj = parse input in assert_eq "ocaml-version" ">= 4.08" (option_get proj.project_ocaml_ver)); () (* ============================================================ *) (* LIBRARY TESTS *) (* ============================================================ *) let test_parser_library () = Printf.printf "\n=== Parser Library Tests ===\n"; test "simple library" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary mylib\n modules: A, B, C\n src-dir: lib\n" in let proj = parse input in assert_eq_int "libs count" 1 (List.length proj.project_libs); let lib = List.hd proj.project_libs in assert_eq "lib name" "mylib" lib.lib_name; assert_eq_int "modules count" 3 (List.length lib.lib_modules); assert_eq_int "src-dir count" 1 (List.length lib.lib_target.ocaml.src_dir)); test "library with build-deps" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary mylib\n modules: A\n build-deps: unix, str, base (>= 0.14)\n" in let proj = parse input in let lib = List.hd proj.project_libs in let deps = lib.lib_target.ocaml.build_deps in assert_eq_int "deps count" 3 (List.length deps); let base_dep = List.nth deps 2 in assert_eq "dep name" "base" base_dep.dep_name; assert_eq "dep constraint" ">= 0.14" (option_get base_dep.dep_constraint)); test "library with C settings" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary mylib\n modules: A\n c-dir: csrc\n c-sources: foo.c, bar.c\n c-flags: -O2, -Wall\n c-libs: m, pthread\n c-pkgs: glib-2.0\n" in let proj = parse input in let lib = List.hd proj.project_libs in let c = lib.lib_target.c in assert_eq "c-dir" "csrc" (option_get c.c_dir); assert_eq_int "c-sources" 2 (List.length c.c_sources); assert_eq_int "c-flags" 2 (List.length c.c_flags); assert_eq_int "c-libs" 2 (List.length c.c_libs); assert_eq_int "c-pkgs" 1 (List.length c.c_pkgs)); test "library with pack and syntax" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary mylib\n modules: A\n pack: true\n syntax: true\n" in let proj = parse input in let lib = List.hd proj.project_libs in assert_eq_bool "pack" true lib.lib_pack; assert_eq_bool "syntax" true lib.lib_syntax); test "library with stdlib none" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary mylib\n modules: A\n stdlib: none\n" in let proj = parse input in let lib = List.hd proj.project_libs in assert_true "stdlib is none" (lib.lib_target.ocaml.stdlib = Some Stdlib_None)); test "library with oflags" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary mylib\n modules: A\n oflags: -w, +a-4\n" in let proj = parse input in let lib = List.hd proj.project_libs in assert_eq_int "oflags" 2 (List.length lib.lib_target.ocaml.oflags)); test "library buildable/installable" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary mylib\n modules: A\n buildable: false\n installable: $flag_install\n" in let proj = parse input in let lib = List.hd proj.project_libs in assert_true "buildable" (lib.lib_target.buildable = Bool_const false); assert_true "installable" (lib.lib_target.installable = Bool_var "flag_install")); test "multiple libraries" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary lib1\n modules: A\n\nlibrary lib2\n modules: B\n" in let proj = parse input in assert_eq_int "libs count" 2 (List.length proj.project_libs)); () (* ============================================================ *) (* CSTUBS TESTS *) (* ============================================================ *) let test_parser_cstubs () = Printf.printf "\n=== Parser Cstubs Tests ===\n"; test "library with cstubs" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary mylib\n modules: Bindings, C, Types_generated\n build-deps: ctypes, ctypes.stubs\n\n cstubs\n external-library-name: mylib_stubs\n type-description: Bindings.Types -> Types_gen\n function-description: Bindings.Functions -> Funcs_gen\n generated-types: Types_generated\n generated-entry-point: C\n headers: string.h, mylib.h\n" in let proj = parse input in let lib = List.hd proj.project_libs in assert_some "cstubs" lib.lib_cstubs; let cstubs = option_get lib.lib_cstubs in assert_eq "external-library-name" "mylib_stubs" cstubs.cstubs_external_lib_name; assert_some "type-description" cstubs.cstubs_type_desc; let type_desc = option_get cstubs.cstubs_type_desc in assert_eq "type functor" "Bindings.Types" type_desc.cstubs_functor; assert_eq "type instance" "Types_gen" type_desc.cstubs_instance; assert_some "function-description" cstubs.cstubs_func_desc; assert_eq "generated-types" "Types_generated" cstubs.cstubs_generated_types; assert_eq "generated-entry-point" "C" cstubs.cstubs_generated_entry; assert_eq_int "headers" 2 (List.length cstubs.cstubs_headers)); test "cstubs minimal" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary mylib\n modules: A\n\n cstubs\n external-library-name: foo\n" in let proj = parse input in let lib = List.hd proj.project_libs in assert_some "cstubs" lib.lib_cstubs; let cstubs = option_get lib.lib_cstubs in assert_eq "external-library-name" "foo" cstubs.cstubs_external_lib_name; assert_none "type-description" cstubs.cstubs_type_desc; assert_none "function-description" cstubs.cstubs_func_desc); () (* ============================================================ *) (* EXECUTABLE TESTS *) (* ============================================================ *) let test_parser_executable () = Printf.printf "\n=== Parser Executable Tests ===\n"; test "simple executable" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nexecutable myexe\n main-is: main.ml\n src-dir: src\n" in let proj = parse input in assert_eq_int "exes count" 1 (List.length proj.project_exes); let exe = List.hd proj.project_exes in assert_eq "exe name" "myexe" exe.exe_name; assert_eq "main-is" "main.ml" exe.exe_main; assert_eq_int "src-dir" 1 (List.length exe.exe_target.ocaml.src_dir)); test "executable with deps" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nexecutable myexe\n main-is: main.ml\n build-deps: unix, cmdliner\n" in let proj = parse input in let exe = List.hd proj.project_exes in assert_eq_int "deps" 2 (List.length exe.exe_target.ocaml.build_deps)); test "multiple executables" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nexecutable exe1\n main-is: main1.ml\n\nexecutable exe2\n main-is: main2.ml\n" in let proj = parse input in assert_eq_int "exes count" 2 (List.length proj.project_exes)); () (* ============================================================ *) (* TEST TARGET TESTS *) (* ============================================================ *) let test_parser_test () = Printf.printf "\n=== Parser Test Target Tests ===\n"; test "simple test" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\ntest mytest\n main-is: test_main.ml\n src-dir: tests\n" in let proj = parse input in assert_eq_int "tests count" 1 (List.length proj.project_tests); let t = List.hd proj.project_tests in assert_eq "test name" "mytest" t.test_name; assert_eq "main-is" "test_main.ml" t.test_main); test "test with rundir" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\ntest mytest\n main-is: test.ml\n run-dir: test_data\n" in let proj = parse input in let t = List.hd proj.project_tests in assert_eq "rundir" "test_data" (option_get t.test_rundir)); () (* ============================================================ *) (* PER BLOCK TESTS *) (* ============================================================ *) let test_parser_per () = Printf.printf "\n=== Parser Per Block Tests ===\n"; test "library with per block" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary mylib\n modules: A, B\n\n per A\n build-deps: special_lib\n oflags: -w, -40\n" in let proj = parse input in let lib = List.hd proj.project_libs in assert_eq_int "per blocks" 1 (List.length lib.lib_target.per); let per = List.hd lib.lib_target.per in assert_eq_int "per files" 1 (List.length per.per_files); assert_eq "per file" "A" (List.hd per.per_files); assert_eq_int "per deps" 1 (List.length per.per_build_deps); assert_eq_int "per oflags" 2 (List.length per.per_oflags)); test "multiple per blocks" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary mylib\n modules: A, B, C\n\n per A\n oflags: -w, -40\n\n per B C\n pp: ppx_deriving\n" in let proj = parse input in let lib = List.hd proj.project_libs in assert_eq_int "per blocks" 2 (List.length lib.lib_target.per); let per2 = List.nth lib.lib_target.per 1 in assert_eq_int "per2 files" 2 (List.length per2.per_files); assert_eq "per2 pp" "ppx_deriving" (option_get per2.per_pp)); () (* ============================================================ *) (* SUB-LIBRARY TESTS *) (* ============================================================ *) let test_parser_sublib () = Printf.printf "\n=== Parser Sub-library Tests ===\n"; test "library with sublibrary" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary mylib\n modules: A\n\n sublib internal\n modules: B, C\n src-dir: internal\n" in let proj = parse input in let lib = List.hd proj.project_libs in assert_eq_int "subs" 1 (List.length lib.lib_subs); let sub = List.hd lib.lib_subs in assert_eq "sub name" "internal" sub.lib_name; assert_eq_int "sub modules" 2 (List.length sub.lib_modules)); () (* ============================================================ *) (* FLAG TESTS *) (* ============================================================ *) let test_parser_flag () = Printf.printf "\n=== Parser Flag Tests ===\n"; test "flag definition" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nflag debug\n description: Enable debug mode\n default: false\n" in let proj = parse input in assert_eq_int "flags" 1 (List.length proj.project_flags); let flag = List.hd proj.project_flags in assert_eq "flag name" "debug" flag.flag_name; assert_eq "flag desc" "Enable debug mode" flag.flag_description; assert_eq_bool "flag default" false flag.flag_default); () (* ============================================================ *) (* REAL FILE TESTS *) (* ============================================================ *) let test_real_files () = Printf.printf "\n=== Real File Tests ===\n"; test "ctypes_test.obuild" (fun () -> let input = "name: ctypes_test\nversion: 0.1.0\nobuild-ver: 1\n\nlibrary mylib\n modules: Bindings, C, Types_generated\n build-deps: ctypes, ctypes.stubs\n src-dir: lib\n\n cstubs\n external-library-name: mylib_stubs\n type-description: Bindings.Types -> Types_gen\n function-description: Bindings.Functions -> Funcs_gen\n generated-types: Types_generated\n generated-entry-point: C\n headers: string.h\n\nexecutable test_mylib\n main-is: main.ml\n src-dir: bin\n build-deps: mylib, integers, ctypes\n" in let proj = parse input in assert_eq "name" "ctypes_test" proj.project_name.value; assert_eq "version" "0.1.0" proj.project_version.value; assert_eq_int "obuild-ver" 1 proj.project_obuild_ver.value; assert_eq_int "libs" 1 (List.length proj.project_libs); assert_eq_int "exes" 1 (List.length proj.project_exes); let lib = List.hd proj.project_libs in assert_eq "lib name" "mylib" lib.lib_name; assert_eq_int "lib modules" 3 (List.length lib.lib_modules); assert_some "lib cstubs" lib.lib_cstubs; let exe = List.hd proj.project_exes in assert_eq "exe name" "test_mylib" exe.exe_name; assert_eq "exe main" "main.ml" exe.exe_main; assert_eq_int "exe deps" 3 (List.length exe.exe_target.ocaml.build_deps)); test "complex project" (fun () -> let input = "name: myproject\nversion: 1.0.0\nobuild-ver: 1\nsynopsis: A complex project\nlicense: BSD-3-Clause\nauthors: Alice, Bob, Charlie\nhomepage: https://github.com/example/myproject\n\n# Main library\nlibrary core\n modules: Types, Utils, Engine\n build-deps: base (>= 0.14), stdio, unix\n src-dir: lib/core\n oflags: -w, +a-4-40-42\n\n per Engine\n build-deps: threads\n pp: ppx_deriving.show\n\n# CLI executable\nexecutable mycli\n main-is: main.ml\n src-dir: bin\n build-deps: core, cmdliner (>= 1.0)\n\n# Tests\ntest unit_tests\n main-is: test_unit.ml\n src-dir: tests\n build-deps: core, alcotest\n\ntest integration_tests\n main-is: test_integration.ml\n src-dir: tests\n build-deps: core, alcotest\n run-dir: test_fixtures\n\n# Feature flag\nflag debug\n description: Build with debug info\n default: false\n" in let proj = parse input in assert_eq "name" "myproject" proj.project_name.value; assert_eq_int "authors" 3 (List.length proj.project_authors); assert_eq_int "libs" 1 (List.length proj.project_libs); assert_eq_int "exes" 1 (List.length proj.project_exes); assert_eq_int "tests" 2 (List.length proj.project_tests); assert_eq_int "flags" 1 (List.length proj.project_flags); let lib = List.hd proj.project_libs in assert_eq_int "lib modules" 3 (List.length lib.lib_modules); assert_eq_int "lib deps" 3 (List.length lib.lib_target.ocaml.build_deps); assert_eq_int "lib per" 1 (List.length lib.lib_target.per); let exe = List.hd proj.project_exes in assert_eq_int "exe deps" 2 (List.length exe.exe_target.ocaml.build_deps); let test1 = List.hd proj.project_tests in assert_none "test1 rundir" test1.test_rundir; let test2 = List.nth proj.project_tests 1 in assert_eq "test2 rundir" "test_fixtures" (option_get test2.test_rundir)); () (* ============================================================ *) (* EDGE CASES *) (* ============================================================ *) let test_edge_cases () = Printf.printf "\n=== Edge Case Tests ===\n"; test "empty value" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\ndescription:" in let proj = parse input in assert_eq "description" "" (option_get proj.project_description)); test "value with colons" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\nhomepage: https://example.com:8080/path" in let proj = parse input in assert_eq "homepage" "https://example.com:8080/path" (option_get proj.project_homepage)); test "dependency with complex constraint" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary mylib\n modules: A\n build-deps: foo (>= 1.0 && < 2.0)\n" in let proj = parse input in let lib = List.hd proj.project_libs in let dep = List.hd lib.lib_target.ocaml.build_deps in assert_eq "constraint" ">= 1.0 && < 2.0" (option_get dep.dep_constraint)); test "tabs as indentation" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\nlibrary mylib\n\tmodules: A" in let proj = parse input in assert_eq_int "libs" 1 (List.length proj.project_libs)); test "mixed content" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\n# comment before library\nlibrary mylib\n modules: A # inline comments not supported, this is part of value\n\n # comment in library\n src-dir: lib\n" in let proj = parse input in let lib = List.hd proj.project_libs in (* Note: inline comment becomes part of value - lexer doesn't handle inline comments *) assert_eq_int "src-dir" 1 (List.length lib.lib_target.ocaml.src_dir)); test "unknown fields ignored" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\nunknown-field: some value\n\nlibrary mylib\n modules: A\n unknown-lib-field: ignored\n" in let proj = parse input in assert_eq "name" "x" proj.project_name.value; assert_eq_int "libs" 1 (List.length proj.project_libs)); () (* ============================================================ *) (* MAIN *) (* ============================================================ *) let () = Printf.printf "Running new parser tests...\n"; test_lexer (); test_parser_basic (); test_parser_library (); test_parser_cstubs (); test_parser_executable (); test_parser_test (); test_parser_per (); test_parser_sublib (); test_parser_flag (); test_real_files (); test_edge_cases (); Printf.printf "\n=== Summary ===\n"; Printf.printf "Tests run: %d\n" !tests_run; Printf.printf "Passed: %d\n" !tests_passed; Printf.printf "Failed: %d\n" !tests_failed; if !tests_failed > 0 then exit 1 else Printf.printf "\nAll tests passed!\n" obuild-0.2.2/tests/test_path.ml000066400000000000000000000126451515212760700164760ustar00rootroot00000000000000let err = ref 0 let assumeEq testname expected got = if expected = got then Printf.printf "SUCCESS %s\n" testname else ( Printf.printf "FAILED %s Expected %s Got %s\n" testname expected got; err := !err + 1) let assumeTrue testname v = if v then Printf.printf "SUCCESS %s\n" testname else ( Printf.printf "FAILED %s Expected true Got false\n" testname; err := !err + 1) let assumeRaises testname f = let raised = (try f (); false with _ -> true) in if raised then Printf.printf "SUCCESS %s\n" testname else ( Printf.printf "FAILED %s Expected exception\n" testname; err := !err + 1) let () = (* --- Hier.add_prefix tests (original) --- *) let b = Filepath.fp "src/b" in let b_abc = Hier.of_string "B.Abc" in let b_b_abc = Hier.add_prefix b b_abc in assumeEq "src/b + B.Abc" "src/b" (Filepath.fp_to_string b_b_abc); let b_abc = Filepath.fp "src/b/abc" in let b_abc_foo = Hier.of_string "B.Abc.Foo" in let b_abc_b_abc_foo = Hier.add_prefix b_abc b_abc_foo in assumeEq "src/b/abc + B.Abc.Foo" "src/b/abc" (Filepath.fp_to_string b_abc_b_abc_foo); (* --- Hier.of_string / to_string round-trip --- *) assumeEq "hier round-trip simple" "Foo" (Hier.to_string (Hier.of_string "Foo")); assumeEq "hier round-trip nested" "Foo.Bar.Baz" (Hier.to_string (Hier.of_string "Foo.Bar.Baz")); (* --- Hier.root / leaf / parent --- *) let hier_abc = Hier.of_string "A.B.C" in assumeEq "hier root" "A" (Modname.to_string (Hier.root hier_abc)); assumeEq "hier leaf" "C" (Modname.to_string (Hier.leaf hier_abc)); (match Hier.parent hier_abc with | Some p -> assumeEq "hier parent" "A.B" (Hier.to_string p) | None -> Printf.printf "FAILED hier parent: Expected Some, Got None\n"; err := !err + 1); let hier_single = Hier.of_string "Solo" in (match Hier.parent hier_single with | None -> Printf.printf "SUCCESS hier parent of single\n" | Some p -> Printf.printf "FAILED hier parent of single: Expected None, Got %s\n" (Hier.to_string p); err := !err + 1); (* --- Hier.lvl --- *) assumeEq "hier lvl 0" "0" (string_of_int (Hier.lvl (Hier.of_string "X"))); assumeEq "hier lvl 2" "2" (string_of_int (Hier.lvl (Hier.of_string "X.Y.Z"))); (* --- Hier.to_dirpath --- *) assumeEq "hier to_dirpath single" "./" (Filepath.fp_to_string (Hier.to_dirpath (Hier.of_string "Foo"))); assumeEq "hier to_dirpath nested" "foo/bar" (Filepath.fp_to_string (Hier.to_dirpath (Hier.of_string "Foo.Bar.Baz"))); (* --- Hier.of_filename --- *) let hier_from_fn = Hier.of_filename (Filepath.fn "parser.ml") in assumeEq "hier of_filename" "Parser" (Hier.to_string hier_from_fn); (* --- Hier.add_prefix edge cases --- *) let empty_prefix = Filepath.fp "./" in let hier_deep = Hier.of_string "A.B.C" in let result = Hier.add_prefix empty_prefix hier_deep in assumeEq "add_prefix empty + A.B.C" "a/b" (Filepath.fp_to_string result); let prefix_no_overlap = Filepath.fp "lib/core" in let hier_xy = Hier.of_string "X.Y.Z" in let result2 = Hier.add_prefix prefix_no_overlap hier_xy in assumeEq "add_prefix no overlap" "lib/core/x/y" (Filepath.fp_to_string result2); (* --- Modname tests --- *) assumeEq "modname round-trip" "Foo" (Modname.to_string (Modname.of_string "Foo")); assumeEq "modname to_dir" "foo" (Modname.to_dir (Modname.of_string "Foo")); assumeRaises "modname empty" (fun () -> ignore (Modname.of_string "")); assumeRaises "modname lowercase" (fun () -> ignore (Modname.of_string "foo")); assumeRaises "modname invalid chars" (fun () -> ignore (Modname.of_string "Foo-bar")); assumeEq "modname to_filename" "foo.ml" (Filepath.fn_to_string (Modname.to_filename (Modname.of_string "Foo"))); assumeEq "modname of_filename" "Parser" (Modname.to_string (Modname.of_filename (Filepath.fn "parser.ml"))); (* --- Libname tests --- *) let lib_simple = Libname.of_string "unix" in assumeEq "libname simple" "unix" (Libname.to_string lib_simple); let lib_sub = Libname.of_string "base.shadow_stdlib" in assumeEq "libname sub" "base.shadow_stdlib" (Libname.to_string lib_sub); assumeEq "libname main_name" "base" lib_sub.Libname.main_name; assumeEq "libname subnames" "shadow_stdlib" (String.concat "." lib_sub.Libname.subnames); let lib_appended = Libname.append lib_simple "sub" in assumeEq "libname append" "unix.sub" (Libname.to_string lib_appended); (* Libname.of_string "" produces { main_name = ""; subnames = [] } rather than raising *) assumeEq "libname empty string" "" (Libname.to_string (Libname.of_string "")); (* --- Filepath tests --- *) assumeEq "fp absolute" "/usr/lib" (Filepath.fp_to_string (Filepath.fp "/usr/lib")); assumeEq "fp relative" "src/main" (Filepath.fp_to_string (Filepath.fp "src/main")); assumeEq "fp current" "./" (Filepath.fp_to_string (Filepath.fp ".")); assumeEq "fp root" "/" (Filepath.fp_to_string (Filepath.fp "/")); assumeTrue "fp is_absolute" (Filepath.is_absolute (Filepath.fp "/usr")); assumeTrue "fp not absolute" (not (Filepath.is_absolute (Filepath.fp "src"))); let combined = Filepath.(fp "src" fn "main.ml") in assumeEq "fp combine" "src/main.ml" (Filepath.fp_to_string combined); let concat = Filepath.(fp "a/b" fp "c/d") in assumeEq "fp concat" "a/b/c/d" (Filepath.fp_to_string concat); assumeRaises "fn empty" (fun () -> ignore (Filepath.fn "")); assumeRaises "fn with slash" (fun () -> ignore (Filepath.fn "a/b")); if !err > 0 then exit 1 else exit 0 obuild-0.2.2/tests/test_project_errors.ml000066400000000000000000000226371515212760700206060ustar00rootroot00000000000000open Test_framework open Test_helpers (** Comprehensive Project parser error tests These tests systematically verify error handling for: - Required field validation - Field syntax errors - Block syntax errors - Value format errors - Semantic validation errors *) (** {1 Required Field Tests} *) let test_missing_name () = assert_project_parse_error ~content:"version: 1.0.0\nobuild-ver: 1\n" ~expected_msg:"Missing required field: name" ~name:"missing name field" let test_missing_version () = assert_project_parse_error ~content:"name: test\nobuild-ver: 1\n" ~expected_msg:"Missing required field: version" ~name:"missing version field" let test_missing_obuild_ver () = assert_project_parse_error ~content:"name: test\nversion: 1.0.0\n" ~expected_msg:"Missing required field: obuild-ver" ~name:"missing obuild-ver field" let test_empty_name () = assert_project_parse_error ~content:"name:\nversion: 1.0.0\nobuild-ver: 1\n" ~expected_msg:"Missing required field: name" ~name:"empty name value" (** {1 Field Value Tests} *) let test_invalid_obuild_ver () = assert_project_parse_error ~content:"name: test\nversion: 1.0.0\nobuild-ver: not_a_number\n" ~expected_msg:"int_of_string" ~name:"invalid obuild-ver value" let test_future_obuild_ver () = assert_project_parse_error ~content:"name: test\nversion: 1.0.0\nobuild-ver: 999\n" ~expected_msg:"Unsupported obuild version" ~name:"unsupported future obuild-ver" let test_valid_minimal () = assert_project_parses ~content:minimal_project ~name:"valid minimal project" (** {1 Block Section Tests} *) (* Note: "library: value" is lexed as KEY_VALUE, not BLOCK (because of the colon). Since "library" isn't a recognized top-level field, it's silently ignored. No library is created, so parsing succeeds with just the project metadata. *) let test_block_as_value () = assert_project_parses ~content:"name: test\nversion: 1.0.0\nobuild-ver: 1\nlibrary: some_value\n" ~name:"library: value is ignored (KEY_VALUE not BLOCK)" let test_executable_block_as_value () = (* Same as above - "executable: value" is KEY_VALUE, silently ignored *) assert_project_parses ~content:"name: test\nversion: 1.0.0\nobuild-ver: 1\nexecutable: some_value\n" ~name:"executable: value is ignored (KEY_VALUE not BLOCK)" (** {1 Library Block Tests} *) let test_library_without_modules () = (* Library with no modules fails at validation *) assert_project_parse_error ~content:"name: test\nversion: 1.0.0\nobuild-ver: 1\n\nlibrary mylib\n src-dir: src\n" ~expected_msg:"has no modules" ~name:"library without modules" let test_valid_library () = (* Parser validates that modules exist on disk - this will fail without actual files *) assert_project_parse_error ~content:"name: test\nversion: 1.0.0\nobuild-ver: 1\n\nlibrary mylib\n modules: Foo, Bar\n src-dir: src\n" ~expected_msg:"ModuleNotFound" ~name:"library with non-existent modules" (** {1 Executable Block Tests} *) let test_executable_without_name () = (* New parser allows empty name but validation catches missing main file *) assert_project_parse_error ~content:"name: test\nversion: 1.0.0\nobuild-ver: 1\n\nexecutable\n main-is: main.ml\n" ~expected_msg:"FileNotFoundInPaths" ~name:"executable without name" let test_valid_executable () = (* Parser validates that main-is file exists on disk *) assert_project_parse_error ~content:"name: test\nversion: 1.0.0\nobuild-ver: 1\n\nexecutable myexe\n main-is: main.ml\n src-dir: src\n" ~expected_msg:"FileNotFoundInPaths" ~name:"executable with non-existent main file" (** {1 Test Block Tests} *) let test_test_without_name () = (* New parser allows empty test name; Project.check() doesn't validate tests *) assert_project_parses ~content:"name: test\nversion: 1.0.0\nobuild-ver: 1\n\ntest\n main-is: test.ml\n" ~name:"test without name (allowed)" let test_valid_test () = assert_project_parses ~content:"name: test\nversion: 1.0.0\nobuild-ver: 1\n\ntest mytest\n main-is: test.ml\n src-dir: tests\n" ~name:"valid test block" (** {1 Field Format Tests} *) let test_multiline_description () = assert_project_parses ~content: "name: test\n\ version: 1.0.0\n\ obuild-ver: 1\n\ description: This is a long\n\ description that spans\n\ multiple lines\n" ~name:"multiline description" let test_csv_authors () = assert_project_parses ~content: "name: test\n\ version: 1.0.0\n\ obuild-ver: 1\n\ authors: Alice , Bob \n" ~name:"CSV authors field" let test_single_author () = assert_project_parses ~content:"name: test\nversion: 1.0.0\nobuild-ver: 1\nauthor: Alice \n" ~name:"single author field" (** {1 Unknown Field Handling} *) let test_unknown_field_strict () = (* In strict mode, unknown fields should cause errors *) (* This test documents current behavior *) assert_project_parses ~content:"name: test\nversion: 1.0.0\nobuild-ver: 1\nunknown-field: value\n" ~name:"unknown field in non-strict mode" (** {1 Indentation and Whitespace} *) let test_empty_file () = assert_project_parse_error ~content:"" ~expected_msg:"Missing required field: name" ~name:"empty file" let test_whitespace_only () = assert_project_parse_error ~content:" \n \n " ~expected_msg:"Missing required field: name" ~name:"whitespace only" let test_valid_with_comments () = assert_project_parses ~content:"# This is a comment\nname: test\nversion: 1.0.0\nobuild-ver: 1\n" ~name:"file with comments" (** {1 Complex Nested Structures} *) let test_multiple_libraries () = (* Parser validates module existence *) assert_project_parse_error ~content:"name: test\nversion: 1.0.0\nobuild-ver: 1\n\nlibrary lib1\n modules: Foo\n src-dir: src1\n\nlibrary lib2\n modules: Bar\n src-dir: src2\n" ~expected_msg:"ModuleNotFound" ~name:"multiple libraries with non-existent modules" let test_mixed_targets () = (* Parser validates file/module existence *) assert_project_parse_error ~content:"name: test\nversion: 1.0.0\nobuild-ver: 1\n\nlibrary mylib\n modules: Lib\n src-dir: lib\n\nexecutable myexe\n main-is: main.ml\n src-dir: src\n build-deps: mylib\n\ntest mytest\n main-is: test.ml\n src-dir: tests\n build-deps: mylib\n" ~expected_msg:"ModuleNotFound" ~name:"mixed targets with non-existent files" (** {1 Edge Cases} *) let test_library_too_many_names () = (* New parser takes first name, ignores rest; fails on module validation *) assert_project_parse_error ~content:"name: test\nversion: 1.0.0\nobuild-ver: 1\n\nlibrary lib1 lib2\n modules: Foo\n" ~expected_msg:"ModuleNotFound" ~name:"library with extra names (first used)" let test_colons_vs_equals () = (* Test both : and = syntax *) assert_project_parses ~content:"name: test\nversion: 1.0.0\nobuild-ver: 1\n" ~name:"colon syntax" (** {1 Real-World Examples} *) let test_real_world_obuild () = (* Based on actual obuild.obuild structure - but modules don't exist *) assert_project_parse_error ~content:"name: example\nversion: 0.1.0\nsynopsis: Example project\nobuild-ver: 1\nlicense: BSD\nauthors: Test Author \n\nlibrary example_lib\n modules: Foo, Bar\n src-dir: lib\n build-deps: unix\n\nexecutable example_exe\n main-is: main.ml\n src-dir: src\n build-deps: example_lib\n\ntest example_test\n main-is: test.ml\n src-dir: tests\n build-deps: example_lib\n" ~expected_msg:"ModuleNotFound" ~name:"real-world obuild file with non-existent files" (** {1 Test Suite} *) let all_tests = [ (* Required fields *) make_test "missing_name" test_missing_name; make_test "missing_version" test_missing_version; make_test "missing_obuild_ver" test_missing_obuild_ver; make_test "empty_name" test_empty_name; (* Field values *) make_test "invalid_obuild_ver" test_invalid_obuild_ver; make_test "future_obuild_ver" test_future_obuild_ver; make_test "valid_minimal" test_valid_minimal; (* Block errors *) make_test "block_as_value" test_block_as_value; make_test "executable_block_as_value" test_executable_block_as_value; (* Library blocks *) make_test "library_without_modules" test_library_without_modules; make_test "library_non_existent_modules" test_valid_library; (* Executable blocks *) make_test "executable_without_name" test_executable_without_name; make_test "executable_non_existent_main" test_valid_executable; (* Test blocks *) make_test "test_without_name" test_test_without_name; make_test "valid_test" test_valid_test; (* Field formats *) make_test "multiline_description" test_multiline_description; make_test "csv_authors" test_csv_authors; make_test "single_author" test_single_author; (* Unknown fields *) make_test "unknown_field_strict" test_unknown_field_strict; (* Whitespace *) make_test "empty_file" test_empty_file; make_test "whitespace_only" test_whitespace_only; make_test "valid_with_comments" test_valid_with_comments; (* Complex structures *) make_test "multiple_libraries_non_existent" test_multiple_libraries; make_test "mixed_targets_non_existent" test_mixed_targets; (* Edge cases *) make_test "library_too_many_names" test_library_too_many_names; make_test "colons_vs_equals" test_colons_vs_equals; (* Real-world *) make_test "real_world_non_existent_files" test_real_world_obuild; ] let () = run_tests all_tests obuild-0.2.2/tests/test_validate.ml000066400000000000000000000301131515212760700173210ustar00rootroot00000000000000(** Tests for the validation/transformation module *) open Obuild_validate (** Test result tracking *) let tests_run = ref 0 let tests_passed = ref 0 let tests_failed = ref 0 let test name f = incr tests_run; try f (); incr tests_passed; Printf.printf " [PASS] %s\n" name with e -> incr tests_failed; Printf.printf " [FAIL] %s: %s\n" name (Printexc.to_string e) let assert_eq msg expected actual = if expected <> actual then failwith (Printf.sprintf "%s: expected '%s', got '%s'" msg expected actual) let assert_eq_int msg expected actual = if expected <> actual then failwith (Printf.sprintf "%s: expected %d, got %d" msg expected actual) let assert_true msg cond = if not cond then failwith msg let assert_raises msg f = try f (); failwith (msg ^ ": expected exception, but none was raised") with | Validation_error _ -> () (* expected *) | Failure _ -> () (* also acceptable *) | e -> failwith (msg ^ ": unexpected exception: " ^ Printexc.to_string e) (* Helper for Option in older OCaml *) let option_is_some = function Some _ -> true | None -> false let option_get = function Some x -> x | None -> failwith "option_get: None" (* ============================================================ *) (* BASIC CONVERSION TESTS *) (* ============================================================ *) let test_basic_conversion () = Printf.printf "\n=== Basic Conversion Tests ===\n"; test "minimal project" (fun () -> let input = "\ name: test\n\ version: 1.0\n\ obuild-ver: 1\n" in let proj = parse_and_convert input in assert_eq "name" "test" proj.Project.name; assert_eq "version" "1.0" proj.Project.version; assert_eq_int "obuild-ver" 1 proj.Project.obuild_ver); test "project with metadata" (fun () -> let input = "\ name: myproject\n\ version: 2.0.0\n\ obuild-ver: 1\n\ synopsis: A test project\n\ description: Longer description\n\ license: MIT\n\ homepage: https://example.com\n\ authors: Alice, Bob\n" in let proj = parse_and_convert input in assert_eq "synopsis" "A test project" proj.Project.synopsis; assert_eq "description" "Longer description" proj.Project.description; assert_eq "license" "MIT" proj.Project.license; assert_eq "homepage" "https://example.com" proj.Project.homepage; assert_eq_int "authors" 2 (List.length proj.Project.authors)); () (* ============================================================ *) (* LIBRARY CONVERSION TESTS *) (* ============================================================ *) let test_library_conversion () = Printf.printf "\n=== Library Conversion Tests ===\n"; test "simple library" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary mylib\n modules: A, B, C\n src-dir: lib\n" in let proj = parse_and_convert input in assert_eq_int "libs count" 1 (List.length proj.Project.libs); let lib = List.hd proj.Project.libs in assert_eq "lib name" "mylib" (Libname.to_string lib.Project.Library.name); assert_eq_int "modules" 3 (List.length lib.Project.Library.modules); assert_eq_int "src-dir" 1 (List.length lib.Project.Library.target.Target.target_obits.Target.target_srcdir)); test "library with build-deps" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary mylib\n modules: A\n build-deps: unix, str\n" in let proj = parse_and_convert input in let lib = List.hd proj.Project.libs in let deps = lib.Project.Library.target.Target.target_obits.Target.target_builddeps in assert_eq_int "deps count" 2 (List.length deps)); test "library with C settings" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary mylib\n modules: A\n c-dir: csrc\n c-sources: foo.c\n c-flags: -O2\n" in let proj = parse_and_convert input in let lib = List.hd proj.Project.libs in let cbits = lib.Project.Library.target.Target.target_cbits in assert_eq_int "c-sources" 1 (List.length cbits.Target.target_csources); assert_eq_int "c-flags" 1 (List.length cbits.Target.target_cflags)); test "library with pack" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary mylib\n modules: A\n pack: true\n" in let proj = parse_and_convert input in let lib = List.hd proj.Project.libs in assert_true "pack" lib.Project.Library.pack); () (* ============================================================ *) (* EXECUTABLE CONVERSION TESTS *) (* ============================================================ *) let test_executable_conversion () = Printf.printf "\n=== Executable Conversion Tests ===\n"; test "simple executable" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nexecutable myexe\n main-is: main.ml\n src-dir: src\n" in let proj = parse_and_convert input in assert_eq_int "exes count" 1 (List.length proj.Project.exes); let exe = List.hd proj.Project.exes in assert_eq "name" "myexe" exe.Project.Executable.name; assert_eq "main" "main.ml" (Filepath.fn_to_string exe.Project.Executable.main)); test "executable with deps" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nexecutable myexe\n main-is: main.ml\n build-deps: unix, cmdliner\n" in let proj = parse_and_convert input in let exe = List.hd proj.Project.exes in let deps = exe.Project.Executable.target.Target.target_obits.Target.target_builddeps in assert_eq_int "deps" 2 (List.length deps)); () (* ============================================================ *) (* TEST TARGET CONVERSION TESTS *) (* ============================================================ *) let test_test_conversion () = Printf.printf "\n=== Test Target Conversion Tests ===\n"; test "simple test" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\ntest mytest\n main-is: test_main.ml\n" in let proj = parse_and_convert input in assert_eq_int "tests count" 1 (List.length proj.Project.tests); let t = List.hd proj.Project.tests in assert_eq "name" "mytest" t.Project.Test.name; assert_eq "main" "test_main.ml" (Filepath.fn_to_string t.Project.Test.main)); test "test with rundir" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\ntest mytest\n main-is: test.ml\n run-dir: fixtures\n" in let proj = parse_and_convert input in let t = List.hd proj.Project.tests in assert_true "rundir is some" (option_is_some t.Project.Test.rundir)); () (* ============================================================ *) (* CSTUBS CONVERSION TESTS *) (* ============================================================ *) let test_cstubs_conversion () = Printf.printf "\n=== Cstubs Conversion Tests ===\n"; test "library with cstubs" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary mylib\n modules: Bindings, C\n build-deps: ctypes\n\n cstubs\n external-library-name: mylib_stubs\n type-description: Bindings.Types -> Types_gen\n function-description: Bindings.Functions -> Funcs_gen\n headers: string.h\n" in let proj = parse_and_convert input in let lib = List.hd proj.Project.libs in assert_true "cstubs present" (option_is_some lib.Project.Library.target.Target.target_cstubs); let cstubs = option_get lib.Project.Library.target.Target.target_cstubs in assert_eq "external-library-name" "mylib_stubs" cstubs.Target.cstubs_external_library_name; assert_true "type-description" (option_is_some cstubs.Target.cstubs_type_description); assert_true "function-description" (option_is_some cstubs.Target.cstubs_function_description); assert_eq_int "headers" 1 (List.length cstubs.Target.cstubs_headers)); test "cstubs auto-adds generated module" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary mylib\n modules: Bindings\n\n cstubs\n external-library-name: foo\n" in let proj = parse_and_convert input in let lib = List.hd proj.Project.libs in (* Should have Bindings + auto-generated Foo_generated + C + Types_generated *) assert_eq_int "modules" 4 (List.length lib.Project.Library.modules)); () (* ============================================================ *) (* FLAG CONVERSION TESTS *) (* ============================================================ *) let test_flag_conversion () = Printf.printf "\n=== Flag Conversion Tests ===\n"; test "flag definition" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nflag debug\n description: Enable debug mode\n default: true\n" in let proj = parse_and_convert input in assert_eq_int "flags" 1 (List.length proj.Project.flags); let flag = List.hd proj.Project.flags in assert_eq "flag name" "debug" flag.Project.Flag.name; assert_eq "flag desc" "Enable debug mode" flag.Project.Flag.description); () (* ============================================================ *) (* VALIDATION ERROR TESTS *) (* ============================================================ *) let test_validation_errors () = Printf.printf "\n=== Validation Error Tests ===\n"; test "missing name" (fun () -> let input = "\ version: 1.0\n\ obuild-ver: 1\n" in assert_raises "missing name" (fun () -> ignore (parse_and_convert input))); test "missing version" (fun () -> let input = "\ name: x\n\ obuild-ver: 1\n" in assert_raises "missing version" (fun () -> ignore (parse_and_convert input))); test "missing obuild-ver" (fun () -> let input = "\ name: x\n\ version: 1.0\n" in assert_raises "missing obuild-ver" (fun () -> ignore (parse_and_convert input))); test "library with no modules" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nlibrary mylib\n src-dir: lib\n" in assert_raises "no modules" (fun () -> ignore (parse_and_convert input))); test "executable with no main" (fun () -> let input = "name: x\nversion: 1\nobuild-ver: 1\n\nexecutable myexe\n src-dir: src\n" in assert_raises "no main" (fun () -> ignore (parse_and_convert input))); () (* ============================================================ *) (* COMPLEX PROJECT TESTS *) (* ============================================================ *) let test_complex_project () = Printf.printf "\n=== Complex Project Tests ===\n"; test "full project" (fun () -> let input = "name: myproject\nversion: 1.0.0\nobuild-ver: 1\nsynopsis: A complex project\nlicense: BSD-3-Clause\nauthors: Alice, Bob\nhomepage: https://github.com/example/myproject\n\nlibrary core\n modules: Types, Utils, Engine\n build-deps: base, stdio, unix\n src-dir: lib/core\n\n per Engine\n build-deps: threads\n\nexecutable mycli\n main-is: main.ml\n src-dir: bin\n build-deps: core, cmdliner\n\ntest unit_tests\n main-is: test_unit.ml\n src-dir: tests\n build-deps: core, alcotest\n\nflag debug\n description: Build with debug info\n default: false\n" in let proj = parse_and_convert input in assert_eq "name" "myproject" proj.Project.name; assert_eq_int "libs" 1 (List.length proj.Project.libs); assert_eq_int "exes" 1 (List.length proj.Project.exes); assert_eq_int "tests" 1 (List.length proj.Project.tests); assert_eq_int "flags" 1 (List.length proj.Project.flags); let lib = List.hd proj.Project.libs in assert_eq_int "lib modules" 3 (List.length lib.Project.Library.modules); assert_eq_int "lib extras" 1 (List.length lib.Project.Library.target.Target.target_extras)); () (* ============================================================ *) (* MAIN *) (* ============================================================ *) let () = Printf.printf "Running validation tests...\n"; test_basic_conversion (); test_library_conversion (); test_executable_conversion (); test_test_conversion (); test_cstubs_conversion (); test_flag_conversion (); test_validation_errors (); test_complex_project (); Printf.printf "\n=== Summary ===\n"; Printf.printf "Tests run: %d\n" !tests_run; Printf.printf "Passed: %d\n" !tests_passed; Printf.printf "Failed: %d\n" !tests_failed; if !tests_failed > 0 then exit 1 else Printf.printf "\nAll tests passed!\n" obuild-0.2.2/tests/validate_real_world.ml000066400000000000000000000226301515212760700205010ustar00rootroot00000000000000open Printf (** Real-world META file validation script This script: 1. Finds all META files in standard OCaml library locations 2. Parses each one with the improved parser 3. Logs errors with improved error messages 4. Reports statistics on parser improvements *) (** Scan a directory for META files *) let rec find_meta_files dir_path = let dir = Filepath.fp dir_path in if not (Filesystem.exists dir) then [] else if not (Filesystem.is_dir dir) then [] else try Filesystem.list_dir_pred_map (fun filename -> let fn_str = Filepath.fn_to_string filename in let full_path_str = Filename.concat dir_path fn_str in let full_path = Filepath.fp full_path_str in (* If it's META file, return it *) if fn_str = "META" then Some full_path_str (* If it's a directory, recursively scan it *) else if Filesystem.is_dir full_path then None (* We'll handle directories separately to avoid deep nesting *) else None ) dir @ (* Recursively scan subdirectories *) List.flatten (Filesystem.list_dir_pred_map (fun filename -> let fn_str = Filepath.fn_to_string filename in let full_path_str = Filename.concat dir_path fn_str in let full_path = Filepath.fp full_path_str in if Filesystem.is_dir full_path then Some (find_meta_files full_path_str) else None ) dir) with _ -> [] (** Read file contents *) let read_file path = try let ic = open_in path in let len = in_channel_length ic in let buf = Compat.bytes_create len in really_input ic buf 0 len; let content = Compat.bytes_to_string buf in close_in ic; Some content with _ -> None (** Parse result type *) type parse_result = | Success of string (* file path *) | LexerError of string * string (* file path, error message *) | ParserError of string * string (* file path, error message *) | ReadError of string (* file path *) (** Check if error message has position tracking *) let has_position_tracking msg = (* Position format: "line.column: " *) try let _ = Str.search_forward (Str.regexp "[0-9]+\\.[0-9]+:") msg 0 in true with Not_found -> false (** Check if error has context *) let has_context msg = String.length msg > 50 || (* Long messages likely have context *) (try let _ = Str.search_forward (Str.regexp "expected") msg 0 in true with Not_found -> false) (** Parse a single META file *) let parse_meta_file path = match read_file path with | None -> ReadError path | Some content -> try let pkg_name = Filename.basename (Filename.dirname path) in let _ = Meta.parse (Filepath.fp path) content pkg_name in Success path with | Meta.MetaParseError (_, msg) -> (* Determine if it's a lexer or parser error *) if String.contains msg ':' && has_position_tracking msg then LexerError (path, msg) else ParserError (path, msg) | exn -> ParserError (path, Printexc.to_string exn) (** Statistics tracker *) type stats = { mutable total_files: int; mutable successful: int; mutable lexer_errors: int; mutable lexer_errors_with_position: int; mutable parser_errors: int; mutable parser_errors_with_context: int; mutable read_errors: int; } let create_stats () = { total_files = 0; successful = 0; lexer_errors = 0; lexer_errors_with_position = 0; parser_errors = 0; parser_errors_with_context = 0; read_errors = 0; } (** Update statistics with parse result *) let update_stats stats result = stats.total_files <- stats.total_files + 1; match result with | Success _ -> stats.successful <- stats.successful + 1 | LexerError (_, msg) -> stats.lexer_errors <- stats.lexer_errors + 1; if has_position_tracking msg then stats.lexer_errors_with_position <- stats.lexer_errors_with_position + 1 | ParserError (_, msg) -> stats.parser_errors <- stats.parser_errors + 1; if has_context msg then stats.parser_errors_with_context <- stats.parser_errors_with_context + 1 | ReadError _ -> stats.read_errors <- stats.read_errors + 1 (** Print error details *) let print_error result = match result with | LexerError (path, msg) -> printf "\n[LEXER ERROR] %s\n" path; printf " Message: %s\n" msg; printf " Has position: %s\n" (if has_position_tracking msg then "✅ YES" else "❌ NO") | ParserError (path, msg) -> printf "\n[PARSER ERROR] %s\n" path; printf " Message: %s\n" msg; printf " Has context: %s\n" (if has_context msg then "✅ YES" else "❌ NO") | ReadError path -> printf "\n[READ ERROR] %s\n" path | Success _ -> () (** Print statistics *) let print_stats stats = printf "\n"; printf "════════════════════════════════════════════════════════════════\n"; printf " VALIDATION SUMMARY\n"; printf "════════════════════════════════════════════════════════════════\n"; printf "\n"; printf "Total META files scanned: %d\n" stats.total_files; printf "├─ ✅ Successfully parsed: %d (%.1f%%)\n" stats.successful (100.0 *. float_of_int stats.successful /. float_of_int stats.total_files); printf "├─ ❌ Lexer errors: %d (%.1f%%)\n" stats.lexer_errors (100.0 *. float_of_int stats.lexer_errors /. float_of_int stats.total_files); printf "│ └─ With position tracking: %d/%d (%.1f%%)\n" stats.lexer_errors_with_position stats.lexer_errors (if stats.lexer_errors > 0 then 100.0 *. float_of_int stats.lexer_errors_with_position /. float_of_int stats.lexer_errors else 0.0); printf "├─ ❌ Parser errors: %d (%.1f%%)\n" stats.parser_errors (100.0 *. float_of_int stats.parser_errors /. float_of_int stats.total_files); printf "│ └─ With context: %d/%d (%.1f%%)\n" stats.parser_errors_with_context stats.parser_errors (if stats.parser_errors > 0 then 100.0 *. float_of_int stats.parser_errors_with_context /. float_of_int stats.parser_errors else 0.0); printf "└─ ❌ Read errors: %d (%.1f%%)\n" stats.read_errors (100.0 *. float_of_int stats.read_errors /. float_of_int stats.total_files); printf "\n"; printf "════════════════════════════════════════════════════════════════\n"; printf "\n"; (* Quality metrics *) printf "IMPROVEMENT QUALITY METRICS:\n"; printf "├─ Lexer error quality: %s\n" (if stats.lexer_errors = 0 then "N/A (no lexer errors)" else if stats.lexer_errors_with_position = stats.lexer_errors then "✅ EXCELLENT (100%% have position)" else if stats.lexer_errors_with_position * 2 > stats.lexer_errors then "⚠️ GOOD (>50%% have position)" else "❌ POOR (<50%% have position)"); printf "└─ Parser error quality: %s\n" (if stats.parser_errors = 0 then "N/A (no parser errors)" else if stats.parser_errors_with_context = stats.parser_errors then "✅ EXCELLENT (100%% have context)" else if stats.parser_errors_with_context * 2 > stats.parser_errors then "⚠️ GOOD (>50%% have context)" else "❌ POOR (<50%% have context)"); printf "\n" (** Main validation *) let () = printf "Real-World META File Validation\n"; printf "════════════════════════════════════════════════════════════════\n\n"; (* Find all META files *) printf "Scanning for META files...\n"; let search_paths = [ "/usr/lib/ocaml"; Filename.concat (Sys.getenv "HOME") ".opam/default/lib"; ] in let all_meta_files = List.flatten (List.map (fun path -> printf " Scanning %s...\n" path; find_meta_files path ) search_paths) in printf "\nFound %d META files\n\n" (List.length all_meta_files); (* Parse each file *) printf "Parsing META files...\n"; let stats = create_stats () in let errors = ref [] in List.iter (fun path -> let result = parse_meta_file path in update_stats stats result; (* Collect errors for detailed reporting *) match result with | Success _ -> printf "."; flush stdout | LexerError _ | ParserError _ | ReadError _ -> printf "E"; flush stdout; errors := result :: !errors ) all_meta_files; printf "\n\n"; (* Print detailed errors if any *) if List.length !errors > 0 then begin printf "════════════════════════════════════════════════════════════════\n"; printf " ERROR DETAILS\n"; printf "════════════════════════════════════════════════════════════════\n"; List.iter print_error (List.rev !errors); printf "\n" end; (* Print statistics *) print_stats stats; (* Exit code *) if stats.successful = stats.total_files then exit 0 else exit 1