Mantis Bug Tracker

View Issue Details Jump to Notes ] Issue History ] Print ]
IDProjectCategoryView StatusDate SubmittedLast Update
0004561OCamlOCaml generalpublic2008-06-04 08:222008-06-04 09:33
Reporterpalomer 
Assigned To 
PrioritynormalSeveritycrashReproducibilityalways
StatusclosedResolutionfixed 
PlatformOSOS Version
Product Version3.09.1 
Target VersionFixed in Version3.10.3+dev 
Summary0004561: Another OO segfault
DescriptionHere's another piece of code (much more complicated) that segfaults:


class virtual bottle_environment =
object
  method virtual gladiators : string list
  method virtual bottles : bottle list
end
and virtual bottle =
object
  method virtual action : (unit -> bottle_environment option)
end

type outer_space = {
    foo : int list
}
let empty_outer_space =
  {

    foo = [];
      
  }

class virtual expression =
object
  method virtual get_silly_bottle : bottle
end
class virtual expression_skel =
object(self)
  inherit expression
  method bambam = empty_outer_space
  method get_silly_bottle =
  (object
     inherit bottle
     method action () =
       Some (object
           method gladiators =
         print_endline "entering bottles";
         ignore (self#bambam.foo);
         ["enter "]
           method bottles =

         []
         end)
   end)
end
 

class virtual baggy_expression_skel =
object(self)
  inherit expression_skel
  method get_bottle_environment =
  object
    method gladiators = ([]:string list)
    method bottles = [self#get_silly_bottle]
  end
end
  
class virtual papa_expression_skel =
object(self)
  method get_right_sibling_specific = print_endline "im being called, though I shouldn't" ; (None:expression option)
  inherit expression
end

class papa_baggy_expression =
object(self)
  inherit baggy_expression_skel
  inherit papa_expression_skel
end
      
class top_baggy_expression =
object(self)
  inherit baggy_expression_skel
end

let _ =
  let body_expression = new top_baggy_expression in
  let e = new papa_baggy_expression in
    ignore ((body_expression#get_bottle_environment)#bottles);
    let sugg = e#get_silly_bottle in
      match sugg#action () with
    | None -> ()
    | Some y ->
        ignore (y#gladiators)
          



  
      
      
TagsNo tags attached.
Attached Files

- Relationships
duplicate of 0004560closed Segfault in object system 

-  Notes
(0004513)
garrigue (manager)
2008-06-04 09:33

exactly the same problem as PR#4561, which is now closed.

- Issue History
Date Modified Username Field Change
2008-06-04 08:22 palomer New Issue
2008-06-04 09:33 garrigue Relationship added duplicate of 0004560
2008-06-04 09:33 garrigue Status new => closed
2008-06-04 09:33 garrigue Note Added: 0004513
2008-06-04 09:33 garrigue Resolution open => fixed
2008-06-04 09:33 garrigue Fixed in Version => 3.10.3+dev


Copyright © 2000 - 2011 MantisBT Group
Powered by Mantis Bugtracker