source4/build/pidl/validator.pm

   1 ###################################################
   2 # check that a parsed IDL file is valid
   3 # Copyright tridge@samba.org 2003
   4 # released under the GNU GPL
   5
   6 package IdlValidator;
   7
   8 use strict;
   9
  10 #####################################################################
  11 # signal a fatal validation error
  12 sub fatal($)
  13 {
  14         my $s = shift;
  15         print "$s\n";
  16         die "IDL is not valid\n";
  17 }
  18
  19 sub el_name($)
  20 {
  21         my $e = shift;
  22
  23         if ($e->{PARENT} && $e->{PARENT}->{NAME}) {
  24                 return "$e->{PARENT}->{NAME}.$e->{NAME}";
  25         }
  26
  27         if ($e->{PARENT} && $e->{PARENT}->{PARENT}->{NAME}) {
  28                 return "$e->{PARENT}->{PARENT}->{NAME}.$e->{NAME}";
  29         }
  30
  31         if ($e->{PARENT}) {
  32                 return "$e->{PARENT}->{NAME}.$e->{NAME}";
  33         }
  34         return $e->{NAME};
  35 }
  36
  37 #####################################################################
  38 # parse a struct
  39 sub ValidElement($)
  40 {
  41         my $e = shift;
  42         if ($e->{POINTERS} && $e->{POINTERS} > 1) {
  43                 fatal(el_name($e) . " : pidl cannot handle multiple pointer levels. Use a sub-structure containing a pointer instead\n");
  44         }
  45
  46         if ($e->{POINTERS} && $e->{ARRAY_LEN}) {
  47                 fatal(el_name($e) . " : pidl cannot handle pointers to arrays. Use a substructure instead\n");
  48         }
  49 }
  50
  51 #####################################################################
  52 # parse a struct
  53 sub ValidStruct($)
  54 {
  55         my($struct) = shift;
  56
  57         foreach my $e (@{$struct->{ELEMENTS}}) {
  58                 $e->{PARENT} = $struct;
  59                 ValidElement($e);
  60         }
  61 }
  62
  63
  64 #####################################################################
  65 # parse a union
  66 sub ValidUnion($)
  67 {
  68         my($union) = shift;
  69         foreach my $e (@{$union->{DATA}}) {
  70                 $e->{PARENT} = $union;
  71                 ValidElement($e);
  72         }
  73 }
  74
  75 #####################################################################
  76 # parse a typedef
  77 sub ValidTypedef($)
  78 {
  79         my($typedef) = shift;
  80         my $data = $typedef->{DATA};
  81
  82         $data->{PARENT} = $typedef;
  83
  84         if (ref($data) eq "HASH") {
  85                 if ($data->{TYPE} eq "STRUCT") {
  86                         ValidStruct($data);
  87                 }
  88
  89                 if ($data->{TYPE} eq "UNION") {
  90                         ValidUnion($data);
  91                 }
  92         }
  93 }
  94
  95 #####################################################################
  96 # parse a function
  97 sub ValidFunction($)
  98 {
  99         my($fn) = shift;
 100
 101         foreach my $e (@{$fn->{DATA}}) {
 102                 $e->{PARENT} = $fn;
 103                 if (util::has_property($e, "ref") && !$e->{POINTERS}) {
 104                         fatal "[ref] variables must be pointers ($fn->{NAME}/$e->{NAME})\n";
 105                 }
 106                 ValidElement($e);
 107         }
 108 }
 109
 110 #####################################################################
 111 # parse the interface definitions
 112 sub ValidInterface($)
 113 {
 114         my($interface) = shift;
 115         my($data) = $interface->{DATA};
 116
 117         if (util::has_property($interface, "object")) {
 118         if(util::has_property($interface, "version") &&
 119                         $interface->{PROPERTIES}->{version} != 0) {
 120                         fatal "Object interfaces must have version 0.0 ($interface->{NAME})\n";
 121                 }
 122
 123                 if(!defined($interface->{BASE}) &&
 124                         not ($interface->{NAME} eq "IUnknown")) {
 125                         fatal "Object interfaces must all derive from IUnknown ($interface->{NAME})\n";
 126                 }
 127         }
 128
 129         foreach my $d (@{$data}) {
 130                 ($d->{TYPE} eq "TYPEDEF") &&
 131                     ValidTypedef($d);
 132                 ($d->{TYPE} eq "FUNCTION") &&
 133                     ValidFunction($d);
 134         }
 135
 136 }
 137
 138 #####################################################################
 139 # parse a parsed IDL into a C header
 140 sub Validate($)
 141 {
 142         my($idl) = shift;
 143
 144         foreach my $x (@{$idl}) {
 145                 ($x->{TYPE} eq "INTERFACE") &&
 146                     ValidInterface($x);
 147         }
 148 }
 149
 150 1;