From ce4a32fe52ef09d8f5ff1dd22c001110902b60a2 Mon Sep 17 00:00:00 2001 From: toma Date: Wed, 25 Nov 2009 17:56:58 +0000 Subject: Copy the KDE 3.5 branch to branches/trinity for new KDE 3.5 features. BUG:215923 git-svn-id: svn://anonsvn.kde.org/home/kde/branches/trinity/kdelibs@1054174 283d02a7-25f6-0310-bc7c-ecb5cbfe19da --- dcop/dcopidlng/kdocAstUtil.pm | 536 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 536 insertions(+) create mode 100644 dcop/dcopidlng/kdocAstUtil.pm (limited to 'dcop/dcopidlng/kdocAstUtil.pm') diff --git a/dcop/dcopidlng/kdocAstUtil.pm b/dcop/dcopidlng/kdocAstUtil.pm new file mode 100644 index 000000000..ec67ace5f --- /dev/null +++ b/dcop/dcopidlng/kdocAstUtil.pm @@ -0,0 +1,536 @@ +=head1 kdocAstUtil + + Utilities for syntax trees. + +=cut + + +package kdocAstUtil; + +use Ast; +use Carp; +use File::Basename; +use kdocUtil; +use Iter; +use strict; + +use vars qw/ $depth $refcalls $refiters @noreflist %noref /; + +sub BEGIN { +# statistics for findRef + + $depth = 0; + $refcalls = 0; + $refiters = 0; + +# findRef will ignore these words + + @noreflist = qw( const int char long double template + unsigned signed float void bool true false uint + uint32 uint64 extern static inline virtual operator ); + + foreach my $r ( @noreflist ) { + $noref{ $r } = 1; + } +} + + +=head2 findRef + + Parameters: root, ident, report-on-fail + Returns: node, or undef + + Given a root node and a fully qualified identifier (:: separated), + this function will try to find a child of the root node that matches + the identifier. + +=cut + +sub findRef +{ + my( $root, $name, $r ) = @_; + + confess "findRef: no name" if !defined $name || $name eq ""; + + $name =~ s/\s+//g; + return undef if exists $noref{ $name }; + + $name =~ s/^#//g; + + my ($iter, @tree) = split /(?:\:\:|#)/, $name; + my $kid; + + $refcalls++; + + # Upward search for the first token + return undef if !defined $iter; + + while ( !defined findIn( $root, $iter ) ) { + return undef if !defined $root->{Parent}; + $root = $root->{Parent}; + } + $root = $root->{KidHash}->{$iter}; + carp if !defined $root; + + # first token found, resolve the rest of the tree downwards + foreach $iter ( @tree ) { + confess "iter in $name is undefined\n" if !defined $iter; + next if $iter =~ /^\s*$/; + + unless ( defined findIn( $root, $iter ) ) { + confess "findRef: failed on '$name' at '$iter'\n" + if defined $r; + return undef; + } + + $root = $root->{KidHash}->{ $iter }; + carp if !defined $root; + } + + return $root; +} + +=head2 findIn + + node, name: search for a child + +=cut + +sub findIn +{ + return undef unless defined $_[0]->{KidHash}; + + my $ret = $_[0]->{KidHash}->{ $_[1] }; + + return $ret; +} + + +# +# Inheritance utilities +# + +=head2 makeInherit + + Parameter: $rootnode, $parentnode + + Make an inheritance graph from the parse tree that begins + at rootnode. parentnode is the node that is the parent of + all base class nodes. + +=cut + +sub makeInherit +{ + my( $rnode, $parent ) = @_; + + foreach my $node ( @{ $rnode->{Kids} } ) { + next if !defined $node->{Compound}; + + # set parent to root if no inheritance + + if ( !exists $node->{InList} ) { + newInherit( $node, "Global", $parent ); + $parent->AddPropList( 'InBy', $node ); + + makeInherit( $node, $parent ); + next; + } + + # link each ancestor + my $acount = 0; +ANITER: + foreach my $in ( @{ $node->{InList} } ) { + unless ( defined $in ) { + Carp::cluck "warning: $node->{astNodeName} " + ." has undef in InList."; + next ANITER; + } + + my $ref = kdocAstUtil::findRef( $rnode, + $in->{astNodeName} ); + + if( !defined $ref ) { + # ancestor undefined + warn "warning: ", $node->{astNodeName}, + " inherits unknown class '", + $in->{astNodeName},"'\n"; + + $parent->AddPropList( 'InBy', $node ); + } + else { + # found ancestor + $in->AddProp( "Node", $ref ); + $ref->AddPropList( 'InBy', $node ); + $acount++; + } + } + + if ( $acount == 0 ) { + # inherits no known class: just parent it to global + newInherit( $node, "Global", $parent ); + $parent->AddPropList( 'InBy', $node ); + } + makeInherit( $node, $parent ); + } +} + +=head2 newInherit + + p: $node, $name, $lnode? + + Add a new ancestor to $node with raw name = $name and + node = lnode. +=cut + +sub newInherit +{ + my ( $node, $name, $link ) = @_; + + my $n = Ast::New( $name ); + $n->AddProp( "Node", $link ) unless !defined $link; + + $node->AddPropList( "InList", $n ); + return $n; +} + +=head2 inheritName + + pr: $inheritance node. + + Returns the name of the inherited node. This checks for existence + of a linked node and will use the "raw" name if it is not found. + +=cut + +sub inheritName +{ + my ( $innode ) = @_; + + return defined $innode->{Node} ? + $innode->{Node}->{astNodeName} + : $innode->{astNodeName}; +} + +=head2 inheritedBy + + Parameters: out listref, node + + Recursively searches for nodes that inherit from this one, returning + a list of inheriting nodes in the list ref. + +=cut + +sub inheritedBy +{ + my ( $list, $node ) = @_; + + return unless exists $node->{InBy}; + + foreach my $kid ( @{ $node->{InBy} } ) { + push @$list, $kid; + inheritedBy( $list, $kid ); + } +} + +=head2 hasLocalInheritor + + Parameter: node + Returns: 0 on fail + + Checks if the node has an inheritor that is defined within the + current library. This is useful for drawing the class hierarchy, + since you don't want to display classes that have no relationship + with classes within this library. + + NOTE: perhaps we should cache the value to reduce recursion on + subsequent calls. + +=cut + +sub hasLocalInheritor +{ + my $node = shift; + + return 0 if !exists $node->{InBy}; + + my $in; + foreach $in ( @{$node->{InBy}} ) { + return 1 if !exists $in->{ExtSource} + || hasLocalInheritor( $in ); + } + + return 0; +} + + + +=head2 allMembers + + Parameters: hashref outlist, node, $type + + Fills the outlist hashref with all the methods of outlist, + recursively traversing the inheritance tree. + + If type is not specified, it is assumed to be "method" + +=cut + +sub allMembers +{ + my ( $outlist, $n, $type ) = @_; + my $in; + $type = "method" if !defined $type; + + if ( exists $n->{InList} ) { + + foreach $in ( @{$n->{InList}} ) { + next if !defined $in->{Node}; + my $i = $in->{Node}; + + allMembers( $outlist, $i ) + unless $i == $main::rootNode; + } + } + + return unless exists $n->{Kids}; + + foreach $in ( @{$n->{Kids}} ) { + next if $in->{NodeType} ne $type; + + $outlist->{ $in->{astNodeName} } = $in; + } +} + +=head2 findOverride + + Parameters: root, node, name + + Looks for nodes of the same name as the parameter, in its parent + and the parent's ancestors. It returns a node if it finds one. + +=cut + +sub findOverride +{ + my ( $root, $node, $name ) = @_; + return undef if !exists $node->{InList}; + + foreach my $in ( @{$node->{InList}} ) { + my $n = $in->{Node}; + next unless defined $n && $n != $root && exists $n->{KidHash}; + + my $ref = $n->{KidHash}->{ $name }; + + return $n if defined $ref && $ref->{NodeType} eq "method"; + + if ( exists $n->{InList} ) { + $ref = findOverride( $root, $n, $name ); + return $ref if defined $ref; + } + } + + return undef; +} + +=head2 attachChild + + Parameters: parent, child + + Attaches child to the parent, setting Access, Kids + and KidHash of respective nodes. + +=cut + +sub attachChild +{ + my ( $parent, $child ) = @_; + confess "Attempt to attach ".$child->{astNodeName}." to an ". + "undefined parent\n" if !defined $parent; + + $child->AddProp( "Access", $parent->{KidAccess} ); + $child->AddProp( "Parent", $parent ); + + $parent->AddPropList( "Kids", $child ); + + if( !exists $parent->{KidHash} ) { + my $kh = Ast::New( "LookupTable" ); + $parent->AddProp( "KidHash", $kh ); + } + + $parent->{KidHash}->AddProp( $child->{astNodeName}, + $child ); +} + +=head2 makeClassList + + Parameters: node, outlist ref + + fills outlist with a sorted list of all direct, non-external + compound children of node. + +=cut + +sub makeClassList +{ + my ( $rootnode, $list ) = @_; + + @$list = (); + + Iter::LocalCompounds( $rootnode, + sub { + my $node = shift; + + my $her = join ( "::", heritage( $node ) ); + $node->AddProp( "FullName", $her ); + + if ( !exists $node->{DocNode}->{Internal} || + !$main::skipInternal ) { + push @$list, $node; + } + } ); + + @$list = sort { $a->{FullName} cmp $b->{FullName} } @$list; +} + +# +# Debugging utilities +# + +=head2 dumpAst + + Parameters: node, deep + Returns: none + + Does a recursive dump of the node and its children. + If deep is set, it is used as the recursion property, otherwise + "Kids" is used. + +=cut + +sub dumpAst +{ + my ( $node, $deep ) = @_; + + $deep = "Kids" if !defined $deep; + + print "\t" x $depth, $node->{astNodeName}, + " (", $node->{NodeType}, ")\n"; + + my $kid; + + foreach $kid ( $node->GetProps() ) { + print "\t" x $depth, " -\t", $kid, " -> ", $node->{$kid},"\n" + unless $kid =~ /^(astNodeName|NodeType|$deep)$/; + } + if ( exists $node->{InList} ) { + print "\t" x $depth, " -\tAncestors -> "; + foreach my $innode ( @{$node->{InList}} ) { + print $innode->{astNodeName} . ","; + } + print "\n"; + } + + print "\t" x $depth, " -\n" if (defined $node->{ $deep } && scalar(@{$node->{ $deep }}) != 0); + + $depth++; + foreach $kid ( @{$node->{ $deep }} ) { + dumpAst( $kid ); + } + + print "\t" x $depth, "Documentation nodes:\n" if defined + @{ $node->{Doc}->{ "Text" }}; + + foreach $kid ( @{ $node->{Doc}->{ "Text" }} ) { + dumpAst( $kid ); + } + + $depth--; +} + +=head2 testRef + + Parameters: rootnode + + Interactive testing of referencing system. Calling this + will use the readline library to allow interactive entering of + identifiers. If a matching node is found, its node name will be + printed. + +=cut + +sub testRef { + require Term::ReadLine; + + my $rootNode = $_[ 0 ]; + + my $term = new Term::ReadLine 'Testing findRef'; + + my $OUT = $term->OUT || *STDOUT{IO}; + my $prompt = "Identifier: "; + + while( defined ($_ = $term->readline($prompt)) ) { + + my $node = kdocAstUtil::findRef( $rootNode, $_ ); + + if( defined $node ) { + print $OUT "Reference: '", $node->{astNodeName}, + "', Type: '", $node->{NodeType},"'\n"; + } + else { + print $OUT "No reference found.\n"; + } + + $term->addhistory( $_ ) if /\S/; + } +} + +sub printDebugStats +{ + print "findRef: ", $refcalls, " calls, ", + $refiters, " iterations.\n"; +} + +sub External +{ + return defined $_[0]->{ExtSource}; +} + +sub Compound +{ + return defined $_[0]->{Compound}; +} + +sub localComp +{ + my ( $node ) = $_[0]; + return defined $node->{Compound} + && !defined $node->{ExtSource} + && $node->{NodeType} ne "Forward"; +} + +sub hasDoc +{ + return defined $_[0]->{DocNode}; +} + +### Warning: this returns the list of parents, e.g. the 3 words in KParts::ReadOnlyPart::SomeEnum +### It has nothing do to with inheritance. +sub heritage +{ + my $node = shift; + my @heritage; + + while( 1 ) { + push @heritage, $node->{astNodeName}; + + last unless defined $node->{Parent}; + $node = $node->{Parent}; + last unless defined $node->{Parent}; + } + + return reverse @heritage; +} + + +1; -- cgit v1.2.1