

A la hora de hacer las pruebas necesitamos comprobar que dos árboles son iguales. El problema que aparece en el diseño de un compilador es un caso particular de la regla defina su API antes de realizar las pruebas y de la ausencia de herramientas adecuadas.
Como el diseño de un compilador se hace por fases 
y las fases a veces se superponen resulta que el resultado
de una llamada a la misma subrutina cambia en las diversas etapas del desarrollo.
Terminada la fase de análisis sintáctico el producto es un AST.
cuando posteriormente añadimos la fase de análisis de ámbito
obtenemos un árbol decorado. Si hicimos pruebas para la primera fase y hemos
usado is_deeply las pruebas no funcionaran con la versión ampliada
a menos que se cambie el árbol esperado. Ello es debido 
a que is_deeply requiere la igualdad estructural total 
de los dos árboles.
La descripción dada con Data::Dumper de una estructura 
de datos anidada como es el árbol es difícil de seguir,
especialmente como en este ejemplo
en el que hay enlaces que autoreferencian la estructura.
$VAR1 = bless( {
  'types' => {
    'CHAR' => bless( { 'children' => [] }, 'CHAR' ),
    'INT' => bless( { 'children' => [] }, 'INT' ),
    'F(X_0(),CHAR)' => bless( { 'children' => [
        bless( { 'children' => [] }, 'X_0' ), bless( { 'children' => [] }, 'CHAR' )
      ]
    }, 'F' ),
    'F(X_0(),INT)' => bless( { 'children' => [
        bless( { 'children' => [] }, 'X_0' ), bless( { 'children' => [] }, 'INT' )
      ]
    }, 'F' )
  },
  'symboltable' => {
    'd0' => { 'type' => 'CHAR', 'line' => 1 },
    'f'  => { 'type' => 'F(X_0(),CHAR)', 'line' => 2 },
    'g'  => { 'type' => 'F(X_0(),INT)', 'line' => 13 },
  },
  'lines' => 19,
  'children' => [
    bless( { # FUNCTION f  <---------------------------------------------------x
      'parameters' => [], 'symboltable' => {}, 'fatherblock' => $VAR1,         |
      'function_name' => [ 'f', 2 ],                                           |
      'children' => [                                                          |
        bless( {    <----------------------------------------------------------|------x
          'line' => 3                                                          |      |
          'symboltable' => {}, 'fatherblock' => $VAR1->{'children'}[0], -------x      |
          'children' => [                                                      |      |
            bless( {                                                           |      |
              'symboltable' => {}, 'fatherblock' => $VAR1->{'children'}[0]{'children'}[0],
              'children' => [], 'line' => 4                                    |
            }, 'BLOCK' )                                                       |
          ],                                                                   |
        }, 'BLOCK' ),                                                          |
        bless( {                                                               |
          'symboltable' => {}, 'fatherblock' => $VAR1->{'children'}[0], -------x 
          'children' => [
            bless( {
              'symboltable' => {}, 'fatherblock' => $VAR1->{'children'}[0]{'children'}[1],
              'children' => [], 'line' => 7
            }, 'BLOCK' )
          ],
          'line' => 6
        }, 'BLOCK' ),
        bless( {
          'symboltable' => {}, 'fatherblock' => $VAR1->{'children'}[0],
          'children' => [
            bless( {
              'symboltable' => {}, 'fatherblock' => $VAR1->{'children'}[0]{'children'}[2],
              'children' => [
                bless( {
                  'symboltable' => {}, 'fatherblock' => $VAR1->{'children'}[0]{'children'}[2]{'children'}[0],
                  'children' => [], 'line' => 10
                }, 'BLOCK' )
              ],
              'line' => 10
            }, 'BLOCK' )
          ],
          'line' => 9
        }, 'BLOCK' )
      ],
      'line' => 2
    }, 'FUNCTION' ),
    bless( { # FUNCTION g
      'parameters' => [], 'symboltable' => {}, 'fatherblock' => $VAR1,
      'function_name' => [ 'g', 13 ],
      'children' => [
        bless( {
          'symboltable' => {}, 'fatherblock' => $VAR1->{'children'}[1],
          'children' => [], 'line' => 14
        }, 'BLOCK' ),
        bless( {
          'symboltable' => {}, 'fatherblock' => $VAR1->{'children'}[1],
          'children' => [
            bless( {
              'symboltable' => {}, 'fatherblock' => $VAR1->{'children'}[1]{'children'}[1],
              'children' => [], 'line' => 16
            }, 'BLOCK' )
          ],
          'line' => 15
        }, 'BLOCK' ),
        bless( {
          'symboltable' => {}, 'fatherblock' => $VAR1->{'children'}[1],
          'children' => [], 'line' => 18
        }, 'BLOCK' )
      ],
      'line' => 13
    }, 'FUNCTION' )
  ],
  'line' => 1
}, 'PROGRAM' );
La estructura es en realidad el árbol de análisis abstracto decorado
para un programa SimpleC
(véase el capítulo 12).
Para ver el fuente que se describe y la estructura del AST
consulte la tabla 12.1. Al decorar 
el árbol con la jerarquía de bloques (calculada en la sección
10.4, página
)
se producen númerosas 
referencias cruzadas que hacen difícil de leer la salida de 
Data::Dumper.
El problema no es sólo que es dificil seguir una estructura que se autoreferencia como la anterior. Una estructura recursiva como esta no puede ser evaluada como código Perl, ya que Perl prohibe que una variable pueda ser usada antes de que finalice su definición. Por ejemplo, la declaración-inicialización:
my $x = $x -1;es considerada incorrecta. Eso significa que el texto producido por Data::Dumper de esta forma no puede ser insertado en un test de regresión.
El módulo  Data::Dumper  dispone de la variable
 Data::Dumper::Purity  la cual ayuda a subsanar esta
