!38 Bug fix equal private was being used in too many pla

From: @xing_xing1992 
Reviewed-by: @Charlie_li 
Signed-off-by: @Charlie_li
This commit is contained in:
openeuler-ci-bot 2023-01-18 08:59:26 +00:00 committed by Gitee
commit 3d2a1ba0bf
No known key found for this signature in database
GPG Key ID: 173E9B9CA92EEF8F
2 changed files with 79 additions and 1 deletions

View File

@ -0,0 +1,74 @@
From 7849115b075308168eafc18913652e0dc458a19a Mon Sep 17 00:00:00 2001
From: Antal Spector-Zabusky <antal.b.sz@gmail.com>
Date: Fri, 4 Jun 2021 18:59:57 -0400
Subject: [PATCH] Bug fix: `equal_private` was being used in too many places
`equal_private` should only be used when checking inclusion for
private *type abbreviations*, but was being used incorrectly for
private data types and private row types as well.
---
typing/includecore.ml | 34 ++++++++++++++++++++++++----------
1 file changed, 24 insertions(+), 10 deletions(-)
diff --git a/typing/includecore.ml b/typing/includecore.ml
index df6a51309..61ddad5dc 100644
--- a/typing/includecore.ml
+++ b/typing/includecore.ml
@@ -516,7 +516,7 @@ let private_object env fields1 params1 fields2 params2 =
| () -> None
end
-let type_manifest env ty1 params1 ty2 params2 priv2 =
+let type_manifest env ty1 params1 ty2 params2 priv2 kind2 =
let ty1' = Ctype.expand_head env ty1 and ty2' = Ctype.expand_head env ty2 in
match ty1'.desc, ty2'.desc with
| Tvariant row1, Tvariant row2
@@ -537,14 +537,28 @@ let type_manifest env ty1 params1 ty2 params2 priv2 =
| Some err -> Some (Private_object(ty1, ty2, err))
end
| _ -> begin
- match
- match priv2 with
- | Private -> Ctype.equal_private env params1 ty1 params2 ty2
- | Public -> Ctype.equal env true (params1 @ [ty1]) (params2 @ [ty2])
- with
- | exception Ctype.Equality trace -> Some (Manifest (env, trace))
- | () -> None
- end
+ let is_private_abbrev_2 =
+ match priv2, kind2 with
+ | Private, Type_abstract -> begin
+ (* Same checks as the [when] guards from above, inverted *)
+ match ty2'.desc with
+ | Tvariant row ->
+ not (is_absrow env (Btype.row_more row))
+ | Tobject (fi, _) ->
+ not (is_absrow env (snd (Ctype.flatten_fields fi)))
+ | _ -> true
+ end
+ | _, _ -> false
+ in
+ match
+ if is_private_abbrev_2 then
+ Ctype.equal_private env params1 ty1 params2 ty2
+ else
+ Ctype.equal env true (params1 @ [ty1]) (params2 @ [ty2])
+ with
+ | exception Ctype.Equality err -> Some (Manifest(env,err))
+ | () -> None
+ end
let type_declarations ?(equality = false) ~loc env ~mark name
decl1 path decl2 =
@@ -565,7 +579,7 @@ let type_declarations ?(equality = false) ~loc env ~mark name
end
| (Some ty1, Some ty2) ->
type_manifest env ty1 decl1.type_params ty2 decl2.type_params
- decl2.type_private
+ decl2.type_private decl2.type_kind
| (None, Some ty2) ->
let ty1 =
Btype.newgenty (Tconstr(path, decl2.type_params, ref Mnil))
--
2.39.0.windows.2

View File

@ -1,6 +1,6 @@
Name: ocaml
Version: 4.13.1
Release: 4
Release: 5
Summary: OCaml compiler and programming environment
License: LGPL-2.1-only
URL: http://www.ocaml.org
@ -10,6 +10,7 @@ Patch0001: 0001-Don-t-add-rpaths-to-libraries.patch
Patch0002: 0002-configure-Allow-user-defined-C-compiler-flags.patch
Patch0003: 0003-configure-Remove-incorrect-assumption-about-cross-co.patch
Patch0004: 0004-Update-dependencies.patch
Patch0005: 0005-Bug-fix-equal_private-was-being-used-in-too-many-pla.patch
BuildRequires: gcc binutils-devel ncurses-devel gdbm-devel gawk perl-interpreter
BuildRequires: util-linux chrpath autoconf annobin make
@ -200,6 +201,9 @@ rm -f $RPM_BUILD_ROOT%{_libdir}/ocaml/eventlog_metadata
%{_mandir}/man3/*
%changelog
* Tue Jan 18 2023 xingxing<xingxing@xfusion.com> - 4.13.1-5
- Bug fix equal private was being used in too many pla
* Mon Jan 09 2023 xingxing<xingxing@xfusion.com> - 4.13.1-4
- Update dependencies