util / atlanta-pm-code Goto Github PK

There are no tests written for 'mother' that test the following line:
  Carp::croak "I'm a read-only method!" if @_;


---------------------------------------------
sub mother { # read-only attrib-method: returns an object (the mother node)
  my $this = shift;
  Carp::croak "I'm a read-only method!" if @_;
  return $this->{'mother'};
}

What steps will reproduce the problem?
1. Run code coverage report
2. see that the subroutine isn't tested


What is the expected output? What do you see instead?
Need to see that code tested!

Please use labels and text to provide additional information.

There are no tests for '_init_daughters' that test the following lines:
  $this->set_daughters( @{$o->{'daughters'}} )
    if ref($o->{'daughters'}) && (@{$o->{'daughters'}});


--------------------------------------------------
sub _init_daughters { # to be called by an _init
  my($this, $o) = @_[0,1];

  $this->{'daughters'} = [];

  # Undocumented and disfavored.  Consider this just an example.
  $this->set_daughters( @{$o->{'daughters'}} )
    if ref($o->{'daughters'}) && (@{$o->{'daughters'}});
  # DO NOT use this option (as implemented) with new_daughter or
  #  new_daughter_left!!!!!
  # BAD THINGS MAY HAPPEN!!!
}

What steps will reproduce the problem?
1. copy_at_and_under not testing for it.
2.
3.

What is the expected output? What do you see instead?


What version of the product are you using? On what operating system?


Please provide any additional information below.

What steps will reproduce the problem?
1. run test tree

What is the expected output? What do you see instead?
Should show as tested, does not

What version of the product are you using? On what operating system?
r20

Please provide any additional information below.

What steps will reproduce the problem?
1. run tests

What is the expected output? What do you see instead?
That it will actually test the code.

Tests need written for the following two subroutines: remove_daughters &
remove_daughter



---------------------------------------------------
sub remove_daughters { # write-only method
  my($mother, @daughters) = @_;
  Carp::croak "mother must be an object!" unless ref $mother;
  return unless @daughters;

  my %to_delete;
  @daughters = grep {ref($_)
               and defined($_->{'mother'})
               and $mother eq $_->{'mother'}
                    } @daughters;
  return unless @daughters;
  @to_delete{ @daughters } = undef;

  # This could be done better and more efficiently, I guess.
  foreach my $daughter (@daughters) {
    $daughter->{'mother'} = undef;
  }
  my $them = $mother->{'daughters'};
  @$them = grep { !exists($to_delete{$_}) } @$them;

  # $mother->_update_daughter_links; # unnecessary
  return;
}

=item $node->remove_daughter( LIST )

An exact synonym for $node->remove_daughters( LIST )

=cut

sub remove_daughter { # alias
  my($it,@them) = @_;  $it->remove_daughters(@them);
}

1. Document the project on behalf of the coding group
2. Get commentary
3. revise

Current documentation for add_daughters_left needs expanded to state the
order in which the node objects in LIST are added to the $mother's daughter
list.

From testing, when a LIST that contains $1, $2, $3 (in that order) is
passed to the add_daughters_left the objects in the LIST are added to the
$mother's daughters list one at a time and not all at once in the order of
the LIST that was passed.

How I assumed the order of the mother's daughter list was going to be after
I called add_daughters_left:
$1, $2, $3

How the order actually was:
$3, $2, $1


=item $mother->add_daughters_left( LIST )

This method is just like C<add_daughters>, except that it adds the
node objects in LIST to the (left) beginning of $mother's daughter
list, instead of the (right) end of it.

=item $node->add_daughter_left( LIST )

An exact synonym for $node->add_daughters_left( LIST )

=cut

No test has been written that covers the following line in sub new:
  print "Constructing $it in class $class\n" if $Debug;



sub new { # constructor
  # Presumably you won't EVER need to override this -- _init is what
  # you'd override in order to set an object's default attribute values.
  my $class = shift;
  $class = ref($class) if ref($class); # tchristic style.  why not?

  my $o = ref($_[0]) eq 'HASH' ? $_[0] : {}; # o for options hashref
  my $it = bless( {}, $class );
  print "Constructing $it in class $class\n" if $Debug;
  $it->_init( $o );
  return $it;
}

Need to add testing for add_right_sisters.

Should these methods be commented out?