limitación. Veamos la salida que se produce para el programa
anterior cuando Data::Dumper::Purity esta activa:
$VAR1 = bless( {
  'types' => { ... },
  'symboltable' => { ... },
  'lines' => 19,
  'children' => [
    bless( {
      'function_name' => [ 'f', 2 ], 'line' => 2, 
      'parameters' => [], 'symboltable' => {}, 'fatherblock' => {}, 
      'children' => [
        bless( {
          'symboltable' => {}, 'fatherblock' => {}, 'line' => 3
          'children' => [
            bless( { 'symboltable' => {}, 'fatherblock' => {}, 'children' => [], 'line' => 4 }, 'BLOCK' )
          ],
        }, 'BLOCK' ),
        bless( {
          'symboltable' => {}, 'fatherblock' => {}, 'line' => 6
          'children' => [
            bless( {
              'symboltable' => {},
              'fatherblock' => {},
              'children' => [],
              'line' => 7
            }, 'BLOCK' )
          ],
        }, 'BLOCK' ),
        bless( {
          'line' => 9, 'symboltable' => {}, 'fatherblock' => {},
          'children' => [
            bless( {
              'line' => 10, 'symboltable' => {}, 'fatherblock' => {},
              'children' => [
                bless( {
                  'line' => 10, 'symboltable' => {}, 'fatherblock' => {},
                  'children' => [],
                }, 'BLOCK' )
              ],
            }, 'BLOCK' )
          ],
        }, 'BLOCK' )
      ],
    }, 'FUNCTION' ),
    bless( {
      'function_name' => [ 'g', 13 ],
       .............................
    }, 'FUNCTION' )
  ],
  'line' => 1
}, 'PROGRAM' );
$VAR1->{'children'}[0]{'fatherblock'} = $VAR1;
$VAR1->{'children'}[0]{'children'}[0]{'fatherblock'} = $VAR1->{'children'}[0];
$VAR1->{'children'}[0]{'children'}[0]{'children'}[0]{'fatherblock'} 
  = $VAR1->{'children'}[0]{'children'}[0];
$VAR1->{'children'}[0]{'children'}[1]{'fatherblock'} 
  = $VAR1->{'children'}[0];
$VAR1->{'children'}[0]{'children'}[1]{'children'}[0]{'fatherblock'} 
  = $VAR1->{'children'}[0]{'children'}[1];
$VAR1->{'children'}[0]{'children'}[2]{'fatherblock'} 
  = $VAR1->{'children'}[0];
$VAR1->{'children'}[0]{'children'}[2]{'children'}[0]{'fatherblock'} 
  = $VAR1->{'children'}[0]{'children'}[2];
$VAR1->{'children'}[0]{'children'}[2]{'children'}[0]{'children'}[0]{'fatherblock'} 
  = $VAR1->{'children'}[0]{'children'}[2]{'children'}[0];
