+OCaml 4.12.1 (24 September 2021)
+--------------------------------
+
+### Bug fixes:
+
+- #10107: Ensure modules compiled with -afl-instrument can still link on
+ platforms without AFL support.
+ (David Allsopp, review by Xavier Leroy)
+
+- #10294, #10295: fix an assert-failure in pattern-matching compilation
+ (Gabriel Scherer, review by Thomas Refis and Luc Maranget,
+ report by Nicolás Ojeda Bär)
+
+- #10310: configure's --enable-spacetime option now causes an error rather than
+ being silently ignored.
+ (David Allsopp, review by Gabriel Scherer)
+
+- #10351: Fix DLL loading with binutils 2.36+ on mingw-w64
+ (David Allsopp, review by Nicolás Ojeda Bär)
+
+- #10442, #10446: Fix regression in the toplevel to #directory caused by
+ corrections and improvements to the Load_path in #9611. #directory now
+ adds the path to the start of the load path again (so files in the newly
+ added directory take priority).
+ (David Allsopp, report by Vasile Rotaru, review by Florian Angeletti
+ and Nicolás Ojeda Bär)
+
+- #10449: Fix major GC work accounting (the GC was running too fast).
+ (Damien Doligez, report by Stephen Dolan, review by Nicolás Ojeda Bär
+ and Sadiq Jaffer)
+
+- #10478: Fix segfault under Windows due to a mistaken initialization of thread
+ ID when a thread starts.
+ (David Allsopp, Nicolás Ojeda Bär, review by Xavier Leroy)
+
+- #10626, #10628: Wrong reloading of the x86-64 instruction for
+ integer multiplication by a constant, causing the assembler to
+ reject the ocamlopt-generated code.
+ (Xavier Leroy, report by Dave Aitken, review by Vincent Laviron)
+
+### Manual and documentation
+
+- #10497: Styling changes in the post-processed HTML manual (webman)
+ (Wiktor Kuchta, review by Florian Angeletti)
+
+
OCaml 4.12.0 (24 February 2021)
-------------------------------
(David Allsopp, review by Guillaume Munch-Maccagnoni and
Jacques-Henri Jourdan)
-- #9508: Remove support for FreeBSD prior to 4.0R, that required explicit
+- #9506: Remove support for FreeBSD prior to 4.0R, that required explicit
floating-point initialization to behave like IEEE standard
(Hannes Mehnert, review by David Allsopp)
-4.12.0
+4.12.1
# The version string is the first line of this file.
# It must be in the format described in stdlib/sys.mli
Iintop(others) R R S
or S S R
Iintop_imm(Iadd, n)/lea R R
+ Iintop_imm(Imul, n) R R
Iintop_imm(others) S S
Inegf...Idivf R R S
Ifloatofint R S
(* This add will be turned into a lea; args and results must be
in registers *)
super#reload_operation op arg res
+ | Iintop_imm(Imul, _) ->
+ (* The result (= the argument) must be a register (#10626) *)
+ if stackp arg.(0)
+ then (let r = self#makereg arg.(0) in ([|r|], [|r|]))
+ else (arg, res)
| Iintop(Imulh | Idiv | Imod | Ilsl | Ilsr | Iasr)
| Iintop_imm(_, _) ->
(* The argument(s) and results can be either in register or on stack *)
fi
fi
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.69 for OCaml 4.12.0.
+# Generated by GNU Autoconf 2.69 for OCaml 4.12.1.
#
# Report bugs to <caml-list@inria.fr>.
#
# Identity of this package.
PACKAGE_NAME='OCaml'
PACKAGE_TARNAME='ocaml'
-PACKAGE_VERSION='4.12.0'
-PACKAGE_STRING='OCaml 4.12.0'
+PACKAGE_VERSION='4.12.1'
+PACKAGE_STRING='OCaml 4.12.1'
PACKAGE_BUGREPORT='caml-list@inria.fr'
PACKAGE_URL='http://www.ocaml.org'
enable_frame_pointers
enable_naked_pointers
enable_naked_pointers_checker
+enable_spacetime
enable_cfi
enable_installing_source_artifacts
enable_installing_bytecode_programs
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures OCaml 4.12.0 to adapt to many kinds of systems.
+\`configure' configures OCaml 4.12.1 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of OCaml 4.12.0:";;
+ short | recursive ) echo "Configuration of OCaml 4.12.1:";;
esac
cat <<\_ACEOF
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-OCaml configure 4.12.0
+OCaml configure 4.12.1
generated by GNU Autoconf 2.69
Copyright (C) 2012 Free Software Foundation, Inc.
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by OCaml $as_me 4.12.0, which was
+It was created by OCaml $as_me 4.12.1, which was
generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
-{ $as_echo "$as_me:${as_lineno-$LINENO}: Configuring OCaml version 4.12.0" >&5
-$as_echo "$as_me: Configuring OCaml version 4.12.0" >&6;}
+{ $as_echo "$as_me:${as_lineno-$LINENO}: Configuring OCaml version 4.12.1" >&5
+$as_echo "$as_me: Configuring OCaml version 4.12.1" >&6;}
# Configuration variables
-VERSION=4.12.0
+VERSION=4.12.1
# Note: This is present for the flexdll bootstrap where it exposed as the old
fi
+# Check whether --enable-spacetime was given.
+if test "${enable_spacetime+set}" = set; then :
+ enableval=$enable_spacetime; as_fn_error $? "spacetime profiling was deleted in OCaml 4.12." "$LINENO" 5
+fi
+
+
# Check whether --enable-cfi was given.
if test "${enable_cfi+set}" = set; then :
enableval=$enable_cfi;
cc_warnings='-Wall -Wdeclaration-after-statement' ;;
esac
-case $enable_warn_error,4.12.0 in #(
+case $enable_warn_error,4.12.1 in #(
yes,*|,*+dev*) :
cc_warnings="$cc_warnings $warn_error_flag" ;; #(
*) :
ocamldoc=ocamldoc
fi
-case $enable_ocamltest,4.12.0 in #(
+case $enable_ocamltest,4.12.1 in #(
yes,*|,*+dev*) :
ocamltest='ocamltest' ;; #(
*) :
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by OCaml $as_me 4.12.0, which was
+This file was extended by OCaml $as_me 4.12.1, which was
generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
-OCaml config.status 4.12.0
+OCaml config.status 4.12.1
configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
[AS_HELP_STRING([--enable-naked-pointers-checker],
[enable the naked pointers checker])])
+AC_ARG_ENABLE([spacetime], [],
+ [AC_MSG_ERROR([spacetime profiling was deleted in OCaml 4.12.])],
+ [])
+
AC_ARG_ENABLE([cfi],
[AS_HELP_STRING([--disable-cfi],
[disable the CFI directives in assembly files])])
\setcounter{page}{1}
\begin{htmlonly}
-\begin{quote}
-\rule{}{}
+\begin{maintitle}
+\vspace*{2ex}
This manual is also available in
\ahref{https://ocaml.org/releases/\ocamlversion/ocaml-\ocamlversion-refman.pdf}{PDF},
\ahref{https://ocaml.org/releases/\ocamlversion/ocaml-\ocamlversion-refman.txt}{plain text},
\ahref{https://ocaml.org/releases/\ocamlversion/ocaml-\ocamlversion-refman-html.tar.gz}{bundle of HTML files},
and as a
\ahref{https://ocaml.org/releases/\ocamlversion/ocaml-\ocamlversion-refman.info.tar.gz}{bundle of Emacs Info files}.
-\rule{}{}
-\end{quote}
+\end{maintitle}
\end{htmlonly}
\tableofcontents
$logo_height:67px;
@if $ocamlorg {
- .container {
+ .container {
margin-left:0;
margin-right:0;
}
@import url(https://fonts.googleapis.com/css?family=Noticia+Text:400,400i,700);
@import url(https://fonts.googleapis.com/css?family=Fira+Sans:400,400i,500,500i,600,600i,700,700i);
+$font-sans: "Fira Sans", Helvetica, Arial, sans-serif;
+$font-mono: "Fira Mono", courier, monospace;
+$font-serif: "Noticia Text", Georgia, serif;
+
/* Reset */
.pre,a,b,body,code,div,em,form,h1,h2,h3,h4,h5,h6,header,html,i,img,li,mark,menu,nav,object,output,p,pre,s,section,span,time,ul,td,var{
margin:0;
}
body{
- font-family:"Fira Sans",Helvetica,Arial,sans-serif;
+ font-family: $font-sans;
text-align:left;
color:#333;
background:#fff
&>header {
margin-bottom: 30px;
nav {
- font-family: "Fira Sans", Helvetica, Arial, sans-serif;
+ font-family: $font-sans;
}
}
}
margin-right:4ex;
margin-top:20px;
margin-bottom:50px;
- font-family:"Noticia Text",Georgia,serif;
+ font-family: $font-serif;
line-height:1.5
}
padding-left:12px;
}
a {
- font-family:"Fira Sans",sans-serif;
+ font-family: $font-sans;
font-size:.95em;
color:#333;
font-weight:400;
}
}
}
-
+
@mixin nav-toc-mobile {
position:static;
width:auto;
position: absolute;
background: transparent;
}
- .content, .api {
+ .content, .api {
nav.toc {
margin-right: 1em;
float: left;
margin-right:4px;
margin-left:-1em
}
+
+@mixin disc {
+ content:"●";
+ color:$logocolor;
+ margin-right:4px;
+ margin-left:-1em;
+ font-family: $font-sans;
+ font-size:13px;
+ vertical-align:1px;
+}
+
+@mixin diamond {
+ content:"◆";
+ color:$logocolor;
+ margin-right:4px;
+ margin-left:-1em;
+ font-family: $font-sans;
+ font-size:14px;
+ vertical-align:1px;
+}
float:left;
color:#777;
cursor: context-menu;
- font-family:"Fira Sans",Helvetica,Arial,sans-serif;
+ font-family: $font-sans;
span{ /* menu icon */
font-size:22px;
margin-right:1ex;
}
}
ul{list-style:none;}
- ul.itemize li::before{@include caret;}
+ ul.itemize li::before{@include disc;}
/* When the TOC is repeated in the main content */
ul.ul-content {
}
}
/* only for Contents/Foreword in index.html: */
- ul.ul-content li::before{@include caret;}
+ ul.ul-content li::before{
+ @include disc;
+ margin-left: 0;
+ }
/* table of contents: (manual.001.html): */
ul.toc ul.toc ul.toc{
font-size:smaller;
}
section>ul>li>a{ /* for Parts title */
- font-family:"Fira Sans",Helvetica,Arial,sans-serif;
+ font-family: $font-sans;
font-size:larger;
background:linear-gradient(to left,#fff 0,#ede8e5 100%);
}
color:#d5d5d5
}
.h10,.h7,.h8,.h9,h1,h2,h3,h4,h5,h6{
- font-family:"Fira Sans",Helvetica,Arial,sans-serif;
+ font-family: $font-sans;
font-weight:400;
margin:.5em 0 .5em 0;
padding-top:.1em;
h4{
font-size:1.12em
}
+h2, h3, h4, h5 {
+ font-weight: 500;
+}
.ocaml,.pre,code,pre,tt{
- font-family:"Fira Mono",courier;
+ font-family: $font-mono;
font-weight:400
}
.pre,pre{
color: #d28853;
}
blockquote.quote{
- margin:0;
/*font-size: smaller;*/
hr{
display:none;
}
}
#part-menu{
- font-family:"Fira Sans";
+ font-family: $font-sans;
text-align:right;
list-style:none;
overflow-y:hidden;
}
#part-menu li.active a{
color:#000;
- &::before{@include caret;}
+ &::before{@include diamond}
+}
+.center {
+ text-align: center;
+ margin-left: auto;
+ margin-right: auto;
+}
+.display {
+ margin: 0 auto;
+}
+.c001 {
+ border-spacing: 6px;
+ border-collapse: separate;
}
span.c003{
color:#564233;
- font-family:"Fira Mono",courier;
- background-color:#f3ece6;
+ font-family: $font-mono;
border-radius:6px
}
div.caml-example.toplevel code.caml-input::before,
div.caml-example.toplevel div.caml-input::before{
- content:"#";
+ /* content:"#"; */ /* pre-4.11 */
color:#888
}
-span.c004{
+span.number{
+ padding-right: 1ex;
+}
+span.c004, span.c005, span.c007 {
+ font-family: $font-mono;
+}
+span.c003, span.c005 {
+ color: rgba(91, 33, 6, 0.87);
+}
+span.c002{
color:#888
}
span.c006{
font-weight:700;
color:#564233;
- font-family:"Fira Mono",courier;
+ font-family: $font-mono;
}
-span.c009{
- font-style:italic;
- background-color:#f3ece6;
- border-radius:6px
+.c008 {
+ font-family: $font-sans;
+}
+span.c010 {
+ font-style: italic;
}
-span.authors.c009{
+span.authors{
+ font-style:italic;
background-color:inherit
}
+span.c011 {
+ font-style: italic;
+}
+.c012 {
+ font-style: italic;
+}
span.c013{
- font-weight:700
+ font-style: italic;
+}
+.center table {
+ margin-left: inherit;
+ margin-right: inherit;
+}
+td .c014 {
+ font-weight: bold;
+}
+.c016 {
+ text-align: center;
+}
+.cellpadding1 tr td {
+ padding: 1px 4px;
}
.caml-input{
span.ocamlkeyword{
.api {
// font-size: 16px;
- // font-family: "Fira Sans", Helvetica, Arial, sans-serif;
+ // font-family: $font-sans;
// text-align: left;
// color: #333;
// background: #FFFFFF;
we restart the sequence there like h2 */
h1, h2, h3, h4, h5, h6, .h7, .h8, .h9, .h10 {
- font-family: "Fira Sans", Helvetica, Arial, sans-serif;
+ font-family: $font-sans;
font-weight: 400;
margin: 0.5em 0 0.5em 0;
padding-top: 0.1em;
/* Preformatted and code */
tt, code, pre {
- font-family: "Fira Mono", courier;
+ font-family: $font-mono;
font-weight: 400;
}
span.arrow {
font-size: 20px;
line-height: 8pt;
- font-family: "Fira Mono";
+ font-family: $font-mono;
}
header dl dd, header dl dt {
display: inline-block;
}
ul.tutos_menu {
- font-family: "Fira Sans";
+ font-family: $font-sans;
text-align: right;
list-style: none;
}
}
span.c003 {
- font-family: "Fira Mono", courier;
+ font-family: $font-mono;
background-color: #f3ece6;
border-radius: 6px;
}
code span.constructor,
.caml-input span.kw2 {
- font-weight: 500;
- color: #a28867;
+ color: #8d543c;
}
.caml-input span.numeric {
let archives =
["refman-html.tar.gz"; "refman.txt"; "refman.pdf"; "refman.info.tar.gz"]
+let preg_anyspace =
+ String.concat "\\|"
+ ["\u{00a0}"; (* NO-BREAK SPACE *)
+ "\u{2000}"; (* EN QUAD *)
+ "\u{2001}"; (* EM QUAD *)
+ "\u{2002}"; (* EN SPACE *)
+ "\u{2003}"; (* EM SPACE *)
+ "\u{2004}"; (* THREE-PER-EM SPACE *)
+ "\u{2005}"; (* FOUR-PER-EM SPACE *)
+ "\u{2006}"; (* SIX-PER-EM SPACE *)
+ "\u{2007}"; (* FIGURE SPACE *)
+ "\u{2008}"; (* PUNCTUATION SPACE *)
+ "\u{2009}"; (* THIN SPACE *)
+ "\u{200a}"; (* HAIR SPACE *)
+ "\u{202f}"; (* NARROW NO-BREAK SPACE *)
+ ]
+ |> sprintf "\\(%s\\)+"
+
+(* WARNING these are sensitive to Hevea fluctuations: *)
+(* "long" space is either " " (hevea 2.32) or "\u{2003}" (hevea 2.35) *)
+let preg_emspace = "\\(\u{2003}\\| \\)"
+(* What hevea inserts between "Chapter" and the chapter number: *)
+let preg_chapter_space = "\\(\u{2004}\u{200d}\\|" ^ preg_anyspace ^ "\\)"
+let writtenby_css = "span.c010" (* "span.c009" for hevea 2.32 *)
+
(* Remove number: "Chapter 1 The core language" ==> "The core language" *)
let remove_number s =
- Re.Str.(global_replace (regexp ".+ ") "" s)
+ Re.Str.(global_replace (regexp (".+" ^ preg_emspace)) "" s)
let toc_get_title li =
let a = li $ "a[href]" in
"<div class=\"copyright\">" ^ !copyright_text ^ "</div>"
|> parse
+
+(* New UTF8 space chars have been introduced in Hevea 2.35. In Hevea 2.32, only
+ html nb_spaces " " were used. With 2.35 we have
+ 'Chapter\u2004\u200d2\u2003The module system'. The \u200d is Zero Width
+ Joiner and should probably not be used here, see
+ https://github.com/maranget/hevea/pull/61 *)
+
+let reg_chapter = Re.Str.regexp
+ ("Chapter" ^ preg_chapter_space ^ "\\([0-9]+\\)" ^ preg_anyspace)
+
let load_html file =
dbg "%s" file;
(* First we perform some direct find/replace in the html string. *)
let html =
read_file (html_file file)
- (* Normalize non-break spaces: *)
+ (* Normalize non-break spaces to the utf8 \u00A0: *)
|> Re.Str.(global_replace (regexp_string " ") " ")
- |> Re.Str.(global_replace (regexp "Chapter \\([0-9]+\\)"))
- (if file = "index.html" then "<span>\\1.</span>"
- else "<span>Chapter \\1</span>")
+ |> Re.Str.(global_replace reg_chapter)
+ (if file = "index.html" then {|<span class="number">\3.</span>|}
+ else {|<span class="number">Chapter \3</span>|})
(* I think it would be good to replace "chapter" by "tutorial" for part
I. The problem of course is how we number chapters in the other parts. *)
(* Remove the chapter number in local links, it makes the TOC unnecessarily
unfriendly. *)
- |> Re.Str.(global_replace (regexp ">[0-9]+\\.\\([0-9]+\\) ") ">\\1 ")
- |> Re.Str.(global_replace (regexp "[0-9]+\\.\\([0-9]+\\.[0-9]+\\) "))
- "\\1 "
+ |> Re.Str.(global_replace
+ (regexp (">[0-9]+\\.\\([0-9]+\\)" ^ preg_anyspace)))
+ {|><span class="number">\1</span>|}
+ |> Re.Str.(global_replace
+ (regexp ("[0-9]+\\.\\([0-9]+\\(\\.[0-9]+\\)+\\)" ^ preg_anyspace)))
+ {|<span class="number">\1</span>|}
(* The API (libref and compilerlibref directories) should be separate
entities, to better distinguish them from the manual. *)
(* For the main index file, we do a few adjustments *)
let html = if file = "index.html"
- then Re.Str.(global_replace (regexp "Part \\([I|V]+\\)<br>")
- "<span>\\1. </span>" html)
+ then Re.Str.(global_replace
+ (regexp ("Part" ^ preg_chapter_space ^ "\\([I|V]+\\)<br>\n"))
+ {|<span class="number">\3.</span>|} html)
else html in
(* Set utf8 encoding directly in the html string *)
| Some div -> div (* This is the case for "index.html" *)
| None -> soup $ "h1" in
title, header
-
+
(* Create a new file by keeping only the head/headers parts of "soup", deleting
everything after the title, and inserting the content of external file (hence
preserving TOC and headers) (WARNING: this mutates soup) *)
(* Move authors to the end *)
let move_authors body =
- body $? "span.c009"
+ body $? writtenby_css
|> Option.iter (fun authors ->
match leaf_text authors with
| None -> ()
% Notations pour les metavariables
\def\nmth#1#2#3{\({#1}_{#2}^{#3}\)}
\def\optvar#1{[\var{#1}\/]}
-\def\event{§§}
+\def\event{$\bowtie$}
\def\fromoneto#1#2{$#1 = 1,\ldots{} , #2$}
\newcommand{\vfill}{}
%%% References to modules in the standard library
\newcommand{\stdmoduleref}[1]{\ahref{libref/#1.html}{\texttt{#1}}}
+
+%%% Missing macro
+\newcommand{\DeclareUnicodeCharacter}[2]{}
opam-version: "2.0"
-version: "4.12.0"
-synopsis: "OCaml 4.12.0"
+version: "4.12.1"
+synopsis: "OCaml 4.12.1"
depends: [
- "ocaml" {= "4.12.0" & post}
+ "ocaml" {= "4.12.1" & post}
"base-unix" {post}
"base-bigarray" {post}
"base-threads" {post}
/* Associate the thread descriptor with the thread */
st_tls_set(thread_descriptor_key, (void *) th);
- st_thread_set_id(Ident(th->descr));
/* Acquire the global mutex */
caml_leave_blocking_section();
+ st_thread_set_id(Ident(th->descr));
caml_setup_stack_overflow_detection();
#ifdef NATIVE_CODE
/* Setup termination handler (for caml_thread_exit) */
/* Runtime support for afl-fuzz */
#include "caml/config.h"
+/* Values used by the instrumentation logic (see cmmgen.ml) */
+static unsigned char afl_area_initial[1 << 16];
+unsigned char* caml_afl_area_ptr = afl_area_initial;
+uintnat caml_afl_prev_loc;
+
#if !defined(HAS_SYS_SHM_H) || !defined(HAS_SHMAT)
#include "caml/mlvalues.h"
to count a testcase as "crashing" */
extern int caml_abort_on_uncaught_exn;
-/* Values used by the instrumentation logic (see cmmgen.ml) */
-static unsigned char afl_area_initial[1 << 16];
-unsigned char* caml_afl_area_ptr = afl_area_initial;
-uintnat caml_afl_prev_loc;
-
/* File descriptors used to synchronise with afl-fuzz */
#define FORKSRV_FD_READ 198
#define FORKSRV_FD_WRITE 199
#ifndef CAMLDLLIMPORT
#if defined(SUPPORT_DYNAMIC_LINKING) && defined(ARCH_SIXTYFOUR) \
- && defined(__CYGWIN__)
+ && (defined(__CYGWIN__) || defined(__MINGW32__))
#define CAMLDLLIMPORT __declspec(dllimport)
#else
#define CAMLDLLIMPORT
if( Tag_hd(chd) < No_scan_tag ) {
mark_stack_push(stk, child, 0, work);
} else {
- *work -= 1; /* Account for header */
+ *work -= Whsize_hd (chd);
}
}
}
--- /dev/null
+(* TEST *)
+
+type import_error = Node of string
+type export_error = Variant of string * string
+
+exception Import of import_error
+exception Export of export_error
+(* Pattern-matching analysis and compilation considers that two
+ exceptions constructors may be equal (one may be a rebinding of
+ the other) as long as they have the same arity, as is the case
+ here.
+
+ The result of splitting on these two exception constructors is what
+ we call an "incoherent row", a pattern matrix whose rows have
+ incompatible types (one matching on [import_error], the other on
+ [export_error]).
+
+ In the case of the code below, the incoherent row is as follows:
+
+ (Node _)
+ (Variant (_, _))
+
+ Note that the two constructors [Node] and [Variant] have different
+ arities, but the same tag (0).
+
+ In bug #10924, this causes an assertion-failure in the
+ pattern-matching compiler, because a matrix-decomposition
+ computation in Default_environment ends up considering that Node
+ and Variant are equal, creating a sub-matrix with one wildcard
+ pattern in the first row, and two in the second.
+
+ This is fixed by comparing constructors by more than their tags
+ (which is insufficient for incoherent rows).
+*)
+let f = function
+ | Import (Node _) ->
+ 1
+ | Export (Variant (_, _)) ->
+ 2
+ | _ ->
+ 3
+
+let () =
+ assert (f (Import (Node "foo")) = 1);
+ assert (f (Export (Variant ("foo", "bar"))) = 2);
--- /dev/null
+#cd "test"
+#directory "."
+#use "payload.ml"
--- /dev/null
+let _ = 42
--- /dev/null
+(* TEST
+
+* setup-ocaml-build-env
+** script
+script = "mkdir -p test"
+*** script
+script = "cp ${test_source_directory}/driver.ml test/"
+**** script
+script = "cp ${test_source_directory}/payload.ml test/"
+***** ocaml
+test_file = "test/driver.ml"
+ocaml_script_as_argument = "true"
+*)
--- /dev/null
+#!/bin/sh
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* Xavier Leroy, projet Cambium, INRIA Paris *
+#* *
+#* Copyright 2021 Institut National de Recherche en Informatique et *
+#* en Automatique. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+# Set up the execution environment before launching the CI script
+# given as argument.
+
+# Currently, the only setup performed is to make sure that ARM-based Macs
+# run the script in ARM64 mode or in x86-64 mode, depending on what
+# the OCAML_ARCH parameter requires.
+# If OCAML_ARCH is just "macos", the default mode is used.
+
+set -x
+
+case "${OCAML_ARCH}" in
+ macos-arm) OCAML_ARCH=macos exec /usr/bin/arch -arm64 "$@";;
+ macos-x86) OCAML_ARCH=macos exec /usr/bin/arch -x86_64 "$@";;
+ *) exec "$@";;
+esac
# be considerate towards other potential users of the test machine
case "${OCAML_ARCH}" in
- bsd|macos|linux) renice 10 $$ ;;
+ bsd|linux) renice 10 $$ ;;
esac
# be verbose and stop on error
let dir_directory s =
let d = expand_directory Config.standard_library s in
let dir = Load_path.Dir.create d in
- Load_path.add dir;
+ Load_path.prepend_dir dir;
toplevel_env :=
Stdlib.String.Set.fold
(fun name env ->
let d = expand_directory Config.standard_library s in
Dll.add_path [d];
let dir = Load_path.Dir.create d in
- Load_path.add dir;
+ Load_path.prepend_dir dir;
toplevel_env :=
Stdlib.String.Set.fold
(fun name env ->
Path.same path1 path2 && b1 = b2
| (Cstr_constant _|Cstr_block _|Cstr_unboxed|Cstr_extension _), _ -> false
-let may_equal_constr c1 c2 = match c1.cstr_tag,c2.cstr_tag with
-| Cstr_extension _,Cstr_extension _ -> c1.cstr_arity = c2.cstr_arity
-| tag1,tag2 -> equal_tag tag1 tag2
+let may_equal_constr c1 c2 =
+ c1.cstr_arity = c2.cstr_arity
+ && (match c1.cstr_tag,c2.cstr_tag with
+ | Cstr_extension _,Cstr_extension _ ->
+ (* extension constructors may be rebindings of each other *)
+ true
+ | tag1, tag2 ->
+ equal_tag tag1 tag2)
type label_description =
{ lbl_name: string; (* Short name *)
we are starting from an empty cache, we can avoid checking whether a unit
name already exists in the cache simply by adding entries in reverse
order. *)
-let add dir =
+let prepend_add dir =
assert (not Config.merlin || Local_store.is_bound ());
let new_files, new_files_uncap =
add_to_maps (Filename.concat dir.Dir.path)
let init l =
reset ();
dirs := List.rev_map Dir.create l;
- List.iter add !dirs
+ List.iter prepend_add !dirs
let remove_dir dir =
assert (not Config.merlin || Local_store.is_bound ());
let new_dirs = List.filter (fun d -> Dir.path d <> dir) !dirs in
if List.compare_lengths new_dirs !dirs <> 0 then begin
reset ();
- List.iter add new_dirs;
+ List.iter prepend_add new_dirs;
dirs := new_dirs
end
files_uncap := SMap.union first !files_uncap new_files_uncap;
dirs := dir :: !dirs
+let append_dir = add
+
let add_dir dir = add (Dir.create dir)
+(* Add the directory at the start of load path - so basenames are
+ unconditionally added. *)
+let prepend_dir dir =
+ assert (not Config.merlin || Local_store.is_bound ());
+ prepend_add dir;
+ dirs := !dirs @ [dir]
+
let is_basename fn = Filename.basename fn = fn
let find fn =
*)
val add_dir : string -> unit
-(** Add a directory to the load path *)
+(** Add a directory to the end of the load path (i.e. at lowest priority.) *)
val remove_dir : string -> unit
(** Remove a directory from the load path *)
sub-directories of this directory. *)
end
-val add : Dir.t -> unit
+val[@deprecated] add : Dir.t -> unit
+(** Old name for {!append_dir} *)
+
+val append_dir : Dir.t -> unit
+(** [append_dir d] adds [d] to the end of the load path (i.e. at lowest
+ priority. *)
+
+val prepend_dir : Dir.t -> unit
+(** [prepend_dir d] adds [d] to the start of the load path (i.e. at highest
+ priority. *)
val get : unit -> Dir.t list
(** Same as [get_paths ()], except that it returns a [Dir.t list]. *)