package require next
package require xotcl::test
package require next::doc

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


Test parameter count 1

#
# some helper
#

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

Class create ::nx::doc::CommentState::Log {
  :method on_enter {line} {
    puts -nonewline stderr "ENTER -> [namespace tail [:info class]]#[namespace tail [self]]"
    next
  }
  :method on_exit {line} { 
    next
    puts -nonewline stderr "EXIT -> [namespace tail [:info class]]#[namespace tail [self]]"
  }
}

Class create ::nx::doc::CommentLine::Log {
  :method on_enter {line} {
    puts -nonewline stderr "\t"; next; puts stderr " -> LINE = ${:processed_line}"
  }
  :method on_exit {line} {
    puts -nonewline stderr "\t"; next; puts stderr " -> LINE = ${:processed_line}"
  }
}

Class create ::nx::doc::CommentSection::Log {
  :method on_enter {line} {
    next; puts -nonewline stderr "\n"
  }
  :method on_exit {line} {
    next; puts -nonewline stderr "\n";
  }
}

set log false

if {$log} {
  ::nx::doc::CommentState mixin add ::nx::doc::CommentState::Log
  ::nx::doc::CommentLine mixin add ::nx::doc::CommentLine::Log
  ::nx::doc::CommentSection mixin add ::nx::doc::CommentSection::Log
}

# --


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

  }
  
  foreach {::line ::result} $lines {
    ? {foreach {is_comment text} [doc analyze_line $::line] break; set is_comment} $::result "doc 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 [doc comment_blocks $script] $blocks] 1
}

