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