inaugurate_root, decommission_root, no_cyclicity, _update_links, 
cyclicity_allowed

The subroutines _init_mother, _init_daughters, _init_name, and _init_attributes 
each have a comment that:

  # Undocumented and disfavored. Consider this just an example.

with regard to setting properties (name, mother, daughters, attributes) from 
methods constructors or methods that call constructors. This is incorrect. The 
documentation explicitly discusses two ways of calling constructors, the latter 
being the one that is supposed to be undocumented.

Resolution of this issue will probably require modification of the 
documentation. While it may be possible to eliminate some uses of this 
approach, it is not possible to eliminate it all without jeopardizing backward 
compatibility.

There are no tests written for '_add_daughters_wrapper' that test the
following lines:

  foreach my $daughter (@daughters) { # which may be ()
    Carp::croak "daughter must be a node object!" unless
UNIVERSAL::can($daughter, 'is_node');

    printf "Mother  : %s (%s)\n", $mother, ref $mother if $Debug;
    printf "Daughter: %s (%s)\n", $daughter, ref $daughter if $Debug;
    printf "Adding %s to %s\n",
      ($daughter->name() || $daughter),
      ($mother->name()   || $mother)     if $Debug > 1;

    Carp::croak "mother can't be its own daughter!" if $mother eq $daughter;

    $daughter->cyclicity_fault(
      "$daughter (" . ($daughter->name || 'no_name') .
      ") is an ancestor of $mother (" . ($mother->name || 'no_name') .
      "), so can't became its daughter."
    ) if exists $ancestors{$daughter};

    my $old_mother = $daughter->{'mother'};

    next if defined($old_mother) && ref($old_mother) && $old_mother eq $mother;
      # noop if $daughter is already $mother's daughter

    $old_mother->remove_daughters($daughter)
      if defined($old_mother) && ref($old_mother);



----------------------------------------------------------
sub _add_daughters_wrapper {
  my($mother, $callback, @daughters) = @_;
  return unless @daughters;

  my %ancestors;
  @ancestors{ $mother->ancestors } = undef;
  # This could be made more efficient by not bothering to compile
  # the ancestor list for $mother if all the nodes to add are
  # daughterless.
  # But then you have to CHECK if they're daughterless.
  # If $mother is [big number] generations down, then it's worth checking.

  foreach my $daughter (@daughters) { # which may be ()
    Carp::croak "daughter must be a node object!" unless
UNIVERSAL::can($daughter, 'is_node');

    printf "Mother  : %s (%s)\n", $mother, ref $mother if $Debug;
    printf "Daughter: %s (%s)\n", $daughter, ref $daughter if $Debug;
    printf "Adding %s to %s\n",
      ($daughter->name() || $daughter),
      ($mother->name()   || $mother)     if $Debug > 1;

    Carp::croak "mother can't be its own daughter!" if $mother eq $daughter;

    $daughter->cyclicity_fault(
      "$daughter (" . ($daughter->name || 'no_name') .
      ") is an ancestor of $mother (" . ($mother->name || 'no_name') .
      "), so can't became its daughter."
    ) if exists $ancestors{$daughter};

    my $old_mother = $daughter->{'mother'};

    next if defined($old_mother) && ref($old_mother) && $old_mother eq $mother;
      # noop if $daughter is already $mother's daughter

    $old_mother->remove_daughters($daughter)
      if defined($old_mother) && ref($old_mother);

    &{$callback}($mother->{'daughters'}, $daughter);
  }
  $mother->_update_daughter_links; # need only do this at the end

  return;
}

Subroutine mother isn't tested. 

Please use labels and text to provide additional information.

What steps will reproduce the problem?

Create a cyclicity fault (loop)

1. create node n1
2. create node n2
3. create node n3
4. make n2 daughter of n1
5. make n3 daughter of n2
6. make n1 daughter of n3

What is the expected output? What do you see instead?
Expected:
Cyclicity fault: <n1>  is an ancestor of <n3>, so it can't become its daughter. 
at <module> 
<line>
Current behavior:
CCyclicity fault: <n1>  is an ancestor of <n3>, so can't became its daughter. 
at <module> 
<line>

What version of the product are you using? On what operating system?
Tree-DAG_Node-1.06

Please provide any additional information below.

Method includes this code where $them is a ref to daughter list for $this:

  # Eliminate duplicate daughters.
  my %seen = ();
  @$them = grep { ref($_) && not($seen{$_}++) } @$them;

  foreach my $one (@$them) { # linkage bookkeeping
    Carp::croak "daughter <$one> isn't an object!" unless ref $one;
    $one->{'mother'} = $this;
  }

Since the order of daughters may be significant, eliminating duplicates is not 
necessarily a good thing; it might be better to throw an exception.

Also, the elimination of non-refs in the grep prevents them from being detected 
in the loop.

Subroutine 'unlink_from_mother' not tested.

sub unlink_from_mother {
  my $node = $_[0];
  my $mother = $node->{'mother'};
  $mother->remove_daughters($node) if defined($mother) && ref($mother);
  return $mother;
}

There are no tests written for 'daughters' that test the following lines:
  if(@_) { # undoc'd and disfavored to use as a write-method
    Carp::croak "Don't set daughters with doughters anymore\n";
    Carp::carp "my parameter must be a listref" unless ref($_[0]);



-----------------------------------------
sub daughters { # read-only attrib-method: returns a list.
  my $this = shift;

  if(@_) { # undoc'd and disfavored to use as a write-method
    Carp::croak "Don't set daughters with doughters anymore\n";
    Carp::carp "my parameter must be a listref" unless ref($_[0]);
    $this->{'daughters'} = $_[0];
    $this->_update_daughter_links;
  }
  #return $this->{'daughters'};
  return @{$this->{'daughters'} || []};
}

There are no tests for '_init_attributes' that test the following lines:
  $this->attributes( $o->{'attributes'} ) if exists $o->{'attributes'};


------------------------------------------------------
sub _init_attributes { # to be called by an _init
  my($this, $o) = @_[0,1];

  $this->{'attributes'} = {};

  # Undocumented and disfavored.  Consider this just an example.
  $this->attributes( $o->{'attributes'} ) if exists $o->{'attributes'};
}

Subroutine '_init' has no tests covering the following line:
  my $o = ref($_[0]) eq 'HASH' ? $_[0] : {};


---------------------------
sub _init { # method
  my $this = shift;
  my $o = ref($_[0]) eq 'HASH' ? $_[0] : {};

  # Sane initialization.
  $this->_init_mother($o);
  $this->_init_daughters($o);
  $this->_init_name($o);
  $this->_init_attributes($o);

  return;
}

Calls to $node->generation() in tests emits an extraneous "Use of
uninitialized value in string eq at ~/Downloads/APM Code
Group/blib/lib/Tree/DAG_Node.pm line 1287."

While the documentation does not list any parameters for generation(), the
code on line 1285 expects a "limit" as a first parameter. On line 1288, the
node is compared to the limit with an "eq".

Subroutine 'new_daughter_left' not tested.

=item the constructor $mother->new_daughter_left, or

=item $mother->new_daughter_left({...options...})

This is just like $mother->new_daughter, but adds the new daughter
to the left (start) of $mother's daughter list.

=cut

# Note that if you radically change 'mother'/'daughters' bookkeeping,
# you may have to change this routine, since it's one of the places
# that directly writes to 'daughters' and 'mother'.

sub new_daughter_left {
  my($mother, @options) = @_;
  my $daughter = $mother->new(@options);

  unshift @{$mother->{'daughters'}}, $daughter;
  $daughter->{'mother'} = $mother;

  return $daughter;
}

Code coverage tool shows the subroutines 'add_daughters_left' and
'add_daughter_left' are not tested.

What steps will reproduce the problem?
1. cd into Tree-DAG_Node-1.06
2. perl Makefile.pl


Produces the following output:

16:28:11 /Users/jasonn/atlanta-pm-code/Tree-DAG_Node-1.06 $ perl Makefile.PL 
WARNING: LICENSE is not a known parameter.
Checking if your kit is complete...
Looks good
'LICENSE' is not a known MakeMaker parameter name.
Writing Makefile for Tree::DAG_Node
16:28:17 /Users/jasonn/atlanta-pm-code/Tree-DAG_Node-1.06 $ 

CPAN documentation states:

Returns a list of all nodes (going left-to-right) that are in $node's
generation -- i.e., that are the some number of nodes down from the root.
$root->generation is just $root.

Documentation in method states:

...generation is just all the daughters of my mom's generation

NOTE: This is functionally identical to self_and_sisters(). 

My reading of the CPAN documentation suggests that given the tree:

    A { B { D E F } C { G H I } }

the generation of "D" would be "D,E,F,G,H,I" rather than "D,E,F".

Regardless of what it returned by the method, the documentation is not self
consistent.

What steps will reproduce the problem?
1. Look at line 808 or so
2. Test it
3. Profit

There are no tests written for 'add_daughters_left' that test the following
line:
  my($mother, @daughters) = @_;


----------------------------------------------
sub add_daughters_left { # write-only method
  my($mother, @daughters) = @_;
  return unless @daughters;
  return
    $mother->_add_daughters_wrapper(
      sub { unshift @{$_[0]}, $_[1]; },
      @daughters
    );
}

There are no tests written for '_update_daughter_links' that test the
following lines:
  @$them = grep { ref($_) && not($seen{$_}++) } @$them;

    Carp::croak "daughter <$one> isn't an object!" unless ref $one;


------------------------------------
sub _update_daughter_links {
  # Eliminate any duplicates in my daughters list, and update
  #  all my daughters' links to myself.
  my $this = shift;

  my $them = $this->{'daughters'};

  # Eliminate duplicate daughters.
  my %seen = ();
  @$them = grep { ref($_) && not($seen{$_}++) } @$them;
   # not that there should ever be duplicate daughters anyhoo.

  foreach my $one (@$them) { # linkage bookkeeping
    Carp::croak "daughter <$one> isn't an object!" unless ref $one;
    $one->{'mother'} = $this;
  }
  return;
}

There are no tests written for '_init_mother' that cover the following line:
( $o->{'mother'} )->add_daughter($this)

--------------------------------------------------
sub _init_mother { # to be called by an _init
  my($this, $o) = @_[0,1];

  $this->{'mother'} = undef;

  # Undocumented and disfavored.  Consider this just an example.
  ( $o->{'mother'} )->add_daughter($this)
    if defined($o->{'mother'}) && ref($o->{'mother'});
  # DO NOT use this option (as implemented) with new_daughter or
  #  new_daughter_left!!!!!
  # BAD THINGS MAY HAPPEN!!!
}

Documentation states:

Like $node->generation, but returns only the nodes in $node's generation that 
are also descendants of NODE2

It is not clear that NODE2 must be in the ancestor chain of $node, but it is 
implemented in this way.

What steps will reproduce the problem?
1. run the tests
2. review the output
3. panic

What is the expected output? What do you see instead?
A completed and working test

Subroutine 'new_daughter' not tested.


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

=item the constructor $daughter = $mother->new_daughter, or

=item the constructor $daughter = $mother->new_daughter({...options...})

This B<constructs> a B<new> node (of the same class as $mother), and
adds it to the (right) end of the daughter list of $mother. This is
essentially the same as going

      $daughter = $mother->new;
      $mother->add_daughter($daughter);

but is rather more efficient because (since $daughter is guaranteed new
and isn't linked to/from anything), it doesn't have to check that
$daughter isn't an ancestor of $mother, isn't already daughter to a
mother it needs to be unlinked from, isn't already in $mother's 
daughter list, etc.

As you'd expect for a constructor, it returns the node-object created.

=cut

# Note that if you radically change 'mother'/'daughters' bookkeeping,
# you may have to change this routine, since it's one of the places
# that directly writes to 'daughters' and 'mother'.

sub new_daughter {
  my($mother, @options) = @_;
  my $daughter = $mother->new(@options);

  push @{$mother->{'daughters'}}, $daughter;
  $daughter->{'mother'} = $mother;

  return $daughter;
}

There are no tests written for 'add_daughters' that test the following line:
  return unless @daughters; # no-op


---------------------------------------------
sub add_daughters { # write-only method
  my($mother, @daughters) = @_;
  return unless @daughters; # no-op
  return
    $mother->_add_daughters_wrapper(
      sub { push @{$_[0]}, $_[1]; },
      @daughters
    );
}

In one place in _add_daughters_wrapper(), the variable $Debug is checked to see 
if it is greater than 1. In all other places, $Debug is treated as a boolean 
variable. This should be changed for consistency.