diff options
| -rw-r--r-- | Changes | 4 | ||||
| -rw-r--r-- | manual/src/library/stdlib-blurb.etex | 4 | ||||
| -rwxr-xr-x | manual/tests/check-stdlib-modules | 2 | ||||
| -rw-r--r-- | stdlib/.depend | 16 | ||||
| -rw-r--r-- | stdlib/StdlibModules | 2 | ||||
| -rw-r--r-- | stdlib/in_channel.ml | 66 | ||||
| -rw-r--r-- | stdlib/in_channel.mli | 136 | ||||
| -rw-r--r-- | stdlib/out_channel.ml | 47 | ||||
| -rw-r--r-- | stdlib/out_channel.mli | 131 | ||||
| -rw-r--r-- | stdlib/stdlib.ml | 2 | ||||
| -rw-r--r-- | stdlib/stdlib.mli | 6 | ||||
| -rw-r--r-- | testsuite/tests/basic/patmatch_for_multiple.ml | 168 | ||||
| -rw-r--r-- | testsuite/tests/generalized-open/gpr1506.ml | 12 | ||||
| -rw-r--r-- | testsuite/tests/typing-sigsubst/sigsubst.ml | 6 |
14 files changed, 505 insertions, 97 deletions
@@ -41,6 +41,10 @@ Working version by the functions from module Marshal) (François Pottier, review by Gabriel Scherer and Kate Deplaix) +- #10545: Add In_channel and Out_channel modules. + (Nicolás Ojeda Bär, review by Daniel Bünzli, Simon Cruanes, Gabriel Scherer, + Guillaume Munch-Maccagnoni, Alain Frisch and Xavier Leroy) + ### Other libraries: - #10192: Add support for Unix domain sockets on Windows and use them diff --git a/manual/src/library/stdlib-blurb.etex b/manual/src/library/stdlib-blurb.etex index 65684b1b3f..8f2e00dfe0 100644 --- a/manual/src/library/stdlib-blurb.etex +++ b/manual/src/library/stdlib-blurb.etex @@ -77,6 +77,8 @@ integers \end{tabular} \subsubsection*{sss:stdlib-io}{input/output:} \begin{tabular}{lll} +"In_channel" & p.~\stdpageref{In-underscorechannel} & input channels \\ +"Out_channel" & p.~\stdpageref{Out-underscorechannel} & output channels \\ "Format" & p.~\stdpageref{Format} & pretty printing with automatic indentation and line breaking \\ "Marshal" & p.~\stdpageref{Marshal} & marshaling of data structures \\ @@ -130,6 +132,7 @@ be called from C \\ \stddocitem{Gc}{memory management control and statistics; finalized values} \stddocitem{Genlex}{a generic lexical analyzer} \stddocitem{Hashtbl}{hash tables and hash functions} +\stddocitem{In_channel}{input channels} \stddocitem{Int}{integers} \stddocitem{Int32}{32-bit integers} \stddocitem{Int64}{64-bit integers} @@ -143,6 +146,7 @@ be called from C \\ \stddocitem{Nativeint}{processor-native integers} \stddocitem{Oo}{object-oriented extension} \stddocitem{Option}{option values} +\stddocitem{Out_channel}{output channels} \stddocitem{Parsing}{the run-time library for parsers generated by \texttt{ocamlyacc}} \stddocitem{Printexc}{facilities for printing exceptions} \stddocitem{Printf}{formatting printing functions} diff --git a/manual/tests/check-stdlib-modules b/manual/tests/check-stdlib-modules index af4d3dadfa..ed17a5e35a 100755 --- a/manual/tests/check-stdlib-modules +++ b/manual/tests/check-stdlib-modules @@ -10,7 +10,7 @@ cut -c 2- $TMPDIR/stdlib-$$-files \ exitcode=0 for i in `cat $TMPDIR/stdlib-$$-modules`; do case $i in - Stdlib | Camlinternal* | *Labels | Obj | Pervasives) continue;; + Stdlib | Camlinternal* | *Labels | Obj | Pervasives | In_channel | Out_channel) continue;; esac grep -q -e '"'$i'" & p\.~\\stdpageref{'$i'} &' $1/manual/src/library/stdlib-blurb.etex || { echo "Module $i is missing from the module description in library/stdlib-blurb.etex." >&2 diff --git a/stdlib/.depend b/stdlib/.depend index 8e902092f8..c2edf6a3f4 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -359,6 +359,14 @@ stdlib__Hashtbl.cmx : hashtbl.ml \ stdlib__Hashtbl.cmi stdlib__Hashtbl.cmi : hashtbl.mli \ stdlib__Seq.cmi +stdlib__In_channel.cmo : in_channel.ml \ + stdlib.cmi \ + stdlib__In_channel.cmi +stdlib__In_channel.cmx : in_channel.ml \ + stdlib.cmx \ + stdlib__In_channel.cmi +stdlib__In_channel.cmi : in_channel.mli \ + stdlib.cmi stdlib__Int.cmo : int.ml \ stdlib.cmi \ stdlib__Int.cmi @@ -496,6 +504,14 @@ stdlib__Option.cmx : option.ml \ stdlib__Option.cmi stdlib__Option.cmi : option.mli \ stdlib__Seq.cmi +stdlib__Out_channel.cmo : out_channel.ml \ + stdlib.cmi \ + stdlib__Out_channel.cmi +stdlib__Out_channel.cmx : out_channel.ml \ + stdlib.cmx \ + stdlib__Out_channel.cmi +stdlib__Out_channel.cmi : out_channel.mli \ + stdlib.cmi stdlib__Parsing.cmo : parsing.ml \ stdlib__Obj.cmi \ stdlib__Lexing.cmi \ diff --git a/stdlib/StdlibModules b/stdlib/StdlibModules index 4d3351c3a3..7d4b4a25d4 100644 --- a/stdlib/StdlibModules +++ b/stdlib/StdlibModules @@ -42,7 +42,7 @@ STDLIB_MODULE_BASENAMES=\ printexc fun gc digest random hashtbl weak \ format scanf callback camlinternalOO oo camlinternalMod genlex ephemeron \ filename complex arrayLabels listLabels bytesLabels stringLabels moreLabels \ - stdLabels bigarray + stdLabels bigarray in_channel out_channel STDLIB_PREFIXED_MODULES=\ $(filter-out stdlib camlinternal%, $(STDLIB_MODULE_BASENAMES)) diff --git a/stdlib/in_channel.ml b/stdlib/in_channel.ml new file mode 100644 index 0000000000..a221c80484 --- /dev/null +++ b/stdlib/in_channel.ml @@ -0,0 +1,66 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2021 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +type t = in_channel + +type open_flag = Stdlib.open_flag = + | Open_rdonly + | Open_wronly + | Open_append + | Open_creat + | Open_trunc + | Open_excl + | Open_binary + | Open_text + | Open_nonblock + +let stdin = Stdlib.stdin +let open_bin = Stdlib.open_in_bin +let open_text = Stdlib.open_in +let open_gen = Stdlib.open_in_gen +let seek = Stdlib.LargeFile.seek_in +let pos = Stdlib.LargeFile.pos_in +let length = Stdlib.LargeFile.in_channel_length +let close = Stdlib.close_in +let close_noerr = Stdlib.close_in_noerr + +let input_char ic = + match Stdlib.input_char ic with + | c -> Some c + | exception End_of_file -> None + +let input_byte ic = + match Stdlib.input_byte ic with + | n -> Some n + | exception End_of_file -> None + +let input_line ic = + match Stdlib.input_line ic with + | s -> Some s + | exception End_of_file -> None + +let input = Stdlib.input + +let really_input ic buf pos len = + match Stdlib.really_input ic buf pos len with + | () -> Some () + | exception End_of_file -> None + +let really_input_string ic len = + match Stdlib.really_input_string ic len with + | s -> Some s + | exception End_of_file -> None + +let set_binary_mode = Stdlib.set_binary_mode_in diff --git a/stdlib/in_channel.mli b/stdlib/in_channel.mli new file mode 100644 index 0000000000..14e65e2ced --- /dev/null +++ b/stdlib/in_channel.mli @@ -0,0 +1,136 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2021 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Input channels. + + @since 4.14.0 *) + +type t = in_channel +(** The type of input channel. *) + +type open_flag = Stdlib.open_flag = + | Open_rdonly (** open for reading. *) + | Open_wronly (** open for writing. *) + | Open_append (** open for appending: always write at end of file. *) + | Open_creat (** create the file if it does not exist. *) + | Open_trunc (** empty the file if it already exists. *) + | Open_excl (** fail if Open_creat and the file already exists. *) + | Open_binary (** open in binary mode (no conversion). *) + | Open_text (** open in text mode (may perform conversions). *) + | Open_nonblock (** open in non-blocking mode. *) +(** Opening modes for {!open_gen}. *) + +val stdin : t +(** The standard input for the process. *) + +val open_bin : string -> t +(** Open the named file for reading, and return a new input channel on that + file, positioned at the beginning of the file. *) + +val open_text : string -> t +(** Same as {!open_bin}, but the file is opened in text mode, so that newline + translation takes place during reads. On operating systems that do not + distinguish between text mode and binary mode, this function behaves like + {!open_bin}. *) + +val open_gen : open_flag list -> int -> string -> t +(** [open_gen mode perm filename] opens the named file for reading, as described + above. The extra arguments [mode] and [perm] specify the opening mode and + file permissions. {!open_text} and {!open_bin} are special cases of this + function. *) + +val seek : t -> int64 -> unit +(** [seek chan pos] sets the current reading position to [pos] for channel + [chan]. This works only for regular files. On files of other kinds, the + behavior is unspecified. *) + +val pos : t -> int64 +(** Return the current reading position for the given channel. For files opened + in text mode under Windows, the returned position is approximate (owing to + end-of-line conversion); in particular, saving the current position with + {!pos}, then going back to this position using {!seek} will not work. For + this programming idiom to work reliably and portably, the file must be + opened in binary mode. *) + +val length : t -> int64 +(** Return the size (number of characters) of the regular file on which the + given channel is opened. If the channel is opened on a file that is not a + regular file, the result is meaningless. The returned size does not take + into account the end-of-line translations that can be performed when reading + from a channel opened in text mode. *) + +val close : t -> unit +(** Close the given channel. Input functions raise a [Sys_error] exception when + they are applied to a closed input channel, except {!close}, which does + nothing when applied to an already closed channel. *) + +val close_noerr : t -> unit +(** Same as {!close}, but ignore all errors. *) + +val input_char : t -> char option +(** Read one character from the given input channel. Returns [None] if there + are no more characters to read. *) + +val input_byte : t -> int option +(** Same as {!input_char}, but return the 8-bit integer representing the + character. Returns [None] if the end of file was reached. *) + +val input_line : t -> string option +(** [input_line ic] reads characters from [ic] until a newline or the end of + file is reached. Returns the string of all characters read, without the + newline (if any). Returns [None] if the end of the file has been reached. + In particular, this will be the case if the last line of input is empty. + + A newline is the character [\n] unless the file is open in text mode and + {!Sys.win32} is [true] in which case it is the sequence of characters + [\r\n]. *) + +val input : t -> bytes -> int -> int -> int +(** [input ic buf pos len] reads up to [len] characters from the given channel + [ic], storing them in byte sequence [buf], starting at character number + [pos]. It returns the actual number of characters read, between 0 and [len] + (inclusive). A return value of 0 means that the end of file was reached. + + Use {!really_input} to read exactly [len] characters. + + @raise Invalid_argument if [pos] and [len] do not designate a valid range of + [buf]. *) + +val really_input : t -> bytes -> int -> int -> unit option +(** [really_input ic buf pos len] reads [len] characters from channel [ic], + storing them in byte sequence [buf], starting at character number [pos]. + + Returns [None] if the end of file is reached before [len] characters have + been read. + + @raise Invalid_argument if [pos] and [len] do not designate a valid range of + [buf]. *) + +val really_input_string : t -> int -> string option +(** [really_input_string ic len] reads [len] characters from channel [ic] and + returns them in a new string. Returns [None] if the end of file is reached + before [len] characters have been read. *) + +val set_binary_mode : t -> bool -> unit +(** [set_binary_mode ic true] sets the channel [ic] to binary mode: no + translations take place during input. + + [set_binary_mode ic false] sets the channel [ic] to text mode: depending + on the operating system, some translations may take place during input. For + instance, under Windows, end-of-lines will be translated from [\r\n] to + [\n]. + + This function has no effect under operating systems that do not distinguish + between text mode and binary mode. *) diff --git a/stdlib/out_channel.ml b/stdlib/out_channel.ml new file mode 100644 index 0000000000..250b73816c --- /dev/null +++ b/stdlib/out_channel.ml @@ -0,0 +1,47 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2021 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +type t = out_channel + +type open_flag = Stdlib.open_flag = + | Open_rdonly + | Open_wronly + | Open_append + | Open_creat + | Open_trunc + | Open_excl + | Open_binary + | Open_text + | Open_nonblock + +let stdout = Stdlib.stdout +let stderr = Stdlib.stderr +let open_bin = Stdlib.open_out_bin +let open_text = Stdlib.open_out +let open_gen = Stdlib.open_out_gen +let seek = Stdlib.LargeFile.seek_out +let pos = Stdlib.LargeFile.pos_out +let length = Stdlib.LargeFile.out_channel_length +let close = Stdlib.close_out +let close_noerr = Stdlib.close_out_noerr +let flush = Stdlib.flush +let flush_all = Stdlib.flush_all +let output_char = Stdlib.output_char +let output_byte = Stdlib.output_byte +let output_string = Stdlib.output_string +let output_bytes = Stdlib.output_bytes +let output = Stdlib.output +let output_substring = Stdlib.output_substring +let set_binary_mode = Stdlib.set_binary_mode_out diff --git a/stdlib/out_channel.mli b/stdlib/out_channel.mli new file mode 100644 index 0000000000..9b94eaaaba --- /dev/null +++ b/stdlib/out_channel.mli @@ -0,0 +1,131 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2021 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Output channels. + + @since 4.14.0 *) + +type t = out_channel +(** The type of output channel. *) + +type open_flag = Stdlib.open_flag = + | Open_rdonly (** open for reading. *) + | Open_wronly (** open for writing. *) + | Open_append (** open for appending: always write at end of file. *) + | Open_creat (** create the file if it does not exist. *) + | Open_trunc (** empty the file if it already exists. *) + | Open_excl (** fail if Open_creat and the file already exists. *) + | Open_binary (** open in binary mode (no conversion). *) + | Open_text (** open in text mode (may perform conversions). *) + | Open_nonblock (** open in non-blocking mode. *) +(** Opening modes for {!open_gen}. *) + +val stdout : t +(** The standard output for the process. *) + +val stderr : t +(** The standard error output for the process. *) + +val open_bin : string -> t +(** Open the named file for writing, and return a new output channel on that + file, positioned at the beginning of the file. The file is truncated to zero + length if it already exists. It is created if it does not already exists. *) + +val open_text : string -> t +(** Same as {!open_bin}, but the file is opened in text mode, so that newline + translation takes place during writes. On operating systems that do not + distinguish between text mode and binary mode, this function behaves like + {!open_bin}. *) + +val open_gen : open_flag list -> int -> string -> t +(** [open_gen mode perm filename] opens the named file for writing, as described + above. The extra argument [mode] specifies the opening mode. The extra + argument [perm] specifies the file permissions, in case the file must be + created. {!open_text} and {!open_bin} are special cases of this + function. *) + +val seek : t -> int64 -> unit +(** [seek chan pos] sets the current writing position to [pos] for channel + [chan]. This works only for regular files. On files of other kinds (such as + terminals, pipes and sockets), the behavior is unspecified. *) + +val pos : t -> int64 +(** Return the current writing position for the given channel. Does not work on + channels opened with the [Open_append] flag (returns unspecified results). + + For files opened in text mode under Windows, the returned position is + approximate (owing to end-of-line conversion); in particular, saving the + current position with {!pos}, then going back to this position using {!seek} + will not work. For this programming idiom to work reliably and portably, + the file must be opened in binary mode. *) + +val length : t -> int64 +(** Return the size (number of characters) of the regular file on which the + given channel is opened. If the channel is opened on a file that is not a + regular file, the result is meaningless. *) + +val close : t -> unit +(** Close the given channel, flushing all buffered write operations. Output + functions raise a [Sys_error] exception when they are applied to a closed + output channel, except {!close} and {!flush}, which do nothing when applied + to an already closed channel. Note that {!close} may raise [Sys_error] if + the operating system signals an error when flushing or closing. *) + +val close_noerr : t -> unit +(** Same as {!close}, but ignore all errors. *) + +val flush : t -> unit +(** Flush the buffer associated with the given output channel, performing all + pending writes on that channel. Interactive programs must be careful about + flushing standard output and standard error at the right time. *) + +val flush_all : unit -> unit +(** Flush all open output channels; ignore errors. *) + +val output_char : t -> char -> unit +(** Write the character on the given output channel. *) + +val output_byte : t -> int -> unit +(** Write one 8-bit integer (as the single character with that code) on the + given output channel. The given integer is taken modulo 256. *) + +val output_string : t -> string -> unit +(** Write the string on the given output channel. *) + +val output_bytes : t -> bytes -> unit +(** Write the byte sequence on the given output channel. *) + +val output : t -> bytes -> int -> int -> unit +(** [output oc buf pos len] writes [len] characters from byte sequence [buf], + starting at offset [pos], to the given output channel [oc]. + + @raise Invalid_argument if [pos] and [len] do not designate a valid range of + [buf]. *) + +val output_substring : t -> string -> int -> int -> unit +(** Same as {!output} but take a string as argument instead of a byte + sequence. *) + +val set_binary_mode : t -> bool -> unit +(** [set_binary_mode oc true] sets the channel [oc] to binary mode: no + translations take place during output. + + [set_binary_mode oc false] sets the channel [oc] to text mode: depending on + the operating system, some translations may take place during output. For + instance, under Windows, end-of-lines will be translated from [\n] to + [\r\n]. + + This function has no effect under operating systems that do not distinguish + between text mode and binary mode. *) diff --git a/stdlib/stdlib.ml b/stdlib/stdlib.ml index aac8fcc171..6268f3c592 100644 --- a/stdlib/stdlib.ml +++ b/stdlib/stdlib.ml @@ -599,6 +599,7 @@ module Fun = Fun module Gc = Gc module Genlex = Genlex module Hashtbl = Hashtbl +module In_channel = In_channel module Int = Int module Int32 = Int32 module Int64 = Int64 @@ -613,6 +614,7 @@ module Nativeint = Nativeint module Obj = Obj module Oo = Oo module Option = Option +module Out_channel = Out_channel module Parsing = Parsing module Pervasives = Pervasives module Printexc = Printexc diff --git a/stdlib/stdlib.mli b/stdlib/stdlib.mli index c84caee3d3..0844af88b9 100644 --- a/stdlib/stdlib.mli +++ b/stdlib/stdlib.mli @@ -1128,12 +1128,12 @@ val really_input_string : in_channel -> int -> string val input_byte : in_channel -> int (** Same as {!Stdlib.input_char}, but return the 8-bit integer representing the character. - @raise End_of_file if an end of file was reached. *) + @raise End_of_file if the end of file was reached. *) val input_binary_int : in_channel -> int (** Read an integer encoded in binary format (4 bytes, big-endian) from the given input channel. See {!Stdlib.output_binary_int}. - @raise End_of_file if an end of file was reached while reading the + @raise End_of_file if the end of file was reached while reading the integer. *) val input_value : in_channel -> 'a @@ -1399,6 +1399,7 @@ module Gc = Gc module Genlex = Genlex [@@deprecated "Use the camlp-streams library instead."] module Hashtbl = Hashtbl +module In_channel = In_channel module Int = Int module Int32 = Int32 module Int64 = Int64 @@ -1413,6 +1414,7 @@ module Nativeint = Nativeint module Obj = Obj module Oo = Oo module Option = Option +module Out_channel = Out_channel module Parsing = Parsing module Pervasives = Pervasives [@@deprecated "Use Stdlib instead.\n\ diff --git a/testsuite/tests/basic/patmatch_for_multiple.ml b/testsuite/tests/basic/patmatch_for_multiple.ml index 8f13ce43ae..0191e1c7bc 100644 --- a/testsuite/tests/basic/patmatch_for_multiple.ml +++ b/testsuite/tests/basic/patmatch_for_multiple.ml @@ -26,15 +26,15 @@ match (3, 2, 1) with | _ -> false ;; [%%expect{| -(let (*match*/88 = 3 *match*/89 = 2 *match*/90 = 1) +(let (*match*/90 = 3 *match*/91 = 2 *match*/92 = 1) (catch (catch - (catch (if (!= *match*/89 3) (exit 3) (exit 1)) with (3) - (if (!= *match*/88 1) (exit 2) (exit 1))) + (catch (if (!= *match*/91 3) (exit 3) (exit 1)) with (3) + (if (!= *match*/90 1) (exit 2) (exit 1))) with (2) 0) with (1) 1)) -(let (*match*/88 = 3 *match*/89 = 2 *match*/90 = 1) - (catch (if (!= *match*/89 3) (if (!= *match*/88 1) 0 (exit 1)) (exit 1)) +(let (*match*/90 = 3 *match*/91 = 2 *match*/92 = 1) + (catch (if (!= *match*/91 3) (if (!= *match*/90 1) 0 (exit 1)) (exit 1)) with (1) 1)) - : bool = false |}];; @@ -47,26 +47,26 @@ match (3, 2, 1) with | _ -> false ;; [%%expect{| -(let (*match*/93 = 3 *match*/94 = 2 *match*/95 = 1) +(let (*match*/95 = 3 *match*/96 = 2 *match*/97 = 1) (catch (catch (catch - (if (!= *match*/94 3) (exit 6) - (let (x/97 =a (makeblock 0 *match*/93 *match*/94 *match*/95)) - (exit 4 x/97))) + (if (!= *match*/96 3) (exit 6) + (let (x/99 =a (makeblock 0 *match*/95 *match*/96 *match*/97)) + (exit 4 x/99))) with (6) - (if (!= *match*/93 1) (exit 5) - (let (x/96 =a (makeblock 0 *match*/93 *match*/94 *match*/95)) - (exit 4 x/96)))) + (if (!= *match*/95 1) (exit 5) + (let (x/98 =a (makeblock 0 *match*/95 *match*/96 *match*/97)) + (exit 4 x/98)))) with (5) 0) - with (4 x/91) (seq (ignore x/91) 1))) -(let (*match*/93 = 3 *match*/94 = 2 *match*/95 = 1) + with (4 x/93) (seq (ignore x/93) 1))) +(let (*match*/95 = 3 *match*/96 = 2 *match*/97 = 1) (catch - (if (!= *match*/94 3) - (if (!= *match*/93 1) 0 - (exit 4 (makeblock 0 *match*/93 *match*/94 *match*/95))) - (exit 4 (makeblock 0 *match*/93 *match*/94 *match*/95))) - with (4 x/91) (seq (ignore x/91) 1))) + (if (!= *match*/96 3) + (if (!= *match*/95 1) 0 + (exit 4 (makeblock 0 *match*/95 *match*/96 *match*/97))) + (exit 4 (makeblock 0 *match*/95 *match*/96 *match*/97))) + with (4 x/93) (seq (ignore x/93) 1))) - : bool = false |}];; @@ -76,8 +76,8 @@ let _ = fun a b -> | ((true, _) as _g) | ((false, _) as _g) -> () [%%expect{| -(function a/98[int] b/99 : int 0) -(function a/98[int] b/99 : int 0) +(function a/100[int] b/101 : int 0) +(function a/100[int] b/101 : int 0) - : bool -> 'a -> unit = <fun> |}];; @@ -96,8 +96,8 @@ let _ = fun a b -> match a, b with | (false, _) as p -> p (* outside, trivial *) [%%expect {| -(function a/102[int] b/103 (let (p/104 =a (makeblock 0 a/102 b/103)) p/104)) -(function a/102[int] b/103 (makeblock 0 a/102 b/103)) +(function a/104[int] b/105 (let (p/106 =a (makeblock 0 a/104 b/105)) p/106)) +(function a/104[int] b/105 (makeblock 0 a/104 b/105)) - : bool -> 'a -> bool * 'a = <fun> |}] @@ -106,8 +106,8 @@ let _ = fun a b -> match a, b with | ((false, _) as p) -> p (* inside, trivial *) [%%expect{| -(function a/106[int] b/107 (let (p/108 =a (makeblock 0 a/106 b/107)) p/108)) -(function a/106[int] b/107 (makeblock 0 a/106 b/107)) +(function a/108[int] b/109 (let (p/110 =a (makeblock 0 a/108 b/109)) p/110)) +(function a/108[int] b/109 (makeblock 0 a/108 b/109)) - : bool -> 'a -> bool * 'a = <fun> |}];; @@ -116,11 +116,11 @@ let _ = fun a b -> match a, b with | (false as x, _) as p -> x, p (* outside, simple *) [%%expect {| -(function a/112[int] b/113 - (let (x/114 =a[int] a/112 p/115 =a (makeblock 0 a/112 b/113)) - (makeblock 0 (int,*) x/114 p/115))) -(function a/112[int] b/113 - (makeblock 0 (int,*) a/112 (makeblock 0 a/112 b/113))) +(function a/114[int] b/115 + (let (x/116 =a[int] a/114 p/117 =a (makeblock 0 a/114 b/115)) + (makeblock 0 (int,*) x/116 p/117))) +(function a/114[int] b/115 + (makeblock 0 (int,*) a/114 (makeblock 0 a/114 b/115))) - : bool -> 'a -> bool * (bool * 'a) = <fun> |}] @@ -129,11 +129,11 @@ let _ = fun a b -> match a, b with | ((false as x, _) as p) -> x, p (* inside, simple *) [%%expect {| -(function a/118[int] b/119 - (let (x/120 =a[int] a/118 p/121 =a (makeblock 0 a/118 b/119)) - (makeblock 0 (int,*) x/120 p/121))) -(function a/118[int] b/119 - (makeblock 0 (int,*) a/118 (makeblock 0 a/118 b/119))) +(function a/120[int] b/121 + (let (x/122 =a[int] a/120 p/123 =a (makeblock 0 a/120 b/121)) + (makeblock 0 (int,*) x/122 p/123))) +(function a/120[int] b/121 + (makeblock 0 (int,*) a/120 (makeblock 0 a/120 b/121))) - : bool -> 'a -> bool * (bool * 'a) = <fun> |}] @@ -142,15 +142,15 @@ let _ = fun a b -> match a, b with | (false, x) as p -> x, p (* outside, complex *) [%%expect{| -(function a/128[int] b/129[int] - (if a/128 - (let (x/130 =a[int] a/128 p/131 =a (makeblock 0 a/128 b/129)) - (makeblock 0 (int,*) x/130 p/131)) - (let (x/132 =a b/129 p/133 =a (makeblock 0 a/128 b/129)) - (makeblock 0 (int,*) x/132 p/133)))) -(function a/128[int] b/129[int] - (if a/128 (makeblock 0 (int,*) a/128 (makeblock 0 a/128 b/129)) - (makeblock 0 (int,*) b/129 (makeblock 0 a/128 b/129)))) +(function a/130[int] b/131[int] + (if a/130 + (let (x/132 =a[int] a/130 p/133 =a (makeblock 0 a/130 b/131)) + (makeblock 0 (int,*) x/132 p/133)) + (let (x/134 =a b/131 p/135 =a (makeblock 0 a/130 b/131)) + (makeblock 0 (int,*) x/134 p/135)))) +(function a/130[int] b/131[int] + (if a/130 (makeblock 0 (int,*) a/130 (makeblock 0 a/130 b/131)) + (makeblock 0 (int,*) b/131 (makeblock 0 a/130 b/131)))) - : bool -> bool -> bool * (bool * bool) = <fun> |}] @@ -160,19 +160,19 @@ let _ = fun a b -> match a, b with -> x, p (* inside, complex *) [%%expect{| -(function a/134[int] b/135[int] +(function a/136[int] b/137[int] (catch - (if a/134 - (let (x/142 =a[int] a/134 p/143 =a (makeblock 0 a/134 b/135)) - (exit 10 x/142 p/143)) - (let (x/140 =a b/135 p/141 =a (makeblock 0 a/134 b/135)) - (exit 10 x/140 p/141))) - with (10 x/136[int] p/137) (makeblock 0 (int,*) x/136 p/137))) -(function a/134[int] b/135[int] + (if a/136 + (let (x/144 =a[int] a/136 p/145 =a (makeblock 0 a/136 b/137)) + (exit 10 x/144 p/145)) + (let (x/142 =a b/137 p/143 =a (makeblock 0 a/136 b/137)) + (exit 10 x/142 p/143))) + with (10 x/138[int] p/139) (makeblock 0 (int,*) x/138 p/139))) +(function a/136[int] b/137[int] (catch - (if a/134 (exit 10 a/134 (makeblock 0 a/134 b/135)) - (exit 10 b/135 (makeblock 0 a/134 b/135))) - with (10 x/136[int] p/137) (makeblock 0 (int,*) x/136 p/137))) + (if a/136 (exit 10 a/136 (makeblock 0 a/136 b/137)) + (exit 10 b/137 (makeblock 0 a/136 b/137))) + with (10 x/138[int] p/139) (makeblock 0 (int,*) x/138 p/139))) - : bool -> bool -> bool * (bool * bool) = <fun> |}] @@ -185,15 +185,15 @@ let _ = fun a b -> match a, b with | (false as x, _) as p -> x, p (* outside, onecase *) [%%expect {| -(function a/144[int] b/145[int] - (if a/144 - (let (x/146 =a[int] a/144 _p/147 =a (makeblock 0 a/144 b/145)) - (makeblock 0 (int,*) x/146 [0: 1 1])) - (let (x/148 =a[int] a/144 p/149 =a (makeblock 0 a/144 b/145)) - (makeblock 0 (int,*) x/148 p/149)))) -(function a/144[int] b/145[int] - (if a/144 (makeblock 0 (int,*) a/144 [0: 1 1]) - (makeblock 0 (int,*) a/144 (makeblock 0 a/144 b/145)))) +(function a/146[int] b/147[int] + (if a/146 + (let (x/148 =a[int] a/146 _p/149 =a (makeblock 0 a/146 b/147)) + (makeblock 0 (int,*) x/148 [0: 1 1])) + (let (x/150 =a[int] a/146 p/151 =a (makeblock 0 a/146 b/147)) + (makeblock 0 (int,*) x/150 p/151)))) +(function a/146[int] b/147[int] + (if a/146 (makeblock 0 (int,*) a/146 [0: 1 1]) + (makeblock 0 (int,*) a/146 (makeblock 0 a/146 b/147)))) - : bool -> bool -> bool * (bool * bool) = <fun> |}] @@ -202,11 +202,11 @@ let _ = fun a b -> match a, b with | ((false as x, _) as p) -> x, p (* inside, onecase *) [%%expect{| -(function a/150[int] b/151 - (let (x/152 =a[int] a/150 p/153 =a (makeblock 0 a/150 b/151)) - (makeblock 0 (int,*) x/152 p/153))) -(function a/150[int] b/151 - (makeblock 0 (int,*) a/150 (makeblock 0 a/150 b/151))) +(function a/152[int] b/153 + (let (x/154 =a[int] a/152 p/155 =a (makeblock 0 a/152 b/153)) + (makeblock 0 (int,*) x/154 p/155))) +(function a/152[int] b/153 + (makeblock 0 (int,*) a/152 (makeblock 0 a/152 b/153))) - : bool -> 'a -> bool * (bool * 'a) = <fun> |}] @@ -223,14 +223,14 @@ let _ =fun a b -> match a, b with | (_, _) as p -> p (* outside, tuplist *) [%%expect {| -(function a/163[int] b/164 +(function a/165[int] b/166 (catch - (if a/163 (if b/164 (let (p/165 =a (field 0 b/164)) p/165) (exit 12)) + (if a/165 (if b/166 (let (p/167 =a (field 0 b/166)) p/167) (exit 12)) (exit 12)) - with (12) (let (p/166 =a (makeblock 0 a/163 b/164)) p/166))) -(function a/163[int] b/164 - (catch (if a/163 (if b/164 (field 0 b/164) (exit 12)) (exit 12)) with (12) - (makeblock 0 a/163 b/164))) + with (12) (let (p/168 =a (makeblock 0 a/165 b/166)) p/168))) +(function a/165[int] b/166 + (catch (if a/165 (if b/166 (field 0 b/166) (exit 12)) (exit 12)) with (12) + (makeblock 0 a/165 b/166))) - : bool -> bool tuplist -> bool * bool tuplist = <fun> |}] @@ -239,19 +239,19 @@ let _ = fun a b -> match a, b with | ((_, _) as p) -> p (* inside, tuplist *) [%%expect{| -(function a/167[int] b/168 +(function a/169[int] b/170 (catch (catch - (if a/167 - (if b/168 (let (p/172 =a (field 0 b/168)) (exit 13 p/172)) (exit 14)) + (if a/169 + (if b/170 (let (p/174 =a (field 0 b/170)) (exit 13 p/174)) (exit 14)) (exit 14)) - with (14) (let (p/171 =a (makeblock 0 a/167 b/168)) (exit 13 p/171))) - with (13 p/169) p/169)) -(function a/167[int] b/168 + with (14) (let (p/173 =a (makeblock 0 a/169 b/170)) (exit 13 p/173))) + with (13 p/171) p/171)) +(function a/169[int] b/170 (catch (catch - (if a/167 (if b/168 (exit 13 (field 0 b/168)) (exit 14)) (exit 14)) - with (14) (exit 13 (makeblock 0 a/167 b/168))) - with (13 p/169) p/169)) + (if a/169 (if b/170 (exit 13 (field 0 b/170)) (exit 14)) (exit 14)) + with (14) (exit 13 (makeblock 0 a/169 b/170))) + with (13 p/171) p/171)) - : bool -> bool tuplist -> bool * bool tuplist = <fun> |}] diff --git a/testsuite/tests/generalized-open/gpr1506.ml b/testsuite/tests/generalized-open/gpr1506.ml index c01c6db910..025e52ee43 100644 --- a/testsuite/tests/generalized-open/gpr1506.ml +++ b/testsuite/tests/generalized-open/gpr1506.ml @@ -103,9 +103,9 @@ include struct open struct type t = T end let x = T end Line 1, characters 15-41: 1 | include struct open struct type t = T end let x = T end ^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The type t/150 introduced by this open appears in the signature +Error: The type t/152 introduced by this open appears in the signature Line 1, characters 46-47: - The value x has no valid type if t/150 is hidden + The value x has no valid type if t/152 is hidden |}];; module A = struct @@ -123,9 +123,9 @@ Lines 3-6, characters 4-7: 4 | type t = T 5 | let x = T 6 | end -Error: The type t/155 introduced by this open appears in the signature +Error: The type t/157 introduced by this open appears in the signature Line 7, characters 8-9: - The value y has no valid type if t/155 is hidden + The value y has no valid type if t/157 is hidden |}];; module A = struct @@ -142,9 +142,9 @@ Lines 3-5, characters 4-7: 3 | ....open struct 4 | type t = T 5 | end -Error: The type t/160 introduced by this open appears in the signature +Error: The type t/162 introduced by this open appears in the signature Line 6, characters 8-9: - The value y has no valid type if t/160 is hidden + The value y has no valid type if t/162 is hidden |}] (* It was decided to not allow this anymore. *) diff --git a/testsuite/tests/typing-sigsubst/sigsubst.ml b/testsuite/tests/typing-sigsubst/sigsubst.ml index 7cfa290283..c64c79ea5b 100644 --- a/testsuite/tests/typing-sigsubst/sigsubst.ml +++ b/testsuite/tests/typing-sigsubst/sigsubst.ml @@ -24,11 +24,11 @@ end Line 3, characters 2-36: 3 | include Comparable with type t = t ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Illegal shadowing of included type t/98 by t/102 +Error: Illegal shadowing of included type t/100 by t/104 Line 2, characters 2-19: - Type t/98 came from this include + Type t/100 came from this include Line 3, characters 2-23: - The value print has no valid type if t/98 is shadowed + The value print has no valid type if t/100 is shadowed |}] module type Sunderscore = sig |