drawing error inside scrolled window

[hendriktews]

With liblablgtk2-ocaml-dev 2.18.13-1 and libgtk2.0-0 2.24.33-2+deb12u1 (from Debian bookworm) I see sometimes drawing errors when drawing in the expose handler of a drawing_area which is inside a scrolled_window. The program appended below reliably reproduces the problem for me. To reproduce:

• compile the program with ocamlopt.opt -g -I +lablgtk2 -o scrolled_expose_problem unix.cmxa lablgtk.cmxa gtkInit.cmx scrolled_expose_problem.ml
• When started, the program creates a drawing_area inside a scrolled_window and requests a size for the drawing area that does not fit inside the window.
• The expose handler only draws a little box inside the exposed area. Therefore, when you press page-down, you see a box at about half of the height of the window.
• However, when you press page-up now, you see two boxes, one in the upper exposed part and one in the lower non-exposed part.
• You can press e before page-up to erase the drawing area - this shows very clear that the second box is a drawing error.
• When you reduce the size request in line 46 to a height of 740, the error goes away - then there is only one box after page-up.
• q quits the program.

The program:

let top_window = GWindow.window ()

let _ = top_window#set_default_size ~width:500 ~height:500

let drawing_scrolling = GBin.scrolled_window
    ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC 
    ~packing:top_window#add () 

let drawing_area = GMisc.drawing_area 
    ~packing:drawing_scrolling#add_with_viewport () 

let _ = drawing_area#misc#realize ()

let drawable = new GDraw.drawable drawing_area#misc#window

let erase () = 
  let (x,y) = drawable#size in
  let fg = (Gdk.GC.get_values drawable#gc).Gdk.GC.foreground in
  let bg = top_window#misc#style#bg `PRELIGHT in
  drawable#set_foreground (`COLOR bg);
  drawable#rectangle ~filled:true ~x:0 ~y:0 ~width:x ~height:y ();
  drawable#set_foreground (`COLOR fg);
  ()

let key_pressed_callback ev =
  match GdkEvent.Key.keyval ev with 
    | ks when (ks = GdkKeysyms._Q || ks = GdkKeysyms._q) ->
       exit 0
    | ks when (ks = GdkKeysyms._e || ks = GdkKeysyms._e) ->
       erase ();
       true
    | _ -> false
  
let expose_callback (_ev : GdkEvent.Expose.t) =
  let r = GdkEvent.Expose.area _ev in
  let x = Gdk.Rectangle.x r in
  let y = Gdk.Rectangle.y r in
  drawable#rectangle ~x:(x+10) ~y:(y+10) ~width:20 ~height:10 ~filled:true ();
  true

let open_window () =
  top_window#set_title ("expose problem");
  ignore(top_window#event#connect#key_press ~callback:key_pressed_callback);
  ignore(drawing_area#event#connect#expose ~callback:expose_callback);
  top_window#show ();
  drawing_area#misc#set_size_request ~width:200 ~height:750 ();
  ()

let main () =
  open_window ();
  GMain.Main.main ()

let _ = main()

(*
 * Local Variables:
 * compile-command: "ocamlopt.opt -g -I +lablgtk2 -o scrolled_expose_problem lablgtk.cmxa gtkInit.cmx scrolled_expose_problem.ml"
 * End:
 *)