$VAR1->{'children'}[1]{'fatherblock'} = $VAR1;
$VAR1->{'children'}[1]{'children'}[0]{'fatherblock'} = $VAR1->{'children'}[1];
$VAR1->{'children'}[1]{'children'}[1]{'fatherblock'} = $VAR1->{'children'}[1];
$VAR1->{'children'}[1]{'children'}[1]{'children'}[0]{'fatherblock'} 
  = $VAR1->{'children'}[1]{'children'}[1];
$VAR1->{'children'}[1]{'children'}[2]{'fatherblock'} 
  = $VAR1->{'children'}[1];
Observe que este segundo código elimina las definiciones recursivas,
retrasa las asignaciones y es código correcto.
Es por tanto apto para reproducir la estructura
de datos en un programa de prueba con, por ejemplo, is_deeply.
Puede que parezca una buena idea volcar los dos árboles esperado y obtenido mediante str
y proceder a comparar las cadenas. Esta estrategia es inadecuado ya que depende 
de la versión de Parse::Eyapp con la que se esta trabajando. Si un usuario de
nuestro módulo ejecuta la prueba con una versión distinta de Parse::Eyapp
de la que hemos usado para la construcción de la prueba, puede obtener un ''falso fallo''
debido a que su version de str trabaja de forma ligeramente distinta.
El método equal (version 1.094 de Parse::Eyapp o posterior) permite
hacer comparaciones ''difusas'' de los nodos.
El formato de llamada es:
$tree1->equal($tree2, attr1 => \&handler1, attr2 => \&handler2, ...)
Dos nodos se consideran iguales si:
$tree1 y $tree2 pertenecen a la misma clase
attr1, attr2, etc. la existencia
y definición es la misma en ambas raíces
attr existe y está definido
el manejador handler($tree1, $tree2) retorna cierto cuando es llamado
Sigue un ejemplo:
pl@nereida:~/LEyapp/examples$ cat -n equal.pl
 1  #!/usr/bin/perl -w
 2  use strict;
 3  use Parse::Eyapp::Node;
 4
 5  my $string1 = shift || 'ASSIGN(VAR(TERMINAL))';
 6  my $string2 = shift || 'ASSIGN(VAR(TERMINAL))';
 7  my $t1 = Parse::Eyapp::Node->new($string1, sub { my $i = 0; $_->{n} = $i++ for @_ });
 8  my $t2 = Parse::Eyapp::Node->new($string2);
 9