Test case parsing {
  #
  # TODO: Add tests for doc-parsing state machine.
  #
  set block {
    {@command cc}
  }
  ? [list StyleViolation thrown_by? [list EntityClass process $block]] 0

  set block {
    {}
  }
  ? [list StyleViolation thrown_by? [list EntityClass process $block]] 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}
  }
  ? [list StyleViolation thrown_by? [list EntityClass process $block]] 1

 set block {
   {command cc}
   {}
  }
  ? [list StyleViolation thrown_by? [list EntityClass process $block]] 1

  set block {
    {@command cc}
    {some description}
  }
  ? [list StyleViolation thrown_by? [list EntityClass process $block]] 1

 set block {
   {@command cc} 
   {}
   {}
   {}
   {@see ::o}
 }
  EntityClass process $block
  ? [list StyleViolation thrown_by? [list EntityClass process $block]] 0

 set block {
   {@command cc}
   {}
   {some description}
   {some description2}
   {}
   {}
  }
  ? [list StyleViolation thrown_by? [list EntityClass process $block]] 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}
  }
  ? [list StyleViolation thrown_by? [list EntityClass process $block]] 0

  #
  # TODO: Do not enforce space line between the context and imediate
  # part block (when description is skipped)?
  # 
  # OR: For absolutely qualifying parts (e.g., outside of an initcmd block),
  # 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 qualifying:
  # @param ::Foo#attr1 (I have a preference for this option).
  set block {
    {@command cc}
    {@see someOtherEntity}
  }
  ? [list StyleViolation thrown_by? [list EntityClass process $block]] 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}
    {}
  }
  ? [list StyleViolation thrown_by? [list EntityClass process $block]] 0

  #
  # 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}
  }
  ? [list StyleViolation thrown_by? [list EntityClass process $block]] 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}
  }
  
  ? [list StyleViolation thrown_by? [list EntityClass process $block]] 1
  
  set block {
    {@command cc}
    {}
    {add a line of description}
    {a second line of description}
    {}
    {a third line of description}
    {}
    {@see SomeOtherEntity2}
  }
  ? [list StyleViolation thrown_by? [list EntityClass process $block]] 0

  set block {
    {@object cc}
    {}
    {add a line of description}
    {a second line of description}
    {}
    {@see SomeOtherEntity2}
    {@xyz SomeOtherEntity2}
  }
  ? [list InvalidTag thrown_by? [list EntityClass process $block]] 1

  set block {
    {@class cc}
    {}
    {add a line of description}
    {a second line of description}
    {}
    {@see SomeOtherEntity2}
    {@xyz SomeOtherEntity2}
  }
  ? [list InvalidTag thrown_by? [list EntityClass process $block]] 1



  #
  # 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 gneumann@wu.ac.at}
  }
  set entity [EntityClass process $block]
  ? [list ::nx::core::is $entity object] 1
  ? [list $entity info is type ::nx::doc::@object] 1
  ? [list $entity @author] "stefan.sobernig@wu.ac.at gneumann@wu.ac.at";
  ? [list $entity text] "some more text and another line for the description";

  set block {
    {@command c} 
    {}
    {some text on the command}
    {}
    {@see ::o}
  }
  set entity [EntityClass process $block]
  ? [list ::nx::core::is $entity object] 1
  ? [list $entity info is type ::nx::doc::@command] 1
  ? [list $entity text] "some text on the command";
  ? [list $entity @see] "::o";

  #
  # basic test for in-situ documentation (initcmd block)
  # 
  #

  set script {
    Class create Foo {
      # The class Foo defines the behaviour for all Foo objects
      #
      # @author gneumann@wu.ac.at
      # @author ssoberni@wu.ac.at
      
      # @param attr1 
      #
      # This attribute 1 is wonderful
      #
      # @see ::nx::Attribute
      # @see ::nx::MetaSlot
      :attribute attr1
      :attribute attr2
      :attribute attr3

      # @method foo
      #
      # This describes the foo method
      #
      # @param a Provides a first value
      # @param b Provides a second value
      :method foo {a b} {;}
    }
  }

  eval $script
  doc process ::Foo
  set entity [@object id ::Foo]
  ? [list ::nx::core::is $entity object] 1
  ? [list $entity info is type ::nx::doc::@object] 1
  ? [list $entity text] "The class Foo defines the behaviour for all Foo objects";
  ? [list $entity @author] "gneumann@wu.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 [@param id ::Foo class attr1]
  set entity [@param id $entity attr1]
  ? [list ::nx::core::is $entity object] 1
  ? [list $entity info is type ::nx::doc::@param] 1
  ? [list $entity @see] "::nx::Attribute ::nx::MetaSlot";

  set entity [@method id ::Foo class foo]
  ? [list [@object id ::Foo] @method] $entity
  ? [list ::nx::core::is $entity object] 1
  ? [list $entity info is type ::nx::doc::@method] 1
  ? [list $entity text] "This describes the foo method";
  
  foreach p [$entity @param] expected {
    "Provides a first value"
    "Provides a second value"
  } {
    ? [list expr [list [$p text] eq $expected]] 1;
  }


  # TODO: how to realise 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)?

  set script {
    namespace import -force ::nx::*
    # @object Bar
    # 
    # The class Bar defines the behaviour for all Bar objects
    #
    # @author gneumann@wu.ac.at
    # @author ssoberni@wu.ac.at

    # @param Bar#attr1 
    #
    # This attribute 1 is wonderful
    #
    # @see ::nx::Attribute
    # @see ::nx::MetaSlot

    # @method Bar#foo
    #
    # This describes the foo method
    #
    # @param a Provides a first value
    # @param b Provides a second value

    # @object-method Bar#foo
    #
    # This describes the per-object foo method
    #
    # @param a Provides a first value
    # @param b Provides a second value

    namespace eval ::ns1 {
      ::nx::Object create ooo
    }
    Class create Bar {

      :attribute attr1
      :attribute attr2
      :attribute attr3

      # @method foo
      #
      # This describes the foo method in the initcmd
      #
      # @param a Provides a first value
      # @param b Provides a second value

      :method foo {a b} {
	# This describes the foo method in the method body
	#
	# @param a Provides a first value (refined)

      }
      
      :object method foo {a b c} {
	# This describes the per-object foo method in the method body
	#
	# @param b Provides a second value (refined)
      	# @param c Provides a third value (first time)

      }

    }
  }

  set i [doc process $script]

  set entity [@object id ::Bar]
  ? [list $i eval [list ::nx::core::is $entity object]] 1
  ? [list $i eval [list $entity info is type ::nx::doc::@object]] 1
  ? [list $i eval [list $entity text]] "The class Bar defines the behaviour for all Bar objects";
  ? [list $i eval [list $entity @author]] "gneumann@wu.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 [@param id ::Bar class attr1]
  set entity [@param id $entity attr1]
  ? [list $i eval [list ::nx::core::is $entity object]] 1
  ? [list $i eval [list $entity info is type ::nx::doc::@param]] 1
  ? [list $i eval [list $entity @see]] "::nx::Attribute ::nx::MetaSlot";

  set entity [@method id ::Bar class foo]
  ? [list $i eval [list [@object id ::Bar] @method]] $entity
  ? [list $i eval [list ::nx::core::is $entity object]] 1
  ? [list $i eval [list $entity info is type ::nx::doc::@method]] 1
  ? [list $i eval [list $entity text]] "This describes the foo method in the method body";

  foreach p [$i eval [list $entity @param]] expected {
    "Provides a first value (refined)"
    "Provides a second value"
  } {
    ? [list expr [list [$i eval [list $p text]] eq $expected]] 1;
  }
  set entity [@method id ::Bar object foo]
  ? [list $i eval [list [@object id ::Bar] @object-method]] $entity
  ? [list $i eval [list ::nx::core::is $entity object]] 1
  ? [list $i eval [list $entity info is type ::nx::doc::@method]] 1
  ? [list $i eval [list $entity text]] "This describes the per-object foo method in the method body";

  foreach p [$i eval [list $entity @param]] expected {
    "Provides a first value"
    "Provides a second value (refined)"
    "Provides a third value (first time)"
  } {
    ? [list expr [list [$i eval [list $p text]] eq $expected]] 1;
  }
 
  interp delete $i
  puts stderr =================================================
  #
  # self documentation
  #
  if {[catch {set i [doc process next::doc]} msg]} {
    if {[Exception behind? $msg]} {
      puts stderr [$msg info class]->[$msg message]
      exit
    } else {
      error $msg
    }
  }
  ? [list $i eval [list ::nx::core::is [@package id next::doc] object]] 1
  puts stderr [$i eval [list [@package id next::doc] text]]
  puts stderr [$i eval [list [@package id next::doc] @require]]
  set path [file join /tmp nextdoc]
  if {[file exists $path]} {
    file delete -force $path
  }
  $i eval [list ::nx::doc::make doc \
	       -renderer ::nx::doc::TemplateData \
	       -outdir /tmp \
	       -project {name nextdoc url http://www.next-scripting.org/}]
  interp delete $i
}



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

# 1) Test case scoping rules -> in Object->eval()
# Why does [info] intropsection not work as expected in eval()?

Test case issues? {
  Object create o 
  ? {o eval {
    set x ns1
    set ns1 [namespace current]
    #
    # I would expect that there are x and ns1 as locally-scoped variables, but there aren't?!
    # They can be referenced during evaluation, but are NOT resolved through introspection:
    # Am I missing anything (probably I just forgot a nitty-gritty
    # detail on the eval() implementation)?
    expr {[info vars $x] eq $x};
  }} 0

  o method bar {arg1:object,type=::some::unknown::Class} {;}
  ? {o bar ::o} "expected object of type ::some::unknown::Class but got \"::o\" for parameter arg1"; # the error should rather reflect that ::some::unknown::Class is a non-existing class object!

  
}

if {$log} {
  ::nx::doc::CommentState mixin delete ::nx::doc::CommentState::Log
  ::nx::doc::CommentLine mixin delete ::nx::doc::CommentLine::Log
  ::nx::doc::CommentSection mixin delete ::nx::doc::CommentSection::Log
}