pidl/lib/Parse/Pidl/Compat.pm

   1 ###################################################
   2 # IDL Compatibility checker
   3 # Copyright jelmer@samba.org 2005
   4 # released under the GNU GPL
   5
   6 package Parse::Pidl::Compat;
   7
   8 use Parse::Pidl qw(warning);
   9 use Parse::Pidl::Util qw(has_property);
  10 use strict;
  11
  12 use vars qw($VERSION);
  13 $VERSION = '0.01';
  14
  15 my %supported_properties = (
  16         # interface
  17         "helpstring"            => ["INTERFACE", "FUNCTION"],
  18         "version"               => ["INTERFACE"],
  19         "uuid"                  => ["INTERFACE"],
  20         "endpoint"              => ["INTERFACE"],
  21         "pointer_default"       => ["INTERFACE"],
  22
  23         # dcom
  24         "object"                => ["INTERFACE"],
  25         "local"                 => ["INTERFACE", "FUNCTION"],
  26         "iid_is"                => ["ELEMENT"],
  27         "call_as"               => ["FUNCTION"],
  28         "idempotent"            => ["FUNCTION"],
  29
  30         # function
  31         "in"                    => ["ELEMENT"],
  32         "out"                   => ["ELEMENT"],
  33
  34         # pointer
  35         "ref"                   => ["ELEMENT"],
  36         "ptr"                   => ["ELEMENT"],
  37         "unique"                => ["ELEMENT"],
  38         "ignore"                => ["ELEMENT"],
  39
  40         "value"                 => ["ELEMENT"],
  41
  42         # generic
  43         "public"                => ["FUNCTION", "TYPEDEF"],
  44         "nopush"                => ["FUNCTION", "TYPEDEF"],
  45         "nopull"                => ["FUNCTION", "TYPEDEF"],
  46         "noprint"               => ["FUNCTION", "TYPEDEF"],
  47
  48         # union
  49         "switch_is"             => ["ELEMENT"],
  50         "switch_type"           => ["ELEMENT", "TYPEDEF"],
  51         "case"                  => ["ELEMENT"],
  52         "default"               => ["ELEMENT"],
  53
  54         # subcontext
  55         "subcontext"            => ["ELEMENT"],
  56         "subcontext_size"       => ["ELEMENT"],
  57
  58         # enum
  59         "enum16bit"             => ["TYPEDEF"],
  60         "v1_enum"               => ["TYPEDEF"],
  61
  62         # bitmap
  63         "bitmap8bit"            => ["TYPEDEF"],
  64         "bitmap16bit"           => ["TYPEDEF"],
  65         "bitmap32bit"           => ["TYPEDEF"],
  66         "bitmap64bit"           => ["TYPEDEF"],
  67
  68         # array
  69         "range"                 => ["ELEMENT"],
  70         "size_is"               => ["ELEMENT"],
  71         "string"                => ["ELEMENT"],
  72         "noheader"              => ["ELEMENT"],
  73         "charset"               => ["ELEMENT"],
  74         "length_is"             => ["ELEMENT"],
  75 );
  76
  77 sub CheckTypedef($)
  78 {
  79         my ($td) = @_;
  80
  81         if (has_property($td, "nodiscriminant")) {
  82                 warning($td, "nodiscriminant property not supported");
  83         }
  84
  85         if ($td->{TYPE} eq "BITMAP") {
  86                 warning($td, "converting bitmap to scalar");
  87                 #FIXME
  88         }
  89
  90         if (has_property($td, "gensize")) {
  91                 warning($td, "ignoring gensize() property. ");
  92         }
  93
  94         if (has_property($td, "enum8bit") and has_property($td, "enum16bit")) {
  95                 warning($td, "8 and 16 bit enums not supported, converting to scalar");
  96                 #FIXME
  97         }
  98
  99         StripProperties($td);
 100 }
 101
 102 sub CheckElement($)
 103 {
 104         my $e = shift;
 105
 106         if (has_property($e, "noheader")) {
 107                 warning($e, "noheader property not supported");
 108                 return;
 109         }
 110
 111         if (has_property($e, "subcontext")) {
 112                 warning($e, "converting subcontext to byte array");
 113                 #FIXME
 114         }
 115
 116         if (has_property($e, "compression")) {
 117                 warning($e, "compression() property not supported");
 118         }
 119
 120         if (has_property($e, "sptr")) {
 121                 warning($e, "sptr() pointer property not supported");
 122         }
 123
 124         if (has_property($e, "relative")) {
 125                 warning($e, "relative() pointer property not supported");
 126         }
 127
 128         if (has_property($e, "relative_short")) {
 129                 warning($e, "relative_short() pointer property not supported");
 130         }
 131
 132         if (has_property($e, "flag")) {
 133                 warning($e, "ignoring flag() property");
 134         }
 135
 136         if (has_property($e, "value")) {
 137                 warning($e, "ignoring value() property");
 138         }
 139 }
 140
 141 sub CheckFunction($)
 142 {
 143         my $fn = shift;
 144
 145         if (has_property($fn, "noopnum")) {
 146                 warning($fn, "noopnum not converted. Opcodes will be out of sync.");
 147         }
 148 }
 149
 150 sub CheckInterface($)
 151 {
 152         my $if = shift;
 153
 154 }
 155
 156 sub Check($)
 157 {
 158         my $pidl = shift;
 159         my $nidl = [];
 160
 161         foreach (@{$pidl}) {
 162                 push (@$nidl, CheckInterface($_)) if ($_->{TYPE} eq "INTERFACE");
 163         }
 164 }
 165
 166 1;