re-do of print polyvariants that start with a core_type,closed, not low with leading bar ("|").

a type "[ | w ]" must be printed with the "|", or it won't be
reparseable.

with tests, Changes entry.

# Please enter the commit message for your changes. Lines starting
# with '#' will be ignored, and an empty message aborts the commit.
#
# On branch pr-polyvariant-pprint
# Changes to be committed:
#	modified:   Changes
#	modified:   parsing/parsetree.mli
#	modified:   parsing/pprintast.ml
#	modified:   testsuite/tests/parsetree/source.ml
#
# Untracked files:
#	Changes.orig
#	parsing/pprintast.ml.orig
#	testsuite/tests/parsetree/source.ml.orig
#	testsuite/tests/parsetree/source.ml.rej
#

Changes

@@ -359,6 +359,9 @@ Working version
 - #9889: more caching when printing types with -short-path.
   (Florian Angeletti, review by Gabriel Scherer)
 
+-  #9591: fix pprint of polyvariants that start with a core_type, closed, not low
+   (Chet Murthy, review by Florian Angeletti)
+
 ### Build system:
 
 - #7121, #9558: Always the autoconf-discovered ld in PACKLD. For

parsing/parsetree.mli

@@ -174,7 +174,7 @@ and row_field_desc =
             (see 4.2 in the manual)
         *)
   | Rinherit of core_type
-        (* [ T ] *)
+        (* [ | t ] *)
 
 and object_field = {
   pof_desc : object_field_desc;

parsing/pprintast.ml

@@ -330,6 +330,9 @@ and core_type1 ctxt f x =
              | _ -> list ~first:"(" ~last:")@;" (core_type ctxt) ~sep:",@;" f l)
           l longident_loc li
     | Ptyp_variant (l, closed, low) ->
+        let first_is_inherit = match l with
+          | {Parsetree.prf_desc = Rinherit _}::_ -> true
+          | _ -> false in
         let type_variant_helper f x =
           match x.prf_desc with
           | Rtag (l, _, ctl) ->
@@ -348,7 +351,7 @@ and core_type1 ctxt f x =
              | _ ->
                  pp f "%s@;%a"
                    (match (closed,low) with
-                    | (Closed,None) -> ""
+                    | (Closed,None) -> if first_is_inherit then " |" else ""
                     | (Closed,Some _) -> "<" (* FIXME desugar the syntax sugar*)
                     | (Open,_) -> ">")
                    (list type_variant_helper ~sep:"@;<1 -2>| ") l) l

testsuite/tests/parsetree/source.ml

@@ -7380,3 +7380,9 @@ type t = unit
 let rec equal : 'a. ('a -> 'a -> bool) -> 'a t -> 'a t -> bool =
  (fun poly_a (_ : unit) (_ : unit) -> true) [@ocaml.warning "-A"]
  [@@ocaml.warning "-39"]
+
+(* Issue #9548, PR #9591 *)
+
+type u = [ `A ] ;;
+type v = [ u | `B ] ;;
+let f = fun (x : [ | u ]) -> x ;;