10  # Without attributes
11  if ($t1->equal($t2)) {
12    print "\nNot considering attributes: Equal\n";
13  }
14  else {
15    print "\nNot considering attributes: Not Equal\n";
16  }
17
18  # Equality with attributes
19  if ($t1->equal($t2, n => sub { return $_[0] == $_[1] })) {
20    print "\nConsidering attributes: Equal\n";
21  }
22  else {
23    print "\nConsidering attributes: Not Equal\n";
24  }
Cuando desarrolle pruebas y desee obtener una comparación parcial del AST esperado con el AST obtenido puede usar la siguiente metodología:
Data::Dumper
Data::Dumper y usando equal
(versión 1.096 de Parse::Eyapp) como en el siguiente ejemplo:
pl@nereida:~/LEyapp/examples$ cat -n testequal.pl
 1  #!/usr/bin/perl -w
 2  use strict;
 3  use Parse::Eyapp::Node;
 4  use Data::Dumper;
 5  use Data::Compare;
 6
 7  my $debugging = 0;
 8
 9  my $handler = sub {
10    print Dumper($_[0], $_[1]) if $debugging;
11    Compare($_[0], $_[1])
12  };
El manejador $handler es usado para comparar atributos 
(véanse las líneas 104-109).
Copie el resultado de Data::Dumper en la variable $t1:
14  my $t1 = bless( {
15                   'types' => {
16                                'CHAR' => bless( { 'children' => [] }, 'CHAR' ),
17                                'VOID' => bless( { 'children' => [] }, 'VOID' ),
18                                'INT' => bless( { 'children' => [] }, 'INT' ),
19                                'F(X_0(),INT)' => bless( {
20                                   'children' => [
21                                      bless( { 'children' => [] }, 'X_0' ),
22                                      bless( { 'children' => [] }, 'INT' ) ]
23                                 }, 'F' )
24                              },
25                   'symboltable' => { 'f' => { 'type' => 'F(X_0(),INT)', 'line' => 1 } },
26                   'lines' => 2,
27                   'children' => [
28                                   bless( {
29                                            'symboltable' => {},
30                                            'fatherblock' => {},
31                                            'children' => [],
32                                            'depth' => 1,
33                                            'parameters' => [],
34                                            'function_name' => [ 'f', 1 ],
35                                            'symboltableLabel' => {},
36                                            'line' => 1
37                                          }, 'FUNCTION' )
38                                 ],
39                   'depth' => 0,
40                   'line' => 1
41                 }, 'PROGRAM' );
42  $t1->{'children'}[0]{'fatherblock'} = $t1;
Para ilustrar la técnica creamos dos árboles $t2 y $t3 similares al anterior
que compararemos con $t1.
De hecho se han obtenido del texto de $t1 suprimiendo algunos atributos.
El árbol de $t2 comparte con $t1 los atributos ''comprobados'' mientras 
que no es así con $t3:
44  # Tree similar to $t1 but without some attttributes (line, depth, etc.)
45  my $t2 = bless( {
46                   'types' => {
47                                'CHAR' => bless( { 'children' => [] }, 'CHAR' ),
48                                'VOID' => bless( { 'children' => [] }, 'VOID' ),
49                                'INT' => bless( { 'children' => [] }, 'INT' ),
50                                'F(X_0(),INT)' => bless( {
51                                   'children' => [
52                                      bless( { 'children' => [] }, 'X_0' ),
53                                      bless( { 'children' => [] }, 'INT' ) ]
54                                 }, 'F' )
55                              },
56                   'symboltable' => { 'f' => { 'type' => 'F(X_0(),INT)', 'line' => 1 } },
57                   'children' => [
58                                   bless( {
59                                            'symboltable' => {},
60                                            'fatherblock' => {},
61                                            'children' => [],
62                                            'parameters' => [],
63                                            'function_name' => [ 'f', 1 ],
64                                          }, 'FUNCTION' )
65                                 ],
66                 }, 'PROGRAM' );
67  $t2->{'children'}[0]{'fatherblock'} = $t2;
68
69  # Tree similar to $t1 but without some attttributes (line, depth, etc.)
70  # and without the symboltable attribute
71  my $t3 = bless( {
72                   'types' => {
73                                'CHAR' => bless( { 'children' => [] }, 'CHAR' ),
74                                'VOID' => bless( { 'children' => [] }, 'VOID' ),
75                                'INT' => bless( { 'children' => [] }, 'INT' ),
76                                'F(X_0(),INT)' => bless( {
77                                   'children' => [
78                                      bless( { 'children' => [] }, 'X_0' ),
79                                      bless( { 'children' => [] }, 'INT' ) ]
80                                 }, 'F' )
81                              },
82                   'children' => [
83                                   bless( {
84                                            'symboltable' => {},
85                                            'fatherblock' => {},
86                                            'children' => [],
87                                            'parameters' => [],
88                                            'function_name' => [ 'f', 1 ],
89                                          }, 'FUNCTION' )
90                                 ],
91                 }, 'PROGRAM' );
92
93  $t3->{'children'}[0]{'fatherblock'} = $t2;
Ahora realizamos las comprobaciones de igualdad mediante equal:
95  # Without attributes
96  if (Parse::Eyapp::Node::equal($t1, $t2)) {
97    print "\nNot considering attributes: Equal\n";
98  }
99  else {
100    print "\nNot considering attributes: Not Equal\n";
101  }
102
103  # Equality with attributes
104  if (Parse::Eyapp::Node::equal(
105        $t1, $t2,
106        symboltable => $handler,
107        types => $handler,
108      )
109     ) {
110        print "\nConsidering attributes: Equal\n";
111  }
112  else {
113    print "\nConsidering attributes: Not Equal\n";
114  }
115
116  # Equality with attributes
117  if (Parse::Eyapp::Node::equal(
118        $t1, $t3,
119        symboltable => $handler,
120        types => $handler,
121      )
122     ) {
123        print "\nConsidering attributes: Equal\n";
124  }
125  else {
126    print "\nConsidering attributes: Not Equal\n";
127  }
Dado que los atibutos usados son symboltable y types, los árboles $t1 y $t2
son considerados equivalentes. No asi $t1 y $t3.
Observe el modo de llamada Parse::Eyapp::Node::equal como subrutina, no como método. 
Se hace así porque $t1, $t2 y  $t3 no son objetos 
Parse::Eyapp::Node. La salida de Data::Dumper reconstruye la forma estructural
de un objeto pero no reconstruye la información sobre la jerarquía de clases.
pl@nereida:~/LEyapp/examples$ testequal.pl Not considering attributes: Equal Considering attributes: Equal Considering attributes: Not Equal
 

