#!/bin/sh set -eu directory=$(mktemp -d) trap 'rm -rf "$directory"' EXIT HUP INT TERM reject() { printf '%s\n' "$1" > "$directory/rejected.ml" if "${OCAMLC:-ocamlc}" -ppx ./rewrite -c "$directory/rejected.ml" 2> "$directory/error"; then echo "Unexpected compilation success: $1" >&2 exit 1 fi if ! grep -q "$2" "$directory/error"; then cat "$directory/error" >&2 exit 1 fi } reject 'type t = { colour : string } [@@fieldglass generate ~no_get] let _ = colour' 'Unbound value colour' reject 'type t = A [@@fieldglass generate]' 'fieldglass: expected a record' reject 'type t = { colour : string } [@@fieldglass invalid]' 'fieldglass: expected generate' reject 'type t = { colour : string } [@@fieldglass generate ~unknown]' 'fieldglass: unrecognised' reject 'type t = { colour : string } [@@fieldglass generate ~no_get:3]' 'fieldglass: expected a boolean' reject 'type t = { colour : string } [@@fieldglass generate ~field_prefix:3]' 'fieldglass: expected an identifier' reject 'type t = { colour : string } [@@fieldglass generate ~field_prefix:"a b"]' 'fieldglass: invalid generated identifier' reject 'type t = { colour : string } [@@fieldglass generate ~func_named_arg:"type"]' 'fieldglass: invalid generated identifier' reject 'type t = { colour : string } [@@fieldglass generate ~no_get ~no_get]' 'fieldglass: duplicate option' reject 'type t = { colour : string } [@@fieldglass generate 3]' 'fieldglass: expected a labelled option' reject 'type t = { colour : string } [@@fieldglass generate] [@@lens generate]' 'fieldglass: expected' reject 'type t = { x : int; set_x : int } [@@fieldglass generate]' 'fieldglass: duplicate generated binding' reject 'type a = { value : int } and b = { value : string } [@@fieldglass generate]' 'fieldglass: duplicate generated binding' reject 'type t = private { colour : string } [@@fieldglass generate]' 'fieldglass: private records' reject "type t = { apply : 'a. 'a -> 'a } [@@fieldglass generate]" 'fieldglass: polymorphic fields' reject 'module type S = sig type t = { colour : string } [@@fieldglass generate] end' 'fieldglass: generate accessors in an implementation' reject 'type t = { item_type : int; item_value : int } [@@fieldglass generate]' 'fieldglass: invalid generated identifier' reject 'type t = { item_ : int; item_value : int } [@@fieldglass generate]' 'fieldglass: invalid generated identifier' reject 'type t = { value : int } [@@fieldglass generate ?no_get:None]' 'fieldglass: expected a labelled option' reject 'type t = { value : int } [@@fieldglass generate ~just_lens] let _ = set_value' 'Unbound value set_value' reject 'type t = { value : int } [@@fieldglass generate ~just_lens] let _ = update_value' 'Unbound value update_value' reject 'type t = { colour : string } [@@fieldglass generate ~no_set] let _ = set_colour' 'Unbound value set_colour' reject 'type t = { colour : string } [@@fieldglass generate ~no_update] let _ = update_colour' 'Unbound value update_colour' reject 'type t = { colour : string } [@@fieldglass generate ~no_lens] let _ = _colour' 'Unbound value _colour' reject 'type t = { colour : string } [@@fieldglass generate ~just_lens] let _ = colour' 'Unbound value colour'