pax_global_header00006660000000000000000000000064152414323110014506gustar00rootroot0000000000000052 comment=c42f62d5f66f11aef6817e450392b0711532a28a obuild-0.3.0/000077500000000000000000000000001524143231100127645ustar00rootroot00000000000000obuild-0.3.0/.gitignore000066400000000000000000000000561524143231100147550ustar00rootroot00000000000000*.cmx *.o *.cmi dist src/obuild ext/compat.ml obuild-0.3.0/.merlin000066400000000000000000000003031524143231100142470ustar00rootroot00000000000000S ./ 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.3.0/.ocamlformat000066400000000000000000000001251524143231100152670ustar00rootroot00000000000000if-then-else=fit-or-vertical break-cases=fit-or-vertical type-decl=sparse margin=100 obuild-0.3.0/DESIGN.md000066400000000000000000001447711524143231100142750ustar00rootroot00000000000000# 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.3.0/LICENSE000066400000000000000000000024521524143231100137740ustar00rootroot00000000000000Copyright (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.3.0/OBUILD_SPEC.md000066400000000000000000000034541524143231100151040ustar00rootroot00000000000000# 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.3.0/README.md000066400000000000000000000226631524143231100142540ustar00rootroot00000000000000obuild ====== 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. * Content-digest based staleness: rebuilds are driven by what actually changed, not file timestamps, with early cutoff (an implementation-only change does not recompile dependents whose interfaces are unchanged). * 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 * Wrapped libraries (`pack: true`): a library's modules namespaced under a single top-level module, so different libraries can reuse module names * Vendored sub-projects (`vendor-dirs:`): build against obuild projects checked into your tree (e.g. git submodules) without installing them * `obuild run`: build and run an executable in one step * Generates `.merlin` automatically for IDE support 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 --build-tests true obuild build obuild test ``` ### Available Commands ``` obuild configure Prepare to build the package obuild build Make this package ready for installation obuild run Build an executable (if needed) and run it 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 obuild generate Generate configuration files (merlin, opam, completions) ``` ### Command Details **configure** - Prepare the project by checking dependencies and setting build options ```bash obuild configure [OPTIONS] Options: --build-tests true|false Build tests --build-examples true|false Build examples --library-bytecode true|false Compile libraries as bytecode --library-native true|false Compile libraries as native -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 ``` **run** - Build an executable target if it is stale, then run it ```bash obuild run [EXE] [ARGS...] # with a single executable in the project the name can be omitted; # everything after the executable name is passed to the program verbatim obuild run obuild run myexec --port 8080 ``` The program inherits the terminal and its exit code is propagated. **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 ``` Wrapped libraries (pack) ------------------------ Adding `pack: true` to a library namespaces all of its modules under a single top-level module named after the library: ``` library mylib modules: Util, Core src-dir: lib pack: true ``` Consumers see `Mylib.Util` and `Mylib.Core`; the bare names are hidden, so two libraries may both define a module `Util` without clashing. Inside the library, modules refer to each other by their plain names. On OCaml >= 4.02 this is implemented with module aliases (dune-style `Mylib__Util` units, cheap incremental builds); on older compilers it falls back to `-pack`. The project syntax is the same either way. Without `pack: true`, a module name may only be defined once per project: obuild reports a clear error when two targets provide the same module name from different source files. Vendored sub-projects --------------------- ``` name: myproject ... vendor-dirs: vendor ``` Each entry of `vendor-dirs` either is a vendored obuild project directory or contains project directories (`vendor/*/x.obuild` — the layout produced by git submodules). The libraries of vendored projects are built as part of your project (their `build-deps` resolve against other vendored or project libraries first, then ocamlfind) and are not installed: they link into your artifacts. Vendored executables and tests are ignored. Vendored projects must themselves be obuild projects. obuild-0.3.0/TODO.md000066400000000000000000000043201524143231100140520ustar00rootroot00000000000000This 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.3.0/bootstrap000077500000000000000000000073131524143231100147330ustar00rootroot00000000000000#!/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 str.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 digests 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.3.0/compat401.ml000066400000000000000000000012031524143231100150220ustar00rootroot00000000000000let 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 (* sub-second sleep; select-based (works on Unix; native Windows needs >= 4.03) *) let sleepf d = ignore (Unix.select [] [] [] d) obuild-0.3.0/compat402.ml000066400000000000000000000012041524143231100150240ustar00rootroot00000000000000let 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 (* sub-second sleep; select-based (works on Unix; native Windows needs >= 4.03) *) let sleepf d = ignore (Unix.select [] [] [] d) obuild-0.3.0/compat403.ml000066400000000000000000000011631524143231100150310ustar00rootroot00000000000000let 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 (* sub-second sleep, portable including native Windows *) let sleepf = Unix.sleepf obuild-0.3.0/compat_common.ml000066400000000000000000000066161524143231100161620ustar00rootroot00000000000000 (* 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.3.0/configure.ml000066400000000000000000000017171524143231100153050ustar00rootroot00000000000000(* Selects the compat implementation for the current compiler version and generates lib/base/compat.ml (compat_common.ml + the matching compat40X.ml). Pure OCaml on purpose: no shell commands, so it behaves identically under Unix shells, the msys2 shell and cmd.exe. *) let read_file path = let ic = open_in_bin path in let len = in_channel_length ic in let buf = Buffer.create len in (try Buffer.add_channel buf ic len with End_of_file -> ()); close_in ic; Buffer.contents buf let () = let version = Sys.ocaml_version in let variant = if version < "4.02.0" then "compat401.ml" else if version < "4.03.0" then "compat402.ml" else "compat403.ml" in let dest = Filename.concat (Filename.concat "lib" "base") "compat.ml" in (try Sys.remove dest with Sys_error _ -> ()); let oc = open_out_bin dest in output_string oc (read_file "compat_common.ml"); output_string oc "\n"; output_string oc (read_file variant); close_out oc obuild-0.3.0/lib/000077500000000000000000000000001524143231100135325ustar00rootroot00000000000000obuild-0.3.0/lib/base/000077500000000000000000000000001524143231100144445ustar00rootroot00000000000000obuild-0.3.0/lib/base/cli.ml000066400000000000000000000614361524143231100155570ustar00rootroot00000000000000(** 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; cmd_stop_at_positional : bool; (* stop option parsing at the first positional: everything after it is passed through verbatim (for commands like `run [args...]`) *) } 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 = []; cmd_stop_at_positional = false; } 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; cmd_stop_at_positional = false; } 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 = []; cmd_stop_at_positional = false; } 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 } (* stop option parsing at the first positional argument; the remaining arguments are passed through to the command verbatim *) let stop_at_first_positional cmd = { cmd with cmd_stop_at_positional = true } 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 arg = "--" then begin (* conventional end-of-options marker: the rest are positionals *) incr idx; stopped := true end else 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, !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 ~stop_at_positional:cmd.cmd_stop_at_positional 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.3.0/lib/base/cli.mli000066400000000000000000000212601524143231100157170ustar00rootroot00000000000000(** 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 stop_at_first_positional : command -> command (** Stop option parsing at the first positional argument; all following arguments are passed through to the command verbatim (for commands like [run [args...]]) *) 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.3.0/lib/base/filepath.ml000066400000000000000000000043141524143231100165740ustar00rootroot00000000000000open 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.3.0/lib/base/filepath.mli000066400000000000000000000046201524143231100167450ustar00rootroot00000000000000(** 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.3.0/lib/base/filesystem.ml000066400000000000000000000106151524143231100171650ustar00rootroot00000000000000open 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 = try Unix.mkdir (fp_to_string path) perm; true with Unix.Unix_error (Unix.EEXIST, _, _) -> if Sys.is_directory (fp_to_string path) then false else failwith ("directory " ^ fp_to_string path ^ " cannot be created: file already exists") 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 write_file_if_changed path s = try let existing = read_file path in if existing <> s then write_file path s with _ -> write_file path s 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.3.0/lib/base/filesystem.mli000066400000000000000000000060061524143231100173350ustar00rootroot00000000000000(** 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 write_file_if_changed : Filepath.filepath -> string -> unit (** Like [write_file] but skips the write when the file already contains identical content, preserving the existing mtime. *) 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.3.0/lib/base/fugue.ml000066400000000000000000000054531524143231100161200ustar00rootroot00000000000000let 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 && List.for_all (fun z -> List.mem z l1) l2 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 list_uniq l = let seen = Hashtbl.create 16 in List.filter (fun x -> if Hashtbl.mem seen x then false else (Hashtbl.replace seen x (); true) ) l 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.3.0/lib/base/fugue.mli000066400000000000000000000106161524143231100162660ustar00rootroot00000000000000(** 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.3.0/lib/base/location.ml000066400000000000000000000007441524143231100166130ustar00rootroot00000000000000(** 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.3.0/lib/base/string_utils.ml000066400000000000000000000061651524143231100175340ustar00rootroot00000000000000open 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_string ~percent 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" | '%' when percent -> Buffer.add_string buf "%%" | c -> Buffer.add_char buf c done; Buffer.contents buf let escape_ocaml_string s = escape_string ~percent:false s let escape_c_string s = escape_string ~percent:true s 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.3.0/lib/base/string_utils.mli000066400000000000000000000040141524143231100176740ustar00rootroot00000000000000(** {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.3.0/lib/core/000077500000000000000000000000001524143231100144625ustar00rootroot00000000000000obuild-0.3.0/lib/core/analyze.ml000066400000000000000000000270001524143231100164560ustar00rootroot00000000000000open 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_hier_registry : Hier.registry; (* module resolution context for this build *) project_metacache : Metacache.t; (* META cache for this build *) 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 = try Hashtbl.find project.project_dep_data pkg = Internal with Not_found -> false let is_pkg_system project pkg = try Hashtbl.find project.project_dep_data pkg = System with Not_found -> false 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 metacache 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 stdlibSet = Hashtbl.create (List.length stdlibLibs) in List.iter (fun f -> Hashtbl.replace stdlibSet f ()) stdlibLibs; 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 Hashtbl.mem stdlibSet (fn libCmxa) then [ ([ Meta.Predicate.Native ], libCmxa) ] else []) @ if Hashtbl.mem stdlibSet (fn libCma) 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 metacache 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) (fp_to_string (fp filename fn "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 hier_registry = let hier_registry_conf = Hier.conf hier_registry in let metacache = Metacache.create () in 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 metacache 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 metacache 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 metacache 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 maybe () (fun c -> if not (Expr.eval ver c) then raise (Dependencies.BuildDepAnalyzeFailed (cpkg ^ " (" ^ ver ^ ") doesn't match the constraint " ^ Expr.to_string c))) cconstr; 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 hier_registry_conf.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_hier_registry = hier_registry; project_metacache = metacache; 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.3.0/lib/core/analyze.mli000066400000000000000000000072171524143231100166370ustar00rootroot00000000000000(** 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_hier_registry : Hier.registry; project_metacache : Metacache.t; 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 -> Hier.registry -> 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.3.0/lib/core/build.ml000066400000000000000000001502241524143231100161170ustar00rootroot00000000000000open 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) = let src_paths = List.map snd srcs in if Filesystem.exists dest then match Digests.check dest src_paths with | Digests.Unchanged -> None | Digests.Changed p -> Digests.record_pending dest src_paths; Some (try List.find (fun (_, sp) -> sp = p) srcs with Not_found -> (Filetype.FileO, p)) | Digests.InputSetChanged -> Digests.record_pending dest src_paths; Some (Filetype.FileO, current_dir) | Digests.NoRecord -> ( (* no digest record yet: fall back to mtime comparison *) let dest_time = Filesystem.get_modification_time dest in try let changed = List.find (fun (_, path) -> let mtime = Filesystem.get_modification_time path in dest_time < mtime) srcs in Digests.record_pending dest src_paths; Some changed with Not_found -> (* valid by mtime: create the record so future builds use digests *) Digests.record_now dest src_paths; None) else begin Digests.record_pending dest src_paths; Some (Filetype.FileO, current_dir) end (* 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 conf target = let compile_opts = Target.get_compilation_opts conf target in let compiled_types = Target.get_ocaml_compiled_types conf 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 conf = if Gconf.get_target_option_typed conf Annot && conf.Gconf.bin_annot then AnnotationBoth else if Gconf.get_target_option_typed conf Annot then AnnotationText else if conf.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 (Hier.generators cstate.compilation_hier) ~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 cstate.compilation_hier 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 (Hier.conf cstate.compilation_hier) target in let annot_mode = annot_mode (Hier.conf cstate.compilation_hier) 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 (* the pack object embeds member implementations, so member objects are inputs too — a .cmi-only check misses implementation-only changes. Use the per-mode object as dest so bytecode and native don't share one staleness record. *) let obj_ty = if build_mode = ByteCode then Filetype.FileCMO else Filetype.FileCMX in let dest = (obj_ty, Hier.get_dest_file cstate.compilation_hier path obj_ty h) in let mdeps = List.concat (List.map (fun m -> (* .cmx is only an approximation of the implementation: the native code lives in the companion .o, which must be tracked for implementation-only changes *) [ (Filetype.FileCMI, Hier.get_dest_file cstate.compilation_hier path Filetype.FileCMI m); (obj_ty, Hier.get_dest_file cstate.compilation_hier path obj_ty m) ] @ if build_mode = Native then [ (Filetype.FileO, Hier.get_dest_file cstate.compilation_hier path Filetype.FileO m) ] else []) modules) in let dir = cstate.compilation_builddir_ml comp_opt in let fcompile = fun () -> run_ocaml_pack cstate.compilation_hier 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 cstate.compilation_hier r_dir_spec use_thread annot_mode build_mode comp_opt pack_opt use_pp oflags h ) in if invalid then begin (* rebuilt because an earlier mode was invalid: snapshot inputs too *) Digests.record_pending (snd dest) (List.map snd srcs); let _, ys = check invalid xs in (Some "", fcompile :: ys) end 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 (Hier.conf cstate.compilation_hier) target in let all_modes = get_all_modes (Hier.conf cstate.compilation_hier) 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 cstate.compilation_hier 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 cstate.compilation_hier 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 cstate.compilation_hier 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 cstate.compilation_hier 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 cstate.compilation_hier path ext module_dep) ] else [] in compiled_file_dep @ [ (Filetype.FileCMI, Hier.get_dest_file cstate.compilation_hier 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 (Hier.conf cstate.compilation_hier) 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 Compat.sleepf 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 (Hier.conf cstate.compilation_hier).Gconf.ocamlmklib then [ [ (fun () -> run_c_linking (Hier.conf cstate.compilation_hier) 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 (Hier.conf cstate.compilation_hier) LinkingShared cdep_files so_file) ]; [ (fun () -> run_ar a_file cdep_files) ]; [ (fun () -> run_ranlib a_file) ]; ] let satisfy_preds metacache 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 metacache 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 bstate.bstate_config.project_metacache 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 bstate.bstate_config.project_metacache dep preds then let archives = Meta.Pkg.get_archive_with_filter (path, rootPkg) dep preds in List.fold_left (fun acc (_, a) -> (* A virtual/meta package declares [archive(...) = ""] (empty), equivalent to having no archive: it contributes nothing to the link line (but its [requires] are still followed). The split then yields empty tokens — drop them so [fn] is never handed "" (which raises Filepath.EmptyFilename). *) let files = List.filter (fun f -> f <> "") (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 (Hier.conf cstate.compilation_hier) 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 ( Compat.sleepf 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 dep_archives dest compiledType compileOpt = 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 (Filesystem.get_modification_time dest); let srcs = (* .cmx files are only implementation approximations: track the .o companions so implementation-only changes trigger a relink. Dep archives cover removed-input staleness via the input-set check. *) List.concat (List.map (fun m -> (ext, Hier.get_dest_file cstate.compilation_hier path ext m) :: (if compiledType = Native then [ (Filetype.FileO, Hier.get_dest_file cstate.compilation_hier path Filetype.FileO m) ] else [])) compiled) @ List.map (fun p -> (Filetype.FileO, p)) c_obj_files @ List.map (fun p -> (Filetype.of_filepath p, p)) dep_archives in (* all staleness logic (digests, input sets, mtime fallback, recording) lives in check_destination_valid_with, shared with every other step *) match check_destination_valid_with srcs (Filetype.of_filepath dest, dest) with | None -> None | Some (_, p) -> Some p (** 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 (* archives of internal library dependencies are linked into executables: the link is stale when one of them changed, even if none of this target's own modules did *) let internal_dep_archives = if is_lib target then [] else List.fold_left (fun acc dep -> match Hashtbl.find bstate.bstate_config.project_dep_data dep with | Internal -> let dir = Dist.get_build_exn (Dist.Target (Name.Lib dep)) in let archive = dir Libname.to_cmca compiledType compileOpt dep in (* .cmxa is only an index: native implementations live in the .a *) let impls = if compiledType = Native then [ dir fn (Libname.to_libstring dep ^ extDP compileOpt ^ ".a") ] else [] in (archive :: impls) @ acc | System -> acc) [] pkgDeps in let depsTime = check_needs_relink cstate compiled c_obj_files internal_dep_archives 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 cstate.compilation_hier (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 (Hier.conf cstate.compilation_hier).Gconf.ocamlmklib then [ [ (fun () -> run_c_linking (Hier.conf cstate.compilation_hier) 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 (Hier.conf cstate.compilation_hier) 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 (Hier.conf cstate.compilation_hier) 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 (Hier.conf cstate.compilation_hier) 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 conf target = let all_modes = get_all_modes conf 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 conf opt ty (Target.get_target_dest_name target)) all_modes let sanity_check conf build_dir target = let files = get_destination_files conf 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 cstate, 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 (Hier.conf cstate.compilation_hier) 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 (); Digests.load (); let taskdep = Helper.Timing.measure_time "Taskdep.init" (fun () -> Taskdep.init dag) in (* input digests snapshotted while dispatching each task, committed on success *) let task_groups = Hashtbl.create initial_task_context_size 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 begin print_warnings warnings; try Digests.commit_group (Hashtbl.find task_groups task) with Not_found -> () end | Process.Failure (out, er, _) -> ( let msg = if String.length out > 0 then out ^ "\n" ^ er else er in match task with | CompileC _ -> raise (CCompilationFailed msg) | _ -> raise (CompilationFailed msg))); if is_done then Taskdep.mark_done taskdep task in let dispatch (task_index, task) = let t0 = Unix.gettimeofday () in Digests.begin_group (); 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 Hashtbl.replace task_groups task (Digests.take_group ()); 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 = try Helper.Timing.measure_time "Scheduler.schedule" (fun () -> Scheduler.schedule (Hier.conf bstate.bstate_config.project_hier_registry).Gconf.parallel_jobs taskdep dispatch schedule_finish) with e -> Digests.save (); raise e in Digests.save (); log Verbose "schedule finished: #processes=%d max_concurrency=%d\n" stat.Scheduler.nb_processes stat.Scheduler.max_runqueue; () (* Extensions of per-module compilation artifacts that the stale sweep may delete. Link products (.cma, .cmxa, .a, .cmxs, executables) are never touched. *) let sweep_extensions = [ "cmi"; "cmo"; "cmx"; "o"; "cmt"; "cmti"; "annot"; "spot"; "spit" ] (* Remove compilation artifacts in the target's build directories that the current DAG no longer produces (module removed, renamed, or no longer referenced). Stale .cmi files otherwise stay visible through -I and can mask errors or corrupt linking until a clean build. *) let sweep_stale_artifacts cstate = let expected = Hashtbl.create 128 in (* expected stems are full paths without the artifact extension; C objects are named .c.o so their stem is the .c path itself *) List.iter (fun comp_opt -> let dir = cstate.compilation_builddir_ml comp_opt in List.iter (fun step -> match step with | CompileModule h | CompileInterface h | CompileDirectory h -> ( try let dest = fp_to_string (Hier.get_dest_file cstate.compilation_hier dir Filetype.FileCMI h) in Hashtbl.replace expected (String.sub dest 0 (String.length dest - 4)) () with Not_found -> ()) | _ -> ()) (Dag.get_nodes cstate.compilation_dag)) [ Normal; WithDebug; WithProf ]; List.iter (fun c -> Hashtbl.replace expected (fp_to_string (cstate.compilation_builddir_c c)) ()) cstate.compilation_csources; let ext_of s = try let i = String.rindex s '.' in if String.contains_from s i '/' then None else Some (String.sub s (i + 1) (String.length s - i - 1)) with Not_found -> None in let rec walk dir = Filesystem.iterate (fun entry -> let p = dir entry in if Filesystem.is_dir p then walk p else let s = fp_to_string p in match ext_of s with | Some ext when List.mem ext sweep_extensions -> let stem = String.sub s 0 (String.length s - String.length ext - 1) in if not (Hashtbl.mem expected stem) then begin log Verbose "removing stale artifact %s\n" s; try Sys.remove s with Sys_error _ -> () end | _ -> ()) dir in let root = cstate.compilation_builddir_ml Normal in if Filesystem.is_dir root then walk root 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 sweep_stale_artifacts cstate; 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 bstate.bstate_config.project_hier_registry 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 Helper.Timing.measure_time "stale artifact sweep" (fun () -> sweep_stale_artifacts cstate); 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 (* explicitly list-valued table: a target accumulates the roots of every internal library it depends on *) let roots = try Hashtbl.find targets_deps ntask with Not_found -> [] 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 -> let existing = try Hashtbl.find targets_deps p with Not_found -> [] in Hashtbl.replace targets_deps p (roots @ existing)) (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.3.0/lib/core/build.mli000066400000000000000000000030701524143231100162640ustar00rootroot00000000000000(** 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 : Gconf.t -> 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.3.0/lib/core/build_cstubs.ml000066400000000000000000000711701524143231100175040ustar00rootroot00000000000000open 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 bstate.bstate_config.project_metacache "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 bstate.bstate_config.project_metacache "str" in let str_dir = Meta.get_include_dir stdlib (str_path, str_pkg) in let (path, pkg) = Metacache.get bstate.bstate_config.project_metacache "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 bstate.bstate_config.project_metacache "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 bstate.bstate_config.project_metacache "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 bstate.bstate_config.project_metacache "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 bstate.bstate_config.project_metacache "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 bstate.bstate_config.project_metacache "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_if_changed target_file content; log Report " Generated %s (no types)\n%!" (fp_to_string target_file); Scheduler.FinishTask task | Some type_desc -> (* Get paths and parse bindings module name *) 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 let bindings_parts = Hier.to_string type_desc.Target.cstubs_functor in 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 (* Skip regeneration if target_file is already newer than the compiled bindings *) let bindings_cmo = build_dir fn (Compat.string_uncapitalize bindings_module ^ ".cmo") in let target_mtime = Filesystem.get_modification_time target_file in let bindings_mtime = Filesystem.get_modification_time bindings_cmo in if Filesystem.exists target_file && target_mtime > bindings_mtime && bindings_mtime > 0.0 then begin log Report "[%*d of %d] cstubs types for %s up to date\n%!" nb_step_len task_index nb_step (Libname.to_string lib); Scheduler.FinishTask task end else begin (* 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_if_changed 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 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 (* Post-process C code to fix anonymous struct/enum compatibility: Replace offsetof(struct Foo, ...) with offsetof(Foo, ...) Replace sizeof(struct Foo) with sizeof(Foo) Replace sizeof(enum Foo) with sizeof(Foo) Replace "struct { ... struct Foo x; }" with "struct { ... Foo x; }" Replace "(enum Foo)" casts with "(Foo)" This makes it work with both named and anonymous types *) let step1 = Str.global_replace (Str.regexp "offsetof(struct \\([A-Za-z_][A-Za-z0-9_]*\\),") "offsetof(\\1," c_code in let step2 = Str.global_replace (Str.regexp "sizeof(struct \\([A-Za-z_][A-Za-z0-9_]*\\))") "sizeof(\\1)" step1 in let step3 = Str.global_replace (Str.regexp "sizeof(enum \\([A-Za-z_][A-Za-z0-9_]*\\))") "sizeof(\\1)" step2 in let step4 = Str.global_replace (Str.regexp "struct { char c; struct \\([A-Za-z_][A-Za-z0-9_]*\\) x; }") "struct { char c; \\1 x; }" step3 in (* Fix enum casts: (enum Foo) -> (Foo) *) let fixed_c_code = Str.global_replace (Str.regexp "(enum \\([A-Za-z_][A-Za-z0-9_]*\\))") "(\\1)" step4 in Filesystem.write_file_if_changed discover_c fixed_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_if_changed target_file ml_code; log Report " Generated %s\n%!" (fp_to_string target_file); ignore (bindings_module, types_functor); Scheduler.FinishTask task ) ) ) ) end (* up-to-date check *) (* 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_if_changed entry_file entry_content; (* Generate empty C stubs *) let c_stubs_file = autogen_dir fn (c_lib_name ^ "_stubs.c") in Filesystem.write_file_if_changed 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 (* Skip regeneration if the entry file is already newer than compiled bindings *) let entry_file = autogen_dir fn (Compat.string_uncapitalize entry_point_name ^ ".ml") in let entry_mtime = Filesystem.get_modification_time entry_file in let bindings_mtime = Filesystem.get_modification_time bindings_cmo in let types_mtime = Filesystem.get_modification_time types_cmo in let inputs_mtime = max bindings_mtime types_mtime in if Filesystem.exists entry_file && entry_mtime > inputs_mtime && inputs_mtime > 0.0 then begin log Report "[%*d of %d] cstubs functions for %s up to date\n%!" nb_step_len task_index nb_step (Libname.to_string lib); Scheduler.FinishTask task end else begin (* 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_if_changed 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_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_if_changed entry_file entry_content; let c_stubs_file = autogen_dir fn (c_lib_name ^ "_stubs.c") in Filesystem.write_file_if_changed 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 fallback_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_if_changed entry_file fallback_content; let c_stubs_file = autogen_dir fn (c_lib_name ^ "_stubs.c") in Filesystem.write_file_if_changed 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%!"; (* Post-process generated C stubs for anonymous struct/enum compatibility *) let c_stubs_file = autogen_dir fn (c_lib_name ^ "_stubs.c") in if Filesystem.exists c_stubs_file then begin let c_content = Filesystem.read_file c_stubs_file in let step1 = Str.global_replace (Str.regexp "struct \\([A-Za-z_][A-Za-z0-9_]*\\)\\*") "\\1*" c_content in let step2 = Str.global_replace (Str.regexp "struct \\([A-Za-z_][A-Za-z0-9_]*\\) ") "\\1 " step1 in let fixed_content = Str.global_replace (Str.regexp "(enum \\([A-Za-z_][A-Za-z0-9_]*\\))") "(\\1)" step2 in Filesystem.write_file_if_changed c_stubs_file fixed_content; log Report " Post-processed C stubs for compatibility\n%!"; end; Scheduler.FinishTask task ) ) end (* up-to-date check *) (* 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 let src_path = autogen_dir c_stubs_file in let dest_mtime = Filesystem.get_modification_time (snd dest) in let src_mtime = Filesystem.get_modification_time src_path in if Filesystem.exists (snd dest) && dest_mtime > src_mtime && src_mtime > 0.0 then begin log Report "[%*d of %d] cstubs C for %s up to date\n%!" nb_step_len task_index nb_step (Libname.to_string lib); Scheduler.FinishTask task end else begin 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) end obuild-0.3.0/lib/core/buildprogs.ml000066400000000000000000000200611524143231100171650ustar00rootroot00000000000000open 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 pack_opt = Hier.t option let annotToOpts conf mode = let bin_annot_opts = if conf.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 reg dirSpec use_thread annot_mode build_mode compileOpt pack_opt pp oflags modhier = let conf = Hier.conf reg in let dst_dir = dirSpec.dst_dir in let entry = Hier.get_file_entry reg modhier [ dirSpec.src_dir ] in let src_file = Hier.get_src_file dirSpec.src_dir entry in let compileOpt = if build_mode = Interface && compileOpt = WithProf then WithDebug else compileOpt in Filesystem.mkdir_safe_recursive dst_dir 0o755; let prog, srcFile, dstFile = match build_mode with | Interface -> ( Prog.get_ocamlc (), Hier.ml_to_ext src_file Filetype.FileMLI, Hier.get_dest_file reg dst_dir 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 reg dst_dir ext modhier ) in let args = [ prog ] @ (match use_thread with | NoThread -> [] | WithThread -> [ "-thread" ]) @ Utils.to_include_path_options dirSpec.include_dirs @ (match compileOpt with | Normal -> [] | WithDebug -> [ "-g" ] | WithProf -> [ "-p" ]) @ annotToOpts conf annot_mode @ oflags @ conf.Gconf.ocaml_extra_args @ Pp.to_params pp @ maybe [] (fun x -> if build_mode = Compiled Native then [ "-for-pack"; Hier.to_string x ] else []) pack_opt @ (if conf.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 reg _srcDir dst_dir annot_mode build_mode pack_opt dest modules = let conf = Hier.conf reg in let prog = if build_mode = ByteCode then Prog.get_ocamlc () else Prog.get_ocamlopt () in let ext = if build_mode = ByteCode then Filetype.FileCMO else Filetype.FileCMX in let ext_f = function | Filetype.FileML -> ext | Filetype.FileMLI -> Filetype.FileCMI | _ -> (* It should not happen *) if build_mode = ByteCode then Filetype.FileCMO else Filetype.FileCMX in Filesystem.mkdir_safe_recursive dst_dir 0o755; let args = [ prog ] @ maybe [] (fun x -> if build_mode = Native then [ "-for-pack"; Hier.to_string x ] else []) pack_opt @ annotToOpts conf annot_mode @ [ "-pack"; "-o"; fp_to_string (Hier.get_dest_file reg dst_dir ext dest) ] @ List.map (fun m -> fp_to_string (Hier.get_dest_file_ext reg dst_dir m ext_f)) modules in Process.make args let run_ocaml_infer reg srcDir includes pp modname = let entry = Hier.get_file_entry reg 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 dst_dir = dirSpec.dst_dir in Filesystem.mkdir_safe_recursive dst_dir 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 conf sharingMode depfiles dest = let args = if conf.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 reg includeDirs build_mode linking_mode compileType use_thread systhread oflags cclibs libs modules dest = let conf = Hier.conf reg in (* 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 conf Executable_as_obj) then let real = fp_to_string dest in let basename = Filename.basename real in if Utils.isWindows then (* a copy goes stale where a symlink doesn't: refresh it on every link. May fail if the copy is currently running (file in use) *) (try Filesystem.copy_file dest (fp basename) with _ -> ()) else if not (file_or_link_exists basename) then Unix.symlink real basename in let prog = match build_mode with | Native -> Prog.get_ocamlopt () | ByteCode -> Prog.get_ocamlc () in let ext = if build_mode = ByteCode then Filetype.FileCMO else Filetype.FileCMX in let args = [ prog ] @ (match use_thread with | NoThreads -> [] | PosixThread -> [ "-thread" ] | VMThread -> [ "-vmthread" ] | DefaultThread -> if systhread = "true" then [ "-thread" ] else [ "-vmthread" ]) @ (match linking_mode with | LinkingPlugin -> [ "-shared" ] | LinkingLibrary -> [ "-a" ] | LinkingExecutable -> if Gconf.get_target_option_typed conf 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 build_mode with | Native -> "-cclib" | ByteCode -> if String.length x > 1 && x.[1] = 'L' then "-cclib" else "-dllib"); x; ]) cclibs) @ List.map (fun m -> fp_to_string (Hier.get_dest_file reg current_dir ext m)) modules in let res = Process.make args in let () = link_maybe linking_mode 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 obuild-0.3.0/lib/core/buildprogs.mli000066400000000000000000000053351524143231100173450ustar00rootroot00000000000000(** 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 pack_opt = Hier.t option val run_ocaml_compile : Hier.registry -> Prepare.dir_spec -> Prepare.use_thread_flag -> annotation_mode -> Types.ocaml_compilation_mode -> Types.ocaml_compilation_option -> pack_opt -> Pp.t -> string list -> Hier.t -> Process.t (** Compile an OCaml module *) val run_ocaml_pack : Hier.registry -> Filepath.filepath -> Filepath.filepath -> annotation_mode -> Types.ocaml_compiled_type -> pack_opt -> Hier.t -> Hier.t list -> Process.t (** Pack multiple OCaml modules into one *) val run_ocaml_infer : Hier.registry -> 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 : Gconf.t -> c_linking_mode -> Filepath.filepath list -> Filepath.filepath -> Process.t (** Link C object files *) val run_ocaml_linking : Hier.registry -> 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.3.0/lib/core/configure.ml000066400000000000000000000252161524143231100170030ustar00rootroot00000000000000open 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 conf 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 conf) @ 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)) (* Remove the build directory content, but preserve the currently running executable if it lives inside it: with a self-hosted obuild, a plain `obuild configure && obuild build` would otherwise delete the very binary the shell is about to invoke. Identity is compared by (device, inode) so no realpath (OCaml 4.13+) is needed. *) let remove_build_content_keep_self () = (* identity by (device, inode) on Unix. On native Windows Unix.stat reports 0 for both fields, so fall back to comparing normalized paths (case-insensitive, / and \ equivalent). *) let normalize p = let p = if Filename.is_relative p then Filename.concat (Sys.getcwd ()) p else p in let b = Buffer.create (String.length p) in String.iter (fun c -> let c = if c = '/' then '\\' else c in let c = if c >= 'A' && c <= 'Z' then Char.chr (Char.code c + 32) else c in Buffer.add_char b c) p; Buffer.contents b in let self_id = try let st = Unix.stat Sys.executable_name in if st.Unix.st_ino = 0 then None else Some (st.Unix.st_dev, st.Unix.st_ino) with _ -> None in let self_path = try Some (normalize Sys.executable_name) with _ -> None in let is_self path = match self_id with | Some id -> ( try let st = Unix.stat (fp_to_string path) in (st.Unix.st_dev, st.Unix.st_ino) = id with _ -> false) | None -> ( match self_path with | Some sp -> (try normalize (fp_to_string path) = sp with _ -> false) | None -> false) in let rec remove_content dir = Filesystem.iterate (fun ent -> let p = dir ent in if Filesystem.is_dir p then begin remove_content p; try Unix.rmdir (fp_to_string p) with _ -> () end else if not (is_self p) then try Sys.remove (fp_to_string p) with _ -> ()) dir in let build_path = Dist.build_path () in if Filesystem.exists build_path then remove_content build_path let create_dist project flags = log Verbose "configuration changed, deleting dist\n%!"; remove_build_content_keep_self (); 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 conf hashtable = (* load the environment *) let opts = Gconf.get_target_options_keys () in List.iter (fun k -> Gconf.set_target_options conf k (bool_of_opt hashtable k)) opts let check_ocaml conf = 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 conf.Gconf.bin_annot <- false; if maj > 4 || (maj = 4 && min > 1) then conf.Gconf.short_path <- true; if maj > 5 || (maj = 5 && min >= 2) then conf.Gconf.bin_annot_occurrences <- true | _ -> conf.Gconf.bin_annot <- false); ocamlCfg let run hier_registry proj_file user_flags user_opts = let conf = Hier.conf hier_registry in Dist.create_maybe (); let _ = check_ocaml conf 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; conf.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 conf 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 conf o v) user_opts; let project = Analyze.prepare proj_file flags hier_registry in let currentSetup = makeSetup conf 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 -> ( try comparekvs "setup" stp (hashtbl_to_list currentSetup); false (* no changes detected *) 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 hier_registry proj_file reconf setup = let conf = Hier.conf hier_registry in let ocamlCfg = check_ocaml conf 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 hier_registry in create_dist project flags; (* write setup file *) log Verbose "Writing new setup\n%!"; let current_setup = makeSetup conf digestKV project flags in Dist.write_setup current_setup); flags obuild-0.3.0/lib/core/configure.mli000066400000000000000000000036421524143231100171530ustar00rootroot00000000000000(** 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 : Hier.registry -> 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 : Hier.registry -> 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 : Gconf.t -> (string, string) Hashtbl.t -> unit (** [set_opts hashtable] sets target options from configuration hashtable *) obuild-0.3.0/lib/core/dag.ml000066400000000000000000000252741524143231100155610ustar00rootroot00000000000000(* 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 is_children_full dag a b = let visited = Hashtbl.create 16 in let queue = Queue.create () in List.iter (fun c -> Queue.push c queue) (get_children dag a); let found = ref false in while not (Queue.is_empty queue) && not !found do let node = Queue.pop queue in if node = b then found := true else if not (Hashtbl.mem visited node) then begin Hashtbl.replace visited node (); List.iter (fun c -> Queue.push c queue) (get_children dag node) end done; !found 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. * Precomputes an adjacency matrix indexed by internal integer IDs so that the * inner loop uses O(1) array reads instead of the 4-hashtable-lookup has_edge. *) let transitive_reduction dag = let reducedDag = copy dag in let n = dag.next_id in if n = 0 then reducedDag else begin (* Build adjacency matrix from the original dag *) let adj = Array.make_matrix n n false in Hashtbl.iter (fun id node -> IntSet.iter (fun cid -> adj.(id).(cid) <- true) node.children ) dag.nodes; (* Collect node IDs once to avoid repeated Hashtbl.iter *) let ids = Hashtbl.fold (fun id _ acc -> id :: acc) dag.nodes [] in (* Triple loop: if x→y and y→z exist in original, remove x→z from reduced *) List.iter (fun xid -> List.iter (fun yid -> if adj.(xid).(yid) then List.iter (fun zid -> if adj.(yid).(zid) then begin let xval = Hashtbl.find dag.id_to_node xid in let zval = Hashtbl.find dag.id_to_node zid in del_edge xval zval reducedDag end ) ids ) ids ) ids; reducedDag end (* 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.3.0/lib/core/dag.mli000066400000000000000000000104051524143231100157200ustar00rootroot00000000000000(** 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.3.0/lib/core/dagutils.ml000066400000000000000000000017151524143231100166340ustar00rootroot00000000000000let 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 acc = if Taskdep.is_complete tdep then List.rev acc else ( match Taskdep.get_next tdep with | None -> failwith "taskdep dag next didn't work" | Some (_,task) -> Taskdep.mark_done tdep task; loop (task :: acc) ) in loop [] obuild-0.3.0/lib/core/dagutils.mli000066400000000000000000000014101524143231100167750ustar00rootroot00000000000000(** 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.3.0/lib/core/dependencies.ml000066400000000000000000000112551524143231100174460ustar00rootroot00000000000000open 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) (* Batch-run ocamldep on a list of .ml source files sharing the same dep_opt. * Fills `cache` with (fp_to_string srcFile -> merged Modname.t list) entries. * Silently skips on failure — callers fall back to run_ocamldep per-file. *) let fill_ocamldep_cache cache dopt ml_files = if ml_files = [] then () else let wrap_safe f = try Some (Modname.wrap f) with Modname.InvalidModuleName _ | Modname.EmptyModuleName -> None in let all_args = List.concat (List.map (fun f -> let base = fp_to_string f in let mli = base ^ "i" in base :: (if Filesystem.exists (fp mli) then [ mli ] else []) ) ml_files) in let args = [ Prog.get_ocamldep () ] @ Utils.to_include_path_options dopt.dep_includes @ Pp.to_params dopt.dep_pp @ [ "-modules" ] @ all_args in (match Process.run args with | Process.Failure _ -> () | Process.Success (out, _, _) -> let file_to_deps : (string, Modname.t list) Hashtbl.t = Hashtbl.create (List.length ml_files * 2) in List.iter (fun line -> match Utils.toKV line with | _, None -> () | k, Some v -> let deps = SafeList.filter_map wrap_safe (String_utils.words_noempty v) in Hashtbl.replace file_to_deps k deps) (String_utils.lines_noempty out); List.iter (fun f -> let base = fp_to_string f in if Hashtbl.mem file_to_deps base || Hashtbl.mem file_to_deps (base ^ "i") then begin let ml_deps = (try Hashtbl.find file_to_deps base with Not_found -> []) in let mli_deps = (try Hashtbl.find file_to_deps (base ^ "i") with Not_found -> []) in let seen = Hashtbl.create 16 in let merged = List.filter (fun x -> if Hashtbl.mem seen x then false else (Hashtbl.replace seen x (); true) ) (ml_deps @ mli_deps) in Hashtbl.replace cache base merged end) ml_files) (* 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.3.0/lib/core/dependencies.mli000066400000000000000000000044451524143231100176220ustar00rootroot00000000000000(** 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 fill_ocamldep_cache : (string, Modname.t list) Hashtbl.t -> dep_opt -> Filepath.filepath list -> unit (** [fill_ocamldep_cache cache dopt ml_files] batch-runs ocamldep on all [ml_files] in one subprocess and stores merged dep lists in [cache] keyed by [Filepath.fp_to_string srcFile]. Silently skips on error so callers can fall back to per-file [run_ocamldep] calls. *) 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.3.0/lib/core/digests.ml000066400000000000000000000156301524143231100164630ustar00rootroot00000000000000(* Content-digest based staleness tracking. * * For each build artifact (dest) we record the digest of every input it was * built from. An artifact is stale when an input's current digest differs * from the recorded one, or when the input set itself changed (e.g. a module * was removed from a link). This is immune to the mtime failure modes: * saves during a build, equal-mtime ties on coarse filesystems, and clock * skew. It also gives early cutoff: rewriting a byte-identical .cmi does * not invalidate dependents. * * Digests of input files are themselves cached against mtime; a cached * digest is only trusted when the file's mtime is older than the time the * hash was taken by a safety margin, so files modified around hashing time * are re-hashed. * * Records are written to /digests. Records for artifacts about to be * rebuilt are snapshotted before the compile runs (record_pending) and only * committed once the task's processes all succeed (commit_group), so a * failed compile never marks its output fresh. When no record exists, * callers fall back to mtime comparison, so a pre-existing dist upgrades * incrementally without a full rebuild. *) open Filepath type check_result = | Unchanged | Changed of filepath | InputSetChanged | NoRecord type group = string list (* input digest cache: path -> (mtime, hash_time, digest) *) let stat_cache : (string, float * float * Digest.t) Hashtbl.t = Hashtbl.create 256 (* committed records: dest -> (input path, digest) list *) let records : (string, (string * Digest.t) list) Hashtbl.t = Hashtbl.create 256 (* snapshots taken before a compile, not yet validated by task success *) let pending : (string, (string * Digest.t) list) Hashtbl.t = Hashtbl.create 64 (* dests snapshotted since the last take_group *) let current_group : string list ref = ref [] let loaded = ref false let dirty = ref false (* don't trust a cached digest when the file mtime is within this margin of * the hashing time: the file may have changed within mtime granularity *) let mtime_margin = 2.0 let db_path () = Dist.get_path () fn "digests" let find_opt tbl k = try Some (Hashtbl.find tbl k) with Not_found -> None (* hex encoding done locally: Digest.to_hex/from_hex only exist on OCaml >= 4.00 and obuild supports 3.x *) let digest_to_hex (d : Digest.t) = let b = Buffer.create 32 in String.iter (fun c -> Buffer.add_string b (Printf.sprintf "%02x" (Char.code c))) (d :> string); Buffer.contents b let digest_of_hex s : Digest.t = let v c = match c with | '0' .. '9' -> Char.code c - Char.code '0' | 'a' .. 'f' -> Char.code c - Char.code 'a' + 10 | 'A' .. 'F' -> Char.code c - Char.code 'A' + 10 | _ -> raise (Invalid_argument "digest_of_hex") in let n = String.length s / 2 in let b = Buffer.create n in for i = 0 to n - 1 do Buffer.add_char b (Char.chr ((v s.[2 * i] * 16) + v s.[(2 * i) + 1])) done; Buffer.contents b let file_digest path = let s = fp_to_string path in let mtime = Filesystem.get_modification_time path in match find_opt stat_cache s with | Some (m, ht, d) when m = mtime && mtime < ht -. mtime_margin -> d | _ -> let d = Digest.file s in Hashtbl.replace stat_cache s (mtime, Unix.gettimeofday (), d); dirty := true; d let check dest srcs = match find_opt records (fp_to_string dest) with | None -> NoRecord | Some recorded -> let cur = List.map fp_to_string srcs in if List.sort compare cur <> List.sort compare (List.map fst recorded) then InputSetChanged else ( try let changed, _ = List.find (fun (src, dg) -> try file_digest (fp src) <> dg with _ -> true) recorded in Changed (fp changed) with Not_found -> Unchanged) let snapshot srcs = List.fold_left (fun acc src -> try (fp_to_string src, file_digest src) :: acc with _ -> acc) [] srcs let record_pending dest srcs = let d = fp_to_string dest in Hashtbl.replace pending d (snapshot srcs); current_group := d :: !current_group let record_now dest srcs = Hashtbl.replace records (fp_to_string dest) (snapshot srcs); dirty := true let begin_group () = current_group := [] let take_group () = let g = !current_group in current_group := []; g let commit_group g = List.iter (fun d -> match find_opt pending d with | Some snap -> Hashtbl.replace records d snap; Hashtbl.remove pending d; dirty := true | None -> ()) g (* storage format, one entry per line: * F stat cache entry * D start of a dest record * I input of the current dest * paths may contain spaces (they extend to end of line) but not newlines *) let split_first s = try let i = String.index s ' ' in (String.sub s 0 i, String.sub s (i + 1) (String.length s - i - 1)) with Not_found -> (s, "") let load () = if not !loaded then begin loaded := true; let path = db_path () in if Filesystem.exists path then try let content = Filesystem.read_file path in let cur_dest = ref None in let flush_dest inputs = match !cur_dest with | Some d -> Hashtbl.replace records d (List.rev inputs) | None -> () in let inputs = ref [] in List.iter (fun line -> if String.length line > 2 then let rest = String.sub line 2 (String.length line - 2) in match line.[0] with | 'F' -> let mt, rest = split_first rest in let ht, rest = split_first rest in let hex, p = split_first rest in Hashtbl.replace stat_cache p (float_of_string mt, float_of_string ht, digest_of_hex hex) | 'D' -> flush_dest !inputs; inputs := []; cur_dest := Some rest | 'I' -> let hex, p = split_first rest in inputs := (p, digest_of_hex hex) :: !inputs | _ -> ()) (String_utils.lines_noempty content); flush_dest !inputs with _ -> (* unreadable or corrupted: start fresh, callers fall back to mtimes *) Hashtbl.clear stat_cache; Hashtbl.clear records end let save () = if !dirty then begin let buf = Buffer.create 4096 in Hashtbl.iter (fun p (mt, ht, d) -> Buffer.add_string buf (Printf.sprintf "F %.17g %.17g %s %s\n" mt ht (digest_to_hex d) p)) stat_cache; Hashtbl.iter (fun dest inputs -> Buffer.add_string buf ("D " ^ dest ^ "\n"); List.iter (fun (p, d) -> Buffer.add_string buf ("I " ^ digest_to_hex d ^ " " ^ p ^ "\n")) inputs) records; Filesystem.write_file (db_path ()) (Buffer.contents buf); dirty := false end obuild-0.3.0/lib/core/digests.mli000066400000000000000000000036701524143231100166350ustar00rootroot00000000000000(** Content-digest based staleness tracking. Records, for each build artifact, the digest of every input it was built from. Staleness checks compare current input digests against the record, which is immune to mtime races (saves during a build, equal-mtime ties) and provides early cutoff when an input is rewritten with identical content. Records persist in [/digests]. *) (** Result of checking an artifact against its recorded inputs *) type check_result = | Unchanged (** all inputs match the recorded digests *) | Changed of Filepath.filepath (** this input's content changed *) | InputSetChanged (** the set of inputs differs from the record *) | NoRecord (** no record: caller should fall back to mtimes *) (** Dests snapshotted during one scheduler dispatch; committed on task success *) type group val load : unit -> unit (** Load persisted records from [/digests]. Idempotent. *) val save : unit -> unit (** Persist records if anything changed since the last save. *) val check : Filepath.filepath -> Filepath.filepath list -> check_result (** [check dest srcs] compares current digests of [srcs] against the record for [dest]. *) val record_pending : Filepath.filepath -> Filepath.filepath list -> unit (** [record_pending dest srcs] snapshots digests of [srcs] now, before the rebuild of [dest] runs; committed only by [commit_group]. *) val record_now : Filepath.filepath -> Filepath.filepath list -> unit (** [record_now dest srcs] records immediately, for artifacts already known valid (mtime-checked) that have no record yet. *) val begin_group : unit -> unit (** Start collecting pending dests for the task being dispatched. *) val take_group : unit -> group (** Return (and clear) the dests snapshotted since [begin_group]. *) val commit_group : group -> unit (** Commit the pending snapshots of a group after its task succeeded. *) obuild-0.3.0/lib/core/dist.ml000066400000000000000000000045321524143231100157630ustar00rootroot00000000000000open 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.3.0/lib/core/dist.mli000066400000000000000000000027211524143231100161320ustar00rootroot00000000000000(** 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 : unit -> Filepath.filepath val setup_path : unit -> Filepath.filepath val configure_path : unit -> 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.3.0/lib/core/exception.ml000066400000000000000000000156141524143231100170210ustar00rootroot00000000000000open Printf open Helper open Filepath (* Exit codes used by obuild *) let exit_arg_error = 2 (* bad command-line argument *) let exit_project_error = 3 (* project file / configuration problem *) let exit_dist_error = 4 (* dist directory / reconfigure needed *) let exit_dependency_error = 5 (* module-level dependency problem *) let exit_compile_error = 6 (* OCaml compilation failure *) let exit_link_error = 7 (* linking failure *) let exit_dep_analyze = 8 (* ocamldep / dependency analysis failure *) let exit_missing_dep = 9 (* missing library dependency *) let exit_unix_error = 20 (* unexpected Unix error *) let exit_invalid_path = 30 (* invalid filename / filepath *) let exit_file_not_found = 40 (* file not found in search paths *) 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 exit_arg_error | Arg.Help h -> eprintf "%s\n" h; exit 0 (* project file related *) | Project.NoConfFile -> error "couldn't find obuild file\n"; exit exit_project_error | Project.MultipleConfFiles -> error "multiples obuild files found\n"; exit exit_project_error | 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 exit_project_error | 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 exit_project_error | Project.ModuleListEmpty l -> error "library %s doesn't have any modules defined.\n" (Libname.to_string l); exit exit_project_error | Hier.ModuleCollision (m, existing, conflicting) -> error "module %s is defined by multiple sources:\n" m; eprintf "\t%s\n\t%s\n" (fp_to_string existing) (fp_to_string conflicting); eprintf " a module name can only be defined once per project.\n"; eprintf " rename one of the files, or namespace a library with 'pack: true'\n"; exit exit_project_error | Project.InvalidConfFile c -> error "configuration file appears invalid: %s\n" c; exit exit_project_error | 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 exit_project_error | Project.BadOcamlVersion (ver, c) -> error "wrong ocaml version: actual %s expected %s\n" ver (Expr.to_string c); exit exit_project_error | Expr.CannotParseConstraints (builddep, s) -> error "cannot parse constraints for build dependency '%s': %s\n" builddep s; exit exit_project_error (* dist directory related *) | Dist.DistNotADirectory -> error "dist is not a directory\n"; exit exit_dist_error | Dist.DistNotFound -> error "run 'obuild configure' first\n"; exit exit_dist_error | Dist.MissingDestinationDirectory dir -> error "missing destination directory: %s\n" (Dist.to_string dir); exit exit_dist_error (* 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 exit_dist_error | 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 exit_dist_error | Target.TargetNotRecognized s -> error "Unknown target specified '%s'\n" s; exit exit_dist_error (* reconfigure *) | Configure.ConfigChanged r -> ( match r with | "digest" -> error "project file changed. run 'obuild configure' again\n"; exit exit_dist_error | _ -> error "config changed (reason=%s). run 'obuild configure' again\n" r; exit exit_dist_error) | Configure.ConfigurationMissingKey k -> error "cannot find key %s in setup. run 'obuild configure' again\n" k; exit exit_dist_error | Configure.ConfigurationTypeMismatch (k, t, v) -> error "%s type mismatch (got '%s') in setup key %s. run 'obuild configure' again\n" t v k; exit exit_dist_error | Meta.MetaParseError (fp, err) -> error "unexpected parse error '%s' in meta file %s\n" err (fp_to_string fp); exit exit_dist_error | 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 exit_dist_error | Analyze.SublibraryNotFound dep -> error "dependency %s not found\n" (Libname.to_string dep); exit exit_dist_error (* build related failure *) | Prepare.Module.DependsItself m -> error "cyclic dependency module detected in module %s\n" (Hier.to_string m); exit exit_dependency_error | 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 exit_dependency_error | 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 exit_dependency_error | Build.CompilationFailed e -> eprintf "\n%s\n%!" e; exit exit_compile_error | Build.CCompilationFailed e -> eprintf "\n%s\n%!" e; exit exit_compile_error | Buildprogs.LinkingFailed e -> eprintf "\n%s\n%!" e; exit exit_link_error | Dependencies.BuildDepAnalyzeFailed e -> eprintf "\n%s\n%!" e; exit exit_dep_analyze | Dependencies.DependenciesMissing missing -> ( match missing with | [] -> assert false | [dep] -> error "missing dependency '%s'\n" dep; exit exit_missing_dep | _ -> eprintf "missing dependencies:\n%s\n" (Utils.showList "\n" (fun x -> x) missing); exit exit_missing_dep) (* others exception *) | Unix.Unix_error (err, fname, params) -> error "unexpected unix error: \"%s\" during %s(%s)\n" (Unix.error_message err) fname params; exit exit_unix_error | Filepath.InvalidFilename f -> error "the filename \"%s\" is not valid, it contains a directory separator\n" f; exit exit_invalid_path | Utils.FileNotFoundInPaths (ds, f) -> error "File %s not found in directories %s\n" (fn_to_string f) (Utils.showList "; " fp_to_string ds); exit exit_file_not_found | Exit -> () | Failure msg -> (* failwith is reserved for internal programming errors; give a clean message *) error "internal error: %s\n" msg; exit 1 | e -> eprintf "uncaught exception\n"; raise e obuild-0.3.0/lib/core/exception.mli000066400000000000000000000005261524143231100171660ustar00rootroot00000000000000(** 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.3.0/lib/core/expr.ml000066400000000000000000000204461524143231100160000ustar00rootroot00000000000000exception 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.3.0/lib/core/expr.mli000066400000000000000000000061451524143231100161510ustar00rootroot00000000000000(** 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.3.0/lib/core/filetype.ml000066400000000000000000000043401524143231100166360ustar00rootroot00000000000000open 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.3.0/lib/core/filetype.mli000066400000000000000000000043441524143231100170130ustar00rootroot00000000000000(** 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.3.0/lib/core/findlibConf.ml000066400000000000000000000051321524143231100172320ustar00rootroot00000000000000open 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 assoc_req key = try List.assoc key kvs with Not_found -> failwith ("findlib config " ^ fp_to_string path ^ ": missing key '" ^ key ^ "'") in (* Relocatable findlib (>= 1.9.9) writes RELATIVE path/destdir entries (".", "./ocaml"), which findlib resolves against the config FILE's own directory. obuild searches these dirs directly, so resolve them the same way — otherwise a relative entry is (wrongly) taken relative to obuild's CWD and no package is found. Absolute entries pass through unchanged (older findlib → no-op). *) let base = fp_to_string (path_dirname path) in let resolve s = let s = if String.length s >= 2 && s.[0] = '.' && s.[1] = '/' then String.sub s 2 (String.length s - 2) else s in if s = "" || s = "." then base else if Filename.is_relative s then Filename.concat base s else s in let paths = List.map (fun s -> fp (resolve s)) (String_utils.split ':' (unquote (assoc_req "path"))) in let destdir = resolve (unquote (assoc_req "destdir")) in { _all = kvs; path = 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.3.0/lib/core/findlibConf.mli000066400000000000000000000021641524143231100174050ustar00rootroot00000000000000(** 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.3.0/lib/core/gconf.ml000066400000000000000000000114061524143231100161120ustar00rootroot00000000000000open Fugue type verbosity_t = | Silent | Report | Verbose | Debug | Trace 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 (* Process-wide console settings. Logging is cross-cutting — passing a context into every log call site would be noise — so this small record is deliberately global. Everything build-affecting lives in the explicit [t] below, created per invocation and carried in the build context. *) type console_t = { mutable verbosity : verbosity_t; mutable color : bool; } let console = { verbosity = Report; color = false } type t = { mutable parallel_jobs : int; mutable dump_dot : bool; mutable bin_annot : bool; mutable bin_annot_occurrences : bool; mutable short_path : bool; mutable ocamlmklib : bool; mutable ocaml_extra_args : string list; target_options : (target_option, bool) Hashtbl.t; } 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 create () = 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; { parallel_jobs = 2; dump_dot = false; bin_annot = true; bin_annot_occurrences = false; short_path = false; ocamlmklib = true; ocaml_extra_args = []; target_options = h; } let rec set_target_option_typed conf opt value = Hashtbl.replace conf.target_options opt value; match (opt, value) with | Executable_profiling, true -> set_target_option_typed conf Library_profiling true | Executable_debugging, true -> set_target_option_typed conf Library_debugging true | Library_plugin, true -> set_target_option_typed conf Library_native true | Library_native, false -> set_target_option_typed conf Library_plugin false | _ -> () let set_target_options conf field value = set_target_option_typed conf (target_option_of_string field) value let get_target_options_keys () = List.map target_option_to_string all_target_options let get_target_options conf = Hashtbl.fold (fun k v acc -> (target_option_to_string k, v) :: acc) conf.target_options [] let get_target_option_typed conf opt = try Hashtbl.find conf.target_options opt with Not_found -> false let get_target_option conf field = get_target_option_typed conf (target_option_of_string field) obuild-0.3.0/lib/core/gconf.mli000066400000000000000000000045221524143231100162640ustar00rootroot00000000000000(** 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 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 (** Process-wide console settings (verbosity, color). Deliberately global: logging is cross-cutting and threading a context through every log site would be noise. Everything build-affecting lives in [t]. *) type console_t = { mutable verbosity : verbosity_t; mutable color : bool; } val console : console_t (** Build configuration, created per invocation and carried in the build context (Hier.registry) *) type t = { mutable parallel_jobs : int; mutable dump_dot : bool; mutable bin_annot : bool; mutable bin_annot_occurrences : bool; mutable short_path : bool; mutable ocamlmklib : bool; mutable ocaml_extra_args : string list; target_options : (target_option, bool) Hashtbl.t; } (** Global configuration record *) (** Typed target options *) val target_option_to_string : target_option -> string val target_option_of_string : string -> target_option exception UnknownOption of string val create : unit -> t (** Create a build configuration with default values *) (** 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 : t -> string -> bool (** Get target-specific option value by string key *) val get_target_option_typed : t -> target_option -> bool (** Get target-specific option value by typed key *) val set_target_options : t -> string -> bool -> unit (** Set target-specific option value by string key *) val set_target_option_typed : t -> target_option -> bool -> unit (** Set target-specific option value by typed key *) val get_target_options : t -> (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.3.0/lib/core/generators.ml000066400000000000000000000171031524143231100171670ustar00rootroot00000000000000open 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 *) (* The set of generators available to a build, derived from the project's custom generator definitions. No global state: the set travels in the per-invocation Hier.registry. *) type set = { set_all : t list; (* suffix-based generators (for auto-detection) *) set_customs : custom list; (* raw custom definitions (for generate blocks) *) } (** 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 } (** Build the generator set from the project's custom generator definitions *) let make_set customs = { (* only generators with a non-empty suffix participate in auto-detection *) set_all = List.filter (fun gen -> gen.suffix <> "") (List.map custom_to_builtin customs); set_customs = customs; } (** Get all generators with suffixes (for automatic detection) *) let get_all gset = gset.set_all (** Check if a file extension has a registered generator *) let is_generator_ext gset ext = let ext_with_dot = "." ^ ext in List.exists (fun gen -> gen.suffix = ext || gen.suffix = ext_with_dot) gset.set_all (** Get ALL generators for filepath based on extension *) let get_generators gset 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) gset.set_all | _ -> [] (** Get single generator for filepath (for backward compatibility) *) let get_generator gset fp = match get_generators gset fp with | [] -> raise (GeneratorNotFound (fp_to_string fp)) | gen :: _ -> gen (** Run ALL generators for source file *) let run gset dest src modName = log Debug " generator dest = %s src = %s\n%!" (fp_to_string dest) (fp_to_string src); let gens = get_generators gset 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 gset name = try Some (List.find (fun (g : custom) -> g.custom_name = name) gset.set_customs) with Not_found -> None (** Run a generator with multiple inputs (for generate blocks) *) let run_custom_multi gset ~generator_name ~dest ~sources ~extra_args = (* Find the custom generator by name *) let custom = match find_generator_by_name gset 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.3.0/lib/core/generators.mli000066400000000000000000000072651524143231100173500ustar00rootroot00000000000000(** 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 *) } (** The set of generators available to a build (no global state) *) type set val make_set : custom list -> set (** Build the generator set from the project's custom generator definitions *) val get_all : set -> t list (** Get list of all registered generators (built-in + custom) *) val is_generator_ext : set -> string -> bool (** Check if file extension has a registered generator *) val get_generator : set -> Filepath.filepath -> t (** Get generator for filepath based on extension @raise GeneratorNotFound if no generator found *) val run : set -> 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} *) (** {2 Multi-Input Generators (for generate blocks)} *) val run_custom_multi : set -> 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 : set -> 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.3.0/lib/core/helper.ml000066400000000000000000000022751524143231100163010ustar00rootroot00000000000000open Printf open Gconf let print_warnings warnings = if warnings <> "" then fprintf stderr "%s\n%!" warnings else () let log lvl fmt = if lvl <= console.verbosity then printf fmt else ifprintf stdout fmt let support_color = not Utils.isWindows && Unix.isatty Unix.stdout let color_red () = if support_color && Gconf.console.color then "\x1b[1;31m" else "" let color_green () = if support_color && Gconf.console.color then "\x1b[1;32m" else "" let color_blue () = if support_color && Gconf.console.color then "\x1b[1;34m" else "" let color_white () = if support_color && Gconf.console.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.3.0/lib/core/helper.mli000066400000000000000000000021251524143231100164440ustar00rootroot00000000000000(** 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 : bool (** Whether terminal supports color output (computed once at startup) *) 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.3.0/lib/core/hier.ml000066400000000000000000000350061524143231100157470ustar00rootroot00000000000000open Fugue open Filepath open Compat exception EmptyModuleHierarchy (* module name resolves to different source files in different targets *) exception ModuleCollision of (string * filepath * filepath) 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 *) | AliasedFileEntry of (filepath * filepath) (* root_path, full_path — like FileEntry, but destination artifact names are derived from the hier leaf instead of the source file basename, so a source like util.ml can compile to the unit Mylib__Util (module-alias wrapping) *) 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) | AliasedFileEntry (p, f) -> Printf.sprintf "AliasedFileEntry %s %s" (fp_to_string p) (fp_to_string f) (* Module resolution registry, one per build invocation. Explicit (no global state): module->file mappings and generated-module names are only shared between the targets of the same build, and unit tests get isolation. *) type registry = { reg_entries : (t, file_entry) Hashtbl.t; reg_generated : (string, unit) Hashtbl.t; (* generate-block module names *) mutable reg_generators : Generators.set; (* generators available to this build; set after the project file is parsed (custom generator definitions live in the .obuild file) *) reg_conf : Gconf.t; (* build configuration for this invocation *) } let create_registry () = { reg_entries = Hashtbl.create 128; reg_generated = Hashtbl.create 16; reg_generators = Generators.make_set []; reg_conf = Gconf.create (); } let generators reg = reg.reg_generators let conf reg = reg.reg_conf let set_custom_generators reg customs = reg.reg_generators <- Generators.make_set customs let register_generated_module reg name = Hashtbl.replace reg.reg_generated name () let is_generated_module reg name = Hashtbl.mem reg.reg_generated name let root = function | x :: _ -> x | [] -> raise EmptyModuleHierarchy let parent x = match x with | [] -> failwith "internal error: hier.parent called on empty hierarchy" | [ _ ] -> 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 reg root_path hier ext : file_entry option = match SafeHashtbl.find_opt reg.reg_entries hier with | Some entry -> (* the module already resolved through another root; if this root also provides a source for it, the module name is ambiguous: the cached entry would silently shadow the other source *) let entry_root = match entry with | FileEntry (r, _) | GeneratedFileEntry (r, _, _) | DirectoryEntry (r, _) | AliasedFileEntry (r, _) -> r in if entry_root <> root_path then begin let path = add_prefix root_path hier in match check_modname path (Modname.to_string (leaf hier)) ext with | Some name -> let conflicting = if ext <> Filetype.FileOther "" then path (fn name <.> Filetype.to_string ext) else path fn name in let existing = match entry with | FileEntry (_, f) | DirectoryEntry (_, f) | GeneratedFileEntry (_, f, _) | AliasedFileEntry (_, f) -> f in if conflicting <> existing then raise (ModuleCollision (to_string hier, existing, conflicting)) | None -> () end; 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 reg.reg_entries hier entry; Some entry) let to_filename reg hier prefix_path = get_filepath reg prefix_path hier Filetype.FileML let to_directory reg hier prefix_path = get_filepath reg prefix_path hier (Filetype.FileOther "") let to_generators reg hier prefix_path = match SafeHashtbl.find_opt reg.reg_entries 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 reg.reg_entries hier (GeneratedFileEntry (prefix_path, fullname, generated_file)); Some (GeneratedFileEntry (prefix_path, fullname, generated_file))) (Generators.get_all reg.reg_generators)) with Not_found -> None) let get_src_file dst_dir = function | FileEntry (_, f) -> f | GeneratedFileEntry (_, _, fn) -> dst_dir fn | DirectoryEntry (_, f) -> f | AliasedFileEntry (_, f) -> f (* destination basename for an aliased entry: the (uncapitalized) hier leaf, so the -o file name makes the compiler use the mangled unit name *) let aliased_dest_name hier = fn (string_uncapitalize (Modname.to_string (leaf hier))) let get_dest_file reg dst_dir ext hier = let entry = match SafeHashtbl.find_opt reg.reg_entries 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) | AliasedFileEntry (_, _) -> let path = add_prefix dst_dir hier in path (aliased_dest_name hier <.> Filetype.to_string ext) let get_dest_file_ext reg dst_dir hier ext_f = let entry = match SafeHashtbl.find_opt reg.reg_entries 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)) | AliasedFileEntry (_, f) -> let path = add_prefix dst_dir hier in let filetype = Filetype.of_filepath f in path (aliased_dest_name hier <.> Filetype.to_string (ext_f filetype)) let to_interface reg hier prefix_path = get_filepath reg prefix_path hier Filetype.FileMLI let get_file_entry_maybe reg hier = SafeHashtbl.find_opt reg.reg_entries hier let get_file_entry reg hier paths = match SafeHashtbl.find_opt reg.reg_entries hier with | Some entry -> (* the module already resolved elsewhere (usually another target); if one of this target's search paths also provides a source for it, the name is ambiguous and the cached entry would silently shadow it *) let entry_root, entry_file = match entry with | FileEntry (r, f) | GeneratedFileEntry (r, f, _) | DirectoryEntry (r, f) | AliasedFileEntry (r, f) -> (r, f) in List.iter (fun path -> if path <> entry_root then let prefixed = add_prefix path hier in match check_modname prefixed (Modname.to_string (leaf hier)) Filetype.FileML with | Some name -> let conflicting = prefixed (fn name <.> Filetype.to_string Filetype.FileML) in if conflicting <> entry_file then raise (ModuleCollision (to_string hier, entry_file, conflicting)) | None -> ()) paths; entry | None -> list_find_map (fun path -> try Some (list_find_map (fun lookup -> lookup reg hier path) [ to_filename; to_directory; to_generators; to_interface ]) with Not_found -> None) paths (* Side-effect-free existence probe: check whether a source (ml, mli, directory or generator input) provides this module in one of the given paths, WITHOUT registering anything in the registry. Used by project validation, which must not pollute the registry: for pack: true libraries the same bare module name may legitimately exist in several targets. *) let source_exists reg hier paths = match SafeHashtbl.find_opt reg.reg_entries hier with | Some _ -> true | None -> let name = Modname.to_string (leaf hier) in List.exists (fun path -> let prefixed = add_prefix path hier in check_modname prefixed name Filetype.FileML <> None || check_modname prefixed name Filetype.FileMLI <> None || check_modname prefixed name (Filetype.FileOther "") <> None || List.exists (fun gen -> let gname = Modname.to_string (gen.Generators.modname (leaf hier)) in check_modname prefixed gname (Filetype.FileOther gen.Generators.suffix) <> None) (Generators.get_all reg.reg_generators)) 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 reg hier root_path full_path = Hashtbl.replace reg.reg_entries 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 reg hier root_path src_path output_file = Hashtbl.replace reg.reg_entries hier (GeneratedFileEntry (root_path, src_path, output_file)) (* Register a directory entry for virtual pack modules (pack: true libraries). The full path's basename determines the pack's artifact names (.cmi/.cmo/.cmx) and does not need to exist on disk. *) let register_directory_entry reg hier root_path full_path = Hashtbl.replace reg.reg_entries hier (DirectoryEntry (root_path, full_path)) (* Register an aliased file entry: the source compiles under the unit name of the hier leaf (e.g. util.ml as Mylib__Util) for module-alias wrapping. *) let register_aliased_entry reg hier root_path full_path = Hashtbl.replace reg.reg_entries hier (AliasedFileEntry (root_path, full_path)) 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.3.0/lib/core/hier.mli000066400000000000000000000207611524143231100161220ustar00rootroot00000000000000(** 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) *) | AliasedFileEntry of (Filepath.filepath * Filepath.filepath) (** Source file compiled under the hier leaf's unit name instead of the file basename (module-alias wrapping): (root_path, full_path) *) (** Module resolution registry, one per build invocation *) type registry val create_registry : unit -> registry (** Create an empty registry. Commands create one and thread it through project validation, analysis and build. *) val generators : registry -> Generators.set (** The generators available to this build *) val conf : registry -> Gconf.t (** The build configuration for this invocation *) val set_custom_generators : registry -> Generators.custom list -> unit (** Install the project's custom generator definitions (called once after the project file is parsed) *) (** {1 Exceptions} *) exception EmptyModuleHierarchy (** Raised when attempting to create an empty module hierarchy *) exception ModuleCollision of (string * Filepath.filepath * Filepath.filepath) (** Raised when a module name resolves to different source files in different targets: (module name, already-registered source, conflicting source) *) (** {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 : registry -> 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 : registry -> t -> Filepath.filepath -> file_entry option (** [to_filename hier root] finds the .ml file for hierarchy *) val to_interface : registry -> t -> Filepath.filepath -> file_entry option (** [to_interface hier root] finds the .mli file for hierarchy *) val to_directory : registry -> t -> Filepath.filepath -> file_entry option (** [to_directory hier root] finds the directory for hierarchy *) val to_generators : registry -> t -> Filepath.filepath -> file_entry option (** [to_generators hier root] finds source files matching custom generators defined in .obuild *) val get_file_entry : registry -> 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 : registry -> 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 : registry -> 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 : registry -> 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 source_exists : registry -> t -> Filepath.filepath list -> bool (** [source_exists hier paths] checks whether a source file (ml, mli, directory or generator input) provides this module in one of [paths], without registering anything in the global registry. Used by project validation. *) val register_synthetic_entry : registry -> 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_directory_entry : registry -> t -> Filepath.filepath -> Filepath.filepath -> unit (** [register_directory_entry hier root_path full_path] registers a directory entry for virtual pack modules ([pack: true] libraries). The full path's basename determines the pack's artifact names and does not need to exist on disk. *) val register_aliased_entry : registry -> t -> Filepath.filepath -> Filepath.filepath -> unit (** [register_aliased_entry hier root_path full_path] registers a source file that compiles under the unit name of the hier leaf (e.g. util.ml as Mylib__Util), used for module-alias wrapping of [pack: true] libraries on OCaml >= 4.02. *) val register_generated_entry : registry -> 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 : registry -> 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 : registry -> string -> bool (** [is_generated_module name] returns true if the module was registered as generated via [register_generated_module]. *) (** [clear ()] resets all caches (file entry cache and generated module registry). *) obuild-0.3.0/lib/core/libname.ml000066400000000000000000000017101524143231100164220ustar00rootroot00000000000000open 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 obuild-0.3.0/lib/core/libname.mli000066400000000000000000000040261524143231100165760ustar00rootroot00000000000000(** 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.3.0/lib/core/meta.ml000066400000000000000000000504501524143231100157460ustar00rootroot00000000000000open 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.3.0/lib/core/meta.mli000066400000000000000000000153401524143231100161160ustar00rootroot00000000000000(** 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.3.0/lib/core/metacache.ml000066400000000000000000000020751524143231100167320ustar00rootroot00000000000000open Gconf open Helper let initial_cache_size = 128 (* META cache, one per build invocation (carried in Analyze.project_config). No global state: caching is scoped to the build that populated it. *) type t = (string, Meta.t) Hashtbl.t let create () : 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 cache name = try Hashtbl.find cache name with Not_found -> let r = get_from_disk name in Hashtbl.add cache name r; r let get_from_cache cache lib = try let (fp,pkg) = Hashtbl.find 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 cache name meta = Hashtbl.add cache name meta let find cache name = try Some (Hashtbl.find cache name) with Not_found -> None obuild-0.3.0/lib/core/metacache.mli000066400000000000000000000026371524143231100171070ustar00rootroot00000000000000(** 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} *) (** A META cache; an explicit value created per build invocation and carried in [Analyze.project_config] — there is no global state. *) type t val create : unit -> t (** Create an empty cache *) val get : t -> 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 : t -> 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 : t -> 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 : t -> string -> Meta.t option (** [find name] looks up a library in the cache without fetching from disk. Returns [Some meta] if cached, [None] otherwise. *) obuild-0.3.0/lib/core/modname.ml000066400000000000000000000023661524143231100164430ustar00rootroot00000000000000open 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.3.0/lib/core/modname.mli000066400000000000000000000044121524143231100166060ustar00rootroot00000000000000(** 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.3.0/lib/core/obuild_ast.ml000066400000000000000000000154051524143231100171460ustar00rootroot00000000000000(** 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_vendor_dirs: 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.3.0/lib/core/obuild_lexer.ml000066400000000000000000000124541524143231100174770ustar00rootroot00000000000000(** 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.3.0/lib/core/obuild_parser.ml000066400000000000000000000630461524143231100176570ustar00rootroot00000000000000(** 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 array; mutable pos : int; } (** Parser state *) (** Create parser state from tokens *) let make_state tokens = { tokens = Array.of_list tokens; pos = 0 } (** Get current token *) let current st = if st.pos < Array.length st.tokens then 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_vendor_dirs = []; 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 } | "vendor-dirs" -> { p with project_vendor_dirs = p.project_vendor_dirs @ 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.3.0/lib/core/obuild_validate.ml000066400000000000000000000367631524143231100201620ustar00rootroot00000000000000(** 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; target_pack = false; } (* ============================================================ *) (* 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 let target = { target with Target.target_pack = lib.lib_pack } 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 let target = { target with Target.target_pack = lib.lib_pack } 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 conf (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 conf ~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 conf (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 conf ~name:b.bench_name ~main:(fn b.bench_main) ~target (* ============================================================ *) (* Convert example *) (* ============================================================ *) let convert_example conf (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 conf ~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 conf (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 conf) proj.project_tests; benchs = List.map (convert_benchmark conf) proj.project_benchs; examples = List.map (convert_example conf) proj.project_examples; extra_srcs = List.map fp proj.project_extra_srcs; extra_tools = List.map fn proj.project_extra_tools; vendor_dirs = List.map fp proj.project_vendor_dirs; 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 conf input : Project.t = let ast = Obuild_parser.parse input in convert conf ast (** Parse and convert from file *) let parse_and_convert_file conf path : Project.t = let ast = Obuild_parser.parse_file path in convert conf ast obuild-0.3.0/lib/core/pp.ml000066400000000000000000000016231524143231100154350ustar00rootroot00000000000000open 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.3.0/lib/core/pp.mli000066400000000000000000000020201524143231100155760ustar00rootroot00000000000000(** 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.3.0/lib/core/ppx_resolver.ml000066400000000000000000000067001524143231100175470ustar00rootroot00000000000000(** 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 conf.project_metacache 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 bstate.bstate_config.project_metacache 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.3.0/lib/core/ppx_resolver.mli000066400000000000000000000026071524143231100177220ustar00rootroot00000000000000(** 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.3.0/lib/core/prepare.ml000066400000000000000000001476611524143231100164710ustar00rootroot00000000000000open 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_hier : Hier.registry; 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 bstate.bstate_config.project_metacache 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) -> match ss with | [] -> failwith ("ppxopt for " ^ ppx_name ^ " has no arguments") | hd :: _ -> if Libname.of_string hd <> ppx_lib then failwith ("Different ppx " ^ ppx_name ^ " <> " ^ hd)) 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 ?pack_members reg dep_cache srcFile hier pp file_search_paths = let cache_key = fp_to_string srcFile in let allDeps = match (try Some (Hashtbl.find dep_cache cache_key) with Not_found -> None) with | Some cached -> cached | None -> let dopt = { dep_includes = file_search_paths hier; dep_pp = pp } in (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. For pack: true libraries the membership is known from the declared module list; probing the global hier registry would pollute it with unqualified names and defeat the namespacing. *) let cwdDepsInDir, otherDeps = match pack_members with | Some members -> List.partition (fun dep -> List.mem dep members) allDeps | None -> List.partition (fun dep -> try let entry = Hier.get_file_entry reg (Hier.of_modname dep) (file_search_paths hier) in match entry with | Hier.DirectoryEntry (p, _) | Hier.FileEntry (p, _) | Hier.GeneratedFileEntry (p, _, _) | Hier.AliasedFileEntry (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 reg 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 (Hier.generators reg) 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 bstate.bstate_config.project_metacache 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 bstate.bstate_config.project_metacache 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 reg target = (* Register suffix-based and generate block modules *) Target.register_generator_outputs reg 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 reg gen_block.Target.generate_module autogenDir target_path ) target.Target.target_generates (* get every module description * and their relationship with each other *) (* wrapping mechanism for pack: true libraries *) type pack_mode = | PackObj (* -pack based, works on every OCaml version *) | PackAlias (* module-alias based, OCaml >= 4.02 *) type pack_desc = { pd_mode : pack_mode; pd_root_hier : Hier.t; (* [Mylib] *) pd_members : Hier.t list; (* [Mylib.Util]... (PackObj) or [Mylib__Util]... (PackAlias) *) pd_member_mods : Modname.t list; (* original member names, for dep classification *) pd_alias_prefix : string; (* "Mylib" *) pd_alias_file : Filepath.filepath; (* generated alias module source (PackAlias) *) pd_synthetic : Hier.t list; (* cstubs/generate-block modules, kept unpacked *) } let ocaml_supports_module_aliases bstate = let version = get_ocaml_config_key "version" bstate.bstate_config in let digits s = let b = Buffer.create 4 in (try String.iter (fun c -> if c >= '0' && c <= '9' then Buffer.add_char b c else raise Exit) s with Exit -> ()); Buffer.contents b in match String_utils.split '.' version with | maj :: minor :: _ -> ( try let m = int_of_string (digits maj) in let n = int_of_string (digits minor) in m > 4 || (m = 4 && n >= 2) with _ -> true) | _ -> true (* Check if a module is cstubs-generated (will be created during build) *) let is_cstubs_generated_module target 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 (* Check if a module is from a generate block (will be created during build) *) let find_generate_block_for_module target 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 (* Check if module is generated by ANY target (not just current one) *) let is_globally_generated_module reg hier = Hier.is_generated_module reg (Hier.to_string hier) (* pack: true — wrap the library's declared modules under a single top-level module named after the library. Two mechanisms, selected by compiler version: - PackAlias (OCaml >= 4.02): members compile as flat mangled units (Mylib__Util) plus a generated alias module (module Util = Mylib__Util), dune-style. Cheap incremental builds, no pack object. - PackObj (older OCaml): members are wrapped under a virtual directory level and combined with -pack via the existing directory machinery. Synthetic modules (cstubs, generate blocks) stay unpacked at top level. *) let make_pack_info bstate target toplevelModules = let reg = bstate.bstate_config.project_hier_registry in if not target.target_pack then None else match target.target_name with | Target.Name.Lib lname -> let raw = Libname.to_string lname in let sanitized = (* String.map is OCaml >= 4.00; stay 3.x compatible *) let b = Buffer.create (String.length raw) in String.iter (fun c -> Buffer.add_char b (if c = '.' || c = '-' then '_' else c)) raw; Buffer.contents b in let pack_str = Compat.string_capitalize sanitized in let pack_mod = Modname.of_string pack_str in let is_synthetic h = is_cstubs_generated_module target h || find_generate_block_for_module target h <> None || is_globally_generated_module reg h in let declared, synthetic = List.partition (fun h -> not (is_synthetic h)) toplevelModules in let srcdirs = target.target_obits.target_srcdir in let pack_hier = Hier.make [ pack_mod ] in let find_source m = let base = Modname.to_string m in let rec try_dirs = function | [] -> None | dir :: rest -> let f1 = dir (fn (Compat.string_uncapitalize base) <.> "ml") in let f2 = dir (fn base <.> "ml") in if Filesystem.exists f1 then Some (dir, f1) else if Filesystem.exists f2 then Some (dir, f2) else try_dirs rest in try_dirs srcdirs in let member_mods = List.map (fun h -> if Hier.lvl h > 0 then failwith (Printf.sprintf "pack: true library %s: nested module %s is not supported, only flat \ module lists" raw (Hier.to_string h)); Hier.root h) declared in if ocaml_supports_module_aliases bstate then begin let builddir = Dist.create_build (Dist.Target target.target_name) in let members = List.map (fun m -> match find_source m with | None -> raise (Module.NotFound (srcdirs, Hier.make [ m ])) | Some (dir, file) -> let mangled = Modname.of_string (pack_str ^ "__" ^ Modname.to_string m) in let mh = Hier.make [ mangled ] in Hier.register_aliased_entry reg mh dir file; mh) member_mods in let alias_file = builddir (fn (Compat.string_uncapitalize pack_str) <.> "ml") in let content = "(* generated by obuild: module aliases for pack:true library " ^ raw ^ " *)\n" ^ String.concat "" (List.map (fun m -> Printf.sprintf "module %s = %s__%s\n" (Modname.to_string m) pack_str (Modname.to_string m)) member_mods) in Filesystem.write_file_if_changed alias_file content; Hier.register_synthetic_entry reg pack_hier builddir alias_file; Some { pd_mode = PackAlias; pd_root_hier = pack_hier; pd_members = members; pd_member_mods = member_mods; pd_alias_prefix = pack_str; pd_alias_file = alias_file; pd_synthetic = synthetic; } end else begin let pack_dirname = fn (Compat.string_uncapitalize pack_str) in (match srcdirs with | dir :: _ -> Hier.register_directory_entry reg pack_hier dir (dir pack_dirname) | [] -> ()); let members = List.map (fun m -> match find_source m with | None -> raise (Module.NotFound (srcdirs, Hier.make [ m ])) | Some (dir, file) -> let wrapped = Hier.make [ pack_mod; m ] in Hier.register_synthetic_entry reg wrapped dir file; wrapped) member_mods in Some { pd_mode = PackObj; pd_root_hier = pack_hier; pd_members = members; pd_member_mods = member_mods; pd_alias_prefix = pack_str; pd_alias_file = current_dir; pd_synthetic = synthetic; } end | _ -> None 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 let reg = bstate.bstate_config.project_hier_registry in (* synthetic-module predicates, specialized to this target *) let is_cstubs_generated_module = is_cstubs_generated_module target in let find_generate_block_for_module = find_generate_block_for_module target in let is_globally_generated_module = is_globally_generated_module reg in let targetPP = Ppx_resolver.get_target_pp bstate target target.target_obits.target_pp in (* Pre-populate dep_cache by batching ocamldep over all .ml files in source dirs. * This avoids spawning one process per module in the common case where all modules * share the same preprocessor flags. Modules with per-file PP overrides miss the * cache and fall back to individual run_ocamldep calls. *) let dep_cache : (string, Modname.t list) Hashtbl.t = Hashtbl.create 64 in let flat_includes = target.target_obits.target_srcdir @ [ autogenDir ] in let ml_files = List.concat (List.map (fun dir -> try Filesystem.list_dir_pred_map (fun f -> if Filetype.of_filename f = Filetype.FileML then Some (dir f) else None) dir with _ -> [] ) target.target_obits.target_srcdir) in if ml_files <> [] then Dependencies.fill_ocamldep_cache dep_cache { dep_includes = flat_includes; dep_pp = targetPP } ml_files; let pack_info = make_pack_info bstate target toplevelModules in let toplevelModules = match pack_info with | None -> toplevelModules | Some pd -> ( match pd.pd_mode with | PackObj -> pd.pd_root_hier :: pd.pd_synthetic | PackAlias -> (pd.pd_root_hier :: pd.pd_members) @ pd.pd_synthetic) in let get_one hier = let moduleName = Hier.to_string hier in log Verbose "Analysing %s\n%!" moduleName; match pack_info with | Some pd when hier = pd.pd_root_hier && pd.pd_mode = PackObj -> Module.make_dir current_dir pd.pd_members | Some pd when hier = pd.pd_root_hier && pd.pd_mode = PackAlias -> (* generated alias module: no dependency analysis — its aliases must not become compile-time deps (that would invert the build order); -no-alias-deps makes member cmis unnecessary when compiling it *) let mtime = Filesystem.get_modification_time pd.pd_alias_file in Module.make_file NoThread pd.pd_alias_file mtime SimpleModule None Pp.none [ "-no-alias-deps"; "-w"; "-49" ] [] [] | _ -> (* 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 reg 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 reg 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 reg 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, _) | Hier.AliasedFileEntry (s, d) -> (s, d) in let module_desc_ty = if Filesystem.is_dir srcDir then discover_directory_modules reg srcDir hier else let _srcPath, srcFile, intfFile = match file_entry with | Hier.FileEntry (path, file) | Hier.AliasedFileEntry (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 (Hier.generators reg) (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 pack_members = match pack_info with | Some pd when List.mem hier pd.pd_members -> Some pd.pd_member_mods | _ -> None in let cwdDeps, otherDeps, use_thread = analyze_module_dependencies ?pack_members reg dep_cache srcFile hier pp file_search_paths in (* alias-wrapped members: sibling deps map to their mangled units and every member depends on the generated alias module, which is opened at compile time so bare sibling names resolve *) let cwdDeps, alias_oflags = match pack_info with | Some pd when pd.pd_mode = PackAlias && List.mem hier pd.pd_members -> let mangle d = if Hier.lvl d = 0 && List.mem (Hier.root d) pd.pd_member_mods then Hier.make [ Modname.of_string (pd.pd_alias_prefix ^ "__" ^ Modname.to_string (Hier.root d)) ] else d in ( pd.pd_root_hier :: List.filter (fun d -> d <> hier) (List.map mangle cwdDeps), [ "-open"; pd.pd_alias_prefix; "-w"; "-49" ] ) | _ -> (cwdDeps, []) 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 _ | Hier.AliasedFileEntry _ -> 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 @ alias_oflags) 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); let reg = bstate.bstate_config.project_hier_registry in (* Register output modules from generators before module discovery *) register_generator_outputs reg 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 (Hier.conf reg).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_hier = reg; 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.3.0/lib/core/prepare.mli000066400000000000000000000120261524143231100166240ustar00rootroot00000000000000(** 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_hier : Hier.registry; 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.3.0/lib/core/prepare_types.ml000066400000000000000000000106241524143231100177010ustar00rootroot00000000000000(** 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_hier : Hier.registry; 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.3.0/lib/core/prepare_types.mli000066400000000000000000000070521524143231100200530ustar00rootroot00000000000000(** 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_hier : Hier.registry; 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.3.0/lib/core/process.ml000066400000000000000000000071351524143231100165000ustar00rootroot00000000000000open Helper open Gconf open Compat (* Child processes run with stdout/stderr redirected to temporary files, and * completion is detected by polling waitpid WNOHANG. This is deliberately * simpler than pipe-based multiplexing: * - no pipe-buffer deadlock class: children can never block on a full pipe * - no Unix.select on pipes, which native Windows does not support * - output is only ever consumed after completion (see terminate), so * nothing is lost by not streaming *) type t = { _args : string list; (* command args - kept for documentation *) pid : int; (* process PID *) time : float; (* process starting time *) out_file : string; (* stdout redirection file *) err_file : string; (* stderr redirection file *) mutable status : Unix.process_status option; (* set once the pid is reaped *) } (* 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.console.Gconf.verbosity >= Gconf.Trace then log Trace " [CMD]: %s\n%!" (String.concat " " (List.map escape args)); let out_file = Filename.temp_file "obuild" ".out" in let err_file = Filename.temp_file "obuild" ".err" in let fd_out = Unix.openfile out_file [ Unix.O_WRONLY; Unix.O_TRUNC ] 0o600 in let fd_err = Unix.openfile err_file [ Unix.O_WRONLY; Unix.O_TRUNC ] 0o600 in let argv = Array.of_list args in let pid = Unix.create_process argv.(0) argv Unix.stdin fd_out fd_err in Unix.close fd_out; Unix.close fd_err; { _args = args; pid = pid; time = Unix.gettimeofday (); out_file = out_file; err_file = err_file; status = None; } type result = Success of string (* stdout *) * string (* stderr *) * float (* duration *) | Failure of string (* stdout *) * string (* stderr *) * int (* exit code *) type call = unit -> t (* poll interval while waiting for a child to finish; children are compiler * invocations that run for tens of milliseconds at minimum, so a couple of * milliseconds of completion latency is noise *) let poll_interval = 0.002 (* process a list of processes until one finishes *) let wait processes = (* true when the process has terminated; reaps and caches its status *) let is_finished (_, p) = match p.status with | Some _ -> true | None -> ( match Unix.waitpid [ Unix.WNOHANG ] p.pid with | 0, _ -> false | _, st -> p.status <- Some st; true) in let remove_from_list e list = List.filter (fun x -> x <> e) list in let rec poll () = try let finished = List.find is_finished processes in (finished, remove_from_list finished processes) with Not_found -> sleepf poll_interval; poll () in poll () (* cleanup a process and return a Success|Failure value. *) let terminate (_, p) = let pstat = match p.status with | Some st -> st | None -> let _, st = Unix.waitpid [] p.pid in st in let slurp f = let content = try Filesystem.read_file (Filepath.fp f) with _ -> "" in (try Sys.remove f with Sys_error _ -> ()); content in let stdout = slurp p.out_file in let stderr = slurp p.err_file in match pstat with | Unix.WEXITED 0 -> Success (stdout, stderr, Unix.gettimeofday () -. p.time) | Unix.WEXITED n -> Failure (stdout, stderr, n) | Unix.WSIGNALED n -> Failure (stdout, stderr, 128 + n) | Unix.WSTOPPED n -> Failure (stdout, stderr, 128 + n) (* simple helper for a single process spawn|process|terminate *) let run args = let p = make args in terminate ((), p) obuild-0.3.0/lib/core/process.mli000066400000000000000000000030051524143231100166410ustar00rootroot00000000000000(** Process execution and management *) (** Process state *) type t (** Process execution result *) type result = | Success of string * string * float (** stdout, stderr, duration *) | Failure of string * string * int (** stdout, stderr, exit_code *) (** 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 stdout, stderr, and exit code *) 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.3.0/lib/core/prog.ml000066400000000000000000000077031524143231100157720ustar00rootroot00000000000000open 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.3.0/lib/core/prog.mli000066400000000000000000000067671524143231100161540ustar00rootroot00000000000000(** 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.3.0/lib/core/project.ml000066400000000000000000000330471524143231100164710ustar00rootroot00000000000000(** 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 conf ~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 conf 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 conf ~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 conf 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 conf ~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 conf 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; vendor_dirs : filepath 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 = []; vendor_dirs = []; 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 reg target modules = let srcdir = target.target_obits.target_srcdir in (* Register generator outputs first so they can be found *) Target.register_generator_outputs reg 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 (* side-effect-free probe: validation must not register entries in the global hier table (pack: true libraries may reuse bare module names) *) if not (Hier.source_exists reg m srcdir) then raise (ModuleNotFound (target, m))) modules (** Validate project configuration Checks for required fields, file existence, module existence, and OCaml version compatibility. *) let check reg 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 reg 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 -> get_val_const_or_var user_flags target.target_installable) 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.3.0/lib/core/project.mli000066400000000000000000000224301524143231100166340ustar00rootroot00000000000000(** 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 : Gconf.t -> 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 : Gconf.t -> 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 : Gconf.t -> 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; vendor_dirs : Filepath.filepath 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 : Hier.registry -> 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.3.0/lib/core/project_read.ml000066400000000000000000000142571524143231100174660ustar00rootroot00000000000000(** 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; } (** Install the project's custom generators into the build context *) let register_generators hier_registry proj = Hier.set_custom_generators hier_registry (List.map convert_generator_to_custom proj.Project.generators) (* ===== Vendored sub-projects ===== A `vendor-dirs:` entry either is itself a vendored obuild project directory or contains vendored project directories (e.g. vendor/*/x.obuild — the layout produced by git submodules). Only the *libraries* of a vendored project are merged into the parent, re-rooted and made non-installable: vendoring provides code to build against, not programs or packages. Their build-deps resolve like any others: against project-internal libraries first (including other vendored ones), then findlib. *) (* a vendored project directory must contain exactly one .obuild file *) let find_vendored_project_file dir = try let entries = Array.to_list (Sys.readdir (fp_to_string dir)) in match List.filter (fun f -> Filename.check_suffix f ".obuild") entries with | [ f ] -> Some (dir fn f) | _ -> None with Sys_error _ -> None let reroot prefix p = if p = current_dir then prefix else prefix p let reroot_target prefix (t : Target.target) = let obits = t.Target.target_obits in let cbits = t.Target.target_cbits in { t with Target.target_obits = { obits with Target.target_srcdir = List.map (reroot prefix) obits.Target.target_srcdir }; target_cbits = { cbits with Target.target_cdir = reroot prefix cbits.Target.target_cdir }; target_generates = List.map (fun (g : Target.target_generate) -> { g with Target.generate_from = List.map (reroot prefix) g.Target.generate_from }) t.Target.target_generates; (* vendored code is built into the parent's artifacts, not installed *) target_installable = Target.BoolConst false; } let rec reroot_library prefix (lib : Project.Library.t) = { lib with Project.Library.target = reroot_target prefix lib.Project.Library.target; subs = List.map (reroot_library prefix) lib.Project.Library.subs; } let parse_project_file conf path = try Obuild_validate.parse_and_convert_file conf (fp_to_string path) with | Obuild_validate.Validation_error (loc, msg) -> raise (Project.InvalidConfFile (Printf.sprintf "%s: %d:%d: %s" (fp_to_string path) loc.Location.line loc.Location.col msg)) | Obuild_parser.Parser_error (loc, msg) -> raise (Project.InvalidConfFile (Printf.sprintf "%s: %d:%d: %s" (fp_to_string path) loc.Location.line loc.Location.col msg)) (* returns (libraries, custom generators) of the vendored project at [dir], including its own vendored projects, recursively. [visited] guards against cycles and double-vendoring of the same project. *) let rec collect_vendored conf visited dir = match find_vendored_project_file dir with | None -> ([], []) | Some path -> let key = fp_to_string path in if Hashtbl.mem visited key then ([], []) else begin Hashtbl.add visited key (); let proj = parse_project_file conf path in let libs = List.map (reroot_library dir) proj.Project.libs in let nested = List.map (fun d -> scan_vendor_dir conf visited (reroot dir d)) proj.Project.vendor_dirs in ( libs @ List.concat (List.map fst nested), proj.Project.generators @ List.concat (List.map snd nested) ) end and scan_vendor_dir conf visited dir = if find_vendored_project_file dir <> None then collect_vendored conf visited dir else let subdirs = try List.filter Filesystem.is_dir (List.map (fun e -> dir fn e) (List.fast_sort String.compare (Array.to_list (Sys.readdir (fp_to_string dir))))) with Sys_error _ -> [] in let results = List.map (collect_vendored conf visited) subdirs in (List.concat (List.map fst results), List.concat (List.map snd results)) let merge_vendored conf proj = match proj.Project.vendor_dirs with | [] -> proj | dirs -> let visited = Hashtbl.create 4 in let results = List.map (scan_vendor_dir conf visited) dirs in let vlibs = List.concat (List.map fst results) in let vgens = List.concat (List.map snd results) in let seen = Hashtbl.create 8 in List.iter (fun (l : Project.Library.t) -> let n = Libname.to_string l.Project.Library.name in if Hashtbl.mem seen n then raise (Project.InvalidConfFile (Printf.sprintf "library %s is defined more than once (vendored library name collision)" n)); Hashtbl.add seen n ()) (proj.Project.libs @ vlibs); { proj with Project.libs = proj.Project.libs @ vlibs; Project.generators = proj.Project.generators @ vgens; } (** Read project file using the new parser *) let read hier_registry = let conf = Hier.conf hier_registry in let path = Project.findPath () in let proj = parse_project_file conf path in (* merge vendored sub-project libraries as internal targets *) let proj = merge_vendored conf proj in (* Apply ocaml_extra_args side effect *) (match proj.Project.ocaml_extra_args with | Some args -> (Hier.conf hier_registry).Gconf.ocaml_extra_args <- args | None -> ()); (* Register custom generators *) register_generators hier_registry proj; (* Validate file existence *) Project.check hier_registry proj; proj obuild-0.3.0/lib/core/scheduler.ml000066400000000000000000000114101524143231100167670ustar00rootroot00000000000000type 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; tasks : ('a, 'a task_group) Hashtbl.t; } (* 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 = Hashtbl.find state.tasks task_done in tg.completion <- tg.completion - 1; if tg.completion = 0 then ( match tg.next with | [] -> Hashtbl.remove state.tasks task_done; 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 Hashtbl.replace state.tasks t tg; 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 = Hashtbl.create 16; } 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.3.0/lib/core/scheduler.mli000066400000000000000000000027041524143231100171460ustar00rootroot00000000000000(** 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.3.0/lib/core/target.ml000066400000000000000000000217771524143231100163200ustar00rootroot00000000000000open 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; target_pack : bool; (* library modules wrapped under one pack module *) } 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 = []; target_pack = false; } 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 conf target = let nat, byte = if is_lib target then (Gconf.get_target_option_typed conf Library_native, Gconf.get_target_option_typed conf Library_bytecode) else (Gconf.get_target_option_typed conf Executable_native, Gconf.get_target_option_typed conf Executable_bytecode) in (if nat then [ Native ] else []) @ if byte then [ ByteCode ] else [] let get_debug_profile conf target = if is_lib target then (Gconf.get_target_option_typed conf Library_debugging, Gconf.get_target_option_typed conf Library_profiling) else (Gconf.get_target_option_typed conf Executable_debugging, Gconf.get_target_option_typed conf Executable_profiling) let get_compilation_opts conf target = let debug, prof = get_debug_profile conf 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 reg target = let generators = Generators.get_all (Hier.generators reg) 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 reg 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 reg module_name ) target.target_generates obuild-0.3.0/lib/core/target.mli000066400000000000000000000156511524143231100164630ustar00rootroot00000000000000(** 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; target_pack : bool; (** library modules wrapped under one pack module *) } 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 : Gconf.t -> target -> Types.ocaml_compiled_type list (** Get OCaml compilation types (Native/ByteCode) based on target type and global config *) val get_debug_profile : Gconf.t -> target -> bool * bool (** Get (debugging, profiling) flags based on target type and global config *) val get_compilation_opts : Gconf.t -> 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 : Hier.registry -> 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.3.0/lib/core/taskdep.ml000066400000000000000000000053001524143231100164450ustar00rootroot00000000000000open 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.3.0/lib/core/taskdep.mli000066400000000000000000000045071524143231100166260ustar00rootroot00000000000000(** 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.3.0/lib/core/types.ml000066400000000000000000000004131524143231100161560ustar00rootroot00000000000000type 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.3.0/lib/core/types.mli000066400000000000000000000015631524143231100163360ustar00rootroot00000000000000(** 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.3.0/lib/core/utils.ml000066400000000000000000000121041524143231100161520ustar00rootroot00000000000000open 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)) | _ -> failwith ("internal error: toKV split returned unexpected result for: " ^ line) 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)) | _ -> failwith ("internal error: toKVeq split returned unexpected result for: " ^ line) let parseCSV value = List.filter (fun s -> String.length s > 0) (List.map String_utils.strip_spaces (String_utils.split ',' value)) let include_path_cache : (string, string list) Hashtbl.t = Hashtbl.create 16 let to_include_path_options paths = let key = String.concat "\000" (List.map fp_to_string paths) in match (try Some (Hashtbl.find include_path_cache key) with Not_found -> None) with | Some result -> result | None -> let ss = ref StringSet.empty in let result = 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 in Hashtbl.replace include_path_cache key result; result 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 conf mode build name = let ext = extDP mode in let ext2 = match build with | ByteCode -> ".byte" | Native -> if Gconf.get_target_option_typed conf 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.3.0/lib/core/utils.mli000066400000000000000000000057411524143231100163340ustar00rootroot00000000000000(** 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 : Gconf.t -> 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.3.0/lib/doc.ml000066400000000000000000000005221524143231100146300ustar00rootroot00000000000000open 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.3.0/lib/doc.mli000066400000000000000000000005441524143231100150050ustar00rootroot00000000000000(** 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.3.0/lib/help.ml000066400000000000000000000021771524143231100150230ustar00rootroot00000000000000 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.3.0/lib/help.mli000066400000000000000000000006621524143231100151710ustar00rootroot00000000000000(** 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.3.0/lib/init.ml000066400000000000000000000073351524143231100150370ustar00rootroot00000000000000open 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.3.0/lib/init.mli000066400000000000000000000013151524143231100152000ustar00rootroot00000000000000(** 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.3.0/lib/install.ml000066400000000000000000000172231524143231100155370ustar00rootroot00000000000000open Fugue open Filepath open Printf open Project open Types open Target open Helper open Gconf let list_target_files_pred conf target pred = let build_dir = Dist.get_build_exn (Dist.Target target.Target.target_name) in Build.sanity_check conf 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 conf lib build_dir = list_target_files_pred conf 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 conf lib build_dir = list_target_files_pred conf lib (fun f -> match Filetype.of_filepath (build_dir f) with | Filetype.FileEXE -> true | _ -> false) let opam_install_file conf 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 dest_prefix = 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%s\"}\n" (fp_to_string build_dir) file_str dest_prefix file_str)) files in (* A library's findlib package is its ROOT node (the first, un-dotted part of a possibly-dotted name); a sub-library shares its parent's root and so installs flat *beside* the parent — the generated META references sub-package archives with no `directory`, i.e. relative to the parent dir. The library whose root == the package name is the PRIMARY findlib package. opam's `lib:` section already scopes to %{lib}%//, so the primary (and its sub-libraries) install flat there. Every OTHER top-level library is a findlib package in its own right and goes to `lib_root:` under %{lib}%//, mirroring the direct-install layout (`obuild install`) — so e.g. obuild_core becomes a real, discoverable findlib package rather than an unreachable %{lib}%/obuild/obuild_core/. Keying on the full dotted name (the earlier bug) instead buried the primary at %{lib}%/// and broke every dependant. *) let lib_root l = List.hd (Libname.to_string_nodes l) in add "lib: [\n"; List.iter (fun target -> match target.target_name with | Name.Lib l when lib_root l = proj_file.name -> print_target_files target (list_lib_files conf) "" | _ -> ()) all_targets; add "]\n"; add "lib_root: [\n"; List.iter (fun target -> match target.target_name with | Name.Lib l when lib_root l <> proj_file.name -> print_target_files target (list_lib_files conf) (lib_root l ^ "/") | _ -> ()) all_targets; add "]\n"; add "bin: [\n"; List.iter (fun target -> match target.target_name with | Name.Exe _ -> print_target_files target (list_exe_files conf) "" | _ -> ()) all_targets; add "]\n") let lib_to_meta conf 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 conf 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 conf 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 conf 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 conf proj_file lib dest_dir = write_lib_meta conf 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 conf build_dir target; list_lib_files conf 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_exe conf exe bindir = let target = Project.Executable.to_target exe in let build_dir = Dist.get_build_exn (Dist.Target target.Target.target_name) in Build.sanity_check conf build_dir target; let _, files = list_exe_files conf target build_dir in log Report "installing executable %s\n" exe.Project.Executable.name; Filesystem.mkdir_safe_recursive bindir 0o755 ; List.iter (fun file -> let src = build_dir file in let dst = bindir file in Filesystem.copy_file src dst; Unix.chmod (fp_to_string dst) 0o755) files let install conf proj_file destdir bindir opam = if not opam then begin List.iter (fun lib -> install_lib conf proj_file lib destdir) proj_file.Project.libs; (* only install executables that were actually built *) List.iter (fun exe -> let target = Project.Executable.to_target exe in if Filesystem.is_dir (Dist.get_build_path (Dist.Target target.Target.target_name)) then install_exe conf exe bindir) proj_file.Project.exes end else List.iter (fun lib -> write_lib_meta conf proj_file lib) proj_file.Project.libs obuild-0.3.0/lib/install.mli000066400000000000000000000016741524143231100157130ustar00rootroot00000000000000(** Library and executable installation *) val opam_install_file : Gconf.t -> 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 : Gconf.t -> Project.t -> Filepath.filepath -> Filepath.filepath -> bool -> unit (** [install_libs proj_file dest_dir bin_dir opam] installs libraries and executables. Copies compiled library files, META files, and executables to the installation directories. @param proj_file the project configuration @param dest_dir destination directory for library installation @param bin_dir destination directory for executable installation @param opam whether to use OPAM-style installation (generates .install file only) *) obuild-0.3.0/lib/sdist.ml000066400000000000000000000036241524143231100152170ustar00rootroot00000000000000open 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.3.0/lib/sdist.mli000066400000000000000000000005421524143231100153640ustar00rootroot00000000000000(** 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.3.0/obuild.install000066400000000000000000000000461524143231100156320ustar00rootroot00000000000000bin: [ "dist/build/obuild/obuild" ] obuild-0.3.0/obuild.obuild000066400000000000000000000070541524143231100154500ustar00rootroot00000000000000name: obuild version: 0.3.0 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, digests, 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, str 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.3.0/opam000066400000000000000000000015461524143231100136510ustar00rootroot00000000000000opam-version: "2.0" name: "obuild" version: "0.3.0" 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.3.0/src/000077500000000000000000000000001524143231100135535ustar00rootroot00000000000000obuild-0.3.0/src/main.ml000066400000000000000000000714541524143231100150440ustar00rootroot00000000000000open 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 conf = FindlibConf.load (); let setup = Dist.read_setup () in Configure.set_opts conf setup; setup (* each command works in its own build context (module resolution registry, generators, build configuration) *) let project_read_with hreg = try Project_read.read hreg with exn -> log Verbose "exception during project read: %s\n" (Printexc.to_string exn); raise exn let project_read_ctx () = let hreg = Hier.create_registry () in (project_read_with hreg, hreg) let project_read () = fst (project_read_ctx ()) 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))) (* ===== .merlin generation (shared by configure and the merlin command) ===== *) let merlin_marker = "# generated by obuild; remove this line to disable automatic updates" let merlin_content proj_file = let buf = Buffer.create 256 in Buffer.add_string buf (merlin_marker ^ "\n"); List.iter (fun lib -> List.iter (fun src_dir -> Buffer.add_string buf (Printf.sprintf "S %s\n" (fp_to_string src_dir))) lib.Project.Library.target.Target.target_obits.Target.target_srcdir; Buffer.add_string buf (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; List.iter (fun exe -> List.iter (fun src_dir -> Buffer.add_string buf (Printf.sprintf "S %s\n" (fp_to_string src_dir))) exe.Project.Executable.target.Target.target_obits.Target.target_srcdir; Buffer.add_string buf (Printf.sprintf "B %s\n" (fp_to_string (current_dir fn "dist" fn "build" fn exe.Project.Executable.name)))) proj_file.Project.exes; List.iter (fun (libname, _) -> Buffer.add_string buf (Printf.sprintf "PKG %s\n" (Libname.to_string libname))) (collect_all_deps proj_file); Buffer.contents buf (* Write .merlin unless a hand-written one (no obuild marker) is in the way. [force] overrides the marker check (explicit `obuild merlin` invocation). *) let write_merlin ?(force = false) proj_file = let path = ".merlin" in let can_write = force || (not (Sys.file_exists path)) || (try let ic = open_in path in let first_line = (try input_line ic with End_of_file -> "") in close_in ic; String_utils.startswith "# generated by obuild" first_line with Sys_error _ -> false) in if can_write then Filesystem.write_file_if_changed (fp path) (merlin_content proj_file); can_write (* ===== 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, hreg = project_read_ctx () in log Report "Configuring %s-%s...\n" proj_file.Project.name proj_file.Project.version; Configure.run hreg proj_file !user_flags !user_opts; (* keep IDE support fresh; never clobbers a hand-written .merlin *) if write_merlin proj_file then log Verbose "refreshed .merlin\n") () 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 -> let hreg = Hier.create_registry () in let conf = Hier.conf hreg in (* Set parallel jobs *) conf.Gconf.parallel_jobs <- Cli.get_int ctx "jobs" ~default:conf.Gconf.parallel_jobs; (* Set other options *) if Cli.get_flag ctx "dot" then conf.Gconf.dump_dot <- true; if Cli.get_flag ctx "noocamlmklib" then conf.Gconf.ocamlmklib <- false; (* Get target names *) let targets = Cli.get_positionals ctx in (* Build *) Dist.exist (); let setup = read_setup conf in let proj_file = project_read_with hreg in let flags = Configure.check hreg proj_file true setup in let project = Analyze.prepare proj_file flags hreg 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:2 ~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 bin_dir_str = Cli.get_string_opt ctx "bindir" in let opam_install = Cli.get_flag ctx "opam" in Dist.exist (); let hreg = Hier.create_registry () in let setup = read_setup (Hier.conf hreg) in let proj_file = project_read_with hreg in let flags = Configure.check hreg 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 let bin_dir = match bin_dir_str with | Some d -> fp d | None -> Filepath.path_dirname dest_dir fn "bin" in Install.install (Hier.conf hreg) proj_file dest_dir bin_dir opam_install; if opam_install then Install.opam_install_file (Hier.conf hreg) proj_file flags) () in cmd |> Cli.help_flag |> Cli.option_string "destdir" ~placeholder:"DIR" ~doc:"Override destination where to install libraries" |> Cli.option_string "bindir" ~placeholder:"DIR" ~doc:"Override destination where to install executables (default: destdir/../bin)" |> Cli.flag "opam" ~doc:"Only create the .install file for opam" (* ===== Run Command ===== *) let cmd_run = let cmd = Cli.command "run" ~doc:"Build and run an executable" ~description: "Builds the executable target if needed, then runs it. Arguments following the \ executable name are passed to the program verbatim. With a single executable in the \ project, the name can be omitted." ~run:(fun ctx -> let exe_name, prog_args = match Cli.get_positionals ctx with | [] -> (None, []) | name :: rest -> ( ( Some name, match rest with | "--" :: r -> r | r -> r )) in Dist.exist (); let hreg = Hier.create_registry () in let setup = read_setup (Hier.conf hreg) in let proj_file = project_read_with hreg in let exe = match exe_name with | Some name -> Project.find_exe proj_file name | None -> ( match proj_file.Project.exes with | [ e ] -> e | [] -> eprintf "error: no executable in this project\n"; exit 1 | es -> eprintf "error: several executables, specify one of: %s\n" (String.concat ", " (List.map (fun e -> e.Project.Executable.name) es)); exit 1) in (* build the executable target (and its dependencies) if stale *) let flags = Configure.check hreg proj_file true setup in let project = Analyze.prepare proj_file flags hreg in let bstate = Prepare.init project in let target_name = Target.Name.Exe exe.Project.Executable.name in let dag = Dag.subset project.Analyze.project_targets_dag [ target_name ] in Build.build_dag bstate proj_file dag; (* run it, inheriting the terminal, and propagate the exit code *) let target = Project.Executable.to_target exe in let dir = Dist.get_build_exn (Dist.Target target.Target.target_name) in let dest_name = Target.get_target_dest_name target in let exe_path = let candidates = [ Utils.to_exe_name (Hier.conf hreg) Normal Native dest_name; Utils.to_exe_name (Hier.conf hreg) Normal ByteCode dest_name ] in try dir List.find (fun c -> Filesystem.exists (dir c)) candidates with Not_found -> eprintf "error: executable %s not found after build\n" (Target.get_target_name target); exit 1 in let argv = Array.of_list (fp_to_string exe_path :: prog_args) in let pid = Unix.create_process argv.(0) argv Unix.stdin Unix.stdout Unix.stderr in let _, status = Unix.waitpid [] pid in match status with | Unix.WEXITED code -> exit code | Unix.WSIGNALED _ | Unix.WSTOPPED _ -> exit 130) () in cmd |> Cli.help_flag |> Cli.stop_at_first_positional (* ===== 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 hreg = Hier.create_registry () in let setup = read_setup (Hier.conf hreg) in let proj_file = project_read_with hreg in let _ = Configure.check hreg proj_file false setup in if not (Gconf.get_target_option_typed (Hier.conf hreg) 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 (Hier.conf hreg) 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); let args = [ fp_to_string exe_path ] @ test.Project.Test.runopt in let run () = Process.run args in let result = match test.Project.Test.rundir with | None -> run () | Some d -> let saved = Sys.getcwd () in Unix.chdir (fp_to_string d); let r = run () in Unix.chdir saved; r in match result with | Process.Success (out, _, _) -> if show_test then print_warnings out; (test.Project.Test.name, true) | Process.Failure (out, err, _) -> print_warnings (if String.length out > 0 then out ^ "\n" ^ err else 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 let _ = write_merlin ~force:true proj_file in 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 console.verbosity <- Verbose; if Cli.get_flag ctx "quiet" then console.verbosity <- Silent; if Cli.get_flag ctx "debug" then console.verbosity <- Debug; if Cli.get_flag ctx "debug+" then console.verbosity <- Trace; if Cli.get_flag ctx "color" then console.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_run; 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.3.0/src/main.mli000066400000000000000000000004411524143231100152010ustar00rootroot00000000000000(** 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.3.0/tests/000077500000000000000000000000001524143231100141265ustar00rootroot00000000000000obuild-0.3.0/tests/dependencies/000077500000000000000000000000001524143231100165545ustar00rootroot00000000000000obuild-0.3.0/tests/dependencies/camlp4/000077500000000000000000000000001524143231100177345ustar00rootroot00000000000000obuild-0.3.0/tests/dependencies/camlp4/main.ml000066400000000000000000000001621524143231100212110ustar00rootroot00000000000000module Test = struct type t = { t1 : string; t2 : int option; t3 : float; } with fields end obuild-0.3.0/tests/dependencies/camlp4/test.obuild000066400000000000000000000002171524143231100221130ustar00rootroot00000000000000name: 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.3.0/tests/dependencies/cohttp_test/000077500000000000000000000000001524143231100211145ustar00rootroot00000000000000obuild-0.3.0/tests/dependencies/cohttp_test/main.ml000066400000000000000000000000731524143231100223720ustar00rootroot00000000000000let () = print_endline "Testing cohttp-lwt-unix dependency"obuild-0.3.0/tests/dependencies/cohttp_test/test_cohttp.obuild000066400000000000000000000001701524143231100246520ustar00rootroot00000000000000name: test_cohttp version: 1.0 obuild-ver: 1 executable test_cohttp_main main: main.ml build-deps: cohttp-lwt-unix obuild-0.3.0/tests/dependencies/ctypes_test/000077500000000000000000000000001524143231100211225ustar00rootroot00000000000000obuild-0.3.0/tests/dependencies/ctypes_test/bin/000077500000000000000000000000001524143231100216725ustar00rootroot00000000000000obuild-0.3.0/tests/dependencies/ctypes_test/bin/main.ml000066400000000000000000000014151524143231100231510ustar00rootroot00000000000000(* 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.3.0/tests/dependencies/ctypes_test/ctypes_test.obuild000066400000000000000000000010061524143231100246650ustar00rootroot00000000000000name: 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.3.0/tests/dependencies/ctypes_test/lib/000077500000000000000000000000001524143231100216705ustar00rootroot00000000000000obuild-0.3.0/tests/dependencies/ctypes_test/lib/bindings.ml000066400000000000000000000015241524143231100240210ustar00rootroot00000000000000(* 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.3.0/tests/dependencies/ppx_sexp/000077500000000000000000000000001524143231100204225ustar00rootroot00000000000000obuild-0.3.0/tests/dependencies/ppx_sexp/binprot.ml000066400000000000000000000003571524143231100224360ustar00rootroot00000000000000open 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.3.0/tests/dependencies/ppx_sexp/both.ml000066400000000000000000000002241524143231100217060ustar00rootroot00000000000000open 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.3.0/tests/dependencies/ppx_sexp/deriving.ml000066400000000000000000000001621524143231100225620ustar00rootroot00000000000000 type test = S of string [@@deriving show] let () = let t = S "string" in Printf.printf "%s\n" (show_test t) obuild-0.3.0/tests/dependencies/ppx_sexp/hello.ml000066400000000000000000000001141524143231100220530ustar00rootroot00000000000000let _ = let a = [%sexp { msg = "hi there!" }] in Printf.printf "done\n" obuild-0.3.0/tests/dependencies/ppx_sexp/hello.obuild000066400000000000000000000011731524143231100227270ustar00rootroot00000000000000name: 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.3.0/tests/dependencies/ppx_sexp/hello_lwt.ml000066400000000000000000000001561524143231100227470ustar00rootroot00000000000000open Lwt let test () = let%lwt x = return 3 in return (x + 1 = 4) let _ = Printf.printf "Done\n" obuild-0.3.0/tests/dependencies/ppx_sexp/main.ml000066400000000000000000000103621524143231100217020ustar00rootroot00000000000000open 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.3.0/tests/dependencies/ppx_sexp/sexp.ml000066400000000000000000000002741524143231100217360ustar00rootroot00000000000000open 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.3.0/tests/dependencies/ppx_sexp/show.ml000066400000000000000000000001541524143231100217340ustar00rootroot00000000000000type point2d = float * float [@@deriving show] let _ = Printf.printf "%s\n" (show_point2d (1.1,2.2)); obuild-0.3.0/tests/full/000077500000000000000000000000001524143231100150705ustar00rootroot00000000000000obuild-0.3.0/tests/full/autogenerated/000077500000000000000000000000001524143231100177175ustar00rootroot00000000000000obuild-0.3.0/tests/full/autogenerated/p3.ml000066400000000000000000000001411524143231100205670ustar00rootroot00000000000000open Path_generated open Printf let () = printf "project version is : %s\n" project_version obuild-0.3.0/tests/full/autogenerated/p3.obuild000066400000000000000000000001071524143231100214370ustar00rootroot00000000000000name: p3 version: 9.1.23 obuild-ver: 1 executable p3 main-is: p3.ml obuild-0.3.0/tests/full/autopack/000077500000000000000000000000001524143231100166775ustar00rootroot00000000000000obuild-0.3.0/tests/full/autopack/autopack.obuild000066400000000000000000000001411524143231100217020ustar00rootroot00000000000000name: autopack version: 1.0 obuild-ver: 1 executable autopack src-dir: src main-is: main.ml obuild-0.3.0/tests/full/autopack/src/000077500000000000000000000000001524143231100174665ustar00rootroot00000000000000obuild-0.3.0/tests/full/autopack/src/a.ml000066400000000000000000000000221524143231100202320ustar00rootroot00000000000000let foo = "A.foo" obuild-0.3.0/tests/full/autopack/src/b/000077500000000000000000000000001524143231100177075ustar00rootroot00000000000000obuild-0.3.0/tests/full/autopack/src/b/a.ml000066400000000000000000000000241524143231100204550ustar00rootroot00000000000000let foo = "B.A.foo" obuild-0.3.0/tests/full/autopack/src/b/c.ml000066400000000000000000000000511524143231100204570ustar00rootroot00000000000000let foo = "B.C.foo" let test = "B.A.foo" obuild-0.3.0/tests/full/autopack/src/main.ml000066400000000000000000000002051524143231100207410ustar00rootroot00000000000000open 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.3.0/tests/full/autopack2/000077500000000000000000000000001524143231100167615ustar00rootroot00000000000000obuild-0.3.0/tests/full/autopack2/autopack2.obuild000066400000000000000000000001431524143231100220500ustar00rootroot00000000000000name: autopack2 version: 1.0 obuild-ver: 1 executable autopack2 src-dir: src main-is: main.ml obuild-0.3.0/tests/full/autopack2/src/000077500000000000000000000000001524143231100175505ustar00rootroot00000000000000obuild-0.3.0/tests/full/autopack2/src/a.ml000066400000000000000000000000221524143231100203140ustar00rootroot00000000000000let foo = "A.foo" obuild-0.3.0/tests/full/autopack2/src/b/000077500000000000000000000000001524143231100177715ustar00rootroot00000000000000obuild-0.3.0/tests/full/autopack2/src/b/a.ml000066400000000000000000000000241524143231100205370ustar00rootroot00000000000000let foo = "B.A.foo" obuild-0.3.0/tests/full/autopack2/src/b/abc/000077500000000000000000000000001524143231100205165ustar00rootroot00000000000000obuild-0.3.0/tests/full/autopack2/src/b/abc/foo.ml000066400000000000000000000000321524143231100216260ustar00rootroot00000000000000let foo = "B.Abc.Foo.foo" obuild-0.3.0/tests/full/autopack2/src/b/c.ml000066400000000000000000000000241524143231100205410ustar00rootroot00000000000000let foo = "B.C.foo" obuild-0.3.0/tests/full/autopack2/src/main.ml000066400000000000000000000002651524143231100210310ustar00rootroot00000000000000open 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.3.0/tests/full/complex/000077500000000000000000000000001524143231100165375ustar00rootroot00000000000000obuild-0.3.0/tests/full/complex/complex.obuild000066400000000000000000000005261524143231100214110ustar00rootroot00000000000000name: 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.3.0/tests/full/complex/lib/000077500000000000000000000000001524143231100173055ustar00rootroot00000000000000obuild-0.3.0/tests/full/complex/lib/imaginary.ml000066400000000000000000000002661524143231100216230ustar00rootroot00000000000000 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.3.0/tests/full/complex/lib/math/000077500000000000000000000000001524143231100202365ustar00rootroot00000000000000obuild-0.3.0/tests/full/complex/lib/math/accessor.ml000066400000000000000000000001221524143231100223650ustar00rootroot00000000000000let get_real (t: Types.t) = t.Types.real let get_imag (t: Types.t) = t.Types.imag obuild-0.3.0/tests/full/complex/lib/math/types.ml000066400000000000000000000000451524143231100217330ustar00rootroot00000000000000type t = { real : int ; imag : int } obuild-0.3.0/tests/full/complex/lib_real/000077500000000000000000000000001524143231100203105ustar00rootroot00000000000000obuild-0.3.0/tests/full/complex/lib_real/bar.ml000066400000000000000000000000541524143231100214050ustar00rootroot00000000000000 let real_list l = List.map Foo.make_real l obuild-0.3.0/tests/full/complex/lib_real/foo.ml000066400000000000000000000000721524143231100214240ustar00rootroot00000000000000open Math.Types let make_real x = { real = x; imag = 0 } obuild-0.3.0/tests/full/complex/src/000077500000000000000000000000001524143231100173265ustar00rootroot00000000000000obuild-0.3.0/tests/full/complex/src/main.ml000066400000000000000000000003551524143231100206070ustar00rootroot00000000000000open 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.3.0/tests/full/complex/src/main1.ml000066400000000000000000000003101524143231100206570ustar00rootroot00000000000000open 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.3.0/tests/full/complex2/000077500000000000000000000000001524143231100166215ustar00rootroot00000000000000obuild-0.3.0/tests/full/complex2/complex.obuild000066400000000000000000000005401524143231100214670ustar00rootroot00000000000000name: 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.3.0/tests/full/complex2/lib/000077500000000000000000000000001524143231100173675ustar00rootroot00000000000000obuild-0.3.0/tests/full/complex2/lib/math/000077500000000000000000000000001524143231100203205ustar00rootroot00000000000000obuild-0.3.0/tests/full/complex2/lib/math/accessor.ml000066400000000000000000000001221524143231100224470ustar00rootroot00000000000000let get_real (t: Types.t) = t.Types.real let get_imag (t: Types.t) = t.Types.imag obuild-0.3.0/tests/full/complex2/lib/math/types.ml000066400000000000000000000000451524143231100220150ustar00rootroot00000000000000type t = { real : int ; imag : int } obuild-0.3.0/tests/full/complex2/lib2/000077500000000000000000000000001524143231100174515ustar00rootroot00000000000000obuild-0.3.0/tests/full/complex2/lib2/imaginary.ml000066400000000000000000000002661524143231100217670ustar00rootroot00000000000000 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.3.0/tests/full/complex2/lib_real/000077500000000000000000000000001524143231100203725ustar00rootroot00000000000000obuild-0.3.0/tests/full/complex2/lib_real/bar.ml000066400000000000000000000000541524143231100214670ustar00rootroot00000000000000 let real_list l = List.map Foo.make_real l obuild-0.3.0/tests/full/complex2/lib_real/foo.ml000066400000000000000000000000721524143231100215060ustar00rootroot00000000000000open Math.Types let make_real x = { real = x; imag = 0 } obuild-0.3.0/tests/full/complex2/src/000077500000000000000000000000001524143231100174105ustar00rootroot00000000000000obuild-0.3.0/tests/full/complex2/src/main1.ml000066400000000000000000000003101524143231100207410ustar00rootroot00000000000000open 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.3.0/tests/full/complex2/src2/000077500000000000000000000000001524143231100174725ustar00rootroot00000000000000obuild-0.3.0/tests/full/complex2/src2/main.ml000066400000000000000000000003551524143231100207530ustar00rootroot00000000000000open 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.3.0/tests/full/dep-uri/000077500000000000000000000000001524143231100164355ustar00rootroot00000000000000obuild-0.3.0/tests/full/dep-uri/p2.ml000066400000000000000000000001761524143231100173140ustar00rootroot00000000000000open Uri open Printf let () = let u = Uri.make ~scheme:"http" ~host:"foo!.com" () in printf "%s\n" (Uri.to_string u) obuild-0.3.0/tests/full/dep-uri/p2.obuild000066400000000000000000000001551524143231100201570ustar00rootroot00000000000000name: p2 version: 1.0 obuild-ver: 1 ocaml-version: >=3.12.1 executable p2 main-is: p2.ml build-deps: uri obuild-0.3.0/tests/full/embed/000077500000000000000000000000001524143231100161445ustar00rootroot00000000000000obuild-0.3.0/tests/full/embed/assets/000077500000000000000000000000001524143231100174465ustar00rootroot00000000000000obuild-0.3.0/tests/full/embed/assets/greeting.txt000066400000000000000000000000221524143231100220050ustar00rootroot00000000000000Welcome to obuild!obuild-0.3.0/tests/full/embed/assets/hello.txt000066400000000000000000000000161524143231100213070ustar00rootroot00000000000000Hello, World! obuild-0.3.0/tests/full/embed/assets/info.txt000066400000000000000000000000311524143231100211340ustar00rootroot00000000000000This is embedded content.obuild-0.3.0/tests/full/embed/embed.obuild000066400000000000000000000005631524143231100204240ustar00rootroot00000000000000name: 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.3.0/tests/full/embed/embed.sh000077500000000000000000000017261524143231100175650ustar00rootroot00000000000000#!/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.3.0/tests/full/embed/main.ml000066400000000000000000000021121524143231100174160ustar00rootroot00000000000000(* 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.3.0/tests/full/packed/000077500000000000000000000000001524143231100163175ustar00rootroot00000000000000obuild-0.3.0/tests/full/packed/a/000077500000000000000000000000001524143231100165375ustar00rootroot00000000000000obuild-0.3.0/tests/full/packed/a/alpha.ml000066400000000000000000000000271524143231100201550ustar00rootroot00000000000000let who () = Util.name obuild-0.3.0/tests/full/packed/a/util.ml000066400000000000000000000000271524143231100200450ustar00rootroot00000000000000let name = "util-of-A" obuild-0.3.0/tests/full/packed/b/000077500000000000000000000000001524143231100165405ustar00rootroot00000000000000obuild-0.3.0/tests/full/packed/b/beta.ml000066400000000000000000000000271524143231100200040ustar00rootroot00000000000000let who () = Util.name obuild-0.3.0/tests/full/packed/b/util.ml000066400000000000000000000000271524143231100200460ustar00rootroot00000000000000let name = "util-of-B" obuild-0.3.0/tests/full/packed/b/util.mli000066400000000000000000000000221524143231100202120ustar00rootroot00000000000000val name : string obuild-0.3.0/tests/full/packed/check.sh000077500000000000000000000001611524143231100177310ustar00rootroot00000000000000#!/bin/sh # run the built executable: it exits non-zero if the wrong Util was linked exec ./dist/build/main/main obuild-0.3.0/tests/full/packed/main.ml000066400000000000000000000005661524143231100176040ustar00rootroot00000000000000(* both libraries define a module Util; wrapping must keep them separate, and each library's own module must see its own Util *) let () = let a = Liba.Alpha.who () in let b = Libb.Beta.who () in Printf.printf "alpha sees: %s\nbeta sees: %s\n" a b; if a <> "util-of-A" || b <> "util-of-B" then begin print_endline "FAILED: wrong Util linked"; exit 1 end obuild-0.3.0/tests/full/packed/packed.obuild000066400000000000000000000004621524143231100207500ustar00rootroot00000000000000name: packed version: 1.0 obuild-ver: 1 synopsis: pack:true wrapping test — two libraries with colliding member names library liba modules: Util, Alpha src-dir: a pack: true library libb modules: Util, Beta src-dir: b pack: true executable main main-is: main.ml build-deps: liba, libb obuild-0.3.0/tests/full/parser/000077500000000000000000000000001524143231100163645ustar00rootroot00000000000000obuild-0.3.0/tests/full/parser/lexer.mll000066400000000000000000000013361524143231100202140ustar00rootroot00000000000000(* 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.3.0/tests/full/parser/main.ml000066400000000000000000000004551524143231100176460ustar00rootroot00000000000000(* 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.3.0/tests/full/parser/parser.obuild000066400000000000000000000005431524143231100210620ustar00rootroot00000000000000name: 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.3.0/tests/full/parser/rpncalc.mly000066400000000000000000000013621524143231100205330ustar00rootroot00000000000000/* 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.3.0/tests/full/run000077500000000000000000000022601524143231100156220ustar00rootroot00000000000000#!/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 packed vendored" 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 # optional runtime verification: a test dir may provide a check.sh # that exits non-zero when the built artifacts misbehave if [ -x ./check.sh ]; then ./check.sh if [ $? -ne 0 ]; then echo -e "${RED}ERROR${WHITE}: check failed" cd .. continue fi fi echo -e "${GREEN}SUCCESS${WHITE}: $t passed" cd .. done for t in ${TESTS} do cd ${t} ${OBUILD} clean rm -f .merlin cd .. done obuild-0.3.0/tests/full/simple/000077500000000000000000000000001524143231100163615ustar00rootroot00000000000000obuild-0.3.0/tests/full/simple/p1.ml000066400000000000000000000000221524143231100172250ustar00rootroot00000000000000let inc a = a + 1 obuild-0.3.0/tests/full/simple/p1.obuild000066400000000000000000000000761524143231100201040ustar00rootroot00000000000000name: p1 version: 1.0 obuild-ver: 1 library p1 modules: P1 obuild-0.3.0/tests/full/test/000077500000000000000000000000001524143231100160475ustar00rootroot00000000000000obuild-0.3.0/tests/full/test/test.obuild000066400000000000000000000001601524143231100202230ustar00rootroot00000000000000name: test version: 0.1 obuild-ver: 1 library abc modules: X test abc main-is: testX.ml build-deps: abc obuild-0.3.0/tests/full/test/testX.ml000066400000000000000000000003701524143231100175100ustar00rootroot00000000000000let 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.3.0/tests/full/test/x.ml000066400000000000000000000000241524143231100166440ustar00rootroot00000000000000let foo a b = a + b obuild-0.3.0/tests/full/vendored/000077500000000000000000000000001524143231100166765ustar00rootroot00000000000000obuild-0.3.0/tests/full/vendored/check.sh000077500000000000000000000000461524143231100203120ustar00rootroot00000000000000#!/bin/sh exec ./dist/build/main/main obuild-0.3.0/tests/full/vendored/main.ml000066400000000000000000000005031524143231100201520ustar00rootroot00000000000000(* greeter is a vendored, packed library that itself depends on the vendored textutil library; everything must resolve internally *) let () = let s = Greeter.Hello.greet "world" in print_endline s; if s <> "hello WORLD" then begin print_endline "FAILED: wrong output from vendored libraries"; exit 1 end obuild-0.3.0/tests/full/vendored/vendor/000077500000000000000000000000001524143231100201735ustar00rootroot00000000000000obuild-0.3.0/tests/full/vendored/vendor/greeter/000077500000000000000000000000001524143231100216305ustar00rootroot00000000000000obuild-0.3.0/tests/full/vendored/vendor/greeter/greeter.obuild000066400000000000000000000001751524143231100244700ustar00rootroot00000000000000name: greeter version: 0.1 obuild-ver: 1 library greeter modules: Hello src-dir: src build-deps: textutil pack: true obuild-0.3.0/tests/full/vendored/vendor/greeter/src/000077500000000000000000000000001524143231100224175ustar00rootroot00000000000000obuild-0.3.0/tests/full/vendored/vendor/greeter/src/hello.ml000066400000000000000000000000561524143231100240550ustar00rootroot00000000000000let greet name = "hello " ^ Caseit.upper name obuild-0.3.0/tests/full/vendored/vendor/textutil/000077500000000000000000000000001524143231100220555ustar00rootroot00000000000000obuild-0.3.0/tests/full/vendored/vendor/textutil/src/000077500000000000000000000000001524143231100226445ustar00rootroot00000000000000obuild-0.3.0/tests/full/vendored/vendor/textutil/src/caseit.ml000066400000000000000000000000431524143231100244430ustar00rootroot00000000000000let upper = String.uppercase_ascii obuild-0.3.0/tests/full/vendored/vendor/textutil/textutil.obuild000066400000000000000000000001341524143231100251350ustar00rootroot00000000000000name: textutil version: 0.1 obuild-ver: 1 library textutil modules: Caseit src-dir: src obuild-0.3.0/tests/full/vendored/vendored.obuild000066400000000000000000000003151524143231100217030ustar00rootroot00000000000000name: vendored version: 1.0 obuild-ver: 1 synopsis: vendored sub-projects test — vendor-dirs with cross-vendor deps and pack vendor-dirs: vendor executable main main-is: main.ml build-deps: greeter obuild-0.3.0/tests/full/with-c/000077500000000000000000000000001524143231100162635ustar00rootroot00000000000000obuild-0.3.0/tests/full/with-c/cbits.c000066400000000000000000000003341524143231100175330ustar00rootroot00000000000000#include #include #include #include #include CAMLexport value stub_geti(value unit) { CAMLparam1(unit); CAMLreturn(Val_int(10)); } obuild-0.3.0/tests/full/with-c/ccall.ml000066400000000000000000000001761524143231100176770ustar00rootroot00000000000000open Printf external geti : unit -> int = "stub_geti" let inc a = a + 1 let () = printf "%d\n" (inc (geti ())); () obuild-0.3.0/tests/full/with-c/ccall.obuild000066400000000000000000000001431524143231100205370ustar00rootroot00000000000000name: with-c version: 1.0 obuild-ver: 1 executable withc main-is: ccall.ml c-sources: cbits.c obuild-0.3.0/tests/incremental/000077500000000000000000000000001524143231100164275ustar00rootroot00000000000000obuild-0.3.0/tests/incremental/run000077500000000000000000000164021524143231100171640ustar00rootroot00000000000000#!/bin/bash # Incremental-build regression suite. # # Each scenario builds a small project, mutates it, rebuilds, and asserts: # - the resulting program output (catches under-rebuild / stale linking) # - presence/absence of specific build steps (catches over-rebuild and # missing-cutoff regressions) # - convergence: a follow-up build must do nothing # # These lock in the digest-based staleness behavior: mtime races, early # cutoff, implementation-vs-interface propagation, artifact sweeping, # pack/alias wrapping and vendored projects. OBUILD=$(cd "$(dirname "$0")/../.." && pwd)/dist/build/obuild/obuild if [ ! -x "${OBUILD}" ]; then echo "obuild has not been built" exit 1 fi RED="\033[1;31m" GREEN="\033[1;32m" BLUE="\033[1;34m" WHITE="\033[0m" WORK=$(mktemp -d "${TMPDIR:-/tmp}/obuild-incr.XXXXXX") trap 'rm -rf "${WORK}"' EXIT FAILED=0 PASSED=0 CURRENT="" LOG="" fail() { echo -e "${RED}FAIL${WHITE}: ${CURRENT}: $1" if [ -n "${LOG}" ] && [ -f "${LOG}" ]; then sed 's/^/ | /' "${LOG}" | tail -20 fi FAILED=$((FAILED+1)) # non-zero marker so the scenario function can bail out return 1 } scenario() { CURRENT="$1" echo -e "${BLUE} ==== ${CURRENT} ====${WHITE}" DIR="${WORK}/${CURRENT}" mkdir -p "${DIR}" cd "${DIR}" || exit 1 LOG="${DIR}/build.log" } ok() { echo -e "${GREEN}PASS${WHITE}: ${CURRENT}" PASSED=$((PASSED+1)) } # build, log output; fails the scenario if obuild fails build() { if ! ${OBUILD} build > "${LOG}" 2>&1; then fail "build failed" return 1 fi } # build that is expected to fail build_should_fail() { if ${OBUILD} build > "${LOG}" 2>&1; then fail "build unexpectedly succeeded" return 1 fi } configure() { if ! ${OBUILD} configure > /dev/null 2>&1; then fail "configure failed" return 1 fi } # number of Compiling/Packing/Linking/Intfing steps in the last build log steps() { grep -cE "\] (Compiling|Packing|Linking|Intfing)" "${LOG}" } expect_steps() { local n n=$(steps) [ "$n" -eq "$1" ] || fail "expected $1 build steps, got $n" } expect_step() { grep -E "\] (Compiling|Packing|Linking|Intfing)" "${LOG}" | grep -q "$1" \ || fail "expected a step matching '$1'" } expect_no_step() { if grep -E "\] (Compiling|Packing|Linking|Intfing)" "${LOG}" | grep -q "$1"; then fail "unexpected step matching '$1'" fi } expect_output() { local out out=$(./dist/build/main/main 2>&1) [ "$out" = "$1" ] || fail "expected output '$1', got '$out'" } expect_converged() { build || return 1 expect_steps 0 } # common project: lib mylib (Api with mli, Impl without) + exe main write_lib_project() { cat > p.obuild <<-'EOF' name: incr version: 1.0 obuild-ver: 1 library mylib modules: Api, Impl src-dir: lib executable main main-is: main.ml build-deps: mylib EOF mkdir -p lib echo 'let base = "one"' > lib/impl.ml echo 'let msg () = "v-" ^ Impl.base' > lib/api.ml echo 'val msg : unit -> string' > lib/api.mli echo 'let () = print_endline (Api.msg ())' > main.ml } # ---------------------------------------------------------------------- scenario touch-is-noop write_lib_project configure && build && expect_output "v-one" && { touch lib/api.ml lib/impl.ml main.ml build && expect_steps 0 && ok } scenario impl-change-propagates-in-one-build write_lib_project configure && build && { echo 'let base = "two"' > lib/impl.ml build && expect_output "v-two" && expect_converged && ok } scenario comment-change-cuts-off write_lib_project configure && build && { echo '(* comment *)' >> lib/impl.ml build && expect_step "Impl" && expect_no_step "Compiling Main" && expect_output "v-one" && expect_converged && ok } scenario interface-change-cascades write_lib_project configure && build && { # add a value to the interface: dependents of api.cmi must recompile echo 'val extra : int' >> lib/api.mli echo 'let extra = 1' >> lib/api.ml build && expect_step "Intfing Api" && expect_step "Compiling Api" && expect_output "v-one" && expect_converged && ok } scenario exe-relinks-on-lib-change write_lib_project configure && build && { echo 'let base = "three"' > lib/impl.ml build && expect_step "Linking executable" && expect_output "v-three" && ok } scenario module-removal-sweeps-artifacts write_lib_project configure && build && { cat > p.obuild <<-'EOF' name: incr version: 1.0 obuild-ver: 1 library mylib modules: Api src-dir: lib executable main main-is: main.ml build-deps: mylib EOF echo 'let msg () = "no-impl"' > lib/api.ml rm lib/impl.ml build && expect_output "no-impl" && { if ls dist/build/lib-mylib/impl.cm* > /dev/null 2>&1; then fail "stale impl artifacts not swept" else expect_converged && ok fi } } scenario removed-module-still-referenced-errors write_lib_project configure && build && { rm lib/impl.ml cat > p.obuild <<-'EOF' name: incr version: 1.0 obuild-ver: 1 library mylib modules: Api src-dir: lib executable main main-is: main.ml build-deps: mylib EOF # api.ml still references Impl: must fail, not link against a stale cmi build_should_fail && grep -q "Unbound module Impl" "${LOG}" && ok } scenario module-rename write_lib_project configure && build && { git init -q . 2>/dev/null # not required; just ensures mv doesn't confuse anything mv lib/impl.ml lib/core.ml sed -i 's/Impl\.base/Core.base/' lib/api.ml sed -i 's/modules: Api, Impl/modules: Api, Core/' p.obuild build && expect_output "v-one" && { if ls dist/build/lib-mylib/impl.cm* > /dev/null 2>&1; then fail "stale impl artifacts not swept after rename" else expect_converged && ok fi } } scenario packed-lib-impl-change scenario_packed() { cat > p.obuild <<-'EOF' name: incr version: 1.0 obuild-ver: 1 library wrapped modules: Util, Front src-dir: lib pack: true executable main main-is: main.ml build-deps: wrapped EOF mkdir -p lib echo 'let name = "w1"' > lib/util.ml echo 'let who () = Util.name' > lib/front.ml echo 'let () = print_endline (Wrapped.Front.who ())' > main.ml } scenario_packed configure && build && expect_output "w1" && { echo 'let name = "w2"' > lib/util.ml build && expect_output "w2" && expect_converged && ok } scenario vendored-change-propagates mkdir -p vendor/dep/src cat > p.obuild <<-'EOF' name: incr version: 1.0 obuild-ver: 1 vendor-dirs: vendor executable main main-is: main.ml build-deps: veldep EOF cat > vendor/dep/veldep.obuild <<-'EOF' name: veldep version: 0.1 obuild-ver: 1 library veldep modules: V src-dir: src EOF echo 'let v = "vend1"' > vendor/dep/src/v.ml echo 'let () = print_endline V.v' > main.ml configure && build && expect_output "vend1" && { echo 'let v = "vend2"' > vendor/dep/src/v.ml build && expect_output "vend2" && expect_converged && ok } scenario duplicate-module-is-an-error mkdir -p a b cat > p.obuild <<-'EOF' name: incr version: 1.0 obuild-ver: 1 library liba modules: Util src-dir: a library libb modules: Util src-dir: b executable main main-is: main.ml build-deps: liba, libb EOF echo 'let x = 1' > a/util.ml echo 'let x = 2' > b/util.ml echo 'let () = ()' > main.ml configure if ${OBUILD} build > "${LOG}" 2>&1; then fail "collision build unexpectedly succeeded" else grep -q "defined by multiple sources" "${LOG}" && ok fi # ---------------------------------------------------------------------- cd / echo echo -e "passed: ${GREEN}${PASSED}${WHITE} failed: ${RED}${FAILED}${WHITE}" [ "${FAILED}" -eq 0 ] obuild-0.3.0/tests/simple/000077500000000000000000000000001524143231100154175ustar00rootroot00000000000000obuild-0.3.0/tests/simple/deps.build000066400000000000000000000000621524143231100173710ustar00rootroot00000000000000#!/bin/sh ${OBUILDSIMPLE} --deps unix,str deps.ml obuild-0.3.0/tests/simple/deps.ml000066400000000000000000000001421524143231100167010ustar00rootroot00000000000000 let main () = let _s = Str.quote "toto" in let _t = Unix.gettimeofday () in () ;; main () obuild-0.3.0/tests/simple/gtk.build000066400000000000000000000001061524143231100172220ustar00rootroot00000000000000#!/bin/sh ${OBUILDSIMPLE} --cfile gtk_stubs.c --cpkg gtk+-2.0 gtk.ml obuild-0.3.0/tests/simple/gtk.ml000066400000000000000000000001601524143231100165330ustar00rootroot00000000000000external gtk_true : unit -> bool = "stub_gtk_true" let () = Printf.printf "gtk_true(): %b\n" (gtk_true ()) obuild-0.3.0/tests/simple/gtk_stubs.c000066400000000000000000000004221524143231100175660ustar00rootroot00000000000000#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.3.0/tests/simple/hello_world.build000066400000000000000000000000511524143231100207460ustar00rootroot00000000000000#!/bin/sh ${OBUILDSIMPLE} hello_world.ml obuild-0.3.0/tests/simple/hello_world.ml000066400000000000000000000000631524143231100202620ustar00rootroot00000000000000let () = Printf.printf "hello world\n"; () obuild-0.3.0/tests/simple/run000077500000000000000000000004621524143231100161530ustar00rootroot00000000000000#!/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.3.0/tests/simple/z.build000066400000000000000000000000731524143231100167110ustar00rootroot00000000000000#!/bin/sh ${OBUILDSIMPLE} --cfile z_stubs.c --clib z z.ml obuild-0.3.0/tests/simple/z.ml000066400000000000000000000001721524143231100162220ustar00rootroot00000000000000external adler32 : int -> int = "stub_adler32" let () = let v = adler32 10 in Printf.printf "zerror 10 = %x\n" v obuild-0.3.0/tests/simple/z_stubs.c000066400000000000000000000004651524143231100172610ustar00rootroot00000000000000#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.3.0/tests/test_build.ml000066400000000000000000000035641524143231100166260ustar00rootroot00000000000000open 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.3.0/tests/test_build_debug.ml000066400000000000000000000227211524143231100177700ustar00rootroot00000000000000open 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.3.0/tests/test_build_helpers.ml000066400000000000000000000117731524143231100203510ustar00rootroot00000000000000open 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.3.0/tests/test_build_logic.ml000066400000000000000000000333131524143231100177760ustar00rootroot00000000000000open 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.3.0/tests/test_dag.ml000066400000000000000000000146251524143231100162620ustar00rootroot00000000000000let 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.3.0/tests/test_expr.ml000066400000000000000000000052521524143231100165010ustar00rootroot00000000000000let 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.3.0/tests/test_find.ml000066400000000000000000000274371524143231100164540ustar00rootroot00000000000000let 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.3.0/tests/test_framework.ml000066400000000000000000000062171524143231100175220ustar00rootroot00000000000000open 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 [] (* Hook called before each test. Test suites that use global caches should set this to reset state between tests, e.g.: Test_framework.before_each := fun () -> Metacache.clear (); Hier.clear () *) let before_each : (unit -> unit) ref = ref (fun () -> ()) 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 = !before_each (); 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.3.0/tests/test_framework_demo.ml000066400000000000000000000041761524143231100205300ustar00rootroot00000000000000open 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.3.0/tests/test_generators.ml000066400000000000000000000163351524143231100177000ustar00rootroot00000000000000let 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 () = (* --- 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; (* --- make_set / get_all / find_generator_by_name tests --- *) 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 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 let gset = Generators.make_set [ gen_menhir; gen_lex ] in let all = Generators.get_all gset 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 gset "mly"); assumeTrue "is_generator_ext mll" (Generators.is_generator_ext gset "mll"); assumeTrue "is_generator_ext unknown" (not (Generators.is_generator_ext gset "xyz")); assumeTrue "is_generator_ext ml" (not (Generators.is_generator_ext gset "ml")); (* --- find_generator_by_name tests --- *) (match Generators.find_generator_by_name gset "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 gset "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) --- *) 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 let gset_ns = Generators.make_set [ gen_no_suffix ] in (* Generator without suffix should not appear in get_all (auto-detection) *) let all_no_suffix = Generators.get_all gset_ns 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 gset_ns "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 --- *) let builtin = List.hd (Generators.get_all (Generators.make_set [ gen_menhir ])) 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)); (* --- empty set --- *) let all_after_clear = Generators.get_all (Generators.make_set []) in assumeEq "clear generators" "0" (string_of_int (List.length all_after_clear)); (* --- get_generator raises on unknown extension --- *) assumeRaises "get_generator not found" (fun () -> ignore (Generators.get_generator (Generators.make_set []) (Filepath.fp "foo.xyz"))); (* --- make_set (batch) --- *) let all_batch = Generators.get_all (Generators.make_set [ gen_menhir; gen_lex ]) in assumeEq "make_set 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.3.0/tests/test_helpers.ml000066400000000000000000000144751524143231100171740ustar00rootroot00000000000000open Test_framework open Printf (** Historical hook: caches are no longer global (Hier registries and META caches are explicit per-invocation values), so there is nothing to reset. *) let install_cache_reset () = Test_framework.before_each := fun () -> () (** 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 (Hier.create_registry ()) 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 (Hier.create_registry ()) 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.3.0/tests/test_meta.ml000066400000000000000000000274171524143231100164600ustar00rootroot00000000000000open Test_framework open Test_helpers 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 (Metacache.create ()) 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 () = install_cache_reset (); run_tests all_tests obuild-0.3.0/tests/test_meta_errors.ml000066400000000000000000000252161524143231100200470ustar00rootroot00000000000000open 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.3.0/tests/test_new_parser.ml000066400000000000000000000613141524143231100176710ustar00rootroot00000000000000(** 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.3.0/tests/test_path.ml000066400000000000000000000126451524143231100164630ustar00rootroot00000000000000let 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.3.0/tests/test_project_errors.ml000066400000000000000000000226731524143231100205730ustar00rootroot00000000000000open 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 () = install_cache_reset (); run_tests all_tests obuild-0.3.0/tests/test_validate.ml000066400000000000000000000306411524143231100173140ustar00rootroot00000000000000(** 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 (Gconf.create ()) 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 (Gconf.create ()) 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 (Gconf.create ()) 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 (Gconf.create ()) 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 (Gconf.create ()) 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 (Gconf.create ()) 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 (Gconf.create ()) 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 (Gconf.create ()) 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 (Gconf.create ()) 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 (Gconf.create ()) 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 (Gconf.create ()) 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 (Gconf.create ()) 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 (Gconf.create ()) 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 (Gconf.create ()) input))); test "missing version" (fun () -> let input = "\ name: x\n\ obuild-ver: 1\n" in assert_raises "missing version" (fun () -> ignore (parse_and_convert (Gconf.create ()) 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 (Gconf.create ()) 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 (Gconf.create ()) 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 (Gconf.create ()) 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 (Gconf.create ()) 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.3.0/tests/validate_real_world.ml000066400000000000000000000226301524143231100204660ustar00rootroot00000000000000open 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