Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

clean up whitespace and cut long lines

master
Damien Doligez 2016-02-16 13:23:31 +01:00
parent 2a3e2176eb
commit ee8f71101b
284 changed files with 12307 additions and 12081 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
.gitattributes vendored
View File

@ -9,16 +9,22 @@ boot/ocamldep binary
*.png binary
*.tfm binary
.gitattributes ocaml-typo=missing-header
.gitignore ocaml-typo=missing-header
.merlin ocaml-typo=missing-header
.ocp-indent ocaml-typo=missing-header
Changes ocaml-typo=non-ascii,missing-header
CONTRIBUTING.md ocaml-typo=missing-header
INSTALL ocaml-typo=missing-header
LICENSE ocaml-typo=non-printing,missing-header
# No header for text files (would be too obtrusive).
*.md ocaml-typo=missing-header
README* ocaml-typo=missing-header
*.adoc ocaml-typo=missing-header,long-line,unused-prop
/.gitattributes ocaml-typo=missing-header
/.gitignore ocaml-typo=missing-header
/.merlin ocaml-typo=missing-header
/Changes ocaml-typo=non-ascii,missing-header
/INSTALL ocaml-typo=missing-header
/LICENSE ocaml-typo=non-printing,missing-header
/appveyor.yml ocaml-typo=long-line,very-long-line
asmcomp/*/emit.mlp ocaml-typo=tab,long-line,unused-prop
asmcomp/power/NOTES.md ocaml-typo=missing-header,long-line
asmrun/i386.S ocaml-typo=long-line
@ -27,10 +33,11 @@ config/gnu ocaml-typo=prune
emacs/*.el ocaml-typo=long-line,unused-prop
emacs/COPYING ocaml-typo=tab,non-printing,missing-header
emacs/ocamltags.in ocaml-typo=non-printing
emacs/README* ocaml-typo=missing-header
experimental ocaml-typo=prune
manual ocaml-typo=prune
ocamlbuild/* ocaml-typo=long-line
ocamlbuild/AUTHORS ocaml-typo=missing-header
ocamlbuild/ChangeLog ocaml-typo=tab,missing-header
@ -43,6 +50,17 @@ otherlibs/win32unix/readlink.c ocaml-typo=long-line
otherlibs/win32unix/stat.c ocaml-typo=long-line
otherlibs/win32unix/symlink.c ocaml-typo=long-line
stdlib/sharpbang ocaml-typo=white-at-eol,missing-lf
# FIXME remove headers in testsuite and remove unused-prop in next line:
testsuite/** ocaml-typo=missing-header,unused-prop
testsuite/tests/lib-bigarray-2/bigarrf.f ocaml-typo=missing-header,tab
testsuite/tests/misc-unsafe/almabench.ml ocaml-typo=missing-header,long-line
tools/magic ocaml-typo=missing-header
yacc/*.[ch] ocaml-typo=long-line,very-long-line,unused-prop
# Line-ending specifications, for Windows interoperability
*.sh text eol=lf
*.sh.in text eol=lf

2
.gitignore vendored
View File

@ -274,6 +274,8 @@
/testsuite/tests/unboxed-primitive-args/main.ml
/testsuite/tests/unboxed-primitive-args/stubs.c
/testsuite/tests/unwind/unwind_test
/testsuite/tests/warnings/w55.opt.opt_result
/testsuite/tests/warnings/w58.opt.opt_result

6
INSTALL.adoc
View File

@ -234,9 +234,9 @@ or:
make opt > log.opt 2>&1 # in sh
make opt >& log.opt # in csh
5. anchor:step-5[] Compile fast versions of the OCaml compilers, by compiling them
with the native-code compiler (you have only compiled them to bytecode
so far). Just do:
5. anchor:step-5[] Compile fast versions of the OCaml compilers, by
compiling them with the native-code compiler (you have only compiled
them to bytecode so far). Just do:
make opt.opt
+

9
Makefile
View File

@ -367,7 +367,8 @@ partialclean::
rm -f compilerlibs/ocamlopttoplevel.cmxa
ocamlnat: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \
otherlibs/dynlink/dynlink.cmxa compilerlibs/ocamlopttoplevel.cmxa $(OPTTOPLEVELSTART:.cmo=.cmx)
otherlibs/dynlink/dynlink.cmxa compilerlibs/ocamlopttoplevel.cmxa \
$(OPTTOPLEVELSTART:.cmo=.cmx)
$(CAMLOPT) $(LINKFLAGS) -linkall -o ocamlnat \
otherlibs/dynlink/dynlink.cmxa compilerlibs/ocamlcommon.cmxa \
compilerlibs/ocamloptcomp.cmxa compilerlibs/ocamlopttoplevel.cmxa \
@ -480,7 +481,8 @@ ocamlopt.opt: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \
partialclean::
rm -f ocamlopt.opt
$(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(MIDDLE_END:.cmo=.cmx) $(ASMCOMP:.cmo=.cmx): ocamlopt
$(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(MIDDLE_END:.cmo=.cmx) \
$(ASMCOMP:.cmo=.cmx): ocamlopt
# The numeric opcodes
@ -747,7 +749,8 @@ clean::
$(CAMLOPT) $(COMPFLAGS) -c $<
partialclean::
for d in utils parsing typing bytecomp asmcomp middle_end middle_end/base_types driver toplevel tools; \
for d in utils parsing typing bytecomp asmcomp middle_end \
middle_end/base_types driver toplevel tools; \
do rm -f $$d/*.cm[ioxt] $$d/*.cmti $$d/*.annot $$d/*.[so] $$d/*~; done
rm -f *~

80
Makefile.nt
View File

@ -16,48 +16,55 @@ include Makefile.shared
# For users who don't read the INSTALL file
defaultentry:
@echo "Please refer to the installation instructions in file README.win32.adoc."
@echo "Please refer to the instructions in file README.win32.adoc."
FLEXDLL_SUBMODULE_PRESENT:=$(wildcard flexdll/Makefile)
BOOT_FLEXLINK_CMD=$(if $(FLEXDLL_SUBMODULE_PRESENT),FLEXLINK_CMD="../boot/ocamlrun ../flexdll/flexlink.exe")
CAMLOPT:=$(if $(FLEXDLL_SUBMODULE_PRESENT),OCAML_FLEXLINK="boot/ocamlrun flexdll/flexlink.exe") $(CAMLOPT)
ifeq "$(FLEXDLL_SUBMODULE_PRESENT)" ""
BOOT_FLEXLINK_CMD=
else
BOOT_FLEXLINK_CMD=FLEXLINK_CMD="../boot/ocamlrun ../flexdll/flexlink.exe"
CAMLOPT:=OCAML_FLEXLINK="boot/ocamlrun flexdll/flexlink.exe" $(CAMLOPT)
endif
# FlexDLL sources missing error messages
# Different git mechanism displayed depending on whether this source tree came
# from a git clone or a source tarball.
# Displayed in all cases
flexdll-common-err:
@echo In order to bootstrap FlexDLL, you need to place the sources in flexdll
flexdll/Makefile:
@echo In order to bootstrap FlexDLL, you need to place the sources in
@echo flexdll.
@echo This can either be done by downloading a source tarball from
@echo \ http://alain.frisch.fr/flexdll.html
flexdll/Makefile: $(if $(wildcard flexdll/Makefile),,$(if $(wildcard .git),flexdll-common-err,flexdll-repo))
@echo or by checking out the flexdll submodule with
@echo \ git submodule update --init
@false
flexdll-repo: flexdll-common-err
@echo or by cloning the git repository
@echo \ git clone https://github.com/alainfrisch/flexdll.git
@echo
@if [ -d .git ]; then \
echo or by checking out the flexdll submodule with; \
echo \ git submodule update --init; \
else \
echo or by cloning the git repository; \
echo \ git clone https://github.com/alainfrisch/flexdll.git; \
fi
@false
# Bootstrapping FlexDLL - leaves a bytecode image of flexlink.exe in flexdll/
flexdll: flexdll/Makefile
cd byterun ; $(MAKEREC) BOOTSTRAPPING_FLEXLINK=yes ocamlrun$(EXE)
cd byterun && $(MAKEREC) BOOTSTRAPPING_FLEXLINK=yes ocamlrun$(EXE)
cp byterun/ocamlrun.exe boot/ocamlrun.exe
cd stdlib ; $(MAKEREC) COMPILER=../boot/ocamlc stdlib.cma std_exit.cmo
cd stdlib ; cp stdlib.cma std_exit.cmo *.cmi ../boot
cd flexdll ; $(MAKECMD) MSVC_DETECT=0 TOOLCHAIN=$(TOOLCHAIN) TOOLPREF=$(TOOLPREF) CHAINS=$(FLEXDLL_CHAIN) NATDYNLINK=false OCAMLOPT="../boot/ocamlrun ../boot/ocamlc -I ../boot" flexlink.exe support
cd byterun ; $(MAKEREC) clean
cd stdlib && $(MAKEREC) COMPILER=../boot/ocamlc stdlib.cma std_exit.cmo
cd stdlib && cp stdlib.cma std_exit.cmo *.cmi ../boot
cd flexdll && \
$(MAKECMD) MSVC_DETECT=0 TOOLCHAIN=$(TOOLCHAIN) TOOLPREF=$(TOOLPREF) \
CHAINS=$(FLEXDLL_CHAIN) NATDYNLINK=false \
OCAMLOPT="../boot/ocamlrun ../boot/ocamlc -I ../boot" \
flexlink.exe support
cd byterun && $(MAKEREC) clean
$(MAKEREC) partialclean
flexlink.opt:
cd flexdll ; \
mv flexlink.exe flexlink ; \
$(MAKECMD) OCAML_FLEXLINK="../boot/ocamlrun ./flexlink" MSVC_DETECT=0 TOOLCHAIN=$(TOOLCHAIN) TOOLPREF=$(TOOLPREF) OCAMLOPT="../ocamlopt.opt -I ../stdlib" flexlink.exe ; \
mv flexlink.exe flexlink.opt ; \
cd flexdll && \
mv flexlink.exe flexlink && \
$(MAKECMD) OCAML_FLEXLINK="../boot/ocamlrun ./flexlink" MSVC_DETECT=0 \
TOOLCHAIN=$(TOOLCHAIN) TOOLPREF=$(TOOLPREF) \
OCAMLOPT="../ocamlopt.opt -I ../stdlib" flexlink.exe && \
mv flexlink.exe flexlink.opt && \
mv flexlink flexlink.exe
# Recompile the system using the bootstrap compiler
@ -229,28 +236,36 @@ installbyt:
install-flexdll:
# The $(if ...) installs the correct .manifest file for MSVC and MSVC64
# (GNU make doesn't have ifeq as a function, hence slightly convoluted use of filter-out)
cp flexdll/flexlink.exe $(if $(filter-out mingw,$(TOOLCHAIN)),flexdll/default$(filter-out _i386,_$(ARCH)).manifest) $(INSTALL_BINDIR)/
# (GNU make doesn't have ifeq as a function, hence slightly convoluted use of
# filter-out)
cp flexdll/flexlink.exe \
$(if $(filter-out mingw,$(TOOLCHAIN)),\
flexdll/default$(filter-out _i386,_$(ARCH)).manifest) \
$(INSTALL_BINDIR)/
cp flexdll/flexdll_*.$(O) $(INSTALL_LIBDIR)
# Installation of the native-code compiler
installopt:
cd asmrun ; $(MAKEREC) install
cd asmrun && $(MAKEREC) install
cp ocamlopt "$(INSTALL_BINDIR)/ocamlopt.exe"
cd stdlib ; $(MAKEREC) installopt
cd stdlib && $(MAKEREC) installopt
cp middle_end/*.cmi middle_end/*.cmt middle_end/*.cmti \
"$(INSTALL_COMPLIBDIR)"
cp middle_end/base_types/*.cmi middle_end/base_types/*.cmt \
middle_end/base_types/*.cmti "$(INSTALL_COMPLIBDIR)"
cp asmcomp/*.cmi asmcomp/*.cmt asmcomp/*.cmti "$(INSTALL_COMPLIBDIR)"
cp compilerlibs/ocamloptcomp.cma $(OPTSTART) "$(INSTALL_COMPLIBDIR)"
if test -n "$(WITH_OCAMLDOC)"; then (cd ocamldoc; $(MAKEREC) installopt); fi
if test -n "$(WITH_OCAMLDOC)"; then \
(cd ocamldoc && $(MAKEREC) installopt); \
fi
for i in $(OTHERLIBRARIES); do \
$(MAKEREC) -C otherlibs/$$i installopt || exit $$?; \
done
if test -f ocamlopt.opt ; then $(MAKEREC) installoptopt; fi
cd tools; $(MAKEREC) installopt
if test -f ocamlopt.opt -a -f flexdll/flexlink.opt ; then cp -f flexdll/flexlink.opt $(INSTALL_BINDIR)/flexlink.exe ; fi
if test -f ocamlopt.opt -a -f flexdll/flexlink.opt ; then \
cp -f flexdll/flexlink.opt $(INSTALL_BINDIR)/flexlink.exe ; \
fi
installoptopt:
cp ocamlc.opt "$(INSTALL_BINDIR)/ocamlc.opt$(EXE)"
@ -441,7 +456,8 @@ ocamlopt.opt: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \
partialclean::
rm -f ocamlopt.opt
$(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(MIDDLE_END:.cmo=.cmx) $(ASMCOMP:.cmo=.cmx): ocamlopt
$(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(MIDDLE_END:.cmo=.cmx) \
$(ASMCOMP:.cmo=.cmx): ocamlopt
# The numeric opcodes

5
Makefile.shared
View File

@ -19,8 +19,8 @@ include stdlib/StdlibModules
CAMLC=$(CAMLRUN) boot/ocamlc -g -nostdlib -I boot
CAMLOPT=$(CAMLRUN) ./ocamlopt -g -nostdlib -I stdlib -I otherlibs/dynlink
COMPFLAGS=-strict-sequence -principal -w +33..39+48+50 -warn-error A -bin-annot \
-safe-string -strict-formats $(INCLUDES)
COMPFLAGS=-strict-sequence -principal -w +33..39+48+50 -warn-error A \
-bin-annot -safe-string -strict-formats $(INCLUDES)
LINKFLAGS=
YACCFLAGS=-v
@ -234,4 +234,3 @@ partialclean::
alldepend::
cd tools; $(MAKEREC) depend

2
README.adoc
View File

@ -60,7 +60,7 @@ renaming of standard library functions.
config/:: autoconfiguration stuff
debugger/:: source-level replay debugger
driver/:: driver code for the compilers
emacs/:: OCaml editing mode and debugger interface for GNU Emacs
emacs/:: editing mode and debugger interface for GNU Emacs
lex/:: lexer generator
maccaml/:: the Macintosh GUI
ocamldoc/:: documentation generator

18
README.win32.adoc
View File

@ -87,15 +87,16 @@ for Windows.
You will need the following software components to perform the recompilation:
- Windows NT, 2000, XP, Vista, or 7 (32 or 64 bits).
- Items <<tps1,[1]>> and <<tps2,[2]>> from the list of recommended software above.
- Items <<tps1,[1]>> and <<tps2,[2]>> from the list of recommended software
above.
- The Cygwin port of GNU tools, available from http://www.cygwin.com/
Install at least the following packages (and their dependencies):
diffutils, dos2unix, gcc-core, make, ncurses.
First, you need to set up your cygwin environment for using the MS
tools. The following assumes that you have installed <<tps1,[1]>>, <<tps2,[2]>>, and [3]
in their default directories. If this is not the case, you will need
to adjust the paths accordingly.
tools. The following assumes that you have installed <<tps1,[1]>>,
<<tps2,[2]>>, and [3] in their default directories. If this is not
the case, you will need to adjust the paths accordingly.
. Open a Windows Command Prompt and enter the following command:
@ -408,14 +409,15 @@ for Windows.
You will need the following software components to perform the recompilation:
- Windows XP 64, Windows Server 64, or Windows 7 64.
- Items <<tps-native1,[1]>> and <<tps-native2,[2]>> from the list of recommended software above.
- Items <<tps-native1,[1]>> and <<tps-native2,[2]>> from the list of
recommended software above.
- The Cygwin port of GNU tools, available from http://www.cygwin.com/
Install at least the following packages: diffutils, make, ncurses.
First, you need to set up your cygwin environment for using the MS
tools. The following assumes that you have installed <<tps-native1,[1]>> and <<tps-native2,[2]>>
in their default directories. If this is not the case, you will need
to adjust the paths accordingly.
tools. The following assumes that you have installed <<tps-native1,[1]>>
and <<tps-native2,[2]>> in their default directories. If this is not
the case, you will need to adjust the paths accordingly.
. Open a Windows Command Prompt and enter the following commands:

1
asmcomp/amd64/NOTES.md
View File

@ -19,4 +19,3 @@ Debian architecture name: `amd64`
_OS X ABI Function Call Guide: x86-64 Function Calling Conventions_
* Windows 64 application binary interface:
_x64 Software Conventions_ from MSDN

1
asmcomp/arm/NOTES.md
View File

@ -18,4 +18,3 @@ Debian architecture names: `armel` and `armhf`.
_ARM Architecture Reference Manual, ARMv8_, restricted to the AArch32 subset.
* Application binary interface:
_Procedure Call Standard for the ARM Architecture_

5
asmcomp/i386/NOTES.md
View File

@ -20,8 +20,3 @@ Debian architecture name: `i386`
Intel386 Architecture Processor Supplement_
* MacOS X application binary interface:
_OS X ABI Function Call Guide: IA-32 Function Calling Conventions_

1
asmcomp/power/NOTES.md
View File

@ -24,4 +24,3 @@ No longer supported: AIX and MacOS X.
(http://openpowerfoundation.org/technical/technical-resources/technical-specifications/)
* _The PowerPC Compiler Writer's Guide_, Warthman Associates, 1996.
(PDF available from various sources on the Web.)

3
asmcomp/s390x/NOTES.md
View File

@ -14,6 +14,3 @@ running Linux (Debian architecture: `s390x`).
* ELF ABI:
_zSeries ELF Application Binary Interface Supplement_
(http://refspecs.linuxfoundation.org/ELF/zSeries/index.html)

4
asmcomp/sparc/NOTES.md
View File

@ -15,7 +15,3 @@ Status of this port: nearly abandoned
* ELF application binary interface:
_System V Application Binary Interface,
SPARC Processor Supplement_

3
asmrun/amd64.S
View File

@ -189,7 +189,8 @@
#define PUSH_CALLEE_SAVE_REGS \
pushq %rbx; CFI_ADJUST (8); CFI_OFFSET(rbx, -16); \
pushq %rbp; CFI_ADJUST (8); CFI_OFFSET(rbp, -24); /* Allows debugger to walk the stack */ \
pushq %rbp; CFI_ADJUST (8); CFI_OFFSET(rbp, -24); \
/* Allows debugger to walk the stack */ \
pushq %rsi; CFI_ADJUST (8); CFI_OFFSET(rsi, -32); \
pushq %rdi; CFI_ADJUST (8); CFI_OFFSET(rdi, -40); \
pushq %r12; CFI_ADJUST (8); CFI_OFFSET(r12, -48); \

