# -*- Tcl -*-
package require nx
package require nx::test
package require nx::doc

namespace import -force ::nx::*
namespace import -force ::nx::doc::*


nx::test configure -count 1

#
# some helper
#

proc lcompare {a b} {
  foreach x $a y $b {
    if {$a ne $b} {return -1}
  }
  return 1
}

# --

#
# Source the "Document Comment" backend
#
package require nx::doc::dc

Test case scanning {

  set lines {
    "# @package o"			1
    "#@package o"			1
    "bla"				0
    "# @object o"			1
    "# 1 2 3"				1
    "#"					1
    "#    "				1
    "   #   "				1
    "\t#\t \t"				1
    "#  345"				1
    "# @tag1 part1"			1
    "bla; # no comment"			0
    ""					0
    "\t\t"				0
    "### # # # # @object o # ####"	1
    "# # # # # 345"			1
    "# # # @tag1 part1"			1
    "bla; # # # # # no comment"		0
    "    "				0

  }
  
  set ::prj [@project new -name _PROJECT_]
  foreach {::line ::result} $lines {
    ? {lassign [$::prj analyze_line $::line] is_comment text; set is_comment} $::result "processor analyze_line '$::line'"
  }

  set script {
    # @package o
    # 1 2 3
    bla
    bla
    # @object o
    # 1 2 3
    #
    #  345 
    # @tag1 part1 
    # @tag2 part2
    bla; # no comment
    bla
    bla
    bla
    
    
    ### # # # # @object o # ####
    #    1 2 3
    #
    # # # # # 345 
    # # # @tag1 part1 
    # @tag2 part2
    bla; # # # # # no comment
  }

  set blocks {1 {{ @package o} { 1 2 3}} 5 {{ @object o} { 1 2 3} {} {  345} { @tag1 part1} { @tag2 part2}} 17 {{ @object o # ####} {    1 2 3} {} { 345} { @tag1 part1} { @tag2 part2}}}

    ? [list ::lcompare [$::prj comment_blocks $script] $blocks] 1
  }
 
    Test case parsing {
      set ::prj [@project new -name _PROJECT_]
      
      namespace import -force ::nx::doc::CommentBlockParser
      #
      # TODO: Add tests for doc-parsing state machine.
      #
      set block {
	{@command ::cc}
      }
      set ::cbp [CommentBlockParser process $block]
      ? [list $::cbp status ? COMPLETED] 1

      set block {
	{}
      }

      set cbp [CommentBlockParser process $block]
      ? [list $cbp status ? COMPLETED] 0
      ? [list $cbp status ? STYLEVIOLATION] 1
      
      #
      # For now, a valid comment block must start with a non-space line
      # (i.e., a tag or text line, depending on the section: context
      # vs. description)
      #
      
      set block {
	{}
	{@command ::cc}
      }
      
      set cbp [CommentBlockParser process $block]
      ? [list $cbp status ? STYLEVIOLATION] 1

      set block {
	{command ::cc}
	{}
      }

      set cbp [CommentBlockParser process $block]
      ? [list $cbp status ? STYLEVIOLATION] 1

      set block {
	{@command ::cc}
	{some description}
      }
      
      set cbp [CommentBlockParser process $block]
      ? [list $cbp status ? STYLEVIOLATION] 1
      
      set block {
	{@command ::cc} 
	{}
	{}
	{}
	{@see ::o}
      }
      
      set cbp [CommentBlockParser process $block]
      ? [list $cbp status ? STYLEVIOLATION] 0
      ? [list $cbp status ? COMPLETED] 1

      set block {
	{@command ::cc}
	{}
	{some description}
	{some description2}
	{}
	{}
      }

      set cbp [CommentBlockParser process $block]
      ? [list $cbp status ? STYLEVIOLATION] 0

      # Note: We do allow description blocks with intermediate space
      # lines, for now.
      set block {
	{@command ::cc}
	{}
	{some description}
	{some description2}
	{}
	{an erroreneous description line, for now}
      }
      
      set cbp [CommentBlockParser process $block]
      ? [list $cbp status ? STYLEVIOLATION] 0

      #
      # TODO: Do not enforce space line between the context and immediate
      # part block (when description is skipped)?
      # 
      # OR: For absolutely object::qualifying parts (e.g., outside of an initblock),
      # do we need sequences of _two_ (or more) tag lines, e.g.
      # 
      # --
      # @object Foo
      # @param attr1
      # --
      #
      # THEN, we can only discriminate between the context and an
      # immediate part section by requiring a space line!
      #
      # Alternatively, we can use the @see like syntax for object::qualifying:
      # @param ::Foo#attr1 (I have a preference for this option).
      set block {
	{@command ::cc}
	{@see someOtherEntity}
      }

      set cbp [CommentBlockParser process $block]
      ? [list $cbp status ? STYLEVIOLATION] 1
      

      #
      # TODO: Disallow space lines between parts? Check back with Javadoc spec.
      #
      set block {
	{@command ::cc}
	{}
	{@see SomeOtherEntity}
	{add a line of description}
	{}
	{}
	{@see SomeOtherEntity2}
	{}
      }

      set cbp [CommentBlockParser process $block]
      ? [list $cbp status ? STYLEVIOLATION] 1

      #
      # TODO: Should we enforce a mandatory space line between description and part block?
      #
      set block {
	{@command ::cc}
	{}
	{add a line of description}
	{a second line of description}
	{a third line of description}
	{@see entity3}
	{@see SomeOtherEntity2}
      }

      set cbp [CommentBlockParser process $block]
      ? [list $cbp status ? STYLEVIOLATION] 1

      set block {
	{@command ::cc}
	{}
	{add a line of description}
	{a second line of description}
	{a third line of description}
	{}
	{@see SomeOtherEntity2}
	{}
	{}
	{an erroreneous description line, for now}
      }

      set cbp [CommentBlockParser process $block]
      ? [list $cbp status ? STYLEVIOLATION] 1 
      
      set block {
	{@command ::cc}
	{}
	{add a line of description}
	{a second line of description}
	{}
	{a third line of description}
	{}
	{@see SomeOtherEntity2}
      }

      set cbp [CommentBlockParser process $block]
      ? [list $cbp status ? STYLEVIOLATION] 0

      set block {
	{@object ::cc}
	{}
	{add a line of description}
	{a second line of description}
	{}
	{@see SomeOtherEntity2}
	{@xyz SomeOtherEntity2}
      }

      set cbp [CommentBlockParser process $block]
      ? [list $cbp status ? INVALIDTAG] 1

      set block {
	{@class ::cc}
	{}
	{add a line of description}
	{a second line of description}
	{}
	{@see SomeOtherEntity2}
	{@xyz SomeOtherEntity2}
      }

      set cbp [CommentBlockParser process $block]
      ? [list $cbp status ? INVALIDTAG] 1
      
      #
      # TODO: Where shall we allow the @author tag?! Re-activate
      # later, if necessary ...
      #
      if {0} {
      #
      # testing the doc object construction
      #
      set block {
	{@object ::o} 
	{}
	{some more text}
	{and another line for the description}
	{}
	{@author stefan.sobernig@wu.ac.at}
	{@author gustaf.neumann@wu-wien.ac.at}
      }

      set cbp [CommentBlockParser process $block]
    
      ? [list $cbp status ? COMPLETED] 1
    
      set entity [$cbp current_entity]
      ? [list ::nsf::is object $entity] 1
      ? [list $entity info has type ::nx::doc::@object] 1
      ? [list $entity @author] "stefan.sobernig@wu.ac.at gustaf.neumann@wu-wien.ac.at";
      ? [list $entity as_text] "some more text and another line for the description";
      
    }
      
      set block {
	{@command ::c} 
	{}
	{some text on the command}
	{}
	{@see ::o}
      }

      set cbp [CommentBlockParser process $block]
      ? [list $cbp status ? COMPLETED] 1
      set entity [$cbp current_entity]

      ? [list ::nsf::is object $entity] 1
      ? [list $entity info has type ::nx::doc::@command] 1
      ? [list $entity as_text] "some text on the command";
      ? [list $entity @see] "::o";

      set block {
	{@class ::C} 
	{}
	{some text on the class entity}
	{}
	{@class-property attr1 Here! we check whether we can get a valid description block}
	{for text spanning multiple lines}
      }

      set cbp [CommentBlockParser process $block]
      ? [list $cbp status ? COMPLETED] 1
      set entity [$cbp current_entity]

      ? [list ::nsf::is object $entity] 1
      ? [list $entity info has type ::nx::doc::@class] 1
      ? [list $entity as_text] "some text on the class entity";
      ? [list llength [$entity @property]] 1
      ? [list [$entity @property] info has type ::nx::doc::@param] 1
      ? [list [$entity @property] as_text] "Here! we check whether we can get a valid description block for text spanning multiple lines"

    }

    if {0} {
    Test case in-situ-basics {
      #
      # basic test for in-situ documentation (initblock)
      # 
      #
      set script {
	package req nx
	namespace import -force ::nx::Class
	Class create ::Foo {
	  # The class Foo defines the behavior for all Foo objects
	  #
	  # @author gustaf.neumann@wu-wien.ac.at
	  # @author ssoberni@wu.ac.at
	  
	  # @.property attr1 
	  #
	  # This property 1 is wonderful
	  #
	  # @see ::nx::VariableSlot
	  # @see ::nx::MetaSlot
	  :property attr1
	  :property attr2
	  :property attr3
	  
	  # @.method foo
	  #
	  # This describes the foo method
	  #
	  # @parameter a Provides a first value
	  # @parameter b Provides a second value
	  :method foo {a b} {;}
	}
      }

      # set prj [processor process -sandboxed -type eval $script]
      set prj [@project new -name _PROJECT_]
      
      set entity [@class id ::Foo]
      ? [list ::nsf::is object $entity] 1
      ? [list $entity info has type ::nx::doc::@class] 1
      ? [list $entity as_text] "The class Foo defines the behavior for all Foo objects";
      ? [list $entity @author] "gustaf.neumann@wu-wien.ac.at ssoberni@wu.ac.at"
      # TODO: Fix the [@param id] programming scheme to allow (a) for
      # entities to be passed and the (b) documented structures
      set entity [@property id [@class id ::Foo] class attr1]
      ? [list ::nsf::is object $entity] 1
      ? [list $entity info has type ::nx::doc::@property] 1
      ? [list $entity @see] "::nx::VariableSlot ::nx::MetaSlot";
      
      set entity [@method id ::Foo class foo]
      ? [list [@class id ::Foo] @method] $entity
      ? [list ::nsf::is object $entity] 1
      ? [list $entity info has type ::nx::doc::@method] 1
      ? [list $entity as_text] "This describes the foo method";
      
      foreach p [$entity @parameter] expected {
	"Provides a first value"
	"Provides a second value"
      } {
	? [list expr [list [$p as_text] eq $expected]] 1;
      }
      
      $prj destroy
    }

    # TODO: how to realize scanning and parsing for mixed ex- and
    # in-situ documentation? That is, how to differentiate between
    # absolutely and relatively qualified comment blocks in line-based
    # scanning phase (or later)?

    Test case mixed-mode-parsing {
      
      set script {
	package req nx
	namespace import -force ::nx::*
	# @class ::Bar
	# 
	# The class Bar defines the behavior for all Bar objects
	#
	# @author gustaf.neumann@wu-wien.ac.at
	# @author ssoberni@wu.ac.at
	
	# @class.property {::Bar attr1}
	#
	# This property 1 is wonderful
	#
	# @see ::nx::VariableSlot
	# @see ::nx::MetaSlot
	
	# @class.class-method {::Bar foo}
	#
	#
	# This describes the foo method
	#
	# @parameter a Provides a first value
	# @parameter b Provides a second value
	
	# @class.object-method {::Bar foo}
	#
	# This describes the per-object foo method
	#
	# @parameter a Provides a first value
	# @parameter b Provides a second value
	
	namespace eval ::ns1 {
	  ::nx::Object create ooo
	}
	Class create Bar {
	  
	  :property attr1
	  :property attr2
	  :property attr3
	  
	  # @.method foo
	  #
	  # This describes the foo method in the initblock
	  #
	  # @parameter a Provides a first value
	  # @parameter b Provides a second value
	  
	  :public method foo {a b} {
	    # This describes the foo method in the method body
	    #
	    # @parameter a Provides a first value (refined)
	    
	  }
	  
	  :public class method foo {a b c} {
	    # This describes the per-object foo method in the method body
	    #
	    # @parameter b Provides a second value (refined)
	    # @parameter c Provides a third value (first time)
	    
	  }
	  
	}
      }
      
      set prj [processor process -sandboxed -type eval $script]
      set entity [@class id ::Bar]
      ? [list ::nsf::is object $entity] 1
      ? [list $entity info has type ::nx::doc::@class] 1
      ? [list $entity as_text] "The class Bar defines the behavior for all Bar objects";
      ? [list $entity @author] "gustaf.neumann@wu-wien.ac.at ssoberni@wu.ac.at"
      
      # TODO: Fix the [@param id] programming scheme to allow (a) for
      # entities to be passed and the (b) documented structures
      set entity [@property id [@class id ::Bar] class attr1]
      ? [list ::nsf::is object $entity] 1
      ? [list $entity info has type ::nx::doc::@property] 1
      ? [list $entity @see] "::nx::VariableSlot ::nx::MetaSlot";
      
      set entity [@method id ::Bar class foo]
      ? [list [@class id ::Bar] @method] $entity
      ? [list ::nsf::is object $entity] 1
      ? [list $entity info has type ::nx::doc::@method] 1
      ? [list $entity as_text] "This describes the foo method in the method body";
      
      foreach p [$entity @parameter] expected {
	"Provides a first value (refined)"
	"Provides a second value"
      } {
	? [list expr [list [$p as_text] eq $expected]] 1;
      }
      
      
      set entity [@method id ::Bar object foo]
      ? [list [@class id ::Bar] @class-object-method] $entity
      ? [list ::nsf::is object $entity] 1
      ? [list $entity info has type ::nx::doc::@method] 1
      ? [list $entity as_text] "This describes the per-object foo method in the method body";
      
      foreach p [$entity @parameter] expected {
	"Provides a first value"
	"Provides a second value (refined)"
	"Provides a third value (first time)"
      } {
	? [list expr [list [$p as_text] eq $expected]] 1;
      }
      
      $prj destroy
    }

    Test case tag-notations-basics {
      
      #
      # Some tests on structured/navigatable tag notations
      #
      
      # adding support for parsing levels
      
      # -- @class.object.object {::D o1 o2}
      set block {
	{@..object o2 We have a tag notation sensitive to the parsing level}
      }
      
      set entity [[@ @class ::D] @object o1]
      set cbp [CommentBlockParser process -parsing_level 1 -partof_entity $entity $block]
      ? [list $cbp status ? LEVELMISMATCH] 1
      set cbp [CommentBlockParser process -parsing_level 2 -partof_entity $entity $block]
      ? [list $cbp status ? COMPLETED] 1
      set entity [$cbp current_entity]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity info has type ::nx::doc::@object] 1
      ? [list $entity as_text] "We have a tag notation sensitive to the parsing level"
      
      set block {
	{@..object {o2 o3} We still look for balanced specs}
      }
      
      set entity [[@ @class ::D] @object o1]
      set cbp [CommentBlockParser process -parsing_level 2 -partof_entity $entity $block]
      ? [list $cbp status ? STYLEVIOLATION] 1
      
      # This fails because we do not allow uninitialized/non-existing
      # entity objects (@object o) along the resolution path ...
      set block {
	{@class.object.property {::C o attr1} We have an invalid specification}
      }
      
      set cbp [CommentBlockParser process $block]
      ? [list $cbp status ? INVALIDTAG] 1
      #  ? [list $cbp message] "The tag 'object' is not supported for the entity type '@class'"
      
      set block {
	{@class.method.property attr1 We have an imbalanced specification (the names are underspecified!)}
      }
      set cbp [CommentBlockParser process $block]
      ? [list $cbp status ? STYLEVIOLATION] 1
      ? [list $cbp message] "Imbalanced tag line spec: 'class method property' vs. 'attr1'"
      
      # For now, we do not verify and use a fixed scope of permissive tag
      # names. So, punctuation errors or typos are most probably reported
      # as imbalanced specs. In the mid-term run, this should rather
      # become an INVALIDTAG condition.
      set block {
	{@cla.ss.method.parameter {::C foo p1} We mistyped a tag fragment}
      }
      set cbp [CommentBlockParser process $block]
      ? [list $cbp status ? STYLEVIOLATION] 1
      ? [list $cbp message] "Imbalanced tag line spec: 'cla ss method parameter' vs. '::C foo p1'"
      
      set block {
	{@cla,ss.method.parameter {::C foo p1} We mistyped a tag fragment}
      }
      set cbp [CommentBlockParser process $block]
      ? [list $cbp status ? INVALIDTAG] 1
      ? [list $cbp message] "The entity type '@cla,ss' is not available."
    }

    Test case tag-notations-extended {
      set script {
	# @class ::C
	#
	# The global description of ::C
	#
	# @property attr1 Here we can only provide a description block for object parameters
	
	# @class.object-method {::C sub}
	#
	# For now, we have to declare a family of sub methods explicitly
	# (allows for providing some overview, shared description)


	# @class.property {::C attr1} Here, we could also write '@class.class-property \{::C attr1\}', @property is a mere forwarder! In the context section, only one-liners are allowed!
	
	# @class.object.property {::C foo p1} A short description is ...
	#
	# .. is overruled by a long one ...
	
	# If addressing to a nested object, one strategy would be to use
	# @object and provide the object identifier (which reflects the
	# nesting, e.g. ::C::foo). However, we cannot distinguish between
	# namespace qualifiers denoting an object, class or owning
	# namespace!
	#
	# ISSUE: If specifying an axis ".object", we would have to define
	# a part property @object on @class and @object. However, @object
	# would be ambiguous now: It could be called in a freestanding
	# (absolute) manner AND in a contextualised manner (in an init
	# block). In the latter case, it would fail because we would have
	# to provide a FQ'ed name (which defeats the purpose of a nested =
	# contextualised notation).
	# 
	# SO: for now, we introduce a part property child-object (and
	# child-class?) to discrimate between the two situations ...
	#
	# TODO: How to register this so created @object entity as nested
	# object with the doc entity represented the parent object?
	
	Class create C {
	  # This is the initblock description of ::C which overwrites the
	  # global description (see above)
	  
	  # @.property attr1
	  #
	  # This is equivalent to writing "@class-property attr1"
	  :property attr1 {
	    # This description does not apply to the object parameter
	    # "attr1" owned by the ::C class, rather it is a description
	    # of the property slot object! How should we deal with this
	    # situation? Should this level overwrite the top-level and
	    # initblock descriptions?
	  }
	  
	  # @.class-object-property attr2 Carries a short desc only
	  :class property attr2
	  
	  # @.method foo
	  #
	  # @parameter p1
	  set fooHandle [:public method foo {p1} {
	    # Here goes some method-body-level description
	    #
	    # @parameter p1 The most specific level!
	    return [current method]-$p1-[current]
	  }]
	  
	  # @.object-method bar
	  #
	  # Before referring to its parts, an entity must exist; so
	  # declare eagerly ...

	  # @.class-object-method.parameter {bar p1}
	  #
	  # This extended form allows one to describe a method parameter with all
	  # its structural features!
	  set barHandle [:public class method bar {p1} {
	    return [current method]-$p1-[current]
	  }]
	  
	  # @.object foo 'foo' needs to be defined before referencing any of its parts!
	  
	  # @.object.property {foo p1}
	  #
	  # The first element in the name list is resolved into a fully
	  # qualified (absolute) entity, based on the object owning the
	  # initblock!
	  Object create [current]::foo {
	    # Adding a line for the first time (not processed in the initblock phase!)
	    
	    # @..property p1
	    # 
	    # This is equivalent to stating "@class-object-property p1"
	    :property p1
	  }
	  
	  # @.class Foo X
	  #
	  # By providing a fully-qualified identifier ("::Foo") you leave the
	  # context of the initblock-owning object, i.e. you would NOT refer to 
	  # a nested class object named "Foo" anymore!
	  
	  # @.class.property {Foo p1}
	  #
	  # This is equivalent to stating "@child-class.class-property {Foo p1}"
	  
	  # @.class.class-object-property {Foo p2} Y
	  Class create [current]::Foo {
	    
	    # @..property p1
	    # 
	    #
	    # This is equivalent to stating "@class-property p1"; or
	    # '@class.object.property {::C Foo p1}' from the top-level.
	    :property p1
	    
	    # @..class-object-property p2
	    :class property p2
	  }
	  
	  
	  # @.class-object-method.sub-method {sub foo}
	  #
	  # ISSUE: Should submethods be navigatable through "method" (i.e.,
	  # "@method.method.method ...") or "submethod" (i.e.,
	  # "@method.submethod.submethod ...")? ISSUE: Should it be sub* with
	  # "-" (to correspond to "@class-object-method", "@class-method")? Also, we
	  # could allow both (@sub-method is the property name, @method is a
	  # forwarder in the context of an owning @method object!)
	  # 
	  # @parameter p1 Some words on p1
	  :class alias "sub foo" $fooHandle
	  
	  # @.method sub
	  #
	  # The desc of the ensemble object 'sub'
	  #
	  # @sub-method bar Only description available here ...
	  
	  # ISSUE: Should the helper object "sub" be documentable in its own
	  # right?  This would be feasible with the dotted notation from
	  # within and outside the init block, e.g. "@object sub" or
	  # "@class.object {::C sub}"
	  #
	  # ISSUE: Is it correct to say the sub appears as per-object method
	  # and so do its submethods? Or is it misleading to document it that
	  # way? Having an "@class-object-submethod" would not make much sense to
	  # me?!
	  :alias "sub bar" $barHandle 
	  
	  # @.class-object-method sub A brief desc
	  
	  # @.class-object-method {"sub foo2"}
	  #
	  # could allow both (@sub-method is the property name, @method is a
	  # forwarder in the context of an owning @method object!)
	  # 
	  # @parameter p1 Some words on p1
	  # @see anotherentity
	  # @author ss@thinkersfoot.net
	  :class alias "sub foo2" $fooHandle
	}
      }
      
      #
      # 1) process the top-level comments (PARSING LEVEL 0)
      #
      
      processor readin $script
      
      
      # --testing-- "@class ::C"
      set entity [@class id ::C]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity info has type ::nx::doc::@class] 1
      ? [list $entity as_text] "The global description of ::C";
      # --testing-- "@class.property {::C attr1}"
      set entity [@property id $entity class attr1]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity info has type ::nx::doc::@property] 1
      ? [list $entity as_text] "Here, we could also write '@class.class-property {::C attr1}', @property is a mere forwarder! In the context section, only one-liners are allowed!"

      # --testing-- "@class.object.property {::C foo p1} A short description is ..."
      # set entity [@property id $entity class attr1]
      # set entity [@object id -partof_name ::C -scope child foo]
      # ? [list ::nsf::object::exists $entity] 1
      # ? [list $entity info has type ::nx::doc::@object] 1
      # ? [list $entity as_text] ""
      # set entity [@property id $entity object p1]
      # ? [list ::nsf::object::exists $entity] 1
      # ? [list $entity info has type ::nx::doc::@property] 1
      # ? [list $entity as_text] ".. is overruled by a long one ..."

      set entity [@object id ::C::foo]
      ? [list ::nsf::object::exists $entity] 0
      set entity [@property id $entity class p1]
      ? [list ::nsf::object::exists $entity] 0
      #  ? [list $entity info has type ::nx::doc::@property] 1
      #  ? [list $entity as_text] ".. is overruled by a long one ..."

      # --testing-- @class-object-property attr2 (its non-existence)
      set entity [@property id [@class id ::C] object attr2]
      ? [list ::nsf::object::exists $entity] 0
      # --testing-- @child-class Foo (its non-existence)
      set entity [@class id ::C::Foo]
      ? [list ::nsf::object::exists $entity] 0
      # --testing -- @method foo (its non-existence)
      set entity [@method id ::C class foo]
      ? [list ::nsf::object::exists $entity] 0
      # --testing-- @class-object-method.parameter {bar p1} (its non-existence)
      set entity [@parameter id [@method id ::C class bar] "" p1]
      ? [list ::nsf::object::exists $entity] 0
      # --testing-- @child-object.property {foo p1} (its non-existence)
      set cl [@class id ::C::Foo]
      ? [list ::nsf::object::exists $entity] 0
      set entity [@property id $cl class p1]
      ? [list ::nsf::object::exists $entity] 0
      set entity [@property id $cl object p2]
      ? [list ::nsf::object::exists $entity] 0

      #
      # 2) process the initblock comments (PARSING LEVEL 1)
      #
      
      puts stderr -----CMD------
      ::nsf::configure keepcmds true
      eval $script
      ::nsf::configure keepcmds false
      lassign [processor readin \
		   -parsing_level 1 \
		   -docstring \
		   -tag @class \
		   -name ::C \
		   [::C eval {set :__cmd(__initblock)}]] _ processed_entities
      # a) existing, but modified ...
      
      set entity [@class id ::C]
      ? $_ $entity
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity info has type ::nx::doc::@class] 1
      ? [list $entity as_text] "This is the initblock description of ::C which overwrites the global description (see above)"
      
      set entity [@property id $entity class attr1]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity info has type ::nx::doc::@property] 1
      ? [list $entity as_text] {This is equivalent to writing "@class-property attr1"}
      
      
      set entity [@object id ::C::foo]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity info has type ::nx::doc::@object] 1
      ? [list $entity as_text] "'foo' needs to be defined before referencing any of its parts!"; # still empty!
      set entity [@property id $entity object p1]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity info has type ::nx::doc::@property] 1
      ? [list $entity as_text] "The first element in the name list is resolved into a fully qualified (absolute) entity, based on the object owning the initblock!"
      
      # b) newly added ...
      
      # --testing-- @class-object-property attr2
      set entity [@property id [@class id ::C] object attr2]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity info has type ::nx::doc::@property] 1
      ? [list $entity as_text] "Carries a short desc only";
      
      # --testing-- @child-class Foo
      # TODO: provide a check against fully-qualified names in part specifications
      set entity [@class id ::C::Foo]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity info has type ::nx::doc::@class] 1
      ? [list $entity as_text] {By providing a fully-qualified identifier ("::Foo") you leave the context of the initblock owning object, i.e. you would NOT refer to a nested class object named "Foo" anymore!}
      
      set entity [@property id [@class id ::C] class p1]
      ? [list ::nsf::object::exists $entity] 0; # should be 0 at this stage!
      
      # --testing -- @method foo
      set entity [@method id ::C class foo]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity as_text] ""
      # --testing-- @class-object-method.parameter {bar p1} (its non-existence) It
      # still cannot exist as a documented entity, as the class method
      # has not been initialized before!
      set entity [@parameter id [@method id ::C class bar] "" p1]
      ? [list ::nsf::object::exists $entity] 0
      # --testing-- @child-class.property {foo p1} (its non-existence)
      # --testing-- @child-class.object-property {foo p2} (its non-existence)
      set cl [@class id ::C::Foo]
      ? [list ::nsf::object::exists $cl] 1
      set entity [@property id $cl class p1]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity as_text] {This is equivalent to stating "@child-class.class-property {Foo p1}"}
      set entity [@property id $cl object p2]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity as_text] "Y"
      
      set entity [@method id ::C class sub]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity as_text] "The desc of the ensemble object 'sub'"
      
      set entity [@method id ::C class sub::bar]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity as_text] "Only description available here ..."
      
      set entity [@method id ::C object sub]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity as_text] "A brief desc"
      
      set entity [@method id ::C object sub::foo2]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity info has type ::nx::doc::@method] 1
      ? [list $entity as_text] "could allow both (@sub-method is the property name, @method is a forwarder in the context of an owning @method object!)"
      ? [list $entity @see] "anotherentity"
      # TODO: @author not supported for @method (fine so?)
      # ? [list $entity @author] "ss@thinkersfoot"
      set entity [@parameter id $entity "" p1]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity as_text] "Some words on p1"
      
      #
      # 3a) process the property initblocks and method bodies (PARSING LEVEL 2)!
      #  
      
      set project [@project new -name "_%@"]
      $project sandbox [Sandbox new]
      processor process=@class $project [@class id ::C]
      
      # methods ...
      
      set entity [@method id ::C class foo]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity as_text] "Here goes some method-body-level description"
      set entity [@parameter id [@method id ::C class foo] "" p1]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity as_text] "The most specific level!"
      
      # attributes ...
      
      # attr1 
      set entity [@property id [@class id ::C] class attr1]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity info has type ::nx::doc::@property] 1
      ? [list $entity as_text] {This description does not apply to the object parameter "attr1" owned by the ::C class, rather it is a description of the property slot object! How should we deal with this situation? Should this level overwrite the top-level and initblock descriptions?}
      
      #
      # 3b) nested objects/ classes (PARSING LEVEL 2)!
      # 
      processor readin \
	  -docstring \
	  -parsing_level 2 \
	  -tag @object \
	  -name ::C::foo \
	  [::C::foo eval {set :__cmd(__initblock)}]
      
      processor process=@object $project [@object id ::C::foo]
      
      set entity [@object id ::C::foo]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity info has type ::nx::doc::@object] 1
      ? [list $entity as_text] "Adding a line for the first time (not processed in the initblock phase!)"; # still empty!
      set entity [@property id $entity object p1]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity info has type ::nx::doc::@property] 1
      ? [list $entity as_text] {This is equivalent to stating "@class-object-property p1"}
      
      processor readin \
	  -docstring \
	  -parsing_level 2 \
	  -tag @class \
	  -name ::C::Foo \
	  [::C::Foo eval {set :__cmd(__initblock)}]
      processor process=@class $project [@class id ::C::Foo]
      
      set cl [@class id ::C::Foo]
      ? [list ::nsf::object::exists $cl] 1
      set entity [@property id $cl class p1]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity as_text] {This is equivalent to stating "@class-property p1"; or '@class.object.property {::C Foo p1}' from the top-level.}
      set entity [@property id $cl object p2]
      ? [list ::nsf::object::exists $entity] 1
      ? [list $entity as_text] ""
      
      #
      # basic testing of "properties" (switch attributes)
      #

      ? [list $cl eval {set :@deprecated}] 0
      ? [list $cl eval {set :@stashed}] 0
      ? [list $cl eval {set :@c-implemented}] 0

      ? [list $cl @deprecated] 1
      ? [list $cl @stashed] 1
      ? [list $cl @c-implemented] 1

      ? [list $cl eval {set :@deprecated}] 1
      ? [list $cl eval {set :@stashed}] 1
      ? [list $cl eval {set :@c-implemented}] 1

      set entity [@method id ::C class foo]
      ? [list $entity eval {set :@syshook}] 0
      ? [list $entity @syshook] 1
      ? [list $entity eval {set :@syshook}] 1
      ? [list $entity @syshook 0] {wrong # args: should be "get obj prop"}
      ? [list $entity eval {set :@syshook 0}] 0
      ? [list $entity @syshook] 1


    }

    Test case switch-parts {
      
      set script {
	package req nx
	namespace import ::nx::*
	Class create Enil {
	  # The class Enil defines the behavior for all Enil objects,
	  # however, it is deprecated and will be removed from the
	  # provided doc entities in the next iteration ...
	  #
	  # @author ssoberni@wu.ac.at
	  # @deprecated
	  
	  # @.property attr1 
	  #
	  # This property 1 will be invisible in the generated doc
	  #
	  # @stashed
	  :property attr1
	  
	  # @.method foo
	  #
	  # This describes the foo method which is called from within the
	  # nx-enabled Tcl engine
	  #
	  # @syshook
	  :public method foo {a b} {;}
	  
	  :public method baz {} {
	    # This method entity sets a couple of properties in series ...
	    #
	    # @property c-implemented syshook
	  }
	}
      }
      
      set prj [processor process -sandboxed -type eval $script]
      set cl [@class id ::Enil]
      
      ? [list $cl eval {set :@deprecated}] 1
      ? [list $cl @deprecated] 1
      ? [list $cl eval {set :@c-implemented}] 0
      ? [list $cl eval {set :@stashed}] 0
      ? [list $cl @author] ssoberni@wu.ac.at
      
      set entity [@property id $cl class attr1]
      ? [list $entity eval {set :@deprecated}] 0
      ? [list $entity eval {set :@stashed}] 1
      ? [list $entity @stashed] 1
      ? [list $entity eval {set :@c-implemented}] 0
      
      set entity [@method id ::Enil class foo]
      ? [list $entity eval {set :@deprecated}] 0
      ? [list $entity eval {set :@stashed}] 0
      ? [list $entity eval {set :@c-implemented}] 0
      ? [list $entity eval {set :@syshook}] 1
      ? [list $entity @syshook] 1
      
      set entity [@method id ::Enil class baz]
      ? [list $entity eval {set :@deprecated}] 0
      ? [list $entity eval {set :@stashed}] 0
      ? [list $entity eval {set :@c-implemented}] 1
      ? [list $entity @c-implemented] 1
      ? [list $entity eval {set :@syshook}] 1
      ? [list $entity @syshook] 1      
    }
    }

    # # # # # # # # # # # # # # # # # # # #
    # # # # # # # # # # # # # # # # # # # #
    # # # # # # # # # # # # # # # # # # # #

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