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         "noejs"                 => ["FUNCTION", "TYPEDEF"],
  48
  49         # union
  50         "switch_is"             => ["ELEMENT"],
  51         "switch_type"           => ["ELEMENT", "TYPEDEF"],
  52         "case"                  => ["ELEMENT"],
  53         "default"               => ["ELEMENT"],
  54
  55         # subcontext
  56         "subcontext"            => ["ELEMENT"],
  57         "subcontext_size"       => ["ELEMENT"],
  58
  59         # enum
  60         "enum16bit"             => ["TYPEDEF"],
  61         "v1_enum"               => ["TYPEDEF"],
  62
  63         # bitmap
  64         "bitmap8bit"            => ["TYPEDEF"],
  65         "bitmap16bit"           => ["TYPEDEF"],
  66         "bitmap32bit"           => ["TYPEDEF"],
  67         "bitmap64bit"           => ["TYPEDEF"],
  68
  69         # array
  70         "range"                 => ["ELEMENT"],
  71         "size_is"               => ["ELEMENT"],
  72         "string"                => ["ELEMENT"],
  73         "noheader"              => ["ELEMENT"],
  74         "charset"               => ["ELEMENT"],
  75         "length_is"             => ["ELEMENT"],
  76 );
  77
  78 sub CheckTypedef($)
  79 {
  80         my ($td) = @_;
  81
  82         if (has_property($td, "nodiscriminant")) {
  83                 warning($td, "nodiscriminant property not supported");
  84         }
  85
  86         if ($td->{TYPE} eq "BITMAP") {
  87                 warning($td, "converting bitmap to scalar");
  88                 #FIXME
  89         }
  90
  91         if (has_property($td, "gensize")) {
  92                 warning($td, "ignoring gensize() property. ");
  93         }
  94
  95         if (has_property($td, "enum8bit") and has_property($td, "enum16bit")) {
  96                 warning($td, "8 and 16 bit enums not supported, converting to scalar");
  97                 #FIXME
  98         }
  99
 100         StripProperties($td);
 101 }
 102
 103 sub CheckElement($)
 104 {
 105         my $e = shift;
 106
 107         if (has_property($e, "noheader")) {
 108                 warning($e, "noheader property not supported");
 109                 return;
 110         }
 111
 112         if (has_property($e, "subcontext")) {
 113                 warning($e, "converting subcontext to byte array");
 114                 #FIXME
 115         }
 116
 117         if (has_property($e, "compression")) {
 118                 warning($e, "compression() property not supported");
 119         }
 120
 121         if (has_property($e, "sptr")) {
 122                 warning($e, "sptr() pointer property not supported");
 123         }
 124
 125         if (has_property($e, "relative")) {
 126                 warning($e, "relative() pointer property not supported");
 127         }
 128
 129         if (has_property($e, "flag")) {
 130                 warning($e, "ignoring flag() property");
 131         }
 132
 133         if (has_property($e, "value")) {
 134                 warning($e, "ignoring value() property");
 135         }
 136 }
 137
 138 sub CheckFunction($)
 139 {
 140         my $fn = shift;
 141
 142         if (has_property($fn, "noopnum")) {
 143                 warning($fn, "noopnum not converted. Opcodes will be out of sync.");
 144         }
 145 }
 146
 147 sub CheckInterface($)
 148 {
 149         my $if = shift;
 150
 151 }
 152
 153 sub Check($)
 154 {
 155         my $pidl = shift;
 156         my $nidl = [];
 157
 158         foreach (@{$pidl}) {
 159                 push (@$nidl, CheckInterface($_)) if ($_->{TYPE} eq "INTERFACE");
 160         }
 161 }
 162
 163 1;