4
asmrun/arm.S
View File

@ -93,7 +93,9 @@ alloc_limit .req r11
/* Support for profiling with gprof */
#if defined(PROFILING) && (defined(SYS_linux_eabihf) || defined(SYS_linux_eabi) || defined(SYS_netbsd))
#if defined(PROFILING) && (defined(SYS_linux_eabihf) \
|| defined(SYS_linux_eabi) \
|| defined(SYS_netbsd))
#define PROFILE \
push {lr}; CFI_ADJUST(4); \
bl __gnu_mcount_nc; CFI_ADJUST(-4)

2
asmrun/s390x.S
View File

@ -206,7 +206,7 @@ caml_raise_exception:
lay %r15, -160(%r15)
brasl %r14, caml_stash_backtrace@PLT
lay %r15, 160(%r15)
lgdr %r2,%f15 /* restore exn bucket */ /* restore exn bucket */
lgdr %r2,%f15 /* restore exn bucket */
j .L113 /* raise the exn */
/* Start the OCaml program */

4
asmrun/signals_asm.c
View File

@ -145,7 +145,9 @@ int caml_set_signal_action(int signo, int action)
/* Machine- and OS-dependent handling of bound check trap */
#if defined(TARGET_power) || defined(TARGET_s390x) || (defined(TARGET_sparc) && defined(SYS_solaris))
#if defined(TARGET_power) \
|| defined(TARGET_s390x) \
|| (defined(TARGET_sparc) && defined(SYS_solaris))
DECLARE_SIGNAL_HANDLER(trap_handler)
{
#if defined(SYS_solaris)

3
bytecomp/lambda.ml
View File

@ -525,7 +525,8 @@ let subst_lambda s lam =
begin try Ident.find_same id s with Not_found -> l end
| Lconst sc as l -> l
| Lapply ap ->
Lapply{ap with ap_func = subst ap.ap_func; ap_args = List.map subst ap.ap_args}
Lapply{ap with ap_func = subst ap.ap_func;
ap_args = List.map subst ap.ap_args}
| Lfunction{kind; params; body; attr} ->
Lfunction{kind; params; body = subst body; attr}
| Llet(str, id, arg, body) -> Llet(str, id, subst arg, subst body)

3
bytecomp/matching.ml
View File

@ -2980,7 +2980,8 @@ let rec map_return f = function
| Lsequence (l1, l2) -> Lsequence (l1, map_return f l2)
| Levent (l, ev) -> Levent (map_return f l, ev)
| Ltrywith (l1, id, l2) -> Ltrywith (map_return f l1, id, map_return f l2)
| Lstaticcatch (l1, b, l2) -> Lstaticcatch (map_return f l1, b, map_return f l2)
| Lstaticcatch (l1, b, l2) ->
Lstaticcatch (map_return f l1, b, map_return f l2)
| Lstaticraise _ | Lprim(Praise _, _) as l -> l
| l -> f l

9
bytecomp/simplif.ml
View File

@ -355,7 +355,8 @@ let simplify_lets lam =
| Lapply{ap_func = Lfunction{kind = Curried; params; body}; ap_args = args}
when optimize && List.length params = List.length args ->
count bv (beta_reduce params body args)
| Lapply{ap_func = Lfunction{kind = Tupled; params; body}; ap_args = [Lprim(Pmakeblock _, args)]}
| Lapply{ap_func = Lfunction{kind = Tupled; params; body};
ap_args = [Lprim(Pmakeblock _, args)]}
when optimize && List.length params = List.length args ->
count bv (beta_reduce params body args)
| Lapply{ap_func = l1; ap_args = ll} ->
@ -447,10 +448,12 @@ let simplify_lets lam =
| Lapply{ap_func = Lfunction{kind = Curried; params; body}; ap_args = args}
when optimize && List.length params = List.length args ->
simplif (beta_reduce params body args)
| Lapply{ap_func = Lfunction{kind = Tupled; params; body}; ap_args = [Lprim(Pmakeblock _, args)]}
| Lapply{ap_func = Lfunction{kind = Tupled; params; body};
ap_args = [Lprim(Pmakeblock _, args)]}
when optimize && List.length params = List.length args ->
simplif (beta_reduce params body args)
| Lapply ap -> Lapply {ap with ap_func = simplif ap.ap_func; ap_args = List.map simplif ap.ap_args}
| Lapply ap -> Lapply {ap with ap_func = simplif ap.ap_func;
ap_args = List.map simplif ap.ap_args}
| Lfunction{kind; params; body = l; attr} ->
begin match simplif l with
Lfunction{kind=Curried; params=params'; body; attr}

7
bytecomp/translclass.ml
View File

@ -29,7 +29,9 @@ let lfunction params body =
| Lfunction {kind = Curried; params = params'; body = body'; attr} ->
Lfunction {kind = Curried; params = params @ params'; body = body'; attr}
| _ ->
Lfunction {kind = Curried; params; body; attr = default_function_attribute}
Lfunction {kind = Curried; params;
body;
attr = default_function_attribute}
let lapply ap =
match ap.ap_func with
@ -601,7 +603,8 @@ open M
obj_init: creation function (unit -> obj)
class_init: inheritance function (table -> env_init)
(one by source code)
env_init: parameterisation by the local environment (env -> params -> obj_init)
env_init: parameterisation by the local environment
(env -> params -> obj_init)
(one for each combination of inherited class_init )
env: environnement local
If ids=0 (immediate object), then only env_init is conserved.

16
bytecomp/translcore.ml
View File

@ -874,11 +874,12 @@ and transl_exp0 e =
because [caml_modify] might be called upon them (e.g. from
code operating on polymorphic arrays, or functions such as
[caml_array_blit].
To avoid having different Lambda code for bytecode/Closure vs.
Flambda, we always generate [Pduparray] here, and deal with it in
[Bytegen] (or in the case of Closure, in [Cmmgen], which already
has to handle [Pduparray Pmakearray Pfloatarray] in the case where
the array turned out to be inconstant).
To avoid having different Lambda code for
bytecode/Closure vs. Flambda, we always generate
[Pduparray] here, and deal with it in [Bytegen] (or in
the case of Closure, in [Cmmgen], which already has to
handle [Pduparray Pmakearray Pfloatarray] in the case
where the array turned out to be inconstant).
When not [Pfloatarray], the exception propagates to the handler
below. *)
let imm_array = Lprim (Pmakearray (kind, Immutable), ll) in
@ -1122,7 +1123,10 @@ and transl_apply ?(should_be_tailcall=false) ?(inlined = Default_inline)
| [] ->
lapply lam (List.rev_map fst args)
in
(build_apply lam [] (List.map (fun (l, x) -> may_map transl_exp x, Btype.is_optional l) sargs) : Lambda.lambda)
(build_apply lam [] (List.map (fun (l, x) ->
may_map transl_exp x, Btype.is_optional l)
sargs)
: Lambda.lambda)
and transl_function loc untuplify_fn repr partial cases =
match cases with

55
bytecomp/translmod.ml
View File

@ -98,7 +98,8 @@ let rec apply_coercion strict restr arg =
(Lapply{ap_should_be_tailcall=false;
ap_loc=Location.none;
ap_func=Lvar id;
ap_args=[apply_coercion Alias cc_arg (Lvar param)];
ap_args=[apply_coercion Alias cc_arg
(Lvar param)];
ap_inlined=Default_inline;
ap_specialised=Default_specialise})})
| Tcoerce_primitive { pc_loc; pc_desc; pc_env; pc_type; } ->
@ -383,7 +384,8 @@ let rec transl_module cc rootpath mexp =
specialise = Default_specialise;
is_a_functor = true };
body = Llet(Alias, param,
apply_coercion Alias ccarg (Lvar param'),
apply_coercion Alias ccarg
(Lvar param'),
transl_module ccres bodypath body)}
| _ ->
fatal_error "Translmod.transl_module")
@ -493,7 +495,8 @@ and transl_structure fields cc rootpath final_env = function
transl_module Tcoerce_none (field_path rootpath id) mb.mb_expr
in
let module_body =
Translattribute.add_inline_attribute module_body mb.mb_loc mb.mb_attributes
Translattribute.add_inline_attribute module_body mb.mb_loc
mb.mb_attributes
in
Llet(pure_module mb.mb_expr, id,
module_body,
@ -527,7 +530,9 @@ and transl_structure fields cc rootpath final_env = function
[] ->
transl_structure newfields cc rootpath final_env rem
| id :: ids ->
let body, size = rebind_idents (pos + 1) (id :: newfields) ids in
let body, size =
rebind_idents (pos + 1) (id :: newfields) ids
in
Llet(Alias, id, Lprim(Pfield pos, [Lvar mid]), body), size
in
let body, size = rebind_idents 0 fields ids in
@ -650,7 +655,9 @@ let rec more_idents = function
| Tstr_class_type cl_list -> more_idents rem
| Tstr_include _ -> more_idents rem
| Tstr_module {mb_expr={mod_desc = Tmod_structure str}}
| Tstr_module{mb_expr={mod_desc = Tmod_constraint ({mod_desc = Tmod_structure str}, _, _, _)}} ->
| Tstr_module{mb_expr={mod_desc =
Tmod_constraint ({mod_desc = Tmod_structure str},
_, _, _)}} ->
all_idents str.str_items @ more_idents rem
| Tstr_module _ -> more_idents rem
| Tstr_attribute _ -> more_idents rem
@ -678,7 +685,10 @@ and all_idents = function
| Tstr_include incl ->
bound_value_identifiers incl.incl_type @ all_idents rem
| Tstr_module {mb_id;mb_expr={mod_desc = Tmod_structure str}}
| Tstr_module{mb_id; mb_expr={mod_desc = Tmod_constraint ({mod_desc = Tmod_structure str}, _, _, _)}} ->
| Tstr_module{mb_id;
mb_expr={mod_desc =
Tmod_constraint ({mod_desc = Tmod_structure str},
_, _, _)}} ->
mb_id :: all_idents str.str_items @ all_idents rem
| Tstr_module mb -> mb.mb_id :: all_idents rem
| Tstr_attribute _ -> all_idents rem
@ -725,9 +735,12 @@ let transl_store_structure glob map prims str =
| Tstr_type(_, decls) ->
transl_store rootpath subst rem
| Tstr_typext(tyext) ->
let ids = List.map (fun ext -> ext.ext_id) tyext.tyext_constructors in
let ids =
List.map (fun ext -> ext.ext_id) tyext.tyext_constructors
in
let lam =
transl_type_extension item.str_env rootpath tyext (store_idents ids)
transl_type_extension item.str_env rootpath tyext
(store_idents ids)
in
Lsequence(subst_lambda subst lam,
transl_store rootpath (add_idents false ids subst) rem)
@ -742,7 +755,9 @@ let transl_store_structure glob map prims str =
mb_attributes} ->
List.iter (Translattribute.check_attribute_on_module mexp)
mb_attributes;
let lam = transl_store (field_path rootpath id) subst str.str_items in
let lam =
transl_store (field_path rootpath id) subst str.str_items
in
(* Careful: see next case *)
let subst = !transl_store_subst in
Lsequence(lam,
@ -752,7 +767,8 @@ let transl_store_structure glob map prims str =
List.map (fun id -> Lvar id)
(defined_idents str.str_items))),
Lsequence(store_ident id,
transl_store rootpath (add_ident true id subst)
transl_store rootpath
(add_ident true id subst)
rem)))
| Tstr_module{
mb_id=id;
@ -762,10 +778,13 @@ let transl_store_structure glob map prims str =
(Tcoerce_structure (map, _) as _cc))};
mb_attributes
} ->
(* Format.printf "coerc id %s: %a@." (Ident.unique_name id) Includemod.print_coercion cc; *)
(* Format.printf "coerc id %s: %a@." (Ident.unique_name id)
Includemod.print_coercion cc; *)
List.iter (Translattribute.check_attribute_on_module mexp)
mb_attributes;
let lam = transl_store (field_path rootpath id) subst str.str_items in
let lam =
transl_store (field_path rootpath id) subst str.str_items
in
(* Careful: see next case *)
let subst = !transl_store_subst in
let ids = Array.of_list (defined_idents str.str_items) in
@ -781,7 +800,8 @@ let transl_store_structure glob map prims str =
(Lprim(Pmakeblock(0, Immutable),
List.map field map)),
Lsequence(store_ident id,
transl_store rootpath (add_ident true id subst)
transl_store rootpath
(add_ident true id subst)
rem)))
| Tstr_module{mb_id=id; mb_expr=modl; mb_loc; mb_attributes} ->
let lam =
@ -955,7 +975,8 @@ let toplevel_name id =
let toploop_getvalue id =
Lapply{ap_should_be_tailcall=false;
ap_loc=Location.none;
ap_func=Lprim(Pfield toploop_getvalue_pos, [Lprim(Pgetglobal toploop_ident, [])]);
ap_func=Lprim(Pfield toploop_getvalue_pos,
[Lprim(Pgetglobal toploop_ident, [])]);
ap_args=[Lconst(Const_base(Const_string (toplevel_name id, None)))];
ap_inlined=Default_inline;
ap_specialised=Default_specialise}
@ -963,8 +984,10 @@ let toploop_getvalue id =
let toploop_setvalue id lam =
Lapply{ap_should_be_tailcall=false;
ap_loc=Location.none;
ap_func=Lprim(Pfield toploop_setvalue_pos, [Lprim(Pgetglobal toploop_ident, [])]);
ap_args=[Lconst(Const_base(Const_string (toplevel_name id, None))); lam];
ap_func=Lprim(Pfield toploop_setvalue_pos,
[Lprim(Pgetglobal toploop_ident, [])]);
ap_args=[Lconst(Const_base(Const_string (toplevel_name id, None)));
lam];
ap_inlined=Default_inline;
ap_specialised=Default_specialise}

