From: Stephane Glondu Date: Tue, 21 Dec 2021 12:48:26 +0000 (+0100) Subject: New upstream version 4.12.1 X-Git-Tag: archive/raspbian/4.13.1-3+rpi1~2^2~27^2~2 X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=eabdaae7eba23922e31e223c0c97c3efed1f71b8;p=ocaml.git New upstream version 4.12.1 --- diff --git a/Changes b/Changes index 680451b6..f7e2b2cd 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,49 @@ +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) ------------------------------- @@ -236,7 +282,7 @@ 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) diff --git a/VERSION b/VERSION index 83d0f498..89a99f03 100644 --- a/VERSION +++ b/VERSION @@ -1,4 +1,4 @@ -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 diff --git a/asmcomp/amd64/reload.ml b/asmcomp/amd64/reload.ml index 8939fa03..1f4cadc3 100644 --- a/asmcomp/amd64/reload.ml +++ b/asmcomp/amd64/reload.ml @@ -40,6 +40,7 @@ open Mach 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 @@ -74,6 +75,11 @@ method! reload_operation op arg res = (* 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 *) diff --git a/boot/ocamlc b/boot/ocamlc index aa2ce083..f7592f19 100755 Binary files a/boot/ocamlc and b/boot/ocamlc differ diff --git a/boot/ocamllex b/boot/ocamllex index 01856b69..175a81ea 100755 Binary files a/boot/ocamllex and b/boot/ocamllex differ diff --git a/configure b/configure index 34330eab..81a77e3b 100755 --- a/configure +++ b/configure @@ -56,7 +56,7 @@ if test -e '.git' ; then : 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 . # @@ -646,8 +646,8 @@ MAKEFLAGS= # 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' @@ -893,6 +893,7 @@ enable_ocamltest enable_frame_pointers enable_naked_pointers enable_naked_pointers_checker +enable_spacetime enable_cfi enable_installing_source_artifacts enable_installing_bytecode_programs @@ -1472,7 +1473,7 @@ if test "$ac_init_help" = "long"; then # 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]... @@ -1538,7 +1539,7 @@ fi 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 @@ -1694,7 +1695,7 @@ fi 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. @@ -2403,7 +2404,7 @@ cat >config.log <<_ACEOF 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 $@ @@ -2752,8 +2753,8 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu -{ $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 @@ -2834,7 +2835,7 @@ ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. -VERSION=4.12.0 +VERSION=4.12.1 # Note: This is present for the flexdll bootstrap where it exposed as the old @@ -3184,6 +3185,12 @@ if test "${enable_naked_pointers_checker+set}" = set; then : 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; @@ -12640,7 +12647,7 @@ case $ocaml_cv_cc_vendor in #( 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" ;; #( *) : @@ -16922,7 +16929,7 @@ else ocamldoc=ocamldoc fi -case $enable_ocamltest,4.12.0 in #( +case $enable_ocamltest,4.12.1 in #( yes,*|,*+dev*) : ocamltest='ocamltest' ;; #( *) : @@ -17642,7 +17649,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # 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 @@ -17709,7 +17716,7 @@ _ACEOF 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\\" diff --git a/configure.ac b/configure.ac index 83455a3b..656ffe20 100644 --- a/configure.ac +++ b/configure.ac @@ -282,6 +282,10 @@ AC_ARG_ENABLE([naked-pointers-checker], [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])]) diff --git a/manual/manual/allfiles.etex b/manual/manual/allfiles.etex index 990be732..3ece8a9c 100644 --- a/manual/manual/allfiles.etex +++ b/manual/manual/allfiles.etex @@ -23,8 +23,8 @@ \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}, @@ -32,8 +32,7 @@ as a \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 diff --git a/manual/manual/html_processing/scss/_common.scss b/manual/manual/html_processing/scss/_common.scss index 2484cbb2..425f2639 100644 --- a/manual/manual/html_processing/scss/_common.scss +++ b/manual/manual/html_processing/scss/_common.scss @@ -7,7 +7,7 @@ $logocolor:#ec6a0d; $logo_height:67px; @if $ocamlorg { - .container { + .container { margin-left:0; margin-right:0; } @@ -19,6 +19,10 @@ $logo_height:67px; @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; @@ -47,7 +51,7 @@ html.smooth-scroll { } body{ - font-family:"Fira Sans",Helvetica,Arial,sans-serif; + font-family: $font-sans; text-align:left; color:#333; background:#fff @@ -76,7 +80,7 @@ html { &>header { margin-bottom: 30px; nav { - font-family: "Fira Sans", Helvetica, Arial, sans-serif; + font-family: $font-sans; } } } @@ -87,7 +91,7 @@ html { margin-right:4ex; margin-top:20px; margin-bottom:50px; - font-family:"Noticia Text",Georgia,serif; + font-family: $font-serif; line-height:1.5 } @@ -131,7 +135,7 @@ html { padding-left:12px; } a { - font-family:"Fira Sans",sans-serif; + font-family: $font-sans; font-size:.95em; color:#333; font-weight:400; @@ -179,7 +183,7 @@ html { } } } - + @mixin nav-toc-mobile { position:static; width:auto; @@ -225,7 +229,7 @@ html { position: absolute; background: transparent; } - .content, .api { + .content, .api { nav.toc { margin-right: 1em; float: left; @@ -244,3 +248,23 @@ html { 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; +} diff --git a/manual/manual/html_processing/scss/manual.scss b/manual/manual/html_processing/scss/manual.scss index 27d96a03..d73151b0 100644 --- a/manual/manual/html_processing/scss/manual.scss +++ b/manual/manual/html_processing/scss/manual.scss @@ -16,14 +16,14 @@ 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 { @@ -54,13 +54,16 @@ } } /* 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%); } @@ -140,7 +143,7 @@ a.section-anchor{ 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; @@ -182,8 +185,11 @@ h3 code{ 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{ @@ -260,14 +266,13 @@ h1 span{ 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; @@ -275,37 +280,78 @@ blockquote.quote{ } #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{ diff --git a/manual/manual/html_processing/scss/style.scss b/manual/manual/html_processing/scss/style.scss index ff89b375..277664e5 100644 --- a/manual/manual/html_processing/scss/style.scss +++ b/manual/manual/html_processing/scss/style.scss @@ -39,7 +39,7 @@ .api { // font-size: 16px; - // font-family: "Fira Sans", Helvetica, Arial, sans-serif; + // font-family: $font-sans; // text-align: left; // color: #333; // background: #FFFFFF; @@ -259,7 +259,7 @@ 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; @@ -316,7 +316,7 @@ /* Preformatted and code */ tt, code, pre { - font-family: "Fira Mono", courier; + font-family: $font-mono; font-weight: 400; } @@ -705,7 +705,7 @@ 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; @@ -742,7 +742,7 @@ } ul.tutos_menu { - font-family: "Fira Sans"; + font-family: $font-sans; text-align: right; list-style: none; } @@ -756,7 +756,7 @@ } span.c003 { - font-family: "Fira Mono", courier; + font-family: $font-mono; background-color: #f3ece6; border-radius: 6px; } @@ -793,8 +793,7 @@ code span.constructor, .caml-input span.kw2 { - font-weight: 500; - color: #a28867; + color: #8d543c; } .caml-input span.numeric { diff --git a/manual/manual/html_processing/src/process_manual.ml b/manual/manual/html_processing/src/process_manual.ml index 9affb370..2ba37b66 100644 --- a/manual/manual/html_processing/src/process_manual.ml +++ b/manual/manual/html_processing/src/process_manual.ml @@ -19,9 +19,34 @@ let index_title = "Home" 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 @@ -78,16 +103,26 @@ let copyright () = "
" ^ !copyright_text ^ "
" |> 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 "\\1." - else "Chapter \\1") + |> Re.Str.(global_replace reg_chapter) + (if file = "index.html" then {|\3.|} + else {|Chapter \3|}) (* 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. *) @@ -97,9 +132,12 @@ let load_html file = (* 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))) + {|>\1|} + |> Re.Str.(global_replace + (regexp ("[0-9]+\\.\\([0-9]+\\(\\.[0-9]+\\)+\\)" ^ preg_anyspace))) + {|\1|} (* The API (libref and compilerlibref directories) should be separate entities, to better distinguish them from the manual. *) @@ -111,8 +149,9 @@ let load_html file = (* 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]+\\)
") - "\\1. " html) + then Re.Str.(global_replace + (regexp ("Part" ^ preg_chapter_space ^ "\\([I|V]+\\)
\n")) + {|\3.|} html) else html in (* Set utf8 encoding directly in the html string *) @@ -194,7 +233,7 @@ let make_template soup = | 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) *) @@ -368,7 +407,7 @@ let add_logo file 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 -> () diff --git a/manual/manual/macros.hva b/manual/manual/macros.hva index 2d2b60fa..e5187149 100644 --- a/manual/manual/macros.hva +++ b/manual/manual/macros.hva @@ -258,7 +258,7 @@ % 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}{} @@ -280,3 +280,6 @@ %%% References to modules in the standard library \newcommand{\stdmoduleref}[1]{\ahref{libref/#1.html}{\texttt{#1}}} + +%%% Missing macro +\newcommand{\DeclareUnicodeCharacter}[2]{} diff --git a/ocaml-variants.opam b/ocaml-variants.opam index 65bfa569..ff17b284 100644 --- a/ocaml-variants.opam +++ b/ocaml-variants.opam @@ -1,8 +1,8 @@ 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} diff --git a/otherlibs/systhreads/st_stubs.c b/otherlibs/systhreads/st_stubs.c index 2f3f1d10..ff18cd01 100644 --- a/otherlibs/systhreads/st_stubs.c +++ b/otherlibs/systhreads/st_stubs.c @@ -523,9 +523,9 @@ static ST_THREAD_FUNCTION caml_thread_start(void * arg) /* 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) */ diff --git a/runtime/afl.c b/runtime/afl.c index bc6c9826..5d6b12d4 100644 --- a/runtime/afl.c +++ b/runtime/afl.c @@ -15,6 +15,11 @@ /* 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" @@ -50,11 +55,6 @@ static int afl_initialised = 0; 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 diff --git a/runtime/caml/misc.h b/runtime/caml/misc.h index 5c363103..b7ffa4e7 100644 --- a/runtime/caml/misc.h +++ b/runtime/caml/misc.h @@ -78,7 +78,7 @@ CAMLdeprecated_typedef(addr, char *); #ifndef CAMLDLLIMPORT #if defined(SUPPORT_DYNAMIC_LINKING) && defined(ARCH_SIXTYFOUR) \ - && defined(__CYGWIN__) + && (defined(__CYGWIN__) || defined(__MINGW32__)) #define CAMLDLLIMPORT __declspec(dllimport) #else #define CAMLDLLIMPORT diff --git a/runtime/major_gc.c b/runtime/major_gc.c index 75a5f186..eb29d699 100644 --- a/runtime/major_gc.c +++ b/runtime/major_gc.c @@ -456,7 +456,7 @@ Caml_inline void mark_slice_darken(struct mark_stack* stk, value v, mlsize_t i, if( Tag_hd(chd) < No_scan_tag ) { mark_stack_push(stk, child, 0, work); } else { - *work -= 1; /* Account for header */ + *work -= Whsize_hd (chd); } } } diff --git a/testsuite/tests/basic-more/pr10294.ml b/testsuite/tests/basic-more/pr10294.ml new file mode 100644 index 00000000..588b7b25 --- /dev/null +++ b/testsuite/tests/basic-more/pr10294.ml @@ -0,0 +1,45 @@ +(* 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); diff --git a/testsuite/tests/basic-more/pr10294.reference b/testsuite/tests/basic-more/pr10294.reference new file mode 100644 index 00000000..e69de29b diff --git a/testsuite/tests/load_path/driver.ml b/testsuite/tests/load_path/driver.ml new file mode 100644 index 00000000..602af64a --- /dev/null +++ b/testsuite/tests/load_path/driver.ml @@ -0,0 +1,3 @@ +#cd "test" +#directory "." +#use "payload.ml" diff --git a/testsuite/tests/load_path/payload.ml b/testsuite/tests/load_path/payload.ml new file mode 100644 index 00000000..caef8608 --- /dev/null +++ b/testsuite/tests/load_path/payload.ml @@ -0,0 +1 @@ +let _ = 42 diff --git a/testsuite/tests/load_path/test.ml b/testsuite/tests/load_path/test.ml new file mode 100644 index 00000000..7034998f --- /dev/null +++ b/testsuite/tests/load_path/test.ml @@ -0,0 +1,13 @@ +(* 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" +*) diff --git a/tools/ci/inria/launch b/tools/ci/inria/launch new file mode 100755 index 00000000..3de4eeb4 --- /dev/null +++ b/tools/ci/inria/launch @@ -0,0 +1,31 @@ +#!/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 diff --git a/tools/ci/inria/main b/tools/ci/inria/main index 4c133fa5..5c387922 100755 --- a/tools/ci/inria/main +++ b/tools/ci/inria/main @@ -93,7 +93,7 @@ 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 diff --git a/toplevel/opttopdirs.ml b/toplevel/opttopdirs.ml index c5effee1..2d323e9e 100644 --- a/toplevel/opttopdirs.ml +++ b/toplevel/opttopdirs.ml @@ -35,7 +35,7 @@ let _ = Hashtbl.add directive_table "quit" (Directive_none dir_quit) 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 -> diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml index 6fbbc6c1..6b732953 100644 --- a/toplevel/topdirs.ml +++ b/toplevel/topdirs.ml @@ -72,7 +72,7 @@ let dir_directory s = 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 -> diff --git a/typing/types.ml b/typing/types.ml index d723a304..3b2da9d3 100644 --- a/typing/types.ml +++ b/typing/types.ml @@ -434,9 +434,14 @@ let equal_tag t1 t2 = 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 *) diff --git a/utils/load_path.ml b/utils/load_path.ml index 41eb22e9..7f6ebb9f 100644 --- a/utils/load_path.ml +++ b/utils/load_path.ml @@ -66,7 +66,7 @@ let add_to_maps fn basenames files files_uncap = 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) @@ -78,14 +78,14 @@ let add dir = 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 @@ -103,8 +103,17 @@ let add dir = 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 = diff --git a/utils/load_path.mli b/utils/load_path.mli index ea9fe3d3..1f9aba28 100644 --- a/utils/load_path.mli +++ b/utils/load_path.mli @@ -23,7 +23,7 @@ *) 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 *) @@ -60,7 +60,16 @@ module Dir : sig 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]. *)