usr/src/common/ficl/test/ooptest.fr

   1 \ OOP test stuff
   2
   3 only
   4 also oop definitions
   5
   6 object subclass c-aggregate
   7 c-byte obj: m0
   8 c-byte obj: m1
   9 c-4byte obj: m2
  10 c-2byte obj: m3
  11 end-class
  12
  13 object --> sub class1
  14
  15 cell: .a
  16 cell: .b
  17 : init
  18         locals| class inst |
  19         0 inst class --> .a !
  20         1 inst class --> .b !
  21 ;
  22 end-class
  23
  24 class1 --> new c1inst
  25
  26 class1 --> sub class2
  27 cell: .c
  28 cell: .d
  29
  30 : init
  31         locals| class inst |
  32         inst class --> super --> init
  33         2 inst class --> .c !
  34         3 inst class --> .d !
  35 ;
  36 end-class
  37
  38 class2 --> new c2inst
  39
  40 object subclass c-list
  41 c-list ref: link
  42 c-ref  obj: payload
  43 end-class
  44
  45 \ test stuff from ficl.html
  46 .( metaclass methods ) cr
  47 metaclass --> methods
  48
  49 cr .( c-foo class ) cr
  50 object --> sub c-foo
  51 cell: m_cell1
  52     4 chars: m_chars
  53     : init   ( inst class -- )
  54         locals| class inst |
  55         0 inst class --> m_cell1 !
  56         inst class --> m_chars 4 0 fill
  57         ." initializing an instance of c_foo at " inst x. cr
  58     ;
  59 end-class
  60
  61 .( c-foo instance methods... ) cr
  62 c-foo --> new foo-instance
  63 cr
  64 foo-instance --> methods
  65 foo-instance --> pedigree
  66 cr
  67 foo-instance 2dup
  68     --> methods
  69     --> pedigree
  70 cr
  71 c-foo --> see init
  72 cr
  73 foo-instance --> class --> see init