1
bytecomp/typeopt.mli
View File

@ -26,4 +26,3 @@ val array_kind : Typedtree.expression -> Lambda.array_kind
val array_pattern_kind : Typedtree.pattern -> Lambda.array_kind
val bigarray_type_kind_and_layout :
Env.t -> Types.type_expr -> Lambda.bigarray_kind * Lambda.bigarray_layout

4
config/Makefile.mingw
View File

@ -131,7 +131,9 @@ MKEXE_BOOT=$(BYTECC) -o $(1) $(2)
### How to build a static library
MKLIB=rm -f $(1); $(TOOLPREF)ar rc $(1) $(2); $(RANLIB) $(1)
#ml let mklib out files opts = Printf.sprintf "rm -f %s && %sar rcs %s %s %s" out toolpref opts out files;;
#ml let mklib out files opts =
#ml Printf.sprintf "rm -f %s && %sar rcs %s %s %s"
#ml out toolpref opts out files;;
### Canonicalize the name of a system library
SYSLIB=-l$(1)

4
config/Makefile.mingw64
View File

@ -131,7 +131,9 @@ MKEXE_BOOT=$(BYTECC) -o $(1) $(2)
### How to build a static library
MKLIB=rm -f $(1); $(TOOLPREF)ar rc $(1) $(2); $(RANLIB) $(1)
#ml let mklib out files opts = Printf.sprintf "rm -f %s && %sar rcs %s %s %s" out toolpref opts out files;;
#ml let mklib out files opts =
#ml Printf.sprintf "rm -f %s && %sar rcs %s %s %s"
#ml out toolpref opts out files;;
### Canonicalize the name of a system library
SYSLIB=-l$(1)

10
config/Makefile.msvc
View File

@ -121,12 +121,16 @@ MKEXE=$(FLEXLINK) -exe
MKMAINDLL=$(FLEXLINK) -maindll
### Native command to build ocamlrun.exe without flexlink
MERGEMANIFESTEXE=test ! -f $(1).manifest || mt -nologo -outputresource:$(1) -manifest $(1).manifest && rm -f $(1).manifest
MKEXE_BOOT=$(BYTECC) /Fe$(1) $(2) /link /subsystem:console && ($(MERGEMANIFESTEXE))
MERGEMANIFESTEXE=test ! -f $(1).manifest \
|| mt -nologo -outputresource:$(1) -manifest $(1).manifest \
&& rm -f $(1).manifest
MKEXE_BOOT=$(BYTECC) /Fe$(1) $(2) /link /subsystem:console \
&& ($(MERGEMANIFESTEXE))
### How to build a static library
MKLIB=link -lib -nologo -out:$(1) $(2)
#ml let mklib out files opts = Printf.sprintf "link -lib -nologo -out:%s %s %s" out opts files;;
#ml let mklib out files opts =
#ml Printf.sprintf "link -lib -nologo -out:%s %s %s" out opts files;;
MKSHAREDLIBRPATH=
### Canonicalize the name of a system library

11
config/Makefile.msvc64
View File

@ -125,12 +125,17 @@ MKEXE=$(FLEXLINK) -exe
MKMAINDLL=$(FLEXLINK) -maindll
### Native command to build ocamlrun.exe without flexlink
MERGEMANIFESTEXE=test ! -f $(1).manifest || mt -nologo -outputresource:$(1) -manifest $(1).manifest && rm -f $(1).manifest
MKEXE_BOOT=$(BYTECC) /Fe$(1) $(2) /link /subsystem:console && ($(MERGEMANIFESTEXE))
MERGEMANIFESTEXE=test ! -f $(1).manifest \
|| mt -nologo -outputresource:$(1) -manifest $(1).manifest \
&& rm -f $(1).manifest
MKEXE_BOOT=$(BYTECC) /Fe$(1) $(2) /link /subsystem:console \
&& ($(MERGEMANIFESTEXE))
### How to build a static library
MKLIB=link -lib -nologo -machine:AMD64 /out:$(1) $(2)
#ml let mklib out files opts = Printf.sprintf "link -lib -nologo -machine:AMD64 -out:%s %s %s" out opts files;;
#ml let mklib out files opts =
#ml Printf.sprintf "link -lib -nologo -machine:AMD64 -out:%s %s %s"
#ml out opts files;;
MKSHAREDLIBRPATH=
### Canonicalize the name of a system library

18
configure vendored
View File

@ -1074,7 +1074,8 @@ if $with_instrumented_runtime; then
fi
done
if ! $with_instrumented_runtime; then
err "clock_gettime functions not found. Instrumented runtime can't be built."
err "clock_gettime functions not found. " \
"Instrumented runtime can't be built."
fi
fi
@ -1362,7 +1363,10 @@ fi
nargs=none
for i in 5 6; do
if sh ./trycompile -DSYS_${system} -DNUM_ARGS=${i} gethostbyname.c; then nargs=$i; break; fi
if sh ./trycompile -DSYS_${system} -DNUM_ARGS=${i} gethostbyname.c; then
nargs=$i;
break;
fi
done
if test $nargs != "none"; then
inf "gethostbyname_r() found (with ${nargs} arguments)."
@ -1371,7 +1375,10 @@ fi
nargs=none
for i in 7 8; do
if sh ./trycompile -DSYS_${system} -DNUM_ARGS=${i} gethostbyaddr.c; then nargs=$i; break; fi
if sh ./trycompile -DSYS_${system} -DNUM_ARGS=${i} gethostbyaddr.c; then
nargs=$i;
break;
fi
done
if test $nargs != "none"; then
inf "gethostbyaddr_r() found (with ${nargs} arguments)."
@ -1712,7 +1719,6 @@ if test "$with_frame_pointers" = "true"; then
;;
*) err "Unsupported architecture with frame pointers";;
esac
fi
if $no_naked_pointers; then
@ -1751,8 +1757,8 @@ SYSLIB=-l\$(1)
### How to build a static library
MKLIB=${TOOLPREF}ar rc \$(1) \$(2); ${TOOLPREF}ranlib \$(1)
#ml let mklib out files opts =
#ml Printf.sprintf "${TOOLPREF}ar rc %s %s %s;
#ml ${TOOLPREF}ranlib %s" out opts files out;;
#ml Printf.sprintf "${TOOLPREF}ar rc %s %s %s; ${TOOLPREF}ranlib %s"
#ml out opts files out;;
EOF
echo "ARCH=$arch" >> Makefile
echo "MODEL=$model" >> Makefile

7
lex/Makefile.nt
View File

@ -17,7 +17,12 @@ CAMLRUN ?= ../boot/ocamlrun
CAMLYACC ?= ../boot/ocamlyacc
CAMLC=$(CAMLRUN) ../boot/ocamlc -I ../boot
CAMLOPT=$(if $(wildcard ../flexdll/Makefile),OCAML_FLEXLINK="../boot/ocamlrun ../flexdll/flexlink.exe") $(CAMLRUN) ../ocamlopt -I ../stdlib
ifeq "$(wildcard ../flexdll/Makefile)" ""
FLEXLINK_ENV=
else
FLEXLINK_ENV=OCAML_FLEXLINK="../boot/ocamlrun ../flexdll/flexlink.exe"
endif
CAMLOPT=$(FLEXLINK_ENV) $(CAMLRUN) ../ocamlopt -I ../stdlib
COMPFLAGS=-warn-error A
LINKFLAGS=
YACCFLAGS=-v

23
manual/LICENSE-for-the-manual
View File

@ -1,9 +1,20 @@
The present documentation is copyright Institut National de Recherche en Informatique et en Automatique (INRIA).
The present documentation is copyright Institut National de Recherche
en Informatique et en Automatique (INRIA).
The OCaml documentation and user's manual may be reproduced and distributed in whole or in part, subject to the following conditions:
The OCaml documentation and user's manual may be reproduced and
distributed in whole or in part, subject to the following conditions:
- The copyright notice above and this permission notice must be preserved complete on all complete or partial copies.
- Any translation or derivative work of the OCaml documentation and user's manual must be approved by the authors in writing before distribution.
- If you distribute the OCaml documentation and user's manual in part, instructions for obtaining the complete version of this manual must be included, and a means for obtaining a complete version provided.
- Small portions may be reproduced as illustrations for reviews or quotes in other works without this permission notice if proper citation is given.
- The copyright notice above and this permission notice must be
preserved complete on all complete or partial copies.
- Any translation or derivative work of the OCaml documentation and
user's manual must be approved by the authors in writing before
distribution.
- If you distribute the OCaml documentation and user's manual in part,
instructions for obtaining the complete version of this manual must
be included, and a means for obtaining a complete version provided.
- Small portions may be reproduced as illustrations for reviews or
quotes in other works without this permission notice if proper
citation is given.

8
ocamldoc/Makefile.nt
View File

