+OCaml 4.14.1 (20 December 2022)
+------------------------------
+
+### Bug fixes:
+
+- #11803, #11808: on x86, the destination of an integer comparison must be
+ a register, it cannot be a stack slot.
+ (Vincent Laviron, review by Xavier Leroy, report by
+ Emilio Jesús Gallego Arias)
+
+
+OCaml 4.14.1
+-----------------------------
+
+### Compiler user-interface and warnings:
+
+- #11184, #11670: Stop calling ranlib on created / installed libraries
+ (Sébastien Hinderer and Xavier Leroy, review by the same)
+
+### Build system:
+
+- #11370, #11373: Don't pass CFLAGS to flexlink during configure.
+ (David Allsopp, report by William Hu, review by Xavier Leroy and
+ Sébastien Hinderer)
+
+- #11487: Thwart FMA test optimization during configure
+ (William Hu, review by David Allsopp and Sébastien Hinderer)
+
+### Bug fixes:
+
+- #10768, #11340: Fix typechecking regression when combining first class
+ modules and GADTs.
+ (Jacques Garrigue, report by François Thiré, review by Matthew Ryan)
+
+- #11204: Fix regression introduced in 4.14.0 that would trigger Warning 17 when
+ calling virtual methods introduced by constraining the self type from within
+ the class definition.
+ (Nicolás Ojeda Bär, review by Leo White)
+
+- #11263, #11267: caml/{memory,misc}.h: check whether `_MSC_VER` is defined
+ before using it to ensure that the headers can always be used in code which
+ turns on -Wundef (or equivalent).
+ (David Allsopp and Nicolás Ojeda Bär, review by Nicolás Ojeda Bär and
+ Sébastien Hinderer)
+
+- #11314, #11416: fix non-informative error message for module inclusion
+ (Florian Angeletti, report by Thierry Martinez, review by Gabriel Scherer)
+
+- #11358, #11379: Refactor the initialization of bytecode threading,
+ This avoids a "dangling pointer" warning of GCC 12.1.
+ (Xavier Leroy, report by Armaël Guéneau, review by Gabriel Scherer)
+
+- #11387, module type with constraints no longer crash the compiler in presence
+ of both shadowing warnings and the `-bin-annot` compiler flag.
+ (Florian Angeletti, report by Christophe Raffalli, review by Gabriel Scherer)
+
+- #11392, #11392: assertion failure with -rectypes and external definitions
+ (Gabriel Scherer, review by Florian Angeletti, report by Dmitrii Kosarev)
+
+- #11417: Fix regression allowing virtual methods in non-virtual classes.
+ (Leo White, review by Florian Angeletti)
+
+- #11468: Fix regression from #10186 (OCaml 4.13) detecting IPv6 on Windows for
+ mingw-w64 i686 port.
+ (David Allsopp, review by Xavier Leroy and Sébastien Hinderer)
+
+- #11489, #11496: More prudent deallocation of alternate signal stack
+ (Xavier Leroy, report by @rajdakin, review by Florian Angeletti)
+
+- #11516, #11524: Fix the `deprecated_mutable` attribute.
+ (Chris Casinghino, review by Nicolás Ojeda Bär and Florian Angeletti)
+
+- #11194, #11609: Fix inconsistent type variable names in "unbound type var"
+ messages
+ (Ulysse Gérard and Florian Angeletti, review Florian Angeletti and
+ Gabriel Scherer)
+
+- #11622: Prevent stack overflow when printing a constructor or record
+ mismatch error involving recursive types.
+ (Florian Angeletti, review by Gabriel Scherer)
+
+- #11732: Ensure that types from packed modules are always generalised
+ (Stephen Dolan and Leo White, review by Jacques Garrigue)
+
+- #11737: Fix segfault condition in Unix.stat under Windows in the presence of
+ multiple threads.
+ (Marc Lasson, Nicolás Ojeda Bär, review by Gabriel Scherer and David Allsopp)
+
+- #11776: Extend environment with functor parameters in `strengthen_lazy`.
+ (Chris Casinghino and Luke Maurer, review by Gabriel Scherer)
+
+- #11533, #11534: follow synonyms again in #show_module_type
+ (this had stopped working in 4.14.0)
+ (Gabriel Scherer, review by Jacques Garrigue, report by Yaron Minsky)
+
+- #11768, #11788: Fix crash at start-up of bytecode programs in
+ no-naked-pointers mode caused by wrong initialization of caml_global_data
+ (Xavier Leroy, report by Etienne Millon, review by Gabriel Scherer)
+
+
OCaml 4.14.0 (28 March 2022)
----------------------------
definition-aware operations.
(Ulysse Gérard, Thomas Refis and Leo White, review by Florian Angeletti)
-
### Language features:
- #10462: Add attribute to produce a compiler error for polls.
* Under Cygwin, the `gcc-core` package is required. `flexdll` is also necessary
for shared library support.
-* Binutils including `ar`, `ranlib`, and `strip` are required if your
- distribution does not already provide them with the C compiler.
+* Binutils including `ar` and `strip` are required if your distribution
+ does not already provide them with the C compiler.
== Configuration
ifeq "$(INSTALL_OCAMLNAT)" "true"
$(INSTALL_PROG) ocamlnat$(EXE) "$(INSTALL_BINDIR)"
endif
- cd "$(INSTALL_COMPLIBDIR)" && \
- $(RANLIB) ocamlcommon.$(A) ocamlbytecomp.$(A) ocamloptcomp.$(A)
# Installation of the *.ml sources of compiler-libs
.PHONY: install-compiler-sources
# $(ROOTDIR) has been defined.
include $(ROOTDIR)/Makefile.config
-INSTALL ?= @INSTALL@
+INSTALL ?= @INSTALL@ -p
INSTALL_DATA ?= @INSTALL_DATA@
INSTALL_PROG ?= @INSTALL_PROGRAM@
### How to invoke the C preprocessor through the C compiler
CPP=@CPP@
-### How to invoke ranlib
-RANLIB=@RANLIB@
-RANLIBCMD=@RANLIBCMD@
-
### How to invoke ar
ARCMD=@AR@
to be able to run the test suite.
Unless you are also compiling the Cygwin port of OCaml, you do not need the
-`gcc-core` or `flexdll` packages. If you do install them, care may be required
-to ensure that a particular build is using the correct installation of
-`flexlink`.
+`gcc-core` or `flexdll` packages.
[[bmflex]]
In addition to Cygwin, FlexDLL must also be installed, which is available from
Now run:
- ./configure --build=i686-pc-cygwin --host=i686-pc-windows
+ ./configure --build=x86_64-pc-cygwin --host=i686-pc-windows
for 32-bit, or:
Now run:
- ./configure --build=i686-pc-cygwin --host=i686-w64-mingw32
+ ./configure --build=x86_64-pc-cygwin --host=i686-w64-mingw32
for 32-bit, or:
-4.14.0
+4.14.1
# Starting with OCaml 4.14, although the version string that appears above is
# still correct and this file can thus still be used to figure it out,
CC="$1 -chain $2 -exe"
LIBS="conftest2.$ac_objext"
CPPFLAGS="$3 $CPPFLAGS"
+ CFLAGS=""
AC_LINK_IFELSE(
[AC_LANG_SOURCE([int main() { return 0; }])],
[AC_MSG_RESULT([yes])],
broken implementations of Cygwin64, mingw-w64 (x86_64) and VS2013-2017.
The static volatile variables aim to thwart GCC's constant folding. */
static volatile double x, y, z;
- double t264, t265, t266;
+ volatile double t264, t265, t266;
x = 0x3.bd5b7dde5fddap-496;
y = 0x3.bd5b7dde5fddap-496;
z = -0xd.fc352bc352bap-992;
Iload R R R
Istore R R
Iintop(Icomp) R R S
- or S S R
+ or R S R
Iintop(Imul|Idiv|Imod) R R S
Iintop(Imulh) R R S
Iintop(shift) S S R
or S S R
Iintop_imm(Iadd, n)/lea R R
Iintop_imm(Imul, n) R R
+ Iintop_imm(Icomp, n) R S
Iintop_imm(others) S S
Inegf...Idivf R R S
Ifloatofint R S
method! reload_operation op arg res =
match op with
- | Iintop(Iadd|Isub|Iand|Ior|Ixor|Icomp _|Icheckbound) ->
+ | Iintop(Iadd|Isub|Iand|Ior|Ixor|Icheckbound) ->
+ (* One of the two arguments can reside in the stack, but not both *)
+ if stackp arg.(0) && stackp arg.(1)
+ then ([|arg.(0); self#makereg arg.(1)|], res)
+ else (arg, res)
+ | Iintop(Icomp _) ->
+ (* The result must be a register (PR#11803) *)
+ let res = self#makeregs res in
(* One of the two arguments can reside in the stack, but not both *)
if stackp arg.(0) && stackp arg.(1)
then ([|arg.(0); self#makereg arg.(1)|], res)
if stackp arg.(0)
then (let r = self#makereg arg.(0) in ([|r|], [|r|]))
else (arg, res)
+ | Iintop_imm(Icomp _, _) ->
+ (* The result must be in a register (PR#11803) *)
+ (arg, self#makeregs res)
| Iintop(Imulh | Idiv | Imod | Ilsl | Ilsr | Iasr)
| Iintop_imm(_, _) ->
(* The argument(s) and results can be either in register or on stack *)
method! reload_operation op arg res =
match op with
- Iintop(Iadd|Isub|Iand|Ior|Ixor|Icomp _|Icheckbound) ->
+ Iintop(Iadd|Isub|Iand|Ior|Ixor|Icheckbound) ->
+ (* One of the two arguments can reside in the stack *)
+ if stackp arg.(0) && stackp arg.(1)
+ then ([|arg.(0); self#makereg arg.(1)|], res)
+ else (arg, res)
+ | Iintop(Icomp _) ->
+ (* The result must be a register (PR#11803) *)
+ let res = self#makeregs res in
(* One of the two arguments can reside in the stack *)
if stackp arg.(0) && stackp arg.(1)
then ([|arg.(0); self#makereg arg.(1)|], res)
if stackp arg.(0)
then let r = self#makereg arg.(0) in ([|r|], [|r|])
else (arg, res)
+ | Iintop_imm(Icomp _, _) ->
+ (* The result must be in a register (PR#11803) *)
+ (arg, self#makeregs res)
| Iintop(Imulh | Ilsl | Ilsr | Iasr) | Iintop_imm(_, _)
| Ifloatofint | Iintoffloat | Ispecific(Ipush) ->
(* The argument(s) can be either in register or on stack *)
newr.spill_cost <- 100000;
newr
-method private makeregs rv =
+method makeregs rv =
let n = Array.length rv in
let newv = Array.make n Reg.dummy in
for i = 0 to n-1 do newv.(i) <- self#makereg rv.(i) done;
(* Can be overridden to reflect instructions that can operate
directly on stack locations *)
method makereg : Reg.t -> Reg.t
+ method makeregs : Reg.t array -> Reg.t array
(* Can be overridden to avoid creating new registers of some class
(i.e. if all "registers" of that class are actually on stack) *)
method fundecl : Mach.fundecl -> int array -> Mach.fundecl * bool
m4_define([OCAML__VERSION_MAJOR], [4])
m4_define([OCAML__VERSION_MINOR], [14])
-m4_define([OCAML__VERSION_PATCHLEVEL], [0])
+m4_define([OCAML__VERSION_PATCHLEVEL], [1])
# Note that the OCAML__VERSION_EXTRA string defined below is always empty
# for officially-released versions of OCaml.
m4_define([OCAML__VERSION_EXTRA], [])
fi
fi
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.69 for OCaml 4.14.0.
+# Generated by GNU Autoconf 2.69 for OCaml 4.14.1.
#
# Report bugs to <caml-list@inria.fr>.
#
# Identity of this package.
PACKAGE_NAME='OCaml'
PACKAGE_TARNAME='ocaml'
-PACKAGE_VERSION='4.14.0'
-PACKAGE_STRING='OCaml 4.14.0'
+PACKAGE_VERSION='4.14.1'
+PACKAGE_STRING='OCaml 4.14.1'
PACKAGE_BUGREPORT='caml-list@inria.fr'
PACKAGE_URL='http://www.ocaml.org'
DSYMUTIL
MANIFEST_TOOL
AWK
+RANLIB
STRIP
ac_ct_AR
DLLTOOL
natdynlink
supports_shared_libraries
mklib
-RANLIBCMD
-RANLIB
AR
shebangscripts
long_shebang
# 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.14.0 to adapt to many kinds of systems.
+\`configure' configures OCaml 4.14.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.14.0:";;
+ short | recursive ) echo "Configuration of OCaml 4.14.1:";;
esac
cat <<\_ACEOF
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-OCaml configure 4.14.0
+OCaml configure 4.14.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.14.0, which was
+It was created by OCaml $as_me 4.14.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.14.0" >&5
-$as_echo "$as_me: Configuring OCaml version 4.14.0" >&6;}
+{ $as_echo "$as_me:${as_lineno-$LINENO}: Configuring OCaml version 4.14.1" >&5
+$as_echo "$as_me: Configuring OCaml version 4.14.1" >&6;}
# Configuration variables
-VERSION=4.14.0
+VERSION=4.14.1
OCAML_DEVELOPMENT_VERSION=false
OCAML_VERSION_MINOR=14
-OCAML_VERSION_PATCHLEVEL=0
+OCAML_VERSION_PATCHLEVEL=1
OCAML_VERSION_EXTRA=
-
-
$as_echo "#define OCAML_VERSION_MINOR 14" >>confdefs.h
-$as_echo "#define OCAML_VERSION_PATCHLEVEL 0" >>confdefs.h
+$as_echo "#define OCAML_VERSION_PATCHLEVEL 1" >>confdefs.h
$as_echo "#define OCAML_VERSION_ADDITIONAL \"\"" >>confdefs.h
$as_echo "#define OCAML_VERSION_EXTRA \"\"" >>confdefs.h
-$as_echo "#define OCAML_VERSION 41400" >>confdefs.h
+$as_echo "#define OCAML_VERSION 41401" >>confdefs.h
-$as_echo "#define OCAML_VERSION_STRING \"4.14.0\"" >>confdefs.h
+$as_echo "#define OCAML_VERSION_STRING \"4.14.1\"" >>confdefs.h
# Checks for system types
fi ;;
esac
-# Extracting information from libtool's configuration
-if test -n "$RANLIB" ; then :
- RANLIBCMD="$RANLIB"
-else
- RANLIB="$AR rs"; RANLIBCMD=""
-
-fi
-
case $host in #(
# In config/Makefile.mingw*, we had:
# TARGET=i686-w64-mingw32 and x86_64-w64-mingw32
# TOOLPREF=$(TARGET)-
# ARCMD=$(TOOLPREF)ar
- # RANLIB=$(TOOLPREF)ranlib
- # RANLIBCMD=$(TOOLPREF)ranlib
- # However autoconf and libtool seem to use ar and ranlib
+ # However autoconf and libtool seem to use ar
# So we let them do, at the moment
*-pc-windows) :
libext=lib
- AR=""; RANLIB=echo; RANLIBCMD=""
+ AR=""
if test "$host_cpu" = "x86_64" ; then :
machine="-machine:AMD64 "
else
;; #(
*) :
- mklib="rm -f \$(1) && ${AR} rc \$(1) \$(2) && ${RANLIB} \$(1)"
+ mklib="rm -f \$(1) && ${AR} rc \$(1) \$(2)"
;;
esac
CC="$flexlink -chain $flexdll_chain -exe"
LIBS="conftest2.$ac_objext"
CPPFLAGS="$internal_cppflags $CPPFLAGS"
+ CFLAGS=""
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int main() { return 0; }
broken implementations of Cygwin64, mingw-w64 (x86_64) and VS2013-2017.
The static volatile variables aim to thwart GCC's constant folding. */
static volatile double x, y, z;
- double t264, t265, t266;
+ volatile double t264, t265, t266;
x = 0x3.bd5b7dde5fddap-496;
y = 0x3.bd5b7dde5fddap-496;
z = -0xd.fc352bc352bap-992;
$as_echo "#define HAS_STRERROR 1" >>confdefs.h
+ $as_echo "#define HAS_IPV6 1" >>confdefs.h
+
$as_echo "#define HAS_NICE 1" >>confdefs.h
;; #(
*-pc-windows) :
# 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.14.0, which was
+This file was extended by OCaml $as_me 4.14.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.14.0
+OCaml config.status 4.14.1
configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
AC_SUBST([long_shebang])
AC_SUBST([shebangscripts])
AC_SUBST([AR])
-AC_SUBST([RANLIB])
-AC_SUBST([RANLIBCMD])
AC_SUBST([mklib])
AC_SUBST([supports_shared_libraries])
AC_SUBST([natdynlink])
[compute_deps=true])],
[compute_deps=false])])
-# Extracting information from libtool's configuration
-AS_IF([test -n "$RANLIB" ],
- [RANLIBCMD="$RANLIB"],
- [RANLIB="$AR rs"; RANLIBCMD=""]
-)
-
AS_CASE([$host],
# In config/Makefile.mingw*, we had:
# TARGET=i686-w64-mingw32 and x86_64-w64-mingw32
# TOOLPREF=$(TARGET)-
# ARCMD=$(TOOLPREF)ar
- # RANLIB=$(TOOLPREF)ranlib
- # RANLIBCMD=$(TOOLPREF)ranlib
- # However autoconf and libtool seem to use ar and ranlib
+ # However autoconf and libtool seem to use ar
# So we let them do, at the moment
[*-pc-windows],
[
libext=lib
- AR=""; RANLIB=echo; RANLIBCMD=""
+ AR=""
AS_IF([test "$host_cpu" = "x86_64" ],
[machine="-machine:AMD64 "],
[machine=""])
mklib="link -lib -nologo $machine /out:\$(1) \$(2)"
],
[
- mklib="rm -f \$(1) && ${AR} rc \$(1) \$(2) && ${RANLIB} \$(1)"
+ mklib="rm -f \$(1) && ${AR} rc \$(1) \$(2)"
])
## Find vendor of the C compiler
[*-*-mingw32],
[AC_DEFINE([HAS_BROKEN_PRINTF])
AC_DEFINE([HAS_STRERROR])
+ AC_DEFINE([HAS_IPV6])
AC_DEFINE([HAS_NICE])],
[*-pc-windows],
[AC_DEFINE([HAS_BROKEN_PRINTF])
" unannotated unboxable types will not be unboxed (default)"
;;
-let mk_force_tmc f =
- "-force-tmc", Arg.Unit f, " Rewrite all possible TMC calls"
-;;
-
let mk_unsafe f =
"-unsafe", Arg.Unit f,
" Do not compile bounds checking on array and string access"
val _no_strict_sequence : unit -> unit
val _strict_formats : unit -> unit
val _no_strict_formats : unit -> unit
- val _force_tmc : unit -> unit
val _unboxed_types : unit -> unit
val _no_unboxed_types : unit -> unit
val _unsafe_string : unit -> unit
mk_strict_formats F._strict_formats;
mk_no_strict_formats F._no_strict_formats;
mk_thread F._thread;
- mk_force_tmc F._force_tmc;
mk_unboxed_types F._unboxed_types;
mk_no_unboxed_types F._no_unboxed_types;
mk_unsafe F._unsafe;
mk_strict_formats F._strict_formats;
mk_no_strict_formats F._no_strict_formats;
mk_thread F._thread;
- mk_force_tmc F._force_tmc;
mk_unbox_closures F._unbox_closures;
mk_unbox_closures_factor F._unbox_closures_factor;
mk_inline_max_unroll F._inline_max_unroll;
mk_strict_formats F._strict_formats;
mk_no_strict_formats F._no_strict_formats;
mk_thread F._thread;
- mk_force_tmc F._force_tmc;
mk_unboxed_types F._unboxed_types;
mk_no_unboxed_types F._no_unboxed_types;
mk_unsafe_string F._unsafe_string;
let _noprompt = set noprompt
let _nopromptcont = set nopromptcont
let _stdin () = (* placeholder: file_argument ""*) ()
- let _force_tmc = set force_tmc
let _version () = print_version ()
let _vnum () = print_version_num ()
let _eval (_:string) = ()
"Profiling with \"gprof\" (option `-p') is only supported up to \
OCaml 4.08.0"
let _shared () = shared := true; dlcode := true
- let _force_tmc = set force_tmc
let _v () = Compenv.print_version_and_library "native-code compiler"
end
let _pp s = Clflags.preprocessor := (Some s)
let _ppx s = Clflags.all_ppx := (s :: (!Clflags.all_ppx))
let _thread = set Clflags.use_threads
- let _force_tmc = set force_tmc
let _v () = Compenv.print_version_and_library "documentation generator"
let _verbose = set Clflags.verbose
let _version = Compenv.print_version_string
let _output_complete_exe () =
_output_complete_obj (); output_complete_executable := true
let _output_obj () = output_c_object := true; custom_runtime := true
- let _force_tmc = set force_tmc
let _use_prims s = use_prims := s
let _use_runtime s = use_runtime := s
let _v () = Compenv.print_version_and_library "compiler"
val _no_strict_sequence : unit -> unit
val _strict_formats : unit -> unit
val _no_strict_formats : unit -> unit
- val _force_tmc : unit -> unit
val _unboxed_types : unit -> unit
val _no_unboxed_types : unit -> unit
val _unsafe_string : unit -> unit
(a curried OCaml function with three arguments) to \var{a}, \var{b} and \var{c}.
\item "caml_callbackN("\var{f, n, args}")" applies the functional value \var{f}
to the \var{n} arguments contained in the C array of values \var{args}.
+The array \var{args} must \emph{not} be declared with "CAMLlocalN".
+It should be declared as "value "\var{args}"["\var{n}"];".
+Alternatively, a C99 compound literal can be used:
+"caml_callbackN("\var{f, n, }"(value[]){"\nth{arg}{1}, \ldots, \nth{arg}{n}"})".
\end{itemize}
If the function \var{f} does not return, but raises an exception that
escapes the scope of the application, then this exception is
opam-version: "2.0"
-version: "4.14.0"
+version: "4.14.1"
license: "LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception"
-synopsis: "Official release of OCaml 4.14.0"
+synopsis: "Official release of OCaml 4.14.1"
depends: [
- "ocaml" {= "4.14.0" & post}
+ "ocaml" {= "4.14.1" & post}
"base-unix" {post}
"base-bigarray" {post}
"base-threads" {post}
fi
ifneq "$(STUBSLIB)" ""
$(INSTALL_DATA) $(STUBSLIB) "$(INSTALL_LIBDIR)/"
- cd "$(INSTALL_LIBDIR)"; $(RANLIB) lib$(CLIBNAME).$(A)
endif
$(INSTALL_DATA) \
$(INSTALL_DATA) \
$(CAMLOBJS_NAT) $(LIBNAME).cmxa $(LIBNAME).$(A) \
"$(INSTALL_LIBDIR)/"
- cd "$(INSTALL_LIBDIR)"; $(RANLIB) $(LIBNAME).a
if test -f $(LIBNAME).cmxs; then \
$(INSTALL_PROG) $(LIBNAME).cmxs "$(INSTALL_LIBDIR)"; \
fi
endif
installopt:
- if $(NATDYNLINK); then \
- $(INSTALL_DATA) \
- $(NATOBJS) dynlink.cmxa dynlink.$(A) \
- "$(INSTALL_LIBDIR)" && \
- cd "$(INSTALL_LIBDIR)" && $(RANLIB) dynlink.$(A); \
- fi
+ifeq "$(strip $(NATDYNLINK))" "true"
+ $(INSTALL_DATA) \
+ $(NATOBJS) dynlink.cmxa dynlink.$(A) \
+ "$(INSTALL_LIBDIR)"
+endif
partialclean:
rm -f $(extract_crc) *.cm[ioaxt] *.cmti *.cmxa \
$(INSTALL_PROG) dllthreads$(EXT_DLL) "$(INSTALL_STUBLIBDIR)"; \
fi
$(INSTALL_DATA) libthreads.$(A) "$(INSTALL_LIBDIR)"
- cd "$(INSTALL_LIBDIR)"; $(RANLIB) libthreads.$(A)
mkdir -p "$(INSTALL_THREADSLIBDIR)"
$(INSTALL_DATA) \
$(CMIFILES) threads.cma \
installopt:
$(INSTALL_DATA) libthreadsnat.$(A) "$(INSTALL_LIBDIR)"
- cd "$(INSTALL_LIBDIR)"; $(RANLIB) libthreadsnat.$(A)
$(INSTALL_DATA) \
$(THREADS_NCOBJS) threads.cmxa threads.$(A) \
"$(INSTALL_THREADSLIBDIR)"
- cd "$(INSTALL_THREADSLIBDIR)" && $(RANLIB) threads.$(A)
%.cmi: %.mli
$(CAMLC) -c $(COMPFLAGS) $<
{
caml_thread_t th = (caml_thread_t) arg;
value clos;
+ void * signal_stack;
#ifdef NATIVE_CODE
struct longjmp_buffer termination_buf;
char tos;
/* Acquire the global mutex */
caml_leave_blocking_section();
st_thread_set_id(Ident(th->descr));
- caml_setup_stack_overflow_detection();
+ signal_stack = caml_setup_stack_overflow_detection();
#ifdef NATIVE_CODE
/* Setup termination handler (for caml_thread_exit) */
if (sigsetjmp(termination_buf.buf, 0) == 0) {
#ifdef NATIVE_CODE
}
#endif
- caml_stop_stack_overflow_detection();
+ caml_stop_stack_overflow_detection(signal_stack);
/* The thread now stops running */
return 0;
}
val symlink : ?to_dir: (* thwart tools/sync_stdlib_docs *) bool ->
string -> string -> unit
(** [symlink ?to_dir src dst] creates the file [dst] as a symbolic link
- to the file [src]. On Windows, [to_dir] indicates if the symbolic link
+ to the file [src]. On Windows, [~to_dir] indicates if the symbolic link
points to a directory or a file; if omitted, [symlink] examines [src]
using [stat] and picks appropriately, if [src] does not exist then [false]
- is assumed (for this reason, it is recommended that the [to_dir] parameter
- be specified in new code). On Unix, [to_dir] is ignored.
+ is assumed (for this reason, it is recommended that the [~to_dir] parameter
+ be specified in new code). On Unix, [~to_dir] is ignored.
Windows symbolic links are available in Windows Vista onwards. There are some
important differences between Windows symlinks and their POSIX counterparts.
CAMLprim value unix_stat(value path)
{
+ CAMLparam1(path);
struct _stat64 buf;
__int64 st_ino;
if (!do_stat(0, 0, String_val(path), NULL, &st_ino, &buf)) {
uerror("stat", path);
}
- return stat_aux(0, st_ino, &buf);
+ CAMLreturn (stat_aux(0, st_ino, &buf));
}
CAMLprim value unix_stat_64(value path)
{
+ CAMLparam1(path);
struct _stat64 buf;
__int64 st_ino;
if (!do_stat(0, 1, String_val(path), NULL, &st_ino, &buf)) {
uerror("stat", path);
}
- return stat_aux(1, st_ino, &buf);
+ CAMLreturn (stat_aux(1, st_ino, &buf));
}
CAMLprim value unix_lstat(value path)
{
+ CAMLparam1(path);
struct _stat64 buf;
__int64 st_ino;
if (!do_stat(1, 0, String_val(path), NULL, &st_ino, &buf)) {
uerror("lstat", path);
}
- return stat_aux(0, st_ino, &buf);
+ CAMLreturn (stat_aux(0, st_ino, &buf));
}
CAMLprim value unix_lstat_64(value path)
{
+ CAMLparam1(path);
struct _stat64 buf;
__int64 st_ino;
if (!do_stat(1, 1, String_val(path), NULL, &st_ino, &buf)) {
uerror("lstat", path);
}
- return stat_aux(1, st_ino, &buf);
+ CAMLreturn (stat_aux(1, st_ino, &buf));
}
static value do_fstat(value handle, int use_64)
int caml_is_instruction (opcode_t instr1, opcode_t instr2);
#ifdef THREADED_CODE
-extern char ** caml_instr_table;
-extern char * caml_instr_base;
+void caml_init_thread_code(void ** instr_table, void * instr_base);
void caml_thread_code (code_t code, asize_t len);
#endif
#define CAMLunused_start __attribute__ ((unused))
#define CAMLunused_end
#define CAMLunused __attribute__ ((unused))
-#elif _MSC_VER >= 1500
+#elif defined(_MSC_VER) && _MSC_VER >= 1500
#define CAMLunused_start __pragma( warning (push) ) \
__pragma( warning (disable:4189 ) )
#define CAMLunused_end __pragma( warning (pop))
/* Supported since at least GCC 3.1 */
#define CAMLdeprecated_typedef(name, type) \
typedef type name __attribute ((deprecated))
-#elif _MSC_VER >= 1310
+#elif defined(_MSC_VER) && _MSC_VER >= 1310
/* NB deprecated("message") only supported from _MSC_VER >= 1400 */
#define CAMLdeprecated_typedef(name, type) \
typedef __declspec(deprecated) type name
#define CAMLdeprecated_typedef(name, type) typedef type name
#endif
-#if defined(__GNUC__) && __STDC_VERSION__ >= 199901L || _MSC_VER >= 1925
+#if defined(__GNUC__) && __STDC_VERSION__ >= 199901L \
+ || defined(_MSC_VER) && _MSC_VER >= 1925
#define CAML_STRINGIFY(x) #x
#ifdef _MSC_VER
#define CAMLnoreturn_start
#define CAMLnoreturn_end __attribute__ ((noreturn))
#define Noreturn __attribute__ ((noreturn))
-#elif _MSC_VER >= 1500
+#elif defined(_MSC_VER) && _MSC_VER >= 1500
#define CAMLnoreturn_start __declspec(noreturn)
#define CAMLnoreturn_end
#define Noreturn
/* we need to be able to compute the exact offset of each member. */
#if defined(__STDC_VERSION__) && __STDC_VERSION__ >= 201112L
#define CAMLalign(n) _Alignas(n)
-#elif defined(__cplusplus) && (__cplusplus >= 201103L || _MSC_VER >= 1900)
+#elif defined(__cplusplus) \
+ && (__cplusplus >= 201103L || defined(_MSC_VER) && _MSC_VER >= 1900)
#define CAMLalign(n) alignas(n)
#elif defined(SUPPORTS_ALIGNED_ATTRIBUTE)
#define CAMLalign(n) __attribute__((aligned(n)))
-#elif _MSC_VER >= 1500
+#elif defined(_MSC_VER) && _MSC_VER >= 1500
#define CAMLalign(n) __declspec(align(n))
#else
#error "How do I align values on this platform?"
#define CAMLunused_start __attribute__ ((unused))
#define CAMLunused_end
#define CAMLunused __attribute__ ((unused))
-#elif _MSC_VER >= 1500
+#elif defined(_MSC_VER) && _MSC_VER >= 1500
#define CAMLunused_start __pragma( warning (push) ) \
__pragma( warning (disable:4189 ) )
#define CAMLunused_end __pragma( warning (pop))
value caml_process_pending_actions_with_root (value extra_root); // raises
value caml_process_pending_actions_with_root_exn (value extra_root);
int caml_set_signal_action(int signo, int action);
-CAMLextern int caml_setup_stack_overflow_detection(void);
-CAMLextern int caml_stop_stack_overflow_detection(void);
+CAMLextern void * caml_setup_stack_overflow_detection(void);
+CAMLextern int caml_stop_stack_overflow_detection(void *);
CAMLextern void caml_init_signals(void);
CAMLextern void caml_terminate_signals(void);
CAMLextern void (*caml_enter_blocking_section_hook)(void);
#ifdef THREADED_CODE
-char ** caml_instr_table;
-char * caml_instr_base;
+static char ** caml_instr_table;
+static char * caml_instr_base;
+
+void caml_init_thread_code(void ** instr_table, void * instr_base)
+{
+ caml_instr_table = (char **) instr_table;
+ caml_instr_base = (char *) instr_base;
+}
static int* opcode_nargs = NULL;
int* caml_init_opcode_nargs(void)
#ifdef THREADED_CODE
# define Instruct(name) lbl_##name
# if defined(ARCH_SIXTYFOUR) && !defined(ARCH_CODE32)
-# define Jumptbl_base ((char *) &&lbl_ACC0)
+# define Jumptbl_base &&lbl_ACC0
# else
-# define Jumptbl_base ((char *) 0)
+# define Jumptbl_base 0
# define jumptbl_base ((char *) 0)
# endif
# ifdef DEBUG
if (prog == NULL) { /* Interpreter is initializing */
#ifdef THREADED_CODE
- caml_instr_table = (char **) jumptable;
- caml_instr_base = Jumptbl_base;
+ caml_init_thread_code(jumptable, Jumptbl_base);
#endif
return Val_unit;
}
return 0;
}
-CAMLexport int caml_setup_stack_overflow_detection(void) { return 0; }
-CAMLexport int caml_stop_stack_overflow_detection(void) { return 0; }
+CAMLexport void * caml_setup_stack_overflow_detection(void) { return NULL; }
+CAMLexport int caml_stop_stack_overflow_detection(void * p) { return 0; }
CAMLexport void caml_init_signals(void) { }
CAMLexport void caml_terminate_signals(void) { }
/* Initialization of signal stuff */
+#ifdef HAS_STACK_OVERFLOW_DETECTION
+static void * caml_signal_stack = NULL;
+#endif
+
void caml_init_signals(void)
{
/* Bound-check trap handling */
#endif
#ifdef HAS_STACK_OVERFLOW_DETECTION
- if (caml_setup_stack_overflow_detection() != -1) {
+ caml_signal_stack = caml_setup_stack_overflow_detection();
+ if (caml_signal_stack != NULL) {
struct sigaction act;
SET_SIGACT(act, segv_handler);
act.sa_flags |= SA_ONSTACK | SA_NODEFER;
#ifdef HAS_STACK_OVERFLOW_DETECTION
set_signal_default(SIGSEGV);
- caml_stop_stack_overflow_detection();
+ caml_stop_stack_overflow_detection(caml_signal_stack);
+ caml_signal_stack = NULL;
#endif
}
Each thread needs its own alternate stack.
The alternate stack used to be statically-allocated for the main thread,
but this is incompatible with Glibc 2.34 and newer, where SIGSTKSZ
- may not be a compile-time constant (issue #10250). */
+ may not be a compile-time constant (issue #10250).
+ Return the dynamically-allocated alternate signal stack, or NULL
+ if an error occurred.
+ The returned pointer must be passed to [caml_stop_stack_overflow_detection].
+*/
-CAMLexport int caml_setup_stack_overflow_detection(void)
+CAMLexport void * caml_setup_stack_overflow_detection(void)
{
#ifdef HAS_STACK_OVERFLOW_DETECTION
stack_t stk;
- stk.ss_sp = malloc(SIGSTKSZ);
- if (stk.ss_sp == NULL) return -1;
stk.ss_size = SIGSTKSZ;
+ stk.ss_sp = malloc(stk.ss_size);
+ if (stk.ss_sp == NULL) return NULL;
stk.ss_flags = 0;
if (sigaltstack(&stk, NULL) == -1) {
free(stk.ss_sp);
- return -1;
+ return NULL;
}
+ return stk.ss_sp;
+#else
+ return NULL;
#endif
- /* Success (or stack overflow detection not available) */
- return 0;
}
-CAMLexport int caml_stop_stack_overflow_detection(void)
+CAMLexport int caml_stop_stack_overflow_detection(void * signal_stack)
{
#ifdef HAS_STACK_OVERFLOW_DETECTION
stack_t oldstk, stk;
stk.ss_flags = SS_DISABLE;
+ stk.ss_sp = NULL; /* not required but avoids a valgrind false alarm */
+ stk.ss_size = SIGSTKSZ; /* macOS wants a valid size here */
if (sigaltstack(&stk, &oldstk) == -1) return -1;
- /* If caml_setup_stack_overflow_detection failed, we are not using
- an alternate signal stack. SS_DISABLE will be set in oldstk,
- and there is nothing to free in this case. */
- if (! (oldstk.ss_flags & SS_DISABLE)) free(oldstk.ss_sp);
- return 0;
-#else
- return 0;
+ /* Check whether someone else installed their own signal stack */
+ if (!(oldstk.ss_flags & SS_DISABLE) && oldstk.ss_sp != signal_stack) {
+ /* Re-activate their signal stack. */
+ sigaltstack(&oldstk, NULL);
+ }
+ free(signal_stack);
#endif
+ return 0;
}
#include "caml/mlvalues.h"
#include "caml/stacks.h"
-value caml_global_data = 0;
+value caml_global_data = Val_unit; /* must be a valid value (#11768) */
uintnat caml_max_stack_size; /* also used in gc_ctrl.c */
$(INSTALL_DATA) \
stdlib.cmxa stdlib.$(A) std_exit.$(O) *.cmx \
"$(INSTALL_LIBDIR)"
- cd "$(INSTALL_LIBDIR)"; $(RANLIB) stdlib.$(A)
ifeq "$(UNIX_OR_WIN32)" "unix"
HEADERPROGRAM = header
(** Same as [of_string], but returns [None] instead of raising. *)
val to_string : float -> string
-(** Return the string representation of a floating-point number. *)
+(** Return a string representation of a floating-point number.
+
+ This conversion can involve a loss of precision. For greater control over
+ the manner in which the number is printed, see {!Printf}.
+
+ This function is an alias for {!Stdlib.string_of_float}. *)
type fpclass = Stdlib.fpclass =
FP_normal (** Normal number, none of the below *)
Traces are collected if the program is linked to the instrumented runtime
and started with the environment variable OCAML_EVENTLOG_ENABLED.
Events are flushed to disk after pausing, and no new events will be
- recorded until [eventlog_resume] is called. *)
+ recorded until [eventlog_resume] is called.
+
+ @since 4.11
+ *)
external eventlog_resume : unit -> unit = "caml_eventlog_resume"
(** [eventlog_resume ()] will resume the collection of traces in the
and started with the environment variable OCAML_EVENTLOG_ENABLED.
This call can be used after calling [eventlog_pause], or if the program
was started with OCAML_EVENTLOG_ENABLED=p. (which pauses the collection of
- traces before the first event.) *)
+ traces before the first event.)
+
+ @since 4.11
+ *)
(** [Memprof] is a sampling engine for allocated memory words. Every
[Failure "int_of_string"] instead of returning [None]. *)
val string_of_float : float -> string
-(** Return the string representation of a floating-point number. *)
+(** Return a string representation of a floating-point number.
+
+ This conversion can involve a loss of precision. For greater control over
+ the manner in which the number is printed, see {!Printf}. *)
val float_of_string_opt: string -> float option
(** Convert the given string to a float. The string is read in decimal
(** Print an integer, in decimal, on standard output. *)
val print_float : float -> unit
-(** Print a floating-point number, in decimal, on standard output. *)
+(** Print a floating-point number, in decimal, on standard output.
+
+ The conversion of the number to a string uses {!string_of_float} and
+ can involve a loss of precision. *)
val print_endline : string -> unit
(** Print a string, followed by a newline character, on
(** Print an integer, in decimal, on standard error. *)
val prerr_float : float -> unit
-(** Print a floating-point number, in decimal, on standard error. *)
+(** Print a floating-point number, in decimal, on standard error.
+
+ The conversion of the number to a string uses {!string_of_float} and
+ can involve a loss of precision. *)
val prerr_endline : string -> unit
(** Print a string, followed by a newline character on standard
val cat : string -> string -> string
(** [cat s1 s2] concatenates s1 and s2 ([s1 ^ s2]).
- @raise Invalid_argument if the result is longer then
- than {!Sys.max_string_length} bytes.
+ @raise Invalid_argument if the result is longer than
+ {!Sys.max_string_length} bytes.
@since 4.13.0
*)
val starts_with :
prefix (* comment thwarts tools/sync_stdlib_docs *) :string -> string -> bool
-(** [starts_with ][~][prefix s] is [true] if and only if [s] starts with
+(** [starts_with ][~prefix s] is [true] if and only if [s] starts with
[prefix].
@since 4.13.0 *)
val ends_with :
suffix (* comment thwarts tools/sync_stdlib_docs *) :string -> string -> bool
-(** [ends_with suffix s] is [true] if and only if [s] ends with [suffix].
+(** [ends_with ][~suffix s] is [true] if and only if [s] ends with [suffix].
@since 4.13.0 *)
val cat : string -> string -> string
(** [cat s1 s2] concatenates s1 and s2 ([s1 ^ s2]).
- @raise Invalid_argument if the result is longer then
- than {!Sys.max_string_length} bytes.
+ @raise Invalid_argument if the result is longer than
+ {!Sys.max_string_length} bytes.
@since 4.13.0
*)
val starts_with :
prefix (* comment thwarts tools/sync_stdlib_docs *) :string -> string -> bool
-(** [starts_with ][~][prefix s] is [true] if and only if [s] starts with
+(** [starts_with ][~prefix s] is [true] if and only if [s] starts with
[prefix].
@since 4.13.0 *)
val ends_with :
suffix (* comment thwarts tools/sync_stdlib_docs *) :string -> string -> bool
-(** [ends_with ~suffix s] is [true] if and only if [s] ends with [suffix].
+(** [ends_with ][~suffix s] is [true] if and only if [s] ends with [suffix].
@since 4.13.0 *)
(** Same as [of_string], but returns [None] instead of raising. *)
val to_string : float -> string
-(** Return the string representation of a floating-point number. *)
+(** Return a string representation of a floating-point number.
+
+ This conversion can involve a loss of precision. For greater control over
+ the manner in which the number is printed, see {!Printf}.
+
+ This function is an alias for {!Stdlib.string_of_float}. *)
type fpclass = Stdlib.fpclass =
FP_normal (** Normal number, none of the below *)
elif ! grep -q '^CC=gcc' ${ocamlsrcdir}/Makefile.config; then
echo "OCaml was not compiled with gcc" > ${ocamltest_response}
test_result=${TEST_SKIP}
+elif gcc --version 2>&1 | grep -q 'Apple clang version'; then
+ echo "OCaml was not compiled with gcc" > ${ocamltest_response}
+ test_result=${TEST_SKIP}
else
test_result=${TEST_PASS}
fi
(* TEST
+
+* hassysthreads
include systhreads
readonly_files = "input_all.ml"
+** bytecode
+** native
+
*)
let data_file =
[%%expect{|
type 'a t += A : int t
|}];;
+
+
+
+
+(* regression tests for #11533 *)
+#show Set.OrderedType;;
+[%%expect {|
+module type OrderedType = sig type t val compare : t -> t -> int end
+|}];;
+
+(* extra tests after #11533
+
+ The regression in #11533 would only show up when showing values defined
+ outside the current module. Those new tests below test modules and module
+ types from the standard library. To minimize test churn / promotion,
+ we are looking for some that will change as little as possible
+ in the future.
+
+ - For module type it's easy: OrderedType is fixed in stone as
+ changing it would break all code using Set.Make.
+
+ - For modules we use Stdlib.Unit, one of the stdlib modules
+ that is less likely to change very often (there are only
+ so many features you can add to 'unit').
+*)
+module U = Stdlib.Unit;;
+module type OT = Set.OrderedType;;
+[%%expect {|
+module U = Unit
+module type OT = Set.OrderedType
+|}];;
+
+#show U;;
+[%%expect {|
+module U = Unit
+module U :
+ sig
+ type t = unit = ()
+ val equal : t -> t -> bool
+ val compare : t -> t -> int
+ val to_string : t -> string
+ end
+|}];;
+
+#show OT;;
+[%%expect {|
+module type OT = Set.OrderedType
+module type OT = sig type t val compare : t -> t -> int end
+|}];;
--- /dev/null
+(* TEST
+ * expect
+*)
+
+type 'self nat =
+ | Z
+ | S of 'self
+;;
+[%%expect{|
+type 'self nat = Z | S of 'self
+|}]
+
+
+
+(* without rectypes: rejected *)
+external cast : int -> 'self nat as 'self = "%identity"
+;;
+[%%expect{|
+Line 1, characters 16-41:
+1 | external cast : int -> 'self nat as 'self = "%identity"
+ ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This alias is bound to type int -> 'a nat
+ but is used as an instance of type 'a
+ The type variable 'a occurs inside int -> 'a nat
+|}]
+
+#rectypes;;
+
+(* with rectypes: accepted (used to crash) *)
+external cast : int -> 'self nat as 'self = "%identity"
+;;
+[%%expect{|
+external cast : int -> 'a nat as 'a = "%identity"
+|}]
8. Module TY matches the expected module type ty
9. Module TY matches the expected module type ty
|}]
+
+module Shape_arg = struct
+ module M1 (Arg1 : sig end) = struct
+ module type S1 = sig
+ type t
+ end
+ end
+
+ module type S2 = sig
+ module Make (Arg2 : sig end) : M1(Arg2).S1
+ end
+
+ module M2 : S2 = struct
+ module Make (Arg3 : sig end) = struct
+ type t = T
+ end
+ end
+
+ module M3 (Arg4 : sig end) = struct
+ module type S3 = sig
+ type t = M2.Make(Arg4).t
+ end
+ end
+
+ module M4 (Arg5 : sig end) : M3(Arg5).S3 = struct
+ module M5 = M2.Make (Arg5)
+
+ type t = M5.t
+ end
+end
+[%%expect{|
+module Shape_arg :
+ sig
+ module M1 :
+ functor (Arg1 : sig end) -> sig module type S1 = sig type t end end
+ module type S2 =
+ sig module Make : functor (Arg2 : sig end) -> M1(Arg2).S1 end
+ module M2 : S2
+ module M3 :
+ functor (Arg4 : sig end) ->
+ sig module type S3 = sig type t = M2.Make(Arg4).t end end
+ module M4 : functor (Arg5 : sig end) -> M3(Arg5).S3
+ end
+|}]
type t = < m : int >
A private row type would be revealed.
|}];;
+
+
+(** Unexpected recursive types *)
+module M: sig
+ type _ t = A : (<x:'a> as 'a) -> (<y:'b> as 'b) t
+end = struct
+ type _ t = A : (<x:'a * 'a> as 'a) -> (<y:'b> as 'b) t
+end
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type _ t = A : (<x:'a * 'a> as 'a) -> (<y:'b> as 'b) t
+5 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig
+ type _ t = A : (< x : 'b * 'b > as 'b) -> (< y : 'a > as 'a) t
+ end
+ is not included in
+ sig type _ t = A : (< x : 'b > as 'b) -> (< y : 'a > as 'a) t end
+ Type declarations do not match:
+ type _ t = A : (< x : 'b * 'b > as 'b) -> (< y : 'a > as 'a) t
+ is not included in
+ type _ t = A : (< x : 'b > as 'b) -> (< y : 'a > as 'a) t
+ Constructors do not match:
+ A : (< x : 'b * 'b > as 'b) -> (< y : 'a > as 'a) t
+ is not the same as:
+ A : (< x : 'b > as 'b) -> (< y : 'a > as 'a) t
+ The type < x : 'a * 'a > as 'a is not equal to the type
+ < x : 'b > as 'b
+ Types for method x are incompatible
+|}]
+module R: sig
+ type t = { a: (<x:'a> as 'a) }
+end = struct
+ type t = { a: (<x:'a * 'a> as 'a) }
+end
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = { a: (<x:'a * 'a> as 'a) }
+5 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = { a : < x : 'a * 'a > as 'a; } end
+ is not included in
+ sig type t = { a : < x : 'a > as 'a; } end
+ Type declarations do not match:
+ type t = { a : < x : 'a * 'a > as 'a; }
+ is not included in
+ type t = { a : < x : 'a > as 'a; }
+ Fields do not match:
+ a : < x : 'a * 'a > as 'a;
+ is not the same as:
+ a : < x : 'a > as 'a;
+ The type < x : 'a * 'a > as 'a is not equal to the type
+ < x : 'b > as 'b
+ Types for method x are incompatible
+|}]
+type _ ext = ..
+module Ext: sig
+ type _ ext += A : (<x:'a> as 'a) -> (<y:'b> as 'b) ext
+end = struct
+ type _ ext += A : (<x:'a * 'a> as 'a) -> (<y:'b> as 'b) ext
+end
+[%%expect {|
+type _ ext = ..
+Lines 4-6, characters 6-3:
+4 | ......struct
+5 | type _ ext += A : (<x:'a * 'a> as 'a) -> (<y:'b> as 'b) ext
+6 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig
+ type _ ext +=
+ A : (< x : 'b * 'b > as 'b) -> (< y : 'a > as 'a) ext
+ end
+ is not included in
+ sig
+ type _ ext += A : (< x : 'b > as 'b) -> (< y : 'a > as 'a) ext
+ end
+ Extension declarations do not match:
+ type _ ext += A : (< x : 'b * 'b > as 'b) -> (< y : 'a > as 'a) ext
+ is not included in
+ type _ ext += A : (< x : 'b > as 'b) -> (< y : 'a > as 'a) ext
+ Constructors do not match:
+ A : (< x : 'b * 'b > as 'b) -> (< y : 'a > as 'a) ext
+ is not the same as:
+ A : (< x : 'b > as 'b) -> (< y : 'a > as 'a) ext
+ The type < x : 'a * 'a > as 'a is not equal to the type
+ < x : 'b > as 'b
+ Types for method x are incompatible
+|}]
--- /dev/null
+(* TEST
+ flags ="-keep-original-error-size"
+ * expect
+ *)
+
+
+module A = struct
+ type a and b and c and d
+end
+
+module type S = sig
+ module B = A
+end
+
+module C : S = struct
+ module B = struct
+ type a and b and c and d and e and f and g and h
+ end
+end
+[%%expect {|
+module A : sig type a and b and c and d end
+module type S = sig module B = A end
+Lines 9-13, characters 15-3:
+ 9 | ...............struct
+10 | module B = struct
+11 | type a and b and c and d and e and f and g and h
+12 | end
+13 | end
+Error: Signature mismatch:
+ ...
+ In module B:
+ Modules do not match:
+ sig
+ type a = B.a
+ and b = B.b
+ and c = B.c
+ and d = B.d
+ and e = B.e
+ and f = B.f
+ and g = B.g
+ and h = B.h
+ end
+ is not included in
+ (module A)
+|}]
+
+module A = struct
+ type a and b and c and d
+end
+
+module type S = sig
+ module type B = sig
+ module C = A
+ end
+end
+
+module D : S = struct
+ module type B = sig
+ module C: sig
+ type a and b and c and d and e and f and g and h
+ end
+ end
+end
+[%%expect{|
+module A : sig type a and b and c and d end
+module type S = sig module type B = sig module C = A end end
+Lines 11-17, characters 15-3:
+11 | ...............struct
+12 | module type B = sig
+13 | module C: sig
+14 | type a and b and c and d and e and f and g and h
+15 | end
+16 | end
+17 | end
+Error: Signature mismatch:
+ ...
+ ...
+ ...
+ At position module type B = sig module C : <here> end
+ Modules do not match:
+ sig
+ type a = C.a
+ and b = C.b
+ and c = C.c
+ and d = C.d
+ and e = C.e
+ and f = C.f
+ and g = C.g
+ and h = C.h
+ end
+ is not included in
+ (module A)
+|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+type (_, _) equ = Refl : ('q, 'q) equ
+
+module type Ty = sig type t end
+type 'a modu = (module Ty with type t = 'a)
+
+type 'q1 packed =
+ P : 'q0 modu * ('q0, 'q1) equ -> 'q1 packed
+
+(* Adds a module M to the environment where M.t equals an existential *)
+let repack (type q) (x : q packed) : q modu =
+ match x with
+ | P (p, eq) ->
+ let module M = (val p) in
+ let Refl = eq in
+ (module M)
+
+[%%expect{|
+type (_, _) equ = Refl : ('q, 'q) equ
+module type Ty = sig type t end
+type 'a modu = (module Ty with type t = 'a)
+type 'q1 packed = P : 'q0 modu * ('q0, 'q1) equ -> 'q1 packed
+val repack : 'q packed -> 'q modu = <fun>
+|}]
+
+(* Same, using a polymorphic function rather than an existential *)
+
+let mkmod (type a) () : a modu =
+ (module struct type t = a end)
+
+let f (type foo) (intish : (foo, int) equ) =
+ let module M = (val (mkmod () : foo modu)) in
+ let Refl = intish in
+ let module C : sig type t = int end = M in
+ ()
+
+[%%expect{|
+val mkmod : unit -> 'a modu = <fun>
+val f : ('foo, int) equ -> unit = <fun>
+|}]
class c : object method m : int method n : int end
|}];;
+class virtual c = object (self : 'c)
+ constraint 'c = < f : int; .. >
+end
+[%%expect {|
+class virtual c : object method virtual f : int end
+|}];;
+
+class virtual c = object (self : 'c)
+ constraint 'c = < f : int; .. >
+ method g = self # f
+end
+[%%expect {|
+class virtual c : object method virtual f : int method g : int end
+|}];;
+
class [ 'a ] c = object (_ : 'a) end;;
let o = object
method m = 1
class foo : object method f : bool -> bool end
- : bool = true
|}];;
+
+
+class c : object
+ method virtual m : int
+end = object
+ method m = 9
+ end
+[%%expect {|
+Lines 1-3, characters 10-3:
+1 | ..........object
+2 | method virtual m : int
+3 | end.........
+Error: This non-virtual class type has virtual methods.
+ The following methods are virtual : m
+|}];;
+
+class virtual c : object
+ method virtual m : int
+end = object
+ method m = 42
+ end
+[%%expect {|
+class virtual c : object method virtual m : int end
+|}];;
+
+class virtual cv = object
+ method virtual m : int
+ end
+
+class c : cv = object
+ method m = 42
+ end
+[%%expect {|
+class virtual cv : object method virtual m : int end
+Line 5, characters 10-12:
+5 | class c : cv = object
+ ^^
+Error: This non-virtual class type has virtual methods.
+ The following methods are virtual : m
+|}];;
+
+class virtual c : cv = object
+ method m = 41
+ end
+[%%expect {|
+class virtual c : cv
+|}];;
+
+class c = cv
+[%%expect {|
+Line 1, characters 10-12:
+1 | class c = cv
+ ^^
+Error: This non-virtual class has virtual methods.
+ The following methods are virtual : m
+|}];;
+
+class virtual c = cv
+[%%expect {|
+class virtual c : cv
+|}];;
+
+(** Test classes abbreviations with a recursive type *)
+class ['a] c = object method m: (<x:'a; f:'b> as 'b) -> unit = fun _ -> () end
+class d = ['a] c
+[%%expect {|
+class ['a] c : object method m : (< f : 'b; x : 'a > as 'b) -> unit end
+Line 2, characters 0-16:
+2 | class d = ['a] c
+ ^^^^^^^^^^^^^^^^
+Error: Some type variables are unbound in this type: class d : ['a] c
+ The method m has type (< f : 'b; x : 'a > as 'b) -> unit where 'a
+ is unbound
+|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+
+class test a c =
+object
+ method b = c
+end
+
+[%%expect{|
+Lines 1-4, characters 0-3:
+1 | class test a c =
+2 | object
+3 | method b = c
+4 | end
+Error: Some type variables are unbound in this type:
+ class test : 'a -> 'b -> object method b : 'b end
+ The method b has type 'b where 'b is unbound
+|}]
--- /dev/null
+File "deprecated_mutable.ml", line 13, characters 11-12:
+13 | let () = y.x <- 42
+ ^
+Alert deprecated: mutating field x
--- /dev/null
+(* TEST
+
+flags = "-w +A-70"
+
+* bytecode
+
+*)
+
+type t = {mutable x : int [@deprecated_mutable]}
+
+let y : t = {x = 5}
+
+let () = y.x <- 42
check_make_alldepend=false
jobs=''
bootstrap=false
+init_submodule=false
case "${OCAML_ARCH}" in
bsd|solaris)
pwd
cd "$jenkinsdir"
+if $init_submodule; then
+ git submodule update --init flexdll
+elif [ -f flexdll/Makefile ]; then
+ git submodule deinit --force flexdll
+fi
+
#########################################################################
# parse optional command-line arguments (has to be done after the "cd")
then "-machine:AMD64 "
else ""
in
- Printf.sprintf "link -lib -nologo %s-out:%s %s %s"
- machine out opts files
- else Printf.sprintf "%s rcs %s %s %s && %s %s"
- Config.ar out opts files Config.ranlib out
+ Printf.sprintf "link -lib -nologo %s-out:%s %s %s" machine out opts files
+ else Printf.sprintf "%s rcs %s %s %s" Config.ar out opts files
(* PR#4783: under Windows, don't use absolute paths because we do
not know where the binary distribution will be installed. *)
#Remove a tilde if it is followed by a label name and a space or closing
#OCamldoc code section with ]
-TILDEREGEX="s/~([a-z_]+[ \]])/\1/g"
+TILDEREGEX="s/ ~([a-z_]+(?=[ \]]))/ \1/g"
#Indent a non-blank line by two characters, for moreLabels templates
INDENTREGEX="s/^(.+)$/ \1/m"
Btype.unmark_iterators.it_module_declaration Btype.unmark_iterators md;
rs
+let secretly_the_same_path env path1 path2 =
+ let norm path = Printtyp.rewrite_double_underscore_paths env path in
+ Path.same (norm path1) (norm path2)
let () =
reg_show_prim "show_module"
| Pident id -> id
| _ -> id
in
- let rec accum_aliases md acc =
- let acc rs =
+ let rec accum_aliases path md acc =
+ let def rs =
Sig_module (id, Mp_present,
{md with md_type = trim_signature md.md_type},
- rs, Exported) :: acc in
+ rs, Exported) in
match md.md_type with
- | Mty_alias path ->
- let md = Env.find_module path env in
- accum_aliases md (acc Trec_not)
+ | Mty_alias new_path ->
+ let md = Env.find_module new_path env in
+ accum_aliases new_path md
+ (if secretly_the_same_path env path new_path
+ then acc
+ else def Trec_not :: acc)
| Mty_ident _ | Mty_signature _ | Mty_functor _ ->
- List.rev (acc (is_rec_module id md))
+ List.rev (def (is_rec_module id md) :: acc)
in
- accum_aliases md []
+ accum_aliases path md []
)
"Print the signature of the corresponding module."
let () =
reg_show_prim "show_module_type"
(fun env loc id lid ->
- let _path, desc = Env.lookup_modtype ~loc lid env in
- [ Sig_modtype (id, desc, Exported) ]
+ let path, mtd = Env.lookup_modtype ~loc lid env in
+ let id = match path with
+ | Pident id -> id
+ | _ -> id
+ in
+ let rec accum_defs path mtd acc =
+ let def = Sig_modtype (id, mtd, Exported) in
+ match mtd.mtd_type with
+ | Some (Mty_ident new_path) ->
+ let mtd = Env.find_modtype new_path env in
+ accum_defs new_path mtd
+ (if secretly_the_same_path env path new_path
+ then acc
+ else def :: acc)
+ | None | Some (Mty_alias _ | Mty_signature _ | Mty_functor _) ->
+ List.rev (def :: acc)
+ in
+ accum_defs path mtd []
)
"Print the signature of the corresponding module type."
lu.lu_mutation <- true;
lu.lu_construct <- true
+let is_mutating_label_usage = function
+ | Mutation -> true
+ | (Projection | Construct | Exported_private | Exported) -> false
+
let label_usages () =
{lu_projection = false; lu_mutation = false; lu_construct = false}
let add_module ?arg ?shape id presence mty env =
add_module_declaration ~check:false ?arg ?shape id presence (md mty) env
+let add_module_lazy ~update_summary id presence mty env =
+ let md = Subst.Lazy.{mdl_type = mty;
+ mdl_attributes = [];
+ mdl_loc = Location.none;
+ mdl_uid = Uid.internal_not_actually_unique}
+ in
+ add_module_declaration_lazy ~update_summary id presence md env
+
let add_local_type path info env =
{ env with
local_constraints = Path.Map.add path info env.local_constraints }
let use_label ~use ~loc usage env lbl =
if use then begin
mark_label_description_used usage env lbl;
- Builtin_attributes.check_alerts loc lbl.lbl_attributes lbl.lbl_name
+ Builtin_attributes.check_alerts loc lbl.lbl_attributes lbl.lbl_name;
+ if is_mutating_label_usage usage then
+ Builtin_attributes.check_deprecated_mutable loc lbl.lbl_attributes
+ lbl.lbl_name
end
let use_constructor_desc ~use ~loc usage env cstr =
check:bool -> rebind:bool -> Ident.t -> extension_constructor -> t -> t
val add_module: ?arg:bool -> ?shape:Shape.t ->
Ident.t -> module_presence -> module_type -> t -> t
+val add_module_lazy: update_summary:bool ->
+ Ident.t -> module_presence -> Subst.Lazy.modtype -> t -> t
val add_module_declaration: ?arg:bool -> ?shape:Shape.t -> check:bool ->
Ident.t -> module_presence -> module_declaration -> t -> t
val add_module_declaration_lazy: update_summary:bool ->
functor_params ~expansion_token ~env ~before ~ctx d
| _ ->
let inner = if eqmode then eq_module_types else module_types in
- let next = dwith_context_and_elision ctx inner diff in
+ let next =
+ match diff.symptom with
+ | Mt_core _ ->
+ (* In those cases, the refined error messages for the current error
+ will at most add some minor comments on the current error.
+ It is thus better to avoid eliding the current error message.
+ *)
+ dwith_context ctx (inner diff)
+ | _ -> dwith_context_and_elision ctx inner diff
+ in
let before = next :: before in
module_type_symptom ~eqmode ~expansion_token ~env ~before ~ctx
diff.symptom
MtyL_signature(strengthen_lazy_sig ~aliasable env sg p)
| MtyL_functor(Named (Some param, arg), res)
when !Clflags.applicative_functors ->
+ let env =
+ Env.add_module_lazy ~update_summary:false param Mp_present arg env
+ in
MtyL_functor(Named (Some param, arg),
strengthen_lazy ~aliasable:false env res (Papply(p, Pident param)))
| MtyL_functor(Named (None, arg), res)
reset_except_context ()
let prepare_for_printing tyl =
- reset_except_context (); List.iter prepare_type tyl
+ reset_except_context ();
+ List.iter prepare_type tyl
+
+let add_type_to_preparation = prepare_type
(* Disabled in classic mode when printing an unification error *)
let print_labels = ref true
let constructor ppf c =
reset_except_context ();
+ prepare_type_constructor_arguments c.cd_args;
+ Option.iter prepare_type c.cd_res;
!Oprint.out_constr ppf (tree_of_constructor c)
let label ppf l =
reset_except_context ();
+ prepare_type l.ld_type;
!Oprint.out_label ppf (tree_of_label l)
let tree_of_type_declaration id decl rs =
let extension_only_constructor id ppf ext =
reset_except_context ();
+ prepare_type_constructor_arguments ext.ext_args;
+ Option.iter prepare_type ext.ext_ret_type;
let name = Ident.name id in
let args, ret =
extension_constructor_args_and_ret_type_subtree
Any type variables that are shared between multiple types in the input list
will be given the same name when printed with [prepared_type_expr]. *)
val prepare_for_printing: type_expr list -> unit
+
+(** [add_type_to_preparation ty] extend a previous type expression preparation
+ to the type expression [ty]
+*)
+val add_type_to_preparation: type_expr -> unit
+
val prepared_type_expr: formatter -> type_expr -> unit
(** The function [prepared_type_expr] is a less-safe but more-flexible version
of [type_expr] that should only be called on [type_expr]s that have been
let with_constraint sub = function
| Twith_type decl -> Twith_type (sub.type_declaration sub decl)
| Twith_typesubst decl -> Twith_typesubst (sub.type_declaration sub decl)
+ | Twith_modtype mty -> Twith_modtype (sub.module_type sub mty)
+ | Twith_modtypesubst mty -> Twith_modtypesubst (sub.module_type sub mty)
| Twith_module _
- | Twith_modsubst _
- | Twith_modtype _
- | Twith_modtypesubst _ as d -> d
+ | Twith_modsubst _ as d -> d
let open_description sub od =
{od with open_env = sub.env sub od.open_env}
| meths, vars ->
raise(Error(loc, env, Virtual_class(kind, meths, vars)))
+let rec check_virtual_clty loc env virt kind clty =
+ match clty with
+ | Cty_constr(_, _, clty) | Cty_arrow(_, _, clty) ->
+ check_virtual_clty loc env virt kind clty
+ | Cty_signature sign ->
+ check_virtual loc env virt kind sign
+
(* Return the constructor type associated to a class type *)
let rec constructor_type constr cty =
match cty with
) styl params
in
let typ = Cty_constr (path, params, clty) in
+ (* Check for unexpected virtual methods *)
+ check_virtual_clty scty.pcty_loc env virt Class_type typ;
cltyp (Tcty_constr ( path, lid , ctys)) typ
| Pcty_signature pcsig ->
concrete_vals : VarSet.t;
local_meths : MethSet.t;
local_vals : VarSet.t;
- vars : Ident.t Vars.t;
- meths : Ident.t Meths.t; }
+ vars : Ident.t Vars.t; }
let rec class_field_first_pass self_loc cl_num sign self_scope acc cf =
let { rev_fields; val_env; par_env; concrete_meths; concrete_vals;
- local_meths; local_vals; vars; meths } = acc
+ local_meths; local_vals; vars } = acc
in
let loc = cf.pcf_loc in
let attributes = cf.pcf_attributes in
(val_env, par_env, inherited_vars, vars))
parent_sign.csig_vars (val_env, par_env, [], vars)
in
- let meths =
- Meths.fold
- (fun label _ meths ->
- if Meths.mem label meths then meths
- else Meths.add label (Ident.create_local label) meths)
- parent_sign.csig_meths meths
- in
(* Methods available through super *)
let super_meths =
MethSet.fold
in
let rev_fields = field :: rev_fields in
{ acc with rev_fields; val_env; par_env;
- concrete_meths; concrete_vals; vars; meths })
+ concrete_meths; concrete_vals; vars })
| Pcf_val (label, mut, Cfk_virtual styp) ->
with_attrs
(fun () ->
let cty = transl_simple_type val_env false sty in
let ty = cty.ctyp_type in
add_method loc val_env label.txt priv Virtual ty sign;
- let meths =
- if Meths.mem label.txt meths then meths
- else Meths.add label.txt (Ident.create_local label.txt) meths
- in
let field =
Virtual_method { label; priv; cty; loc; attributes }
in
let rev_fields = field :: rev_fields in
- { acc with rev_fields; meths })
+ { acc with rev_fields })
| Pcf_method (label, priv, Cfk_concrete (override, expr)) ->
with_attrs
raise(Error(loc, val_env,
Field_type_mismatch ("method", label.txt, err)))
end;
- let meths =
- if Meths.mem label.txt meths then meths
- else Meths.add label.txt (Ident.create_local label.txt) meths
- in
let sdefinition = make_method self_loc cl_num expr in
let warning_state = Warnings.backup () in
let field =
let rev_fields = field :: rev_fields in
let concrete_meths = MethSet.add label.txt concrete_meths in
let local_meths = MethSet.add label.txt local_meths in
- { acc with rev_fields; concrete_meths; local_meths; meths })
+ { acc with rev_fields; concrete_meths; local_meths })
| Pcf_constraint (sty1, sty2) ->
with_attrs
let local_meths = MethSet.empty in
let local_vals = VarSet.empty in
let vars = Vars.empty in
- let meths = Meths.empty in
let init_acc =
{ rev_fields; val_env; par_env;
concrete_meths; concrete_vals;
- local_meths; local_vals; vars; meths }
+ local_meths; local_vals; vars }
in
let acc =
Builtin_attributes.warning_scope []
(class_field_first_pass self_loc cl_num sign self_scope)
init_acc cfs)
in
- List.rev acc.rev_fields, acc.vars, acc.meths
+ List.rev acc.rev_fields, acc.vars
and class_field_second_pass cl_num sign met_env field =
let mkcf desc loc attrs =
end;
(* Typing of class fields *)
- let (fields, vars, meths) =
+ let (fields, vars) =
class_fields_first_pass self_loc cl_num sign self_scope
val_env par_env str
in
update_class_signature loc val_env
~warn_implicit_public:false virt kind sign;
+ let meths =
+ Meths.fold
+ (fun label _ meths ->
+ Meths.add label (Ident.create_local label) meths)
+ sign.csig_meths Meths.empty
+ in
+
(* Close the signature if it is final *)
begin match final with
| Not_final -> ()
try Ctype.unify val_env ty' ty with Ctype.Unify err ->
raise(Error(cty'.ctyp_loc, val_env, Parameter_mismatch err)))
tyl params;
+ (* Check for unexpected virtual methods *)
+ check_virtual_clty scl.pcl_loc val_env virt Class clty';
let cl =
rc {cl_desc = Tcl_ident (path, lid, tyl);
cl_loc = scl.pcl_loc;
(function ppf ->
fprintf ppf "but is expected to have type")
| Unexpected_field (ty, lab) ->
- Printtyp.prepare_for_printing [ty];
fprintf ppf
"@[@[<2>This object is expected to have type :@ %a@]\
@ This type does not have a method %s."
let print_reason ppf (ty0, real, lab, ty) =
let ty1 =
if real then ty0 else Btype.newgenty(Tobject(ty0, ref None)) in
- Printtyp.prepare_for_printing [ty; ty1];
+ Printtyp.add_type_to_preparation ty;
+ Printtyp.add_type_to_preparation ty1;
fprintf ppf
"The method %s@ has type@;<1 2>%a@ where@ %a@ is unbound"
lab
parse_native_repr_attributes env ct2 t2 ~global_repr
in
(repr_arg :: repr_args, repr_res)
- | Ptyp_poly (_, t), _, _ ->
+ | (Ptyp_poly (_, t) | Ptyp_alias (t, _)), _, _ ->
parse_native_repr_attributes env t ty ~global_repr
| Ptyp_arrow _, _, _ | _, Tarrow _, _ -> assert false
| _ -> ([], make_native_repr env core_type ty ~global_repr)
end
let modtype_of_package env loc p fl =
- package_constraints env loc (Mty_ident p)
- (List.map (fun (n, t) -> (Longident.flatten n, t)) fl)
+ (* We call Ctype.correct_levels to ensure that the types being added to the
+ module type are at generic_level. *)
+ let mty =
+ package_constraints env loc (Mty_ident p)
+ (List.map (fun (n, t) -> Longident.flatten n, Ctype.correct_levels t) fl)
+ in
+ Subst.modtype Keep Subst.identity mty
let package_subtype env p1 fl1 p2 fl2 =
let mkmty p fl =
let wrap_constraint env mark arg mty explicit =
let mark = if mark then Includemod.Mark_both else Includemod.Mark_neither in
+ let mty1 = Subst.modtype Keep Subst.identity arg.mod_type in
+ let mty2 = Subst.modtype Keep Subst.identity mty in
let coercion =
try
- Includemod.modtypes ~loc:arg.mod_loc env ~mark arg.mod_type mty
+ Includemod.modtypes ~loc:arg.mod_loc env ~mark mty1 mty2
with Includemod.Error msg ->
raise(Error(arg.mod_loc, env, Not_included msg)) in
{ mod_desc = Tmod_constraint(arg, mty, explicit, coercion);
$(call SUBST_STRING,OCAMLOPT_CPPFLAGS) \
$(call SUBST_STRING,PACKLD) \
$(call SUBST,PROFINFO_WIDTH) \
- $(call SUBST_STRING,RANLIBCMD) \
$(call SUBST_STRING,RPATH) \
$(call SUBST_STRING,MKSHAREDLIBRPATH) \
$(call SUBST,FORCE_SAFE_STRING) \
quoted_archive (quote_files file_list))
| _ ->
assert(String.length Config.ar > 0);
- let r1 =
- command(Printf.sprintf "%s rc %s %s"
- Config.ar quoted_archive (quote_files file_list)) in
- if r1 <> 0 || String.length Config.ranlib = 0
- then r1
- else command(Config.ranlib ^ " " ^ quoted_archive)
+ command(Printf.sprintf "%s rc %s %s"
+ Config.ar quoted_archive (quote_files file_list))
let expand_libname cclibs =
cclibs |> List.map (fun cclib ->
let native_code = ref false (* set to true under ocamlopt *)
-let force_tmc = ref false (* -force-tmc *)
let force_slash = ref false (* for ocamldep *)
let clambda_checks = ref false (* -clambda-checks *)
let cmm_invariants =
val pic_code : bool ref
val runtime_variant : string ref
val with_runtime : bool ref
-val force_tmc : bool ref
val force_slash : bool ref
val keep_docs : bool ref
val keep_locs : bool ref
val mkmaindll: string
(** The linker command line to build main programs as dlls. *)
-val ranlib: string
-(** Command to randomize a library, or "" if not needed *)
-
val default_rpath: string
(** Option to add a directory to be searched for libraries at runtime
(used by ocamlmklib) *)
c_compiler ^ " " ^ ocamlopt_cflags ^ " " ^ ocamlopt_cppflags
let native_c_libraries = "%%NATIVECCLIBS%%"
let native_pack_linker = "%%PACKLD%%"
-let ranlib = "%%RANLIBCMD%%"
let default_rpath = "%%RPATH%%"
let mksharedlibrpath = "%%MKSHAREDLIBRPATH%%"
let ar = "%%ARCMD%%"
p "bytecomp_c_libraries" bytecomp_c_libraries;
p "native_c_libraries" native_c_libraries;
p "native_pack_linker" native_pack_linker;
- p "ranlib" ranlib;
p "architecture" architecture;
p "model" model;
p_int "int_size" Sys.int_size;
projects / ocaml.git / commitdiff