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