@ -18,7 +18,13 @@ CAMLYACC ?= ../boot/ocamlyacc
##########################
ROOTDIR = ..
OCAMLC = $(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib
OCAMLOPT = $(if $(wildcard $(ROOTDIR)/flexdll/Makefile),OCAML_FLEXLINK="$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/flexdll/flexlink.exe") $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib
ifeq "$(wildcard $(ROOTDIR)/flexdll/Makefile)" ""
FLEXLINK_ENV=
else
FLEXLINK_ENV=OCAML_FLEXLINK="$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/flexdll/flexlink.exe"
endif
OCAMLOPT = $(FLEXLINK_ENV) $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib \
-I $(ROOTDIR)/stdlib
OCAMLDEP = $(CAMLRUN) $(ROOTDIR)/tools/ocamldep
OCAMLLEX = $(CAMLRUN) $(ROOTDIR)/boot/ocamllex
OCAMLLIB = $(LIBDIR)

20
ocamldoc/odoc_sig.ml
View File

@ -779,9 +779,23 @@ module Analyser =
pos_limit2
type_decl
in
print_DEBUG ("Type "^name.txt^" : "^(match assoc_com with None -> "sans commentaire" | Some c -> Odoc_misc.string_of_info c));
let f_DEBUG (name, c_opt) = print_DEBUG ("constructor/field "^name^": "^(match c_opt with None -> "sans commentaire" | Some c -> Odoc_misc.string_of_info c)) in
List.iter f_DEBUG name_comment_list;
(* DEBUG *) begin
(* DEBUG *) let comm =
(* DEBUG *) match assoc_com with
(* DEBUG *) | None -> "sans commentaire"
(* DEBUG *) | Some c -> Odoc_misc.string_of_info c
(* DEBUG *) in
(* DEBUG *) print_DEBUG ("Type "^name.txt^" : "^comm);
(* DEBUG *) let f_DEBUG (name, c_opt) =
(* DEBUG *) let comm =
(* DEBUG *) match c_opt with
(* DEBUG *) | None -> "sans commentaire"
(* DEBUG *) | Some c -> Odoc_misc.string_of_info c
(* DEBUG *) in
(* DEBUG *) print_DEBUG ("constructor/field "^name^": "^comm)
(* DEBUG *) in
(* DEBUG *) List.iter f_DEBUG name_comment_list;
(* DEBUG *) end
(* get the information for the type in the signature *)
let sig_type_decl =
try Signature_search.search_type table name.txt

8
otherlibs/Makefile.nt
View File

@ -15,9 +15,11 @@
include ../Makefile
export OCAML_FLEXLINK:=$(if $(wildcard $(ROOTDIR)/flexdll/Makefile),$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/flexdll/flexlink.exe)
# The Unix version now works fine under Windows
ifeq "$(wildcard $(ROOTDIR)/flexdll/Makefile" ""
export OCAML_FLEXLINK:=
else
export OCAML_FLEXLINK:=$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/flexdll/flexlink.exe
endif
# Note .. is the current directory (this makefile is included from
# a subdirectory)

2
otherlibs/num/Makefile
View File

@ -11,8 +11,6 @@
# #
#########################################################################
# $Id$
# Makefile for the "num" (exact rational arithmetic) library
LIBNAME=nums

2
otherlibs/num/Makefile.nt
View File

@ -11,8 +11,6 @@
# #
#########################################################################
# $Id$
# Makefile for the "num" (exact rational arithmetic) library
LIBNAME=nums

13
otherlibs/num/big_int.ml
View File

@ -438,9 +438,12 @@ let sys_big_int_of_string_base s ofs len sgn =
if len < 2 then sys_big_int_of_string_aux s ofs len sgn 10
else
match (s.[ofs], s.[ofs+1]) with
| ('0', 'x') | ('0', 'X') -> sys_big_int_of_string_aux s (ofs+2) (len-2) sgn 16
| ('0', 'o') | ('0', 'O') -> sys_big_int_of_string_aux s (ofs+2) (len-2) sgn 8
| ('0', 'b') | ('0', 'B') -> sys_big_int_of_string_aux s (ofs+2) (len-2) sgn 2
| ('0', 'x') | ('0', 'X') ->
sys_big_int_of_string_aux s (ofs+2) (len-2) sgn 16
| ('0', 'o') | ('0', 'O') ->
sys_big_int_of_string_aux s (ofs+2) (len-2) sgn 8
| ('0', 'b') | ('0', 'B') ->
sys_big_int_of_string_aux s (ofs+2) (len-2) sgn 2
| _ -> sys_big_int_of_string_aux s ofs len sgn 10
;;
@ -733,7 +736,8 @@ let two_power_m1_big_int n =
let shift_right_big_int bi n =
if n < 0 then invalid_arg "shift_right_big_int"
else if bi.sign >= 0 then shift_right_towards_zero_big_int bi n
else shift_right_towards_zero_big_int (sub_big_int bi (two_power_m1_big_int n)) n
else
shift_right_towards_zero_big_int (sub_big_int bi (two_power_m1_big_int n)) n
(* Extract N bits starting at ofs.
Treats bi in two's complement.
@ -875,4 +879,3 @@ let float_of_big_int x =
(* Round to float and apply exponent *)
ldexp (round_big_int_to_float top exact) n
end

2
otherlibs/num/bng.c
View File

@ -11,8 +11,6 @@
/* */
/***********************************************************************/
/* $Id$ */
#include "bng.h"
#include "caml/config.h"

2
otherlibs/num/bng.h
View File

@ -11,8 +11,6 @@
/* */
/***********************************************************************/
/* $Id$ */
#include <string.h>
#include "caml/config.h"

2
otherlibs/num/bng_amd64.c
View File

@ -11,8 +11,6 @@
/* */
/***********************************************************************/
/* $Id$ */
/* Code specific to the AMD x86_64 architecture. */
#define BngAdd2(res,carryout,arg1,arg2) \

2
otherlibs/num/bng_digit.c
View File

@ -11,8 +11,6 @@
/* */
/***********************************************************************/
/* $Id$ */
/**** Generic operations on digits ****/
/* These macros can be defined in the machine-specific include file.

2
otherlibs/num/bng_ia32.c
View File

@ -11,8 +11,6 @@
/* */
/***********************************************************************/
/* $Id$ */
/* Code specific to the Intel IA32 (x86) architecture. */
#define BngAdd2(res,carryout,arg1,arg2) \

2
otherlibs/num/bng_ppc.c
View File

@ -11,8 +11,6 @@
/* */
/***********************************************************************/
/* $Id$ */
/* Code specific to the PowerPC architecture. */
#define BngAdd2(res,carryout,arg1,arg2) \

2
otherlibs/num/bng_sparc.c
View File

@ -11,8 +11,6 @@
/* */
/***********************************************************************/
/* $Id$ */
/* Code specific to the SPARC (V8 and above) architecture. */
#define BngAdd2(res,carryout,arg1,arg2) \

2
otherlibs/num/nat.h
View File

@ -11,8 +11,6 @@
/* */
/***********************************************************************/
/* $Id$ */
/* Nats are represented as unstructured blocks with tag Custom_tag. */
#define Digit_val(nat,pos) (((bng) Data_custom_val(nat))[pos])

42
otherlibs/num/nat.ml
View File

@ -20,28 +20,44 @@ external set_to_zero_nat: nat -> int -> int -> unit = "set_to_zero_nat"
external blit_nat: nat -> int -> nat -> int -> int -> unit = "blit_nat"
external set_digit_nat: nat -> int -> int -> unit = "set_digit_nat"
external nth_digit_nat: nat -> int -> int = "nth_digit_nat"
external set_digit_nat_native: nat -> int -> nativeint -> unit = "set_digit_nat_native"
external set_digit_nat_native: nat -> int -> nativeint -> unit
= "set_digit_nat_native"
external nth_digit_nat_native: nat -> int -> nativeint = "nth_digit_nat_native"
external num_digits_nat: nat -> int -> int -> int = "num_digits_nat"
external num_leading_zero_bits_in_digit: nat -> int -> int = "num_leading_zero_bits_in_digit"
external num_leading_zero_bits_in_digit: nat -> int -> int
= "num_leading_zero_bits_in_digit"
external is_digit_int: nat -> int -> bool = "is_digit_int"
external is_digit_zero: nat -> int -> bool = "is_digit_zero"
external is_digit_normalized: nat -> int -> bool = "is_digit_normalized"
external is_digit_odd: nat -> int -> bool = "is_digit_odd"
external incr_nat: nat -> int -> int -> int -> int = "incr_nat"
external add_nat: nat -> int -> int -> nat -> int -> int -> int -> int = "add_nat" "add_nat_native"
external add_nat: nat -> int -> int -> nat -> int -> int -> int -> int
= "add_nat" "add_nat_native"
external complement_nat: nat -> int -> int -> unit = "complement_nat"
external decr_nat: nat -> int -> int -> int -> int = "decr_nat"
external sub_nat: nat -> int -> int -> nat -> int -> int -> int -> int = "sub_nat" "sub_nat_native"
external mult_digit_nat: nat -> int -> int -> nat -> int -> int -> nat -> int -> int = "mult_digit_nat" "mult_digit_nat_native"
external mult_nat: nat -> int -> int -> nat -> int -> int -> nat -> int -> int -> int = "mult_nat" "mult_nat_native"
external square_nat: nat -> int -> int -> nat -> int -> int -> int = "square_nat" "square_nat_native"
external shift_left_nat: nat -> int -> int -> nat -> int -> int -> unit = "shift_left_nat" "shift_left_nat_native"
external div_digit_nat: nat -> int -> nat -> int -> nat -> int -> int -> nat -> int -> unit = "div_digit_nat" "div_digit_nat_native"
external div_nat: nat -> int -> int -> nat -> int -> int -> unit = "div_nat" "div_nat_native"
external shift_right_nat: nat -> int -> int -> nat -> int -> int -> unit = "shift_right_nat" "shift_right_nat_native"
external compare_digits_nat: nat -> int -> nat -> int -> int = "compare_digits_nat"
external compare_nat: nat -> int -> int -> nat -> int -> int -> int = "compare_nat" "compare_nat_native"
external sub_nat: nat -> int -> int -> nat -> int -> int -> int -> int
= "sub_nat" "sub_nat_native"
external mult_digit_nat:
nat -> int -> int -> nat -> int -> int -> nat -> int -> int
= "mult_digit_nat" "mult_digit_nat_native"
external mult_nat:
nat -> int -> int -> nat -> int -> int -> nat -> int -> int -> int
= "mult_nat" "mult_nat_native"
external square_nat: nat -> int -> int -> nat -> int -> int -> int
= "square_nat" "square_nat_native"
external shift_left_nat: nat -> int -> int -> nat -> int -> int -> unit
= "shift_left_nat" "shift_left_nat_native"
external div_digit_nat:
nat -> int -> nat -> int -> nat -> int -> int -> nat -> int -> unit
= "div_digit_nat" "div_digit_nat_native"
external div_nat: nat -> int -> int -> nat -> int -> int -> unit
= "div_nat" "div_nat_native"
external shift_right_nat: nat -> int -> int -> nat -> int -> int -> unit
= "shift_right_nat" "shift_right_nat_native"
external compare_digits_nat: nat -> int -> nat -> int -> int
= "compare_digits_nat"
external compare_nat: nat -> int -> int -> nat -> int -> int -> int
= "compare_nat" "compare_nat_native"
external land_digit_nat: nat -> int -> nat -> int -> unit = "land_digit_nat"
external lor_digit_nat: nat -> int -> nat -> int -> unit = "lor_digit_nat"
external lxor_digit_nat: nat -> int -> nat -> int -> unit = "lxor_digit_nat"

42
otherlibs/num/nat.mli
View File

@ -25,11 +25,13 @@ external blit_nat: nat -> int -> nat -> int -> int -> unit = "blit_nat"
val copy_nat: nat -> int -> int -> nat
external set_digit_nat: nat -> int -> int -> unit = "set_digit_nat"
external nth_digit_nat: nat -> int -> int = "nth_digit_nat"
external set_digit_nat_native: nat -> int -> nativeint -> unit = "set_digit_nat_native"
external set_digit_nat_native: nat -> int -> nativeint -> unit
= "set_digit_nat_native"
external nth_digit_nat_native: nat -> int -> nativeint = "nth_digit_nat_native"
val length_nat : nat -> int
external num_digits_nat: nat -> int -> int -> int = "num_digits_nat"
external num_leading_zero_bits_in_digit: nat -> int -> int = "num_leading_zero_bits_in_digit"
external num_leading_zero_bits_in_digit: nat -> int -> int
= "num_leading_zero_bits_in_digit"
external is_digit_int: nat -> int -> bool = "is_digit_int"
external is_digit_zero: nat -> int -> bool = "is_digit_zero"
external is_digit_normalized: nat -> int -> bool = "is_digit_normalized"
@ -39,19 +41,33 @@ val is_nat_int: nat -> int -> int -> bool
val int_of_nat: nat -> int
val nat_of_int: int -> nat
external incr_nat: nat -> int -> int -> int -> int = "incr_nat"
external add_nat: nat -> int -> int -> nat -> int -> int -> int -> int = "add_nat" "add_nat_native"
external add_nat: nat -> int -> int -> nat -> int -> int -> int -> int
= "add_nat" "add_nat_native"
external complement_nat: nat -> int -> int -> unit = "complement_nat"
external decr_nat: nat -> int -> int -> int -> int = "decr_nat"
external sub_nat: nat -> int -> int -> nat -> int -> int -> int -> int = "sub_nat" "sub_nat_native"
external mult_digit_nat: nat -> int -> int -> nat -> int -> int -> nat -> int -> int = "mult_digit_nat" "mult_digit_nat_native"
external mult_nat: nat -> int -> int -> nat -> int -> int -> nat -> int -> int -> int = "mult_nat" "mult_nat_native"
external square_nat: nat -> int -> int -> nat -> int -> int -> int = "square_nat" "square_nat_native"
external shift_left_nat: nat -> int -> int -> nat -> int -> int -> unit = "shift_left_nat" "shift_left_nat_native"
external div_digit_nat: nat -> int -> nat -> int -> nat -> int -> int -> nat -> int -> unit = "div_digit_nat" "div_digit_nat_native"
external div_nat: nat -> int -> int -> nat -> int -> int -> unit = "div_nat" "div_nat_native"
external shift_right_nat: nat -> int -> int -> nat -> int -> int -> unit = "shift_right_nat" "shift_right_nat_native"
external compare_digits_nat: nat -> int -> nat -> int -> int = "compare_digits_nat"
external compare_nat: nat -> int -> int -> nat -> int -> int -> int = "compare_nat" "compare_nat_native"
external sub_nat: nat -> int -> int -> nat -> int -> int -> int -> int
= "sub_nat" "sub_nat_native"
external mult_digit_nat:
nat -> int -> int -> nat -> int -> int -> nat -> int -> int
= "mult_digit_nat" "mult_digit_nat_native"
external mult_nat:
nat -> int -> int -> nat -> int -> int -> nat -> int -> int -> int
= "mult_nat" "mult_nat_native"
external square_nat: nat -> int -> int -> nat -> int -> int -> int
= "square_nat" "square_nat_native"
external shift_left_nat: nat -> int -> int -> nat -> int -> int -> unit
= "shift_left_nat" "shift_left_nat_native"
external div_digit_nat:
nat -> int -> nat -> int -> nat -> int -> int -> nat -> int -> unit
= "div_digit_nat" "div_digit_nat_native"
external div_nat: nat -> int -> int -> nat -> int -> int -> unit
= "div_nat" "div_nat_native"
external shift_right_nat: nat -> int -> int -> nat -> int -> int -> unit
= "shift_right_nat" "shift_right_nat_native"
external compare_digits_nat: nat -> int -> nat -> int -> int
= "compare_digits_nat"
external compare_nat: nat -> int -> int -> nat -> int -> int -> int
= "compare_nat" "compare_nat_native"
val eq_nat : nat -> int -> int -> nat -> int -> int -> bool
val le_nat : nat -> int -> int -> nat -> int -> int -> bool
val lt_nat : nat -> int -> int -> nat -> int -> int -> bool

5
otherlibs/num/nat_stubs.c
View File

@ -11,8 +11,6 @@
/* */
/***********************************************************************/
/* $Id$ */
#include "caml/alloc.h"
#include "caml/config.h"
#include "caml/custom.h"
@ -123,7 +121,8 @@ CAMLprim value is_digit_zero(value nat, value ofs)
CAMLprim value is_digit_normalized(value nat, value ofs)
{
return
Val_bool(Digit_val(nat, Long_val(ofs)) & ((bngdigit)1 << (BNG_BITS_PER_DIGIT-1)));
Val_bool(Digit_val(nat, Long_val(ofs))
& ((bngdigit)1 << (BNG_BITS_PER_DIGIT-1)));
}
CAMLprim value is_digit_odd(value nat, value ofs)

6
otherlibs/systhreads/Makefile.nt
View File

@ -27,7 +27,11 @@ endif
MKLIB=$(CAMLRUN) ../../tools/ocamlmklib
CFLAGS=-I../../byterun $(EXTRACFLAGS)
export OCAML_FLEXLINK:=$(if $(wildcard ../../flexdll/Makefile),../../boot/ocamlrun ../../flexdll/flexlink.exe)
ifeq "$(wildcard ../../flexdll/Makefile)" ""
export OCAML_FLEXLINK:=
else
export OCAML_FLEXLINK:=../../boot/ocamlrun ../../flexdll/flexlink.exe
endif
CAMLOBJS=thread.cmo mutex.cmo condition.cmo event.cmo threadUnix.cmo
CMIFILES=$(CAMLOBJS:.cmo=.cmi)

1
otherlibs/unix/unixsupport.c
View File

@ -312,4 +312,3 @@ void caml_unix_check_path(value path, char * cmdname)
{
if (! caml_string_is_c_safe(path)) unix_error(ENOENT, cmdname, path);
}

1
otherlibs/unix/utimes.c
View File

@ -91,4 +91,3 @@ CAMLprim value unix_utimes(value path, value atime, value mtime)
{ invalid_argument("utimes not implemented"); }
#endif

6
parsing/builtin_attributes.ml
View File

@ -63,7 +63,8 @@ let check_deprecated loc attrs s =
match deprecated_of_attrs attrs with
| None -> ()
| Some "" -> Location.prerr_warning loc (Warnings.Deprecated s)
| Some txt -> Location.prerr_warning loc (Warnings.Deprecated (s ^ "\n" ^ txt))
| Some txt ->
Location.prerr_warning loc (Warnings.Deprecated (s ^ "\n" ^ txt))
let rec check_deprecated_mutable loc attrs s =
match attrs with
@ -173,7 +174,8 @@ let with_warning_attribute attrs f =
let warn_on_literal_pattern =
List.exists
(function
| ({txt="ocaml.warn_on_literal_pattern"|"warn_on_literal_pattern"; _}, _) -> true
| ({txt="ocaml.warn_on_literal_pattern"|"warn_on_literal_pattern"; _}, _)
-> true
| _ -> false
)

3
parsing/builtin_attributes.mli
View File

@ -28,7 +28,8 @@ val deprecated_of_attrs: Parsetree.attributes -> string option
val deprecated_of_sig: Parsetree.signature -> string option
val deprecated_of_str: Parsetree.structure -> string option
val check_deprecated_mutable: Location.t -> Parsetree.attributes -> string -> unit
val check_deprecated_mutable:
Location.t -> Parsetree.attributes -> string -> unit
val error_of_extension: Parsetree.extension -> Location.error

68
parsing/parser.mly
View File

@ -775,7 +775,8 @@ module_expr:
{ mkmod ~attrs:$3
(Pmod_unpack(
ghexp(Pexp_constraint($4, ghtyp(Ptyp_package $6))))) }
| LPAREN VAL attributes expr COLON package_type COLONGREATER package_type RPAREN
| LPAREN VAL attributes expr COLON package_type COLONGREATER package_type
RPAREN
{ mkmod ~attrs:$3
(Pmod_unpack(
ghexp(Pexp_coerce($4, Some(ghtyp(Ptyp_package $6)),
@ -864,7 +865,8 @@ module_binding:
;
rec_module_bindings:
rec_module_binding { let (b, ext) = $1 in ([b], ext) }
| rec_module_bindings and_module_binding { let (l, ext) = $1 in ($2 :: l, ext) }
| rec_module_bindings and_module_binding
{ let (l, ext) = $1 in ($2 :: l, ext) }
;
rec_module_binding:
MODULE ext_attributes REC UIDENT module_binding_body post_item_attributes
@ -989,8 +991,10 @@ module_alias:
, ext }
;
rec_module_declarations:
rec_module_declaration { let (body, ext) = $1 in ([body], ext) }
| rec_module_declarations and_module_declaration { let (l, ext) = $1 in ($2 :: l, ext) }
rec_module_declaration
{ let (body, ext) = $1 in ([body], ext) }
| rec_module_declarations and_module_declaration
{ let (l, ext) = $1 in ($2 :: l, ext) }
;
rec_module_declaration:
MODULE ext_attributes REC UIDENT COLON module_type post_item_attributes
@ -1009,7 +1013,8 @@ module_type_declaration_body:
| EQUAL module_type { Some $2 }
;
module_type_declaration:
MODULE TYPE ext_attributes ident module_type_declaration_body post_item_attributes
MODULE TYPE ext_attributes ident module_type_declaration_body
post_item_attributes
{ let (ext, attrs) = $3 in
Mtd.mk (mkrhs $4 4) ?typ:$5 ~attrs:(attrs@$6)
~loc:(symbol_rloc()) ~docs:(symbol_docs ())
@ -1018,12 +1023,14 @@ module_type_declaration:
/* Class expressions */
class_declarations:
class_declaration { let (body, ext) = $1 in ([body], ext) }
| class_declarations and_class_declaration { let (l, ext) = $1 in ($2 :: l, ext) }
class_declaration
{ let (body, ext) = $1 in ([body], ext) }
| class_declarations and_class_declaration
{ let (l, ext) = $1 in ($2 :: l, ext) }
;
class_declaration:
CLASS ext_attributes virtual_flag class_type_parameters LIDENT class_fun_binding
post_item_attributes
CLASS ext_attributes virtual_flag class_type_parameters LIDENT
class_fun_binding post_item_attributes
{ let (ext, attrs) = $2 in
Ci.mk (mkrhs $5 5) $6 ~virt:$3 ~params:$4 ~attrs:(attrs@$7)
~loc:(symbol_rloc ()) ~docs:(symbol_docs ())
@ -1105,7 +1112,8 @@ class_fields:
{ $2 :: (text_cstr 2) @ $1 }
;
class_field:
| INHERIT override_flag attributes class_expr parent_binder post_item_attributes
| INHERIT override_flag attributes class_expr parent_binder
post_item_attributes
{ mkcf (Pcf_inherit ($2, $4, $5)) ~attrs:($3@$6) ~docs:(symbol_docs ()) }
| VAL attributes value post_item_attributes
{ mkcf (Pcf_val $3) ~attrs:($2@$4) ~docs:(symbol_docs ()) }
@ -1240,12 +1248,14 @@ constrain_field:
core_type EQUAL core_type { $1, $3 }
;
class_descriptions:
class_description { let (body, ext) = $1 in ([body],ext) }
| class_descriptions and_class_description { let (l, ext) = $1 in ($2 :: l, ext) }
class_description
{ let (body, ext) = $1 in ([body],ext) }
| class_descriptions and_class_description
{ let (l, ext) = $1 in ($2 :: l, ext) }
;
class_description:
CLASS ext_attributes virtual_flag class_type_parameters LIDENT COLON class_type
post_item_attributes
CLASS ext_attributes virtual_flag class_type_parameters LIDENT COLON
class_type post_item_attributes
{ let (ext, attrs) = $2 in
Ci.mk (mkrhs $5 5) $7 ~virt:$3 ~params:$4 ~attrs:$8
~loc:(symbol_rloc ()) ~docs:(symbol_docs ())
@ -1259,8 +1269,10 @@ and_class_description:
~text:(symbol_text ()) ~docs:(symbol_docs ()) }
;
class_type_declarations:
class_type_declaration { let (body, ext) = $1 in ([body],ext) }
| class_type_declarations and_class_type_declaration { let (l, ext) = $1 in ($2 :: l, ext) }
class_type_declaration
{ let (body, ext) = $1 in ([body],ext) }
| class_type_declarations and_class_type_declaration
{ let (l, ext) = $1 in ($2 :: l, ext) }
;
class_type_declaration:
CLASS TYPE ext_attributes virtual_flag class_type_parameters LIDENT EQUAL
@ -1547,7 +1559,8 @@ simple_expr:
$3 }
| LPAREN MODULE ext_attributes module_expr COLON error
{ unclosed "(" 1 ")" 6 }
| mod_longident DOT LPAREN MODULE ext_attributes module_expr COLON package_type RPAREN
| mod_longident DOT LPAREN MODULE ext_attributes module_expr COLON
package_type RPAREN
{ mkexp(Pexp_open(Fresh, mkrhs $1 1,
mkexp_attrs (Pexp_constraint (ghexp (Pexp_pack $6),
ghtyp (Ptyp_package $8)))
@ -1641,8 +1654,10 @@ match_case:
{ Exp.case $1 (Exp.unreachable ~loc:(rhs_loc 3) ())}
;
fun_def:
MINUSGREATER seq_expr { $2 }
| COLON simple_core_type MINUSGREATER seq_expr { mkexp (Pexp_constraint ($4, $2)) }
MINUSGREATER seq_expr
{ $2 }
| COLON simple_core_type MINUSGREATER seq_expr
{ mkexp (Pexp_constraint ($4, $2)) }
/* Cf #5939: we used to accept (fun p when e0 -> e) */
| labeled_simple_pattern fun_def
{
@ -1830,8 +1845,8 @@ primitive_declaration_body:
| STRING primitive_declaration_body { fst $1 :: $2 }
;
primitive_declaration:
EXTERNAL ext_attributes val_ident COLON core_type EQUAL primitive_declaration_body
post_item_attributes
EXTERNAL ext_attributes val_ident COLON core_type EQUAL
primitive_declaration_body post_item_attributes
{ let (ext, attrs) = $2 in
Val.mk (mkrhs $3 3) $5 ~prim:$7 ~attrs:(attrs@$8)
~loc:(symbol_rloc ()) ~docs:(symbol_docs ())
@ -1848,8 +1863,8 @@ type_declarations:
;
type_declaration:
TYPE ext_attributes nonrec_flag optional_type_parameters LIDENT type_kind constraints
post_item_attributes
TYPE ext_attributes nonrec_flag optional_type_parameters LIDENT
type_kind constraints post_item_attributes
{ let (kind, priv, manifest) = $6 in
let (ext, attrs) = $2 in
let ty =
@ -1962,8 +1977,8 @@ str_exception_declaration:
, ext }
;
sig_exception_declaration:
| EXCEPTION ext_attributes constr_ident generalized_constructor_arguments attributes
post_item_attributes
| EXCEPTION ext_attributes constr_ident generalized_constructor_arguments
attributes post_item_attributes
{ let args, res = $4 in
let (ext,attrs) = $2 in
Te.decl (mkrhs $3 3) ~args ?res ~attrs:($5 @ $6)
@ -2363,7 +2378,8 @@ class_longident:
toplevel_directive:
SHARP ident { Ptop_dir($2, Pdir_none) }
| SHARP ident STRING { Ptop_dir($2, Pdir_string (fst $3)) }
| SHARP ident INT { let (n, m) = $3 in Ptop_dir($2, Pdir_int (n ,m)) }
| SHARP ident INT { let (n, m) = $3 in
Ptop_dir($2, Pdir_int (n ,m)) }
| SHARP ident val_longident { Ptop_dir($2, Pdir_ident $3) }
| SHARP ident mod_longident { Ptop_dir($2, Pdir_ident $3) }
| SHARP ident FALSE { Ptop_dir($2, Pdir_bool false) }

6
parsing/pprintast.ml
View File

@ -172,9 +172,11 @@ class printer ()= object(self:'self)
| Pconst_string (i, None) -> pp f "%S" i
| Pconst_string (i, Some delim) -> pp f "{%s|%s|%s}" delim i delim
| Pconst_integer (i,None) -> self#paren (i.[0]='-') (fun f -> pp f "%s") f i
| Pconst_integer (i,Some m) -> self#paren (i.[0]='-') (fun f (i,m) -> pp f "%s%c" i m) f (i,m)
| Pconst_integer (i,Some m) ->
self#paren (i.[0]='-') (fun f (i,m) -> pp f "%s%c" i m) f (i,m)
| Pconst_float (i,None) -> self#paren (i.[0]='-') (fun f -> pp f "%s") f i
| Pconst_float (i, Some m) -> self#paren (i.[0]='-') (fun f (i,m) -> pp f "%s%c" i m) f (i,m)
| Pconst_float (i, Some m) -> self#paren (i.[0]='-') (fun f (i,m) ->
pp f "%s%c" i m) f (i,m)
(* trailing space*)
method mutable_flag f = function

7
stdlib/array.ml
View File

@ -78,7 +78,8 @@ let iter f a =
for i = 0 to length a - 1 do f(unsafe_get a i) done
let iter2 f a b =
if length a <> length b then invalid_arg "Array.iter2: arrays must have the same length"
if length a <> length b then
invalid_arg "Array.iter2: arrays must have the same length"
else
for i = 0 to length a - 1 do f (unsafe_get a i) (unsafe_get b i) done
@ -95,7 +96,9 @@ let map f a =
let map2 f a b =
let la = length a in
let lb = length b in
if la <> lb then invalid_arg "Array.map2: arrays must have the same length" else begin
if la <> lb then
invalid_arg "Array.map2: arrays must have the same length"
else begin
if la = 0 then [||] else begin
let r = create la (f (unsafe_get a 0) (unsafe_get b 0)) in
for i = 1 to la - 1 do

1
stdlib/scanf.mli
View File

@ -555,4 +555,3 @@ val kfscanf :
('a, 'b, 'c, 'd) scanner
[@@ocaml.deprecated "Use Scanning.from_channel then Scanf.kscanf."]
(** @deprecated [Scanf.kfscanf] is error prone and deprecated since 4.03.0. *)

5
stdlib/stream.ml
View File

@ -119,7 +119,10 @@ let rec nget_data n s =
;;
let npeek_data n s =
let (al, d, len) = nget_data n s in s.count <- (s.count - len); s.data <- d; al
let (al, d, len) = nget_data n s in
s.count <- (s.count - len);
s.data <- d;
al
;;
let npeek n = function

11
testsuite/Makefile
View File

@ -23,7 +23,8 @@ default:
@echo " all launch all tests"
@echo " all-foo launch all tests beginning with foo"
@echo " parallel launch all tests using GNU parallel"
@echo " parallel-foo launch all tests beginning with foo using GNU parallel"
@echo " parallel-foo launch all tests beginning with foo using \
GNU parallel"
@echo " list FILE=f launch the tests listed in f (one per line)"
@echo " one DIR=p launch the tests located in path p"
@echo " promote DIR=p promote the reference files for the tests in p"
@ -31,8 +32,9 @@ default:
@echo " clean delete generated files"
@echo " report print the report for the last execution"
@echo
@echo "all*, parallel* and list can automatically re-run failed test directories if"
@echo "MAX_TESTSUITE_DIR_RETRIES permits (default value = $(MAX_TESTSUITE_DIR_RETRIES))"
@echo "all*, parallel* and list can automatically re-run failed test"
@echo "directories if MAX_TESTSUITE_DIR_RETRIES permits"
@echo "(default value = $(MAX_TESTSUITE_DIR_RETRIES))"
.PHONY: all
all: lib
@ -183,7 +185,8 @@ retry-list:
@$(MAKE) $(NO_PRINT) retries
retries:
@awk -v retries=1 -v max_retries=$(MAX_TESTSUITE_DIR_RETRIES) -f makefiles/summarize.awk <_log >_retries
@awk -v retries=1 -v max_retries=$(MAX_TESTSUITE_DIR_RETRIES) \
-f makefiles/summarize.awk <_log >_retries
@test `cat _retries | wc -l` -eq 0 || $(MAKE) $(NO_PRINT) retry-list
@rm -f _retries

27
testsuite/makefiles/Makefile.common
View File

@ -43,10 +43,12 @@ include $(TOPDIR)/config/Makefile
ifneq ($(USE_RUNTIME),)
#Check USE_RUNTIME value
ifeq ($(findstring $(USE_RUNTIME),d i),)
$(error If set, USE_RUNTIME must be equal to "d" (debug runtime) or "i" (instrumented runtime))
$(error If set, USE_RUNTIME must be equal to "d" (debug runtime) \
or "i" (instrumented runtime))
endif
RUNTIME_VARIANT=-I $(OTOPDIR)/asmrun -I $(OTOPDIR)/byterun -runtime-variant $(USE_RUNTIME)
RUNTIME_VARIANT=-I $(OTOPDIR)/asmrun -I $(OTOPDIR)/byterun \
-runtime-variant $(USE_RUNTIME)
export OCAMLRUNPARAM?=v=0
endif
@ -63,9 +65,20 @@ endif
OCAML=$(OCAMLRUN) $(OTOPDIR)/ocaml $(OCFLAGS) \
-init $(OTOPDIR)/testsuite/lib/empty
FLEXLINK_PREFIX=$(if $(FLEXLINK),$(if $(wildcard $(TOPDIR)/flexdll/Makefile),OCAML_FLEXLINK="$(WINTOPDIR)/boot/ocamlrun $(WINTOPDIR)/flexdll/flexlink.exe" ))
OCAMLC=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlc $(CUSTOM) $(OCFLAGS) $(RUNTIME_VARIANT)
OCAMLOPT=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlopt $(OCFLAGS) $(RUNTIME_VARIANT)
ifeq "$(FLEXLINK)" ""
FLEXLINK_PREFIX=
else
ifeq "$(wildcard $(TOPDIR)/flexdll/Makefile)" ""
FLEXLINK_PREFIX=
else
FLEXLINK_PREFIX=OCAML_FLEXLINK="$(WINTOPDIR)/boot/ocamlrun \
$(WINTOPDIR)/flexdll/flexlink.exe"
endif
endif
OCAMLC=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlc $(CUSTOM) $(OCFLAGS) \
$(RUNTIME_VARIANT)
OCAMLOPT=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlopt $(OCFLAGS) \
$(RUNTIME_VARIANT)
OCAMLDOC=$(OCAMLRUN) $(OTOPDIR)/ocamldoc/ocamldoc
OCAMLLEX=$(OCAMLRUN) $(OTOPDIR)/lex/ocamllex
OCAMLMKLIB=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/tools/ocamlmklib \
@ -130,7 +143,9 @@ defaultclean:
@$(ASM) -o $*.o $*.s
.cmm.obj:
@$(OCAMLRUN) ./codegen $*.cmm | grep -v "_caml_\(young_ptr\|young_limit\|extra_params\|allocN\|raise_exn\|reraise_exn\)" > $*.s
@$(OCAMLRUN) ./codegen $*.cmm \
| grep -v "_caml_\(young_ptr\|young_limit\|extra_params\
\|allocN\|raise_exn\|reraise_exn\)" > $*.s
@set -o pipefail ; \
$(ASM) $*.obj $*.s | tail -n +2

9
testsuite/tests/asmcomp/parsecmm.mly
View File

@ -210,11 +210,14 @@ expr:
| LPAREN FLOATAREF expr expr RPAREN
{ Cop(Cload Double_u, [access_array $3 $4 Arch.size_float]) }
| LPAREN ADDRASET expr expr expr RPAREN
{ Cop(Cstore (Word_val, Assignment), [access_array $3 $4 Arch.size_addr; $5]) }
{ Cop(Cstore (Word_val, Assignment),
[access_array $3 $4 Arch.size_addr; $5]) }
| LPAREN INTASET expr expr expr RPAREN
{ Cop(Cstore (Word_int, Assignment), [access_array $3 $4 Arch.size_int; $5]) }
{ Cop(Cstore (Word_int, Assignment),
[access_array $3 $4 Arch.size_int; $5]) }
| LPAREN FLOATASET expr expr expr RPAREN
{ Cop(Cstore (Double_u, Assignment), [access_array $3 $4 Arch.size_float; $5]) }
{ Cop(Cstore (Double_u, Assignment),
[access_array $3 $4 Arch.size_float; $5]) }
;
exprlist:
exprlist expr { $2 :: $1 }

6
testsuite/tests/backtrace/Makefile
View File

@ -54,10 +54,12 @@ byte:
skip:
@for file in $(ABCDFILES); do \
for arg in a b c d ''; do \
echo " ... testing '$$file' with ocamlopt and argument '$$arg': => skipped"; \
echo " ... testing '$$file' with ocamlopt and argument '$$arg': \
=> skipped"; \
done; \
done
@for file in $(OTHERFILES) $(OTHERFILESNOINLINING) $(OTHERFILESNOINLINING_NATIVE); do \
@for file in $(OTHERFILES) $(OTHERFILESNOINLINING) \
$(OTHERFILESNOINLINING_NATIVE); do \
echo " ... testing '$$file' with ocamlopt: => skipped"; \
done

12
testsuite/tests/basic-more/if_in_if.ml
View File

@ -4,28 +4,32 @@ let sequor b1 b2 =
let b2 = ref b2 in
let b1 = !b1 in
let b2 = !b2 in
if (if b1 then true else b2 && if b1 then true else b2) then "true" else "false"
if (if b1 then true else b2 && if b1 then true else b2)
then "true" else "false"
let sequand b1 b2 =
let b1 = ref b1 in
let b2 = ref b2 in
let b1 = !b1 in
let b2 = !b2 in
if (if b1 then b2 else false && if b1 then b2 else false) then "true" else "false"
if (if b1 then b2 else false && if b1 then b2 else false)
then "true" else "false"
let sequor' b1 b2 =
let b1 = ref b1 in
let b2 = ref b2 in
let b1 = !b1 in
let b2 = !b2 in
if (if b1 then true else b2 || if b1 then true else b2) then "true" else "false"
if (if b1 then true else b2 || if b1 then true else b2)
then "true" else "false"
let sequand' b1 b2 =
let b1 = ref b1 in
let b2 = ref b2 in
let b1 = !b1 in
let b2 = !b2 in
if (if b1 then b2 else false || if b1 then b2 else false) then "true" else "false"
if (if b1 then b2 else false || if b1 then b2 else false)
then "true" else "false"
let test b1 b2 =
assert(sequor b1 b2 = if b1 || b2 then "true" else "false");

3
testsuite/tests/basic-more/sequential_and_or.ml
View File

@ -116,7 +116,8 @@ let () =
(* test generation *)
(*
let values = ["true"; "false"; "true_effect ()"; "false_effect ()"; "unknown_true"; "unknown_false"]
let values = ["true"; "false"; "true_effect ()"; "false_effect ()";
"unknown_true"; "unknown_false"]
let ops = ["||"; "&&"]
let count = ref 0
let f op v1 v2 =

1
testsuite/tests/basic/float_physical_equality.ml
View File

@ -8,4 +8,3 @@ let f () =
let a = -0. in
let b = +0. in
assert(not (a == b))

12
testsuite/tests/extension-constructor/test.ml
View File

@ -21,9 +21,13 @@ type t += C
type t += D of int * string
let () =
assert (Obj.extension_constructor M.A == [%extension_constructor M.A]);
assert (Obj.extension_constructor (M.B 42) == [%extension_constructor M.B]);
assert (Obj.extension_constructor C == [%extension_constructor C ]);
assert (Obj.extension_constructor (D (42, "")) == [%extension_constructor D ])
assert (Obj.extension_constructor M.A
== [%extension_constructor M.A]);
assert (Obj.extension_constructor (M.B 42)
== [%extension_constructor M.B]);
assert (Obj.extension_constructor C
== [%extension_constructor C]);
assert (Obj.extension_constructor (D (42, ""))
== [%extension_constructor D])
let () = print_endline "OK"

5
testsuite/tests/lib-stack/test.ml
View File

@ -13,7 +13,10 @@
module S = struct
include Stack
let to_list s = let l = ref [] in iter (fun x -> l := x :: !l) s; !l (* from bottom to top *)
let to_list s = (* from bottom to top *)
let l = ref [] in
iter (fun x -> l := x :: !l) s;
!l
end
let does_raise f s =

8
testsuite/tests/lib-str/t01.ml
View File

@ -389,11 +389,11 @@ let automated_test() =
test_search_forward r n "ething"
[||];
start_test "Search for /^ÿ/";
let r = Str.regexp "^ÿ" in
start_test "Search for /^\255/";
let r = Str.regexp "^\255" in
let n = 0 in
test_search_forward r n "ÿ"
[|"ÿ"|];
test_search_forward r n "\255"
[|"\255"|];
start_test "Search for /^[0-9]+$/";
let r = Str.regexp "^[0-9]+$" in

1
testsuite/tests/lib-threads/pr5325.ml
View File

@ -67,4 +67,3 @@ let _ =
Thread.delay 0.5;
writer client "Client data\n";
Thread.join rd

3
testsuite/tests/lib-threads/sockets.ml
View File

@ -47,6 +47,3 @@ let _ =
ignore (Thread.create client (addr, "Client #1\n"));
Thread.delay 0.5;
client (addr, "Client #2\n")

3
testsuite/tests/lib-threads/socketsbuf.ml
View File

@ -49,6 +49,3 @@ let _ =
ignore (Thread.create client (addr, "Client #1\n"));
Thread.delay 0.5;
client (addr, "Client #2\n")

1
testsuite/tests/lib-threads/torture.ml
View File

@ -54,4 +54,3 @@ let _ =
finished := true;
List.iter Thread.join [t1; t2; t3; t4; t5];
print_string "passed\n"

6
testsuite/tests/parsing/int_and_float_with_modifier.ml
View File

@ -1,5 +1,7 @@
let int_with_custom_modifier = 1234567890_1234567890_1234567890_1234567890_1234567890z
let float_with_custom_modifier = 1234567890_1234567890_1234567890_1234567890_1234567890.z
let int_with_custom_modifier =
1234567890_1234567890_1234567890_1234567890_1234567890z
let float_with_custom_modifier =
1234567890_1234567890_1234567890_1234567890_1234567890.z
let int32 = 1234l
let int64 = 1234L

70
testsuite/tests/parsing/int_and_float_with_modifier.ml.reference
View File

@ -1,86 +1,86 @@
[
structure_item (int_and_float_with_modifier.ml[1,0+0]..[1,0+88])
structure_item (int_and_float_with_modifier.ml[1,0+0]..[2,31+57])
Pstr_value Nonrec
[
<def>
pattern (int_and_float_with_modifier.ml[1,0+4]..[1,0+28])
Ppat_var "int_with_custom_modifier" (int_and_float_with_modifier.ml[1,0+4]..[1,0+28])
expression (int_and_float_with_modifier.ml[1,0+33]..[1,0+88])
expression (int_and_float_with_modifier.ml[2,31+2]..[2,31+57])
Pexp_constant PConst_int (1234567890_1234567890_1234567890_1234567890_1234567890,Some z)
]
structure_item (int_and_float_with_modifier.ml[2,89+0]..[2,89+89])
structure_item (int_and_float_with_modifier.ml[3,89+0]..[4,122+58])
Pstr_value Nonrec
[
<def>
pattern (int_and_float_with_modifier.ml[2,89+4]..[2,89+30])
Ppat_var "float_with_custom_modifier" (int_and_float_with_modifier.ml[2,89+4]..[2,89+30])
expression (int_and_float_with_modifier.ml[2,89+33]..[2,89+89])
pattern (int_and_float_with_modifier.ml[3,89+4]..[3,89+30])
Ppat_var "float_with_custom_modifier" (int_and_float_with_modifier.ml[3,89+4]..[3,89+30])
expression (int_and_float_with_modifier.ml[4,122+2]..[4,122+58])
Pexp_constant PConst_float (1234567890_1234567890_1234567890_1234567890_1234567890.,Some z)
]
structure_item (int_and_float_with_modifier.ml[4,180+0]..[4,180+21])
structure_item (int_and_float_with_modifier.ml[6,182+0]..[6,182+21])
Pstr_value Nonrec
[
<def>
pattern (int_and_float_with_modifier.ml[4,180+4]..[4,180+9])
Ppat_var "int32" (int_and_float_with_modifier.ml[4,180+4]..[4,180+9])
expression (int_and_float_with_modifier.ml[4,180+16]..[4,180+21])
pattern (int_and_float_with_modifier.ml[6,182+4]..[6,182+9])
Ppat_var "int32" (int_and_float_with_modifier.ml[6,182+4]..[6,182+9])
expression (int_and_float_with_modifier.ml[6,182+16]..[6,182+21])
Pexp_constant PConst_int (1234,Some l)
]
structure_item (int_and_float_with_modifier.ml[5,202+0]..[5,202+21])
structure_item (int_and_float_with_modifier.ml[7,204+0]..[7,204+21])
Pstr_value Nonrec
[
<def>
pattern (int_and_float_with_modifier.ml[5,202+4]..[5,202+9])
Ppat_var "int64" (int_and_float_with_modifier.ml[5,202+4]..[5,202+9])
expression (int_and_float_with_modifier.ml[5,202+16]..[5,202+21])
pattern (int_and_float_with_modifier.ml[7,204+4]..[7,204+9])
Ppat_var "int64" (int_and_float_with_modifier.ml[7,204+4]..[7,204+9])
expression (int_and_float_with_modifier.ml[7,204+16]..[7,204+21])
Pexp_constant PConst_int (1234,Some L)
]
structure_item (int_and_float_with_modifier.ml[6,224+0]..[6,224+21])
structure_item (int_and_float_with_modifier.ml[8,226+0]..[8,226+21])
Pstr_value Nonrec
[
<def>
pattern (int_and_float_with_modifier.ml[6,224+4]..[6,224+13])
Ppat_var "nativeint" (int_and_float_with_modifier.ml[6,224+4]..[6,224+13])
expression (int_and_float_with_modifier.ml[6,224+16]..[6,224+21])
pattern (int_and_float_with_modifier.ml[8,226+4]..[8,226+13])
Ppat_var "nativeint" (int_and_float_with_modifier.ml[8,226+4]..[8,226+13])
expression (int_and_float_with_modifier.ml[8,226+16]..[8,226+21])
Pexp_constant PConst_int (1234,Some n)
]
structure_item (int_and_float_with_modifier.ml[8,247+0]..[8,247+32])
structure_item (int_and_float_with_modifier.ml[10,249+0]..[10,249+32])
Pstr_value Nonrec
[
<def>
pattern (int_and_float_with_modifier.ml[8,247+4]..[8,247+24])
Ppat_var "hex_without_modifier" (int_and_float_with_modifier.ml[8,247+4]..[8,247+24])
expression (int_and_float_with_modifier.ml[8,247+27]..[8,247+32])
pattern (int_and_float_with_modifier.ml[10,249+4]..[10,249+24])
Ppat_var "hex_without_modifier" (int_and_float_with_modifier.ml[10,249+4]..[10,249+24])
expression (int_and_float_with_modifier.ml[10,249+27]..[10,249+32])
Pexp_constant PConst_int (0x32f,None)
]
structure_item (int_and_float_with_modifier.ml[9,280+0]..[9,280+32])
structure_item (int_and_float_with_modifier.ml[11,282+0]..[11,282+32])
Pstr_value Nonrec
[
<def>
pattern (int_and_float_with_modifier.ml[9,280+4]..[9,280+21])
Ppat_var "hex_with_modifier" (int_and_float_with_modifier.ml[9,280+4]..[9,280+21])
expression (int_and_float_with_modifier.ml[9,280+27]..[9,280+32])
pattern (int_and_float_with_modifier.ml[11,282+4]..[11,282+21])
Ppat_var "hex_with_modifier" (int_and_float_with_modifier.ml[11,282+4]..[11,282+21])
expression (int_and_float_with_modifier.ml[11,282+27]..[11,282+32])
Pexp_constant PConst_int (0x32,Some g)
]
structure_item (int_and_float_with_modifier.ml[11,314+0]..[11,314+33])
structure_item (int_and_float_with_modifier.ml[13,316+0]..[13,316+33])
Pstr_value Nonrec
[
<def>
pattern (int_and_float_with_modifier.ml[11,314+4]..[11,314+25])
Ppat_var "float_without_modifer" (int_and_float_with_modifier.ml[11,314+4]..[11,314+25])
expression (int_and_float_with_modifier.ml[11,314+28]..[11,314+33])
pattern (int_and_float_with_modifier.ml[13,316+4]..[13,316+25])
Ppat_var "float_without_modifer" (int_and_float_with_modifier.ml[13,316+4]..[13,316+25])
expression (int_and_float_with_modifier.ml[13,316+28]..[13,316+33])
Pexp_constant PConst_float (1.2e3,None)
]
structure_item (int_and_float_with_modifier.ml[12,348+0]..[12,348+32])
structure_item (int_and_float_with_modifier.ml[14,350+0]..[14,350+32])
Pstr_value Nonrec
[
<def>
pattern (int_and_float_with_modifier.ml[12,348+4]..[12,348+22])
Ppat_var "float_with_modifer" (int_and_float_with_modifier.ml[12,348+4]..[12,348+22])
expression (int_and_float_with_modifier.ml[12,348+28]..[12,348+32])
pattern (int_and_float_with_modifier.ml[14,350+4]..[14,350+22])
Ppat_var "float_with_modifer" (int_and_float_with_modifier.ml[14,350+4]..[14,350+22])
expression (int_and_float_with_modifier.ml[14,350+28]..[14,350+32])
Pexp_constant PConst_float (1.2,Some g)
]
]
File "int_and_float_with_modifier.ml", line 1, characters 33-88:
File "int_and_float_with_modifier.ml", line 2, characters 2-57:
Error: Unknown modifier 'z' for literal 1234567890_1234567890_1234567890_1234567890_1234567890z

1
testsuite/tests/regression/pr7042/pr7042.ml
View File

@ -14,4 +14,3 @@ let _ =
let a = [| 0.0; -. 0.0 |] in
Printf.printf "%Lx %Lx\n"
(Int64.bits_of_float a.(0)) (Int64.bits_of_float a.(1))

4
testsuite/tests/runtime-errors/Makefile
View File

@ -52,7 +52,9 @@ run:
echo " => unexpected error"; \
fi; \
fn=`basename $$f bytecode`native; \
if $(BYTECODE_ONLY) || [ ! -f "$${fn}$(EXE)" ] ; then echo " ... testing '$$fn': => skipped" ; else \
if $(BYTECODE_ONLY) || [ ! -f "$${fn}$(EXE)" ] ; then \
echo " ... testing '$$fn': => skipped" ; \
else \
printf " ... testing '$$fn':"; \
if [ $$ul -eq 1 ] ; then \
./$${fn}$(EXE) >$$fn.result 2>&1 || true; \

4
testsuite/tests/translprim/ref_spec.ml
View File

@ -49,4 +49,6 @@ let set_open_poly (r:[< `Bar | `Foo | `Baz > `Foo `Bar] ref) y = r := y ;;
let set_open_poly (r:[>`Foo of int] ref) y = r := y ;;
let set_open_poly (r:[<`Foo of int] ref) y = r := y ;;
let set_open_poly (r:[`Foo of int] ref) y = r := y ;;
let set_open_poly (r:[< `Bar | `Foo of float | `Baz > `Foo `Bar] ref) y = r := y ;;
let set_open_poly (r:[< `Bar | `Foo of float | `Baz > `Foo `Bar] ref) y =
r := y
;;

1
testsuite/tests/typing-gadts/pr5332.ml
View File

@ -15,4 +15,3 @@ let f : type env a. (env, a) typ -> (env, a) typ -> int = fun ta tb ->
| _ -> . (* error *)
;;
(* let x = f Tint (Tvar Zero) ;; *)

1
testsuite/tests/typing-misc/printing.ml
View File

@ -5,4 +5,3 @@ type t = [ 'A_name | `Hi ];;
let f (x:'id_arg) = x;;
let f (x:'Id_arg) = x;;

3
testsuite/tests/typing-warnings/ambiguous_guarded_disjunction.ml
View File

@ -108,7 +108,8 @@ let ambiguous__in_depth = function
let not_ambiguous__several_orpats = function
| `A ((`B (x, Some _, _) | `B (x, _, Some _)),
(`C (y, Some _, _) | `C (y, _, Some _)),
(`D1 (_, z, Some _, _) | `D2 (_, z, _, Some _))) when x < y && x < z -> ()
(`D1 (_, z, Some _, _) | `D2 (_, z, _, Some _))) when x < y && x < z ->
()
| _ -> ()
;;

3
testsuite/tests/unwind/Makefile
View File

@ -15,7 +15,8 @@ unwind_test:
@$(OCAMLOPT) -c driver.ml
@$(OCAMLOPT) -c mylib.ml
@$(OCAMLOPT) -c stack_walker.c
@$(OCAMLOPT) -cclib -Wl,-keep_dwarf_unwind -o unwind_test mylib.cmx driver.cmx stack_walker.o
@$(OCAMLOPT) -cclib -Wl,-keep_dwarf_unwind -o unwind_test mylib.cmx \
driver.cmx stack_walker.o
clean:
@rm -f *.cm* *.o unwind_test

4
testsuite/tests/unwind/mylib.ml
View File

@ -4,7 +4,9 @@ let foo1 f x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 =
let foo2 f x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 =
f x1 x2 x3 x4 x5 x6 x7 x8 x9 x10
external func_with_10_params: int -> int -> int -> int -> int -> int -> int -> int -> int -> int -> unit = "ml_func_with_10_params_bytecode" "ml_func_with_10_params_native"
external func_with_10_params:
int -> int -> int -> int -> int -> int -> int -> int -> int -> int -> unit
= "ml_func_with_10_params_bytecode" "ml_func_with_10_params_native"
let bar x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 =
func_with_10_params x1 x2 x3 x4 x5 x6 x7 x8 x9 x10;

12
testsuite/tests/unwind/mylib.mli
View File

@ -1,6 +1,10 @@
val foo1: ('a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> unit) -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> unit
val foo1: ('a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> unit)
-> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> unit
val foo2: ('a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> unit) -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> unit
val foo2: ('a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> unit)
-> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> unit
val bar: int -> int -> int -> int -> int -> int -> int -> int -> int -> int -> unit
val baz: int -> int -> int -> int -> int -> int -> int -> int -> int -> int -> unit
val bar:
int -> int -> int -> int -> int -> int -> int -> int -> int -> int -> unit
val baz:
int -> int -> int -> int -> int -> int -> int -> int -> int -> int -> unit

8
testsuite/tests/unwind/stack_walker.c
View File

@ -5,8 +5,9 @@
#include <caml/mlvalues.h>
#include <libunwind.h>
value ml_func_with_10_params_native(value x1, value x2, value x3, value x4, value x5,
value x6, value x7, value x8, value x9, value x10) {
value ml_func_with_10_params_native(value x1, value x2, value x3, value x4,
value x5, value x6, value x7, value x8,
value x9, value x10) {
return Val_unit;
}
@ -30,7 +31,8 @@ void perform_stack_walk() {
{
char procname[256];
unw_word_t ip_offset; // IP - start_of_proc
int result = unw_get_proc_name(&cursor, procname, sizeof(procname), &ip_offset);
int result = unw_get_proc_name(&cursor, procname, sizeof(procname),
&ip_offset);
if (result != 0) error();
if (strcmp(procname, "main") == 0)
reached_main = 1;

24
testsuite/tests/warnings/w55.opt_backend.clambda.opt_reference
View File

@ -1,12 +1,12 @@
File "w55.opt.ml", line 4, characters 10-26:
Warning 55: Inlining impossible in this context: Function information unavailable
File "w55.opt.ml", line 8, characters 10-27:
Warning 55: Inlining impossible in this context: Unknown function
File "w55.opt.ml", line 12, characters 10-26:
Warning 55: Inlining impossible in this context: Partial application
File "w55.opt.ml", line 18, characters 12-30:
Warning 55: Inlining impossible in this context: Over-application
File "w55.opt.ml", line 18, characters 12-30:
Warning 55: Inlining impossible in this context: Function information unavailable
File "w55.opt.ml", line 21, characters 10-26:
Warning 55: Inlining impossible in this context: Function information unavailable
File "w55.opt_backend.ml", line 4, characters 10-26:
Warning 55: Cannot inline: Function information unavailable
File "w55.opt_backend.ml", line 8, characters 10-27:
Warning 55: Cannot inline: Unknown function
File "w55.opt_backend.ml", line 12, characters 10-26:
Warning 55: Cannot inline: Partial application
File "w55.opt_backend.ml", line 18, characters 12-30:
Warning 55: Cannot inline: Over-application
File "w55.opt_backend.ml", line 18, characters 12-30:
Warning 55: Cannot inline: Function information unavailable
File "w55.opt_backend.ml", line 21, characters 10-26:
Warning 55: Cannot inline: Function information unavailable

6
testsuite/tests/warnings/w55.opt_backend.flambda.opt_reference
View File

@ -1,6 +1,6 @@
File "w55.opt_backend.ml", line 12, characters 10-26:
Warning 55: Inlining impossible in this context: [@inlined] attributes may not be used on partial applications
Warning 55: Cannot inline: [@inlined] attributes may not be used on partial applications
File "w55.opt_backend.ml", line 8, characters 10-27:
Warning 55: Inlining impossible in this context: [@inlined] attribute was not used on this function application (the optimizer did not know what function was being applied)
Warning 55: Cannot inline: [@inlined] attribute was not used on this function application (the optimizer did not know what function was being applied)
File "w55.opt_backend.ml", line 18, characters 12-30:
Warning 55: Inlining impossible in this context: [@inlined] attribute was not used on this function application (the optimizer did not know what function was being applied)
Warning 55: Cannot inline: [@inlined] attribute was not used on this function application (the optimizer did not know what function was being applied)

7
tools/Makefile.nt
View File

@ -12,12 +12,15 @@
include Makefile.shared
CAMLOPT:=$(if $(wildcard ../flexdll/Makefile),OCAML_FLEXLINK="../boot/ocamlrun ../flexdll/flexlink.exe") $(CAMLOPT)
ifneq "$(wildcard ../flexdll/Makefile)"
CAMLOPT:=OCAML_FLEXLINK="../boot/ocamlrun ../flexdll/flexlink.exe" $(CAMLOPT)
endif
# To make custom toplevels
OCAMLMKTOP=ocamlmktop.cmo
OCAMLMKTOP_IMPORTS=misc.cmo identifiable.cmo numbers.cmo config.cmo arg_helper.cmo clflags.cmo ccomp.cmo
OCAMLMKTOP_IMPORTS=misc.cmo identifiable.cmo numbers.cmo config.cmo \
arg_helper.cmo clflags.cmo ccomp.cmo
ocamlmktop: $(OCAMLMKTOP)
$(CAMLC) $(LINKFLAGS) -o ocamlmktop $(OCAMLMKTOP_IMPORTS) $(OCAMLMKTOP)

12
tools/Makefile.shared
View File

@ -39,7 +39,8 @@ CAMLDEP_IMPORTS=timings.cmo misc.cmo config.cmo identifiable.cmo numbers.cmo \
arg_helper.cmo clflags.cmo terminfo.cmo \
warnings.cmo location.cmo longident.cmo docstrings.cmo \
syntaxerr.cmo ast_helper.cmo parser.cmo lexer.cmo parse.cmo \
ccomp.cmo ast_mapper.cmo ast_iterator.cmo ast_invariants.cmo pparse.cmo compenv.cmo \
ccomp.cmo ast_mapper.cmo ast_iterator.cmo ast_invariants.cmo pparse.cmo \
compenv.cmo \
builtin_attributes.cmo
ocamldep: depend.cmi $(CAMLDEP_OBJ)
@ -77,11 +78,13 @@ ocamlprof: $(CSLPROF) profiling.cmo
ocamlcp: ocamlcp.cmo
$(CAMLC) $(LINKFLAGS) -o ocamlcp misc.cmo warnings.cmo config.cmo \
identifiable.cmo numbers.cmo arg_helper.cmo clflags.cmo main_args.cmo ocamlcp.cmo
identifiable.cmo numbers.cmo arg_helper.cmo clflags.cmo \
main_args.cmo ocamlcp.cmo
ocamloptp: ocamloptp.cmo
$(CAMLC) $(LINKFLAGS) -o ocamloptp misc.cmo warnings.cmo config.cmo \
identifiable.cmo numbers.cmo arg_helper.cmo clflags.cmo main_args.cmo \
identifiable.cmo numbers.cmo arg_helper.cmo clflags.cmo \
main_args.cmo \
ocamloptp.cmo
opt:: profiling.cmx
@ -102,7 +105,8 @@ clean::
# To help building mixed-mode libraries (OCaml + C)
ocamlmklib: ocamlmklibconfig.cmo ocamlmklib.cmo
$(CAMLC) $(LINKFLAGS) -o ocamlmklib ocamlmklibconfig.cmo config.cmo ocamlmklib.cmo
$(CAMLC) $(LINKFLAGS) -o ocamlmklib ocamlmklibconfig.cmo config.cmo \
ocamlmklib.cmo
install::
cp ocamlmklib "$(INSTALL_BINDIR)/ocamlmklib$(EXE)"

9
tools/check-typo
View File

@ -38,6 +38,7 @@
# - Any file whose name matches one of the following patterns is
# automatically exempt from all rules
# *.reference
# *.opt_reference
# */reference
# */.depend*
# - Any file whose name begins with "Makefile" is automatically exempt
@ -149,7 +150,7 @@ IGNORE_DIRS="
case "$f" in
Makefile*|*/Makefile*) rules="tab,$rules";;
*.mlpack|*.mllib|*.mltop|*.odocl|*.itarget|*.clib) add_hd;;
*.reference|*/reference|*/.depend*) continue;;
*.reference|*.opt_reference|*/reference|*/.depend*) continue;;
esac
case "$f" in
ocamldoc/*|*/ocamldoc/*) rules="long-line,$rules";;
@ -230,11 +231,15 @@ IGNORE_DIRS="
if (!empty_file && match(prev_line, /^$/)){
err("white-at-eof", "empty line(s) at EOF");
}
if (NR >= 10 && !(header_ocaml && header_copyright)){
if (!(header_ocaml && header_copyright)){
if (NR >= 10){
NR = 1;
RSTART = 1;
RLENGTH = 0;
err("missing-header", "missing copyright header");
}else{
counts["missing-header"] = 1;
}
}
split(svnrules, r, "[, ]");
for (i in r){

1
tools/cmpbyt.ml
View File

@ -82,4 +82,3 @@ let _ =
exit 2
end;
if cmpbyt Sys.argv.(1) Sys.argv.(2) then exit 0 else exit 2

10
tools/ocaml-instr-graph
View File

@ -14,10 +14,12 @@
# Use this script on OCAML_INSTR_FILE files
default_curves=major,minor,coll,dispatch
usage () {
echo 'usage: ocaml-instr-graph file [options]'
echo ' options:'
echo ' -d names plot the data for names (default major,minor,coll,dispatch)'
echo " -d names plot the data for names (default: $default_curves)"
echo ' -t title set the graph title'
echo ' -m n clip the values to n (default 1G)'
echo ' -rt n set the range for times to 0..n'
@ -52,7 +54,7 @@ while [[ $# > 0 ]]; do
done
if [[ "$curves" = , ]]; then
curves=,major,minor,coll,dispatch,
curves=,$default_curves,
fi
if ! $titleset; then
@ -98,7 +100,9 @@ awk -v curves="$curves" -v clip=$max -v tmpfile="$tmpfile" -v from=$from \
f=$tmpfile-${curve//\//:}
if [ -f $f ]; then
case $f in
*#) printf "\"%s\" using 1:2 axes x1y2 title '%s', " "$f" "$curve";;
*#) printf "\"%s\" using 1:2 axes x1y2 title '%s', " "$f" \
"$curve"
;;
*) printf "\"%s\" using 1:2 title '%s', " "$f" "$curve";;
esac
fi

3
tools/stripdebug.ml
View File

@ -52,6 +52,3 @@ let _ =
eprintf "Usage: stripdebug <source file> <destination file>\n";
exit 2
end

3
toplevel/opttoploop.mli
View File

@ -47,7 +47,8 @@ val execute_phrase : bool -> formatter -> Parsetree.toplevel_phrase -> bool
phrase executed with no errors and [false] otherwise.
First bool says whether the values and types of the results
should be printed. Uncaught exceptions are always printed. *)
val preprocess_phrase : formatter -> Parsetree.toplevel_phrase -> Parsetree.toplevel_phrase
val preprocess_phrase :
formatter -> Parsetree.toplevel_phrase -> Parsetree.toplevel_phrase
(* Preprocess the given toplevel phrase using regular and ppx
preprocessors. Return the updated phrase. *)
val use_file : formatter -> string -> bool

3
toplevel/topdirs.ml
View File

@ -73,7 +73,8 @@ let dir_directory s =
let _ = add_directive "directory" (Directive_string dir_directory)
{
section = section_run;
doc = "Add the given directory to search path for source and compiled files.";
doc = "Add the given directory to search path for source and compiled \
files.";
}
(* To remove a directory from the load path *)

3
typing/env.ml
View File

@ -183,7 +183,8 @@ type t = {
and module_components =
{
deprecated: string option;
comps: (t * Subst.t * Path.t * Types.module_type, module_components_repr) EnvLazy.t;
comps: (t * Subst.t * Path.t * Types.module_type, module_components_repr)
EnvLazy.t;
}
and module_components_repr =

7
typing/predef.ml
View File

@ -75,7 +75,8 @@ and type_int32 = newgenty (Tconstr(path_int32, [], ref Mnil))
and type_int64 = newgenty (Tconstr(path_int64, [], ref Mnil))
and type_lazy_t t = newgenty (Tconstr(path_lazy_t, [t], ref Mnil))
and type_string = newgenty (Tconstr(path_string, [], ref Mnil))
and type_extension_constructor = newgenty (Tconstr(path_extension_constructor, [], ref Mnil))
and type_extension_constructor =
newgenty (Tconstr(path_extension_constructor, [], ref Mnil))
let ident_match_failure = ident_create_predef_exn "Match_failure"
and ident_out_of_memory = ident_create_predef_exn "Out_of_memory"
@ -190,7 +191,9 @@ let common_initial_env add_type add_extension empty_env =
ext_ret_type = None;
ext_private = Asttypes.Public;
ext_loc = Location.none;
ext_attributes = [{Asttypes.txt="ocaml.warn_on_literal_pattern";loc=Location.none}, Parsetree.PStr[]] }
ext_attributes = [{Asttypes.txt="ocaml.warn_on_literal_pattern";
loc=Location.none},
Parsetree.PStr[]] }
in
add_extension ident_match_failure
[newgenty (Ttuple[type_string; type_int; type_int])] (

3
typing/printtyp.ml
View File

@ -1452,7 +1452,8 @@ let warn_on_missing_def env ppf t =
ignore(Env.find_type p env : Types.type_declaration)
with Not_found ->
fprintf ppf
"@,@[%a is abstract because no corresponding cmi file was found in path.@]" path p
"@,@[%a is abstract because no corresponding cmi file was found \
in path.@]" path p
end
| _ -> ()

10
typing/typecore.ml
View File

@ -264,7 +264,8 @@ let type_constant = function
| Const_int64 _ -> instance_def Predef.type_int64
| Const_nativeint _ -> instance_def Predef.type_nativeint
let constant : Parsetree.constant -> (Asttypes.constant, error) result = function
let constant : Parsetree.constant -> (Asttypes.constant, error) result =
function
| Pconst_integer (i,None) ->
begin
try Ok (Const_int (Misc.Int_literal_converter.int i))
@ -2883,7 +2884,8 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
exp.exp_extra;
}
| Pexp_extension ({ txt = ("ocaml.extension_constructor"|"extension_constructor"); _ },
| Pexp_extension ({ txt = ("ocaml.extension_constructor"
|"extension_constructor"); _ },
payload) ->
begin match payload with
| PStr [ { pstr_desc =
@ -3987,8 +3989,8 @@ and type_let ?(check = fun s -> Warnings.Unused_var s)
generalize_structure ty'
end;
let exp =
Builtin_attributes.with_warning_attribute pvb_attributes (fun () ->
type_expect exp_env sexp ty')
Builtin_attributes.with_warning_attribute pvb_attributes
(fun () -> type_expect exp_env sexp ty')
in
end_def ();
check_univars env true "definition" exp pat.pat_type vars;

3
typing/typedecl.ml
View File

@ -1437,7 +1437,8 @@ let error_if_has_deep_native_repr_attributes core_type =
get_native_repr_attribute core_type.ptyp_attributes ~global_repr:None
with
| Native_repr_attr_present kind ->
raise (Error (core_type.ptyp_loc, Deep_unbox_or_untag_attribute kind))
raise (Error (core_type.ptyp_loc,
Deep_unbox_or_untag_attribute kind))
| Native_repr_attr_absent -> ()
end;
default_iterator.typ iterator core_type }

Some files were not shown because too many files have changed in this diff Show More