"Fossies" - the Fresh Open Source Software Archive

Member "aspell-0.60.8/auto/MkSrc/Type.pm" (8 Oct 2019, 2179 Bytes) of package /linux/misc/aspell-0.60.8.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Type.pm" see the Fossies "Dox" file reference documentation.

    1 # This file is part of The New Aspell
    2 # Copyright (C) 2001-2002 by Kevin Atkinson under the GNU LGPL
    3 # license version 2.0 or 2.1.  You should have received a copy of the
    4 # LGPL license along with this library if you did not you can find it
    5 # at http://www.gnu.org/.
    6 
    7 package MkSrc::Type;
    8 
    9 BEGIN {
   10   use Exporter;
   11   our @ISA = qw(Exporter);
   12   our @EXPORT = qw(creates_type update_type finalized_type);
   13 }
   14 
   15 use strict;
   16 use warnings;
   17 no warnings qw(uninitialized);
   18 no locale;
   19 
   20 sub creates_type ( $ );
   21 sub update_type ( $ ; $ );
   22 sub finalized_type ( $ );
   23 
   24 use MkSrc::Util;
   25 use MkSrc::Info;
   26 
   27 #
   28 # Type Functions
   29 #
   30 
   31 
   32 sub creates_type ( $ ) 
   33 {
   34   my ($i) = @_;
   35   my $d;
   36   $d->{type} = $info{$i->{type}}{creates_type};
   37   return undef unless defined $d->{type};
   38   $d->{name} = $i->{name};
   39   $d->{treat_as} =
   40     ($i->{type} eq 'basic'                                    ? 'special'
   41      : exists $i->{'treat as object'} || $i->{type} eq 'enum' ? 'object'
   42      :                                                          'pointer');
   43   if (my $name = $info{$i->{type}}{creates_name}) {
   44     $d->{name} = $name->($i);
   45   }
   46   return $d;
   47 }
   48 
   49 sub update_type ( $ ; $ ) 
   50 {
   51   my ($name, $data) = @_;
   52   my $d = $types{$name};
   53   $types{$name} = $d = {} unless defined $d;
   54   $d->{data} = $data if defined $data;
   55   $d->{data} = {} unless defined $d->{data};
   56   return $d;
   57 }
   58 
   59 sub finalized_type ( $ ) 
   60 {
   61   my ($name) = @_;
   62 
   63   my $d = $types{$name};
   64   $types{$name} = $d = {data=>{}} unless defined $d;
   65   return $d unless exists $d->{data};
   66 
   67   while (my ($k,$v) = each %{$d->{data}}) {
   68     $d->{$k} = defined $v ? $v : true;
   69   }
   70   delete $d->{data};
   71 
   72   local $_ = $name;
   73 
   74   s/^const //       and $d->{const}   = true;
   75   s/^array (\d+) // and $d->{array}   = $1;
   76   s/ ?pointer$//    and $d->{pointer} = true;
   77   s/ ?object$//     and $d->{pointer} = false;
   78 
   79   $_ = 'void' if length $_ == 0;
   80 
   81   my $r = finalized_type $_;
   82 
   83   $d->{type} = exists $r->{type} ? $r->{type} : 'unknown';
   84   $d->{name} = $_;
   85   $d->{orig_name} = $name;
   86   $d->{pointer} = ($r->{treat_as} eq 'pointer')
   87     unless exists $d->{pointer};
   88   $d->{const} = false unless $d->{pointer};
   89   $d->{created_in} = $r->{created_in};
   90 
   91   return $d;
   92 
   93 }
   94 1;