@@ -15,7 +15,7 @@ sub new { sub coupling { my ($self, $module) = @_; my %seen = (); - for my $caller_function (@{$self->model->modules->{$module}}) { + for my $caller_function ($self->model->functions($module)) { for my $called_function (keys(%{$self->model->calls->{$caller_function}})) { my $called_module = $self->model->members->{$called_function}; next if $called_module && ($called_module eq $module); @@ -87,7 +87,8 @@ sub lcom4 { sub number_of_functions { my ($self, $module) = @_; - return (scalar $self->model->functions($module)); + my $list = $self->model->functions($module); + return $list? scalar $list : 0; } sub amz_size { Egypt/Metrics.pm @@ -4,7 +4,6 @@ use strict; sub new { my @defaults = ( members => {}, - types => {}, modules => {}, demangle => {}, calls => {}, @@ -56,17 +55,8 @@ sub declare_member { # mapping member to module $self->{members}->{$member} = $module; - # mapping module to member - $self->{modules}->{$module} = [] if !exists($self->modules->{$module}); - if (! grep { $_ eq $member } @{$self->modules->{$module}}) { - push @{$self->modules->{$module}}, $member; - } - # demangling name $self->{demangle}->{$member} = $demangled_name; - - # registering type of member - $self->{types}->{$member} = $type; } sub type { @@ -77,11 +67,27 @@ sub type { sub declare_function { my ($self, $module, $function, $demangled_name) = @_; $self->declare_member($module, $function, $demangled_name, 'function'); + + if (!exists($self->{modules}->{$module})){ + $self->{modules}->{$module} = {}; + $self->{modules}->{$module}->{functions} = []; + } + if(! grep { $_ eq $function } @{$self->{modules}->{$module}->{functions}}){ + push @{$self->{modules}->{$module}->{functions}}, $function; + } } sub declare_variable { my ($self, $module, $variable, $demangled_name) = @_; $self->declare_member($module, $variable, $demangled_name, 'variable'); + + if (!exists($self->{modules}->{$module})){ + $self->{modules}->{$module} = {}; + $self->{modules}->{$module}->{variables} = []; + } + if(! grep { $_ eq $variable } @{$self->{modules}->{$module}->{variables}}){ + push @{$self->{modules}->{$module}->{variables}}, $variable; + } } sub demangle { @@ -106,12 +112,6 @@ sub add_variable_use { add_call(@_, 'variable'); } -sub _find_by_type { - my ($self, $module, $type) = @_; - my @list = grep { $self->type($_) eq $type } @{$self->modules->{$module}}; - return @list; -} - sub add_loc { my ($self, $function, $lines) = @_; $self->{lines}->{$function} = $lines; @@ -123,13 +123,23 @@ sub add_protection { } sub functions { - _find_by_type(@_, 'function'); + my ($self, $module) = @_; + my $list = $self->{modules}->{$module}->{functions}; + return $list ? @$list : (); } sub variables { - _find_by_type(@_, 'variable'); + my ($self, $module) = @_; + my $list = $self->{modules}->{$module}->{variables}; + return $list ? @$list : (); } +sub all_members { + my ($self, $module) = @_; + my @functions = $self->functions($module); + my @variables = $self->variables($module); + return @functions, @variables; +} 1; Egypt/Model.pm @@ -99,8 +99,8 @@ sub _calculate_clusters { foreach my $module (sort(keys(%{$self->model->modules}))) { $result .= "subgraph \"cluster_$module\" {\n"; $result .= sprintf(" label = \"%s\";\n", _file_to_module($module)); - foreach my $function (@{$self->model->modules->{$module}}) { - my $demangled = $self->_demangle($function); + foreach my $member ($self->model->all_members($module)) { + my $demangled = $self->_demangle($member); $result .= sprintf(" node [label=\"%s\"] \"%s\";\n", $demangled, $demangled); } $result .= "}\n"; Egypt/Output/DOT.pm @@ -38,10 +38,17 @@ sub declaring_inheritance : Tests { sub declaring_function : Tests { my $model = new Egypt::Model; $model->declare_function('mymodule', 'myfunction'); + $model->declare_function('mymodule', 'anotherfunction'); + ok((grep { $_ eq 'myfunction' } keys(%{$model->members})), "declared function must be stored"); is('mymodule', $model->members->{'myfunction'}, 'must map function to module'); ok((grep { $_ eq 'mymodule'} keys(%{$model->modules})), 'declaring a function must declare its module'); - ok((grep { $_ eq 'myfunction' } @{$model->modules->{'mymodule'}}), 'must store members in a module'); + ok((grep { $_ eq 'myfunction' } @{$model->{modules}->{'mymodule'}->{functions}}), 'must store members in a module'); + + ok((grep { $_ eq 'anotherfunction' } keys(%{$model->members})), "another declared function must be stored"); + is('mymodule', $model->members->{'anotherfunction'}, 'must map another function to module'); + ok((grep { $_ eq 'mymodule'} keys(%{$model->modules})), 'declaring a another function must declare its module'); + ok((grep { $_ eq 'anotherfunction' } @{$model->{modules}->{'mymodule'}->{functions}}), 'must store members in a module'); } sub declaring_function_with_demangled_name : Tests { @@ -62,7 +69,7 @@ sub declaring_variables : Tests { ok((grep { $_ eq 'myvariable' } keys(%{$model->members})), "declared variable must be stored"); is('mymodule', $model->members->{'myvariable'}, 'must map variable to module'); ok((grep { $_ eq 'mymodule'} keys(%{$model->modules})), 'declaring a variable must declare its module'); - ok((grep { $_ eq 'myvariable' } @{$model->modules->{'mymodule'}}), 'must store variable in a module'); + ok((grep { $_ eq 'myvariable' } @{$model->modules->{'mymodule'}->{variables}}), 'must store variable in a module'); } sub adding_calls : Tests { @@ -83,21 +90,36 @@ sub addding_variable_uses : Tests { is($model->calls->{'function1'}->{'variable9'}, 'variable', 'must register variable use'); } -sub querying_type_of_member_and_members_by_type : Tests { +sub querying_variables : Tests { my $model = new Egypt::Model; - $model->declare_function('mod1', 'f1'); $model->declare_variable('mod1', 'v1'); - is($model->type('f1'), 'function'); - is($model->type('v1'), 'variable'); + $model->declare_variable('mod1', 'v2'); + ok((grep { $_ eq 'v1' } $model->variables('mod1')), 'must list v1 in variables'); + ok((grep { $_ eq 'v2' } $model->variables('mod1')), 'must list v2 in variables'); +} + +sub querying_functions : Tests { + my $model = new Egypt::Model; + $model->declare_function('mod1', 'f1'); $model->declare_function('mod1', 'f2'); - $model->declare_variable('mod1', 'v2'); ok((grep { $_ eq 'f1' } $model->functions('mod1')), 'must list f1 in functions'); ok((grep { $_ eq 'f2' } $model->functions('mod1')), 'must list f2 in functions'); - ok((grep { $_ eq 'v1' } $model->variables('mod1')), 'must list v1 in variables'); - ok((grep { $_ eq 'v2' } $model->variables('mod1')), 'must list v2 in variables'); +} +sub querying_members : Tests { + my $model = new Egypt::Model; + $model->declare_function('mod1', 'f1'); + $model->declare_variable('mod1', 'v1'); + + $model->declare_function('mod1', 'f2'); + $model->declare_variable('mod1', 'v2'); + + ok((grep { $_ eq 'f1' } $model->all_members('mod1')), 'must list f1 in functions'); + ok((grep { $_ eq 'f2' } $model->all_members('mod1')), 'must list f2 in functions'); + ok((grep { $_ eq 'v1' } $model->all_members('mod1')), 'must list v1 in variables'); + ok((grep { $_ eq 'v2' } $model->all_members('mod1')), 'must list v2 in variables'); } sub declaring_protection : Tests { @@ -113,3 +135,4 @@ sub declating_lines_of_code : Tests { } ModelTests->runtests; + t/03_model.t @@ -40,16 +40,16 @@ sub inheritance : Tests { sub detect_function_declaration : Tests { my $extractor = Egypt::Extractor->load('Doxyparse', current_module => 'module1.c'); $extractor->feed(' function myfunction in line 5'); - ok(grep { $_ eq 'module1::myfunction' } @{$extractor->model->{modules}->{'module1.c'}}); + ok(grep { $_ eq 'module1::myfunction' } @{$extractor->model->{modules}->{'module1.c'}->{functions}}); is($extractor->current_member, 'module1::myfunction', 'must set the current function'); } sub detect_variable_declaration : Tests { my $extractor = Egypt::Extractor->load('Doxyparse', current_module => 'module1.c'); $extractor->feed(' variable myvariable in line 10'); - ok(grep { $_ eq 'module1::myvariable' } @{$extractor->model->{modules}->{'module1.c'}}); + ok(grep { $_ eq 'module1::myvariable' } @{$extractor->model->{modules}->{'module1.c'}->{variables}}); $extractor->current_module; # only read the current module - is(scalar(grep { $_ eq 'module1::myvariable' } @{$extractor->model->{modules}->{'module1.c'}}), 1, 'must not read variable declarations when reading the name of the current module'); + is(scalar(grep { $_ eq 'module1::myvariable' } @{$extractor->model->{modules}->{'module1.c'}->{variables}}), 1, 'must not read variable declarations when reading the name of the current module'); } sub detect_direct_function_calls : Tests { @@ -143,3 +143,4 @@ sub reading_from_directories : Tests { } ExtractorDoxyparseTests->runtests; + t/06_extractor_doxyparse.t ef61cda280c0bf724ae9cee6fd3ffeff120a9d43 João M. Miranda joaomm88@gmail.com http://github.com/terceiro/egypt/commit/40e79055ca8e5ba2a8d72af2762c1dddcfec44c4 40e79055ca8e5ba2a8d72af2762c1dddcfec44c4 2009-10-27T06:00:36-07:00 2009-10-23T13:34:02-07:00 refactoring model: modules has lists of functions and variables (JoaoMM and PauloRMM) 56ab048d198e7bbaa0a23a119009c059b59ac80c Antonio Terceiro terceiro@softwarelivre.org