# oometa.test - Copyright (c) 2016 Sean Woods

# -------------------------------------------------------------------------

source [file join [
    file dirname [file dirname [file join [pwd] [info script]]]
] devtools testutilities.tcl]

testsNeedTcl     8.6 ;# tailcall in oo::meta
testsNeedTcltest 2
testsNeed        TclOO

testing {
  useLocal oometa.tcl   oo::meta
  useLocal oooption.tcl oo::option
}

# -------------------------------------------------------------------------
# Test properties

oo::class create foo {
  meta set const color: blue
  
  constructor args {
    my _staticInit
    my configure {*}$args
  }
}

oo::class create bar {
  superclass ::foo
  meta set const shape: oval
  option color {
    label Color
    default green
  }
}

test oo-class-meta-001 {Test accessing properties} {
  foo meta get const color:
} blue

test oo-class-meta-002 {Test accessing properties} {
  bar meta get const color:
} blue

test oo-class-meta-003 {Test accessing properties} {
  bar meta get const shape:
} oval

bar create cheers color pink
# Pulling the meta data from const will return
# the value specified in the class
test oo-object-meta-001 {Test accessing properties} {
  cheers meta get const color:
} blue

# Accessing the data via cget pulls from the local
# definition
test oo-object-meta-001a {Test accessing properties} {
  cheers meta cget color
} green
# pink - Meta CGET is no longer connected to the local object's config

# With or without the trailing :
test oo-object-meta-001b {Test accessing properties} {
  cheers meta cget color:
} green
# pink - Meta CGET is no longer connected to the local object's config

# And using the local cget
test oo-object-meta-001c {Test accessing properties} {
  cheers cget color
} pink

test  oo-object-meta-002 {Test accessing properties} {
  cheers meta get const shape:
} oval

test  oo-object-meta-003 {Test accessing properties} {
  cheers cget color
} pink

bar create moes
test  oo-object-meta-004 {Test accessing properties} {
  moes meta get const color:
} blue

test  oo-object-meta-004a {Test accessing properties} {
  moes cget color
} green

test  oo-object-meta-004a {Test accessing properties} {
  moes cget color:
} green

test  oo-object-meta-005 {Test accessing properties} {
  moes meta get const shape:
} oval

test  oo-object-meta-006 {Test accessing properties} {
  moes cget color
} green

test  oo-object-meta-007 {Test the CGET retrieves a property if an option doesn't exist} {
  moes cget shape
} oval

###
# Test altering a property
###

#oo::define ::foo property woozle whoop
::foo meta set const woozle: whoop

test oo-modclass-meta-001 {Test accessing properties of an altered class} {
  foo meta get const woozle:
} whoop

test oo-modclass-meta-002 {Test accessing properties of the descendent of an altered class} {
  bar meta get const woozle:
} whoop

test oo-modobject-meta-001 {Test the accessing of properties of an instance of an altered class} {
  moes meta get const woozle:
} whoop

test obj-meta-for-001 {Test object meta for} {
  set output {}
  moes meta for {key value} option {
    lappend output $key $value
  }
  set output
} {color {label: Color default: green}}

test obj-meta-with-001 {Test object meta with} {
  set result {}
  moes meta with option {}
  set color
} {label: Color default: green}

test class-meta-for-001 {Test class meta for} {
  set output {}
  bar meta for {key value} option {
    lappend output $key $value
  }
  set output
} {color {label: Color default: green}}

test class-meta-with-001 {Test class meta with} {
  set result {}
  bar meta with option {}
  set color
} {label: Color default: green}

# -------------------------------------------------------------------------

# Test of recursive dicts

oo::class create baz {
  superclass ::bar
  meta set option color default: purple  
}

test obj-meta-recursive-1 {Test that meta set works with recursive dicts} {
  set result {}
  baz meta get option color default:
} {purple}

test obj-meta-recursive-2 {Test that meta set works with recursive dicts} {
  set result {}
  baz meta get option color label:
} {Color}


###
# New test, of mixins
###
oo::class create mixin-test-A {
  meta set const color: blue
  meta set field {
    pkey {name: {Primary Key} type: integer}
    name {name: {Unit Name} type: string}
    typefield {name: {Type Field} type: integer}
  }
  constructor args {
    my _staticInit
    my configure {*}$args
  }
}

oo::class create mixin-test-B {
  meta set const shape: oval
  meta set field {
    location {name: {Location} type: vector}
    typefield {name: {Type Field} type: custom}
  }
  option color {
    label Color
    default green
  }
  constructor args {
    my _staticInit
    my configure {*}$args
  }
}

mixin-test-B create MTB

test obj-mixin-001 {Test that meta prior to meta mixin we don't have a color} {
  MTB meta exists const color:
} 0

MTB meta mixin mixin-test-A
test obj-mixin-002 {Test that prior to meta mixin we don't have a color} {
  MTB meta exists const color:
} 1
test obj-mixin-002 {Test that after meta mixin we do have a color} {
  MTB meta get const color:
} blue
test obj-mixin-003 {Test that after meta mixin we can access the field dict} {
  MTB meta get field pkey name:
} {Primary Key}
test obj-mixin-004 {Test that after meta mixin we can access the field dict's local only value} {
  MTB meta get field location type:
} vector
test obj-mixin-005 {Test that mixed in data overrides conflicting local data} {
  MTB meta get field typefield type:
} integer
testsuiteCleanup

# Local variables:
# mode: tcl
# indent-tabs-mode: nil
# End: