diff options
Diffstat (limited to 'configgen/src/main/resources/make-config-preproc.pl')
-rwxr-xr-x | configgen/src/main/resources/make-config-preproc.pl | 952 |
1 files changed, 0 insertions, 952 deletions
diff --git a/configgen/src/main/resources/make-config-preproc.pl b/configgen/src/main/resources/make-config-preproc.pl deleted file mode 100755 index a3432957e04..00000000000 --- a/configgen/src/main/resources/make-config-preproc.pl +++ /dev/null @@ -1,952 +0,0 @@ -#!/usr/bin/perl -# Copyright 2017 Yahoo Holdings. Licensed under the terms of the Apache 2.0 license. See LICENSE in the project root. - -# This is the config pre-processor. -# It handles import statements, and does syntax checking etc. -# The idea is that it will be called directly from the script -# that does the code generation. -# -# Errors and warnings are printed in "next-error" compatible ways -# for emacs etc. -# -# Indented like this: -# (cperl-set-style "Whitesmith") -# (setq cperl-continued-brace-offset -4) - -require 5.006_001; -use strict; -use warnings; -use Digest::MD5; - -use Math::BigInt; -use Math::BigFloat; - -die "Usage: $0 <def-file>" unless $#ARGV == 0; - -my $defname = $ARGV[0]; - -my $md5 = Digest::MD5->new; - -my @c_keywords = - ("asm", "auto", "bool", "break", "case", "catch", - "char", "class", "const", "const_cast", "continue", "default", - "delete", "do", "double", "dynamic_cast", "else", "enum", "explicit", - "export", "extern", "false", "float", "for", "friend", "goto", "if", - "inline", "int", "long", "mutable", "namespace", "new", "operator", - "private", "protected", "public", "register", "reinterpret_cast", - "return", "short", "signed", "sizeof", "static", "static_cast", - "struct", "switch", "template", "this", "throw", "true", "try", - "typedef", "typeid", "typename", "union", "unsigned", - "using", "virtual", "void", "volatile", "wchar_t", "while", "and", "bitor", - "not", "or", "xor", "and_eq", "compl", "not_eq", "or_eq", "xor_eq", - "bitand"); - - -my @java_keywords = - ("abstract", "boolean", "break", "byte", "case", - "catch", "char", "class","continue", "default", "do", "double", - "else", "extends","false", "final", "finally", "float", "for", - "if","implements", "import", "instanceof", "int", "interface", - "long","native", "new", "null", "package", "private", - "protected","public", "return", "short", "static", - "strictfp","super","switch", "synchronized", "this", - "throw","throws","transient", "true", "try", "void", - "volatile","while", "byvalue", "cast", "const", "future", - "generic","goto", "inner", "operator", "outer", "rest", "var"); - -my %reserved_words; - -foreach my $word (@c_keywords) { - $reserved_words{$word} = "C"; -} - -foreach my $word (@java_keywords) { - my $x = $reserved_words{$word}; - if (defined($x)) { - $x = "$x, Java"; - } else { - $x = "Java"; - } - $reserved_words{$word} = $x; -} - -my $MIN_INT = -0x80000000; -my $MAX_INT = 0x7fffffff; -my $MIN_DOUBLE = -1e308; -my $MAX_DOUBLE = 1e308; - - -sub do_file { - my ($file, $prefix, $strip) = @_; - - local *FH; - open FH, "< $file" or die "Cannot open $file: $!\n"; - - local *COPY; - my $dir = $ENV{"VESPA_CONFIG_DEF_DIR"}; - my $copy; - my $file_version; - if (defined($dir)) { - $copy = $file; - $copy =~ s=.*/==; - $copy = "$dir/$copy"; - open COPY, ">$copy.new" or die "Cannot open file $copy.new: $!\n"; - } - - # Read line by line. - # 1. Strip away comments and trailing blanks - # 2. Report any errors - # 3. Handle import statements, disallow multi-level imports - # 4. Print everyting to stdout - - my $linenr = 0; - my $written_lines = 0; - my $quoted_strip = quotemeta($strip); - my $seen_version = 0; - - while (<FH>) { - print COPY $_ if $copy; - ++$linenr; - my $line = $_; - chomp $line; - - # Don't process comments or add them to md5 checksum, but print them - # such that codegen can include comments - if ($line =~ /^\s*#/) { - print "$line\n"; - next; - } - - # Strip away comments that are not at start of line - $line = &strip_trailing_comment($line, $linenr) - if ($line =~ m=[\\\#]=); - - if ($line eq "::error::") { - return -1; - } - - # Skip lines that are only whitespace - next if $line =~ m=^\s*$=; - - # Get rid of trailing whitespace - $line =~ s=\s+$==; - - if (!$seen_version) { - if ($line =~ m!^version=([a-zA-Z0-9][-a-zA-Z0-9_/?]*)!) { - $file_version = $1; - $seen_version = 1; - if ($prefix) { - print "$prefix imported $file"; - print ":$strip" if $strip; - print " "; - } - print "$line\n"; - next; - } else { - print STDERR "$file:$linenr: error: Definition file does not " - . "start with a valid version= identifier!\n"; - return -1; - } - } - - if ($strip) { - next unless $line =~ m=^${quoted_strip}[. \t]=; - } - - if (&check_syntax($line, $linenr, $file) == -1) { - return -1; - } - - # Handle import statements - my ($name, $type, $remains, $junk) = split(/\s+/, $line, 4); - if ($type eq "import") { - if ($strip || $prefix) { - my $col = index($line, $type, length("$name ")); - print STDERR "$file:$linenr:$col: error: Multi-level " - . "imports are disallowed.\n"; - return -1; - } - if ($junk) { - my $col = index($line, $junk, length("$name $type $remains")) - + 1; - print STDERR "$file:$linenr:$col: error: Junk after import " - . "target \"$remains\": \"$junk\"\n"; - return -1; - } - my ($impfile, $var) = split(/:/, $remains, 2); - $var = "" unless $var; # Make it defined. - - # Make sure only arrays can include arrays: - if ($name =~ m=\[\]$= && (!$var || $var !~ m=\[\]$=)) { - print STDERR "$file:$linenr: error: Array cannot import " - . "non-array in: $line\n"; - return -1; - } elsif ($name !~ m=\[\]$= && ($var && $var =~ m=\[\]$=)) { - print STDERR "$file:$linenr: error: Non-array cannot import " - . "array in: $line\n"; - return -1; - } - - local *X; - unless (open(X, "< $impfile")) { - my $col = index($line, $remains, length("$name $type")) + 1; - print STDERR "$file:$linenr:$col: error: Cannot open " - . "\"$impfile\": $!\n"; - return -1; - } - close X; - my $imported_lines = &do_file("$impfile", "$name", "$var"); - if ($imported_lines == -1) { - my $col = index($line, $remains, length("$name $type")) + 1; - print STDERR "$file:$linenr:$col: error: Imported from here " - . "as: $line\n"; - return -1; - } elsif ($imported_lines == 0) { - my $col = index($line, $remains, length("$name $type")) + 1; - print STDERR "$file:$linenr:$col: error: Import target " - . "\"$var\" not found in \"$impfile\"\n"; - return -1; - } - $written_lines += $imported_lines; - } else { - ++$written_lines; - if ($strip) { - $line =~ s=^${quoted_strip}=${prefix}= - } elsif ($prefix) { - $line = $prefix . "." . $line; - } - - if (&check_name_sanity($line, $linenr, $file) == -1 - || &check_enum_sanity($line, $linenr, $file) == -1) { - return -1; - } - - $line = &normalize_line($line, $linenr); - if ($line eq "::error::") { - return -1; - } - print $line . "\n"; - } - # Add this line to the md5 checksum - $md5->add("$line\n") unless $prefix; - } - - print "md5=" . $md5->hexdigest . "\n" unless $prefix; - close FH; - if ($copy) { - close COPY; - # We have made a copy. It needs a new name.. - my $new_name = $copy; - $new_name =~ s=\.def==; - $new_name .= ".${file_version}.def"; - if (-f $new_name) { - system "cmp $copy.new $new_name 2>/dev/null" and die "$file:1: error: Definition file $file differs from ${new_name}!\n"; - unlink("$copy.new"); - } else { - rename("$copy.new", "$new_name") or die "Rename $copy.new -> $new_name failed: $!\n"; - } - } - return $written_lines; -} - -sub normalize_enum { - my($x, $linenr, $colnr) = @_; - my $len = length($x); - my $char = ''; - my $output = '{ '; - my $index; - my %enum = (); - my $current_variable = ''; - for ($index = $colnr + 1; $index < $len; ++$index) { - $char = substr($x, $index, 1); - if ($char eq '}') { - if (length($current_variable) < 2) { - print STDERR "$defname:$linenr:$index: error: ". - " variable must be at least two characters: $x\n" ; - return ('', 0); - } elsif ($enum{$current_variable}) { - print STDERR "$defname:$linenr:$index: error: ". - " enum variable declared twice: $x\n" ; - return ('', 0); - } elsif (!%enum && !$current_variable) { - print STDERR "$defname:$linenr:$index: error: ". - " enum cannot be empty: $x\n" ; - return ('', 0); - } - return ($output.$current_variable." } ", $index); - } elsif ($char eq ',') { - if (length($current_variable) < 2) { - print STDERR "$defname:$linenr:$index: error: ". - " variable must be at least two characters: $x\n" ; - return ('', 0); - } elsif ($enum{$current_variable}) { - print STDERR "$defname:$linenr:$index: error: ". - " enum variable declared twice: $x\n" ; - return ('', 0); - } - $enum{$current_variable} = 1; - $output .= "$current_variable, "; - $current_variable = ''; - } elsif ($char =~ m=[A-Z]=) { - $current_variable .= $char; - } elsif ($char =~ m=[0-9_]= && $current_variable) { - $current_variable .= $char; - } elsif ($char =~ m=\s=) { - if ($current_variable && !($x =~ /^.{$index}\s*[,\}]/)) { - print STDERR "$defname:$linenr:$index: error: ". - "expected ',' or '}': $x\n" ; - return ("", 0); - } else { - # skip whitespace - } - } else { - print STDERR "<$char> <$current_variable>\n"; - - print STDERR "$defname:$linenr:$index: error: ". - "Enum must match [A-Z][A-Z0-9_]+: $x\n"; - } - } - return ($output, $index); -} - -{ package Range; - - $Range::DOUBLE_RANGE = - new Range("a double range=[$MIN_DOUBLE,$MAX_DOUBLE] ",0,14); - $Range::INT_RANGE = new Range("a int range=[$MIN_INT,$MAX_INT] ",0,11); - - - sub in_range { - my($self, $value) = @_; - - if ($value =~ s/KB$//) { - $value *= 1024; - } elsif ($value =~ s/MB$//) { - $value *= (1024 * 1024); - } elsif ($value =~ s/GB$//) { - $value *= (1024*1024*1024); - } elsif ($value =~ s/k$//) { - $value *= 1000; - } elsif ($value =~ s/M$//) { - $value *= 1_000_000; - } elsif ($value =~ s/G$//) { - $value *= 1_000_000_000; - } elsif ($value =~ m=^0[xX]=) { - $value = hex($value); - } - - if ($self->{start_bracket} eq '(' ) { - return 0 if $value <= $self->{min}; - } elsif ($self->{start_bracket} eq '[' ) { - return 0 if $value < $self->{min}; - } else { - print STDERR "Illegal start_bracket '$self->{start_bracket}'\n"; - return undef; - } - if ($self->{end_bracket} eq ')' ) { - return 0 if $value >= $self->{max}; - } elsif ($self->{end_bracket} eq ']' ) { - return 0 if $value > $self->{max}; - } else { - print STDERR "Illegal end_bracket '$self->{start_bracket}'\n"; - return undef; - } - return 1; - } - - - sub new { - my($class, $x, $linenr, $colnr) = @_; - my $len = length($x); - my $self = {}; - bless($self, $class); - $self->{min_value} = ''; - my $index; - for ($index = $colnr + 1; $index < $len; ++$index) { - my $char = substr($x, $index, 1); - if (($char eq '(' || $char eq '[') && !$self->{start_bracket}) { - $self->{start_bracket} = $char; - } elsif (($char eq ')' || $char eq ']') && !$self->{end_bracket}) { - $self->{end_bracket} = $char; - last; - } elsif ($char =~ m=\s=) { - #ignore whitespace - } elsif ($char eq ',' && !defined($self->{max_value})) { - $self->{max_value} = ''; - } elsif ($char =~ m=[\d\.\+eE-]= ) { - (defined($self->{max_value}) - ? $self->{max_value} : $self->{min_value}) .= $char; - } else { - print STDERR "$defname:$linenr:$index: error: ". - " syntax error: $x\n" ; - return undef; - } - } - if ($self->{min_value} eq '' && $self->{max_value} eq '') { - print STDERR "$defname:$linenr:$colnr: error: ". - " range cannot be unbounded in both ends: $x\n" ; - return undef; - } - unless ($self->{start_bracket} && $self->{end_bracket}) { - print STDERR "$defname:$linenr:$colnr: error: ". - " missing bracket: $x\n" ; - return undef; - } - - - my @arr = split(/\s+/, $x, 3); - if ($arr[1] eq 'int') { - $self->{min} = Math::BigInt->new - ($self->{min_value} eq '' ? $MIN_INT : $self->{min_value}); - unless (defined($self->{min}) && $self->{min} ne 'NaN') { - print STDERR "$defname:$linenr:$colnr: error: ". - " parse error $self->{min_value}: $x\n" ; - return undef; - } - my $min_val = - $self->{min} + ($self->{start_bracket} eq '('? 1 : 0); - - $self->{max} = Math::BigInt->new - ($self->{max_value} eq '' ? $MAX_INT : $self->{max_value}); - unless (defined($self->{max}) && $self->{max} ne 'NaN') { - print STDERR "$defname:$linenr:$colnr: error: ". - " parse error $self->{max_value}: $x\n" ; - return undef; - } - my $max_val = - $self->{max} - ($self->{end_bracket} eq ')'? 1 : 0); - - if ($min_val < $MIN_INT ) { - print STDERR "$defname:$linenr:$colnr: error: ". - " start of interval less than MIN_INT: $x\n" ; - return undef; - } - if ($max_val > $MAX_INT) { - print STDERR "$self->{max} - 1 > $MAX_INT\n"; - print STDERR "$defname:$linenr:$colnr: error: ". - " end of interval greater than MAX_INT: $x\n" ; - return undef; - } - if ($max_val < $min_val) { - print STDERR "$defname:$linenr:$colnr: error: ". - " illegal range: $x\n" ; - return undef; - } - $self->{string} = - "$self->{start_bracket}$self->{min},$self->{max}$self->{end_bracket}"; - $self->{string} =~ s/\+//g; - $self->{index} = $index; - return $self; - } elsif ($arr[1] eq 'double') { - $self->{min} = Math::BigFloat->new - ($self->{min_value} eq '' ? $MIN_DOUBLE : $self->{min_value}); - unless (defined($self->{min}) && $self->{min} ne 'NaN') { - print STDERR "$defname:$linenr:$colnr: error: ". - " parse error $self->{min_value}: $x\n" ; - return undef; - } - $self->{max} = Math::BigFloat->new - ($self->{max_value} eq '' ? $MAX_DOUBLE : $self->{max_value}); - unless (defined($self->{max}) && $self->{max} ne 'NaN') { - print STDERR "$defname:$linenr:$colnr: error: ". - " parse error $self->{max_value}: $x\n" ; - return undef; - } - if ($self->{min} < $MIN_DOUBLE) { - print STDERR "$defname:$linenr:$colnr: error: ". - " start of interval less than MIN_DOUBLE: $x\n" ; - return undef; - } - if ($self->{max} > $MAX_DOUBLE) { - print STDERR "$defname:$linenr:$colnr: error: ". - " start of interval greater than MAX_DOUBLE: $x\n" ; - return undef; - } - if ($self->{max} < $self->{min}) { - print STDERR "$defname:$linenr:$colnr: error: ". - " illegal range: $x\n" ; - return undef; - } - if (($self->{start_bracket} eq '(' || $self->{end_bracket} eq ')') - && ($self->{min_value} + $self->{min_value} - >= $self->{min_value} + $self->{max_value}) - && ($self->{max_value} + $self->{max_value} - <= $self->{min_value} + $self->{max_value})) { - print STDERR "$defname:$linenr:$colnr: error: ". - " illegal range: $x\n" ; - return undef; - } - $self->{string} = $self->{start_bracket}.$self->{min}->fnorm. - ','.$self->{max}->fnorm.$self->{end_bracket}; - $self->{string} =~ s/\+//g; - $self->{index} = $index; - return $self; - } else { - print STDERR "$defname:$linenr:$colnr: error: ". - " range-option works only for type 'int' and 'double': $x\n" ; - return undef; - } - print STDERR "$defname:$linenr:$colnr: error: ". - " script error: $x\n" ; - return undef; - - } - -} - - - - -sub strip_trailing_comment { - my ($x, $linenr) = @_; - - my $index = 0; - my $len = length($x); - my $in_quotes = 0; - - # ### Support both " and ' quotes maybe? - - for ($index = 0; $index < $len; ++$index) { - if (substr($x, $index, 1) eq "\\") { - ++$index; - next; - } - if (substr($x, $index, 1) eq "\"") { - $in_quotes ^= 1; - } - if ($in_quotes == 0 && substr($x, $index, 1) eq "#") { - if (!(substr($x, $index - 1, 1) =~ m=\s=)) { - my $col = $index + 1; - print STDERR "$defname:$linenr:$col: warning: No whitespace " - . "before comment in line: $x\n"; - } - print substr($x, $index). "\n"; - $x = substr($x, 0, $index); - last; - } - } - if ($index > $len) { - print STDERR "$defname:$linenr:$len: error: syntax error, line " - . "ends with \\: \"$x\"\n"; - return "::error::"; - } - - return $x; -} - -sub normalize_line { - my ($x, $linenr) = @_; - - my $index = 0; - my $len = length($x); - my $in_quotes = 0; - my $char = ''; - my $output = ''; - my %hash = (); - - my @arr = split(/\s+/, $x, 3); - $hash{type} = $arr[1]; - - for ($index = 0; $index < length($x); ++$index) { - $char = substr($x, $index, 1); - if ($char eq "\\") { - $output .= substr($x, $index, 2); - ++$index; - next; - } - if ($char eq "\"") { - $in_quotes ^= 1; - $output .= $char; - next; - } - my $ends_with_whitespace = ($output =~ m= $=); - - if ($in_quotes == 0) { - if ($char =~ m=\s=) { - #delete multiple spaces - if (!$ends_with_whitespace) { # && ($output =~ !m=\=$=)) { - $output .= ' '; - } - } elsif ($char eq '{') { - my($enum, $i) = &normalize_enum($x, $linenr, $index); - return "::error::" unless $i; - $index = $i; - $output .= ($ends_with_whitespace) ? $enum : " $enum "; - } elsif ($char eq ',') { - chop $output if ($ends_with_whitespace); - $output .= ','; - } elsif ($char eq '=') { - chop $output if ($ends_with_whitespace); - $output .= '='; - if ($output =~ /range=$/) { - $hash{range} = - new Range($x, $linenr, $index); - return "::error::" unless $hash{range}; - $index = $hash{range}->{index}; - $output .= $hash{range}->{string}." "; - } - if ($output =~ /default=$/ - && ($hash{type} eq 'int' || $hash{type} eq 'double')) { - $x =~ /^.{$index}=\s*(\S+)/; - $hash{default} = $1; - if ($hash{type} eq 'int' && - !$Range::INT_RANGE->in_range($hash{default})) { - print STDERR "$defname:$linenr:$index: error: ". - "Default not in range: $x\n"; - return "::error::"; - } - if ($hash{type} eq 'double' && - !$Range::DOUBLE_RANGE->in_range($hash{default})) { - print STDERR "$defname:$linenr:$index: error: ". - "Default not in range: $x\n"; - return "::error::"; - } - } - if (defined($hash{default}) && $hash{range}) { - unless ($hash{range}->in_range($hash{default})) { - print STDERR "$defname:$linenr:$index: error: ". - "Default not in range: $x\n"; - return "::error::"; - } - } - } else { - $output .= $char; - } - } else { - $output .= $char; - } - } - if ($index > $len) { - print STDERR "$defname:$linenr:$len: error: syntax error, line " - . "ends with \\: \"$x\"\n"; - return "::error::"; - } - chop $output if $output =~ m/ $/; - return $output; -} - -my %used_enum; -sub check_enum_sanity { - my ($line, $linenr, $file) = @_; - - my ($name, $type, $rest) = split(/\s+/, $line, 3); - return 0 unless ($type eq "enum"); - - $name =~ /(.*)\./; - my $prefix = $1; - $prefix = "" unless defined $prefix; # Make top level prefix - $used_enum{"$prefix"} = $used_enum{"$prefix"} || {}; - $rest = "" unless defined $rest; - $rest =~ /\{\s*(.*?)\}/; - my @values = split(/[,\s]+/, $1); - foreach my $value (@values) { - if ($used_enum{"$prefix"}->{$value}) { - print STDERR - "$file:$linenr: error: Name \"$value\" is already defined\n"; - my $prevdef = $used_enum{"$prefix"}->{$value}; - print STDERR "$prevdef: error: At this point\n"; - return -1; - } else { - $used_enum{"$prefix"}->{$value} = "$file:$linenr"; - } - } - return 0; -} - - -my %used_name; -my %used_component; -my %banned_prefixes; -my $cns_prev_name; -sub check_name_sanity { - my ($line, $linenr, $file) = @_; - my ($name, $junk) = split(/\s+/, $line, 2); - - my $plain_name = $name; - $plain_name =~ s=\[\]$==; - - # See if the name is already used. - if ($used_name{"$plain_name"}) { - print STDERR - "$file:$linenr: error: Name \"$name\" is already defined\n"; - my $prevdef = $used_name{$name}; - print STDERR "$prevdef: error: At this point\n"; - return -1; - } else { - $used_name{$name} = "$file:$linenr"; - } - - # Test for bans - my $banned = "${name}."; - do { - my $err = $banned_prefixes{$banned}; - if (defined($err)) { - print STDERR "$file:$linenr: error: The prefix \"$banned\" is illegal here\n"; - print STDERR "$err\n"; - return -1; - } - } while (($banned =~ s=[.][^.]+[.]$=.=)); - - # Add any new bans generated by this line - $banned_prefixes{"${name}."} = "$file:$linenr: error: \"${name}\" cannot " - . "be both a struct and a non-struct!"; - if ($cns_prev_name) { - my $prev = $cns_prev_name; - my $oldprev = $prev; - while (($prev =~ s=[.][^.]+[.]?$=.=)) { - if (substr($name, 0, length($prev)) eq $prev) { - $banned_prefixes{"$oldprev"} = "$file:" . ($linenr - 1) - . ": error: Last possible line is after this"; - last; - } - $oldprev = $prev; - } - } - $cns_prev_name = $name; - - # See if any of the components previously have a different "arrayness" - my $part_name = $name; - while (($part_name =~ s=[.][^.]+$==)) { - my $clashing_name = $part_name; - if ($part_name =~ m=\[\]$=) { - $clashing_name =~ s=\[\]$==; - } else { - $clashing_name .= "[]"; - } - my $clashline = $used_component{"$clashing_name"}; - if (defined $clashline) { - print STDERR "$file:$linenr: error: \"$clashing_name\" cannot be both array and non-array\n"; - print STDERR "$clashline: error: Previously defined here\n"; - return -1; - } elsif (!$used_component{"$part_name"}) { - $used_component{"$part_name"} = "$file:$linenr"; - } - } - return 0; -} - -# These are all the allowed types/commands -my %types = ( "int" => \&check_int, - "double" => \&check_double, - "string" => \&check_string, - "reference" => \&check_reference, - "enum" => \&check_enum, - "bool" => \&check_bool, - "properties" => \&check_properties, - "import" => \&check_import ); - -sub check_syntax { - my ($line, $linenr, $file) = @_; - - my $col = 0; - my $llen = length($line); - - # Step 1. Sanity check the name. - my $atstart = 1; - my $array_ok = 1; - - for ($col = 0; $col < $llen; ++$col) { - my $c = substr($line, $col, 1); - if ($atstart) { - if ($c !~ m=[a-zA-Z]=) { - print STDERR "$file:$linenr:$col: error: Non-alphabetic start " - . "of variable name in $line\n"; - return -1; - } - $atstart = 0; - } else { - if ($c =~ m=[a-zA-Z0-9_]=) { - 0; # Do nothing - } elsif ($c eq ".") { - $atstart = 1; - $array_ok = 1; - } elsif ($c eq "[") { - if (!$array_ok) { - ++$col; - print STDERR "$file:$linenr:$col: error: Arrays cannot be " - . "multidimensional in $line\n"; - return -1; - } - ++$col; - $array_ok = 0; - $c = substr($line, $col, 1); - if ($c ne "]") { - ++$col; - print STDERR "$file:$linenr:$col: error: Expected ] to " - . "terminate array definition in $line\n"; - return -1; - } - } elsif ($c =~ m=\s=) { - last; - } else { - ++$col; - print STDERR "$file:$linenr:$col: error: Syntax error, " - . "unexpected character in $line\n"; - return -1; - } - } - } - - my $name = substr($line, 0, $col); - $name =~ s=.*[.]==; - $name =~ s=[[]]$==; - - my $clash = $reserved_words{$name}; - if ($clash) { - $col -= (3 + length($name)); - $col = index($line, $name, $col) + 1; - print STDERR "$file:$linenr:$col: error: $name is a reserved word in: " - . "${clash}\n"; - return -1; - } - - while (substr($line, $col, 1) =~ m=\s=) { - ++$col; - } - - # At this point the name is sane. Next, check the type. - my ($type) = split(/\s/, substr($line, $col)); - - unless (defined $types{$type}) { - ++$col; - print STDERR "$file:$linenr:$col: error: Unknown type/command " - . "\"$type\"\n"; - return -1; - } - $col += length($type); - while (substr($line, $col, 1) =~ m=\s=) { - ++$col; - } - return $types{$type}($col, $line, $linenr, $file); -} - -sub reg_words_check { - my ($col, $line, $linenr, $file, $reg) = @_; - my $remainder = substr($line, $col); - my @options = split(/\s+/, $remainder); - - foreach my $option (@options) { - # Keep track of where we are for error reporting - $col = index($line, $option, $col) + 1; - unless ($option =~ m!${reg}!) { - print STDERR "$file:$linenr:$col: error: Bad option \"$option\" no match for m!${reg}!\n"; - return -1; - } - } - return 0; -} - -sub check_int { - my ($col, $line, $linenr, $file) = @_; - my $num = "(-?\\d+(KB|MB|GB|k|M|G)?|0x[0-9a-fA-F]+)"; # All legal numbers - my $optnum = "(${num})?"; # All legal optional numbers - return ®_words_check($col, $line, $linenr, $file, - "^(" - . "default=${num}" - . "|range=[[(]${optnum},${optnum}"."[])]" - . "|restart" - . ")\$"); -} - -sub check_double { - my ($col, $line, $linenr, $file) = @_; - my $num = "-?(\\d+(\\.\\d*)?|\\.\\d+)([eE][+-]?\\d+)?"; # All legal doubles - my $optnum = "(${num})?"; # Optional doubles - return ®_words_check($col, $line, $linenr, $file, - "^(" - . "default=${num}" - . "|range=[[(]${optnum},${optnum}"."[])]" - . "|restart" - . ")\$"); -} - -sub check_string { - my ($col, $line, $linenr, $file) = @_; - my $opts = substr($line, $col); - - # not entirely correct either for something like \\" - my $def = "default=((\"(\\\"|[^\"])*\")|null)"; - - my $res = "restart"; - my $reg = "^(${def}\\s+${res}|(${def})?|${res}|${res}\\s+${def})\$"; - - unless ($opts =~ m!${reg}!) { - print STDERR "$file:$linenr:$col: error: Bad options \"$opts\", no match for m!${reg}!\n"; - return -1; - } - return 0; -} - -sub check_reference { - my ($col, $line, $linenr, $file) = @_; - my $opts = substr($line, $col); - my $def = "default=((\"(\\\"|[^\"])*\")|null)"; - - unless ($opts eq "" || $opts =~m!${def}!) { - print STDERR "$file:$linenr:$col: error: reference can only " - . "take the 'default' option\n"; - return -1; - } - return 0; -} - - -sub check_enum { - my ($col, $line, $linenr, $file) = @_; - my $ret = ®_words_check($col, $line, $linenr, $file, - "^(" - . "[{},]" - . "|[A-Z][A-Z0-9_]+,?" - . "|default=[A-Z][A-Z0-9_]+" - . "|restart" - . ")\$"); - return -1 if $ret; - $col = index($line, '}', $col) + 1; #move $col to end of enum --> } - while (substr($line, $col, 1) =~ m=[\s\{]=) { - ++$col; - } - return 0 if $col >= length($line); - - - return ®_words_check($col, $line, $linenr, $file, - "^(" - . "default=[A-Z][A-Z0-9_]+" - . "|restart" - . ")\$"); -} - -sub check_bool { - my ($col, $line, $linenr, $file) = @_; - return ®_words_check($col, $line, $linenr, $file, - "^(" - . "default=(true|false)" - . "|restart" - . ")\$"); -} - -sub check_properties { - my ($col, $line, $linenr, $file) = @_; - return ®_words_check($col, $line, $linenr, $file, "^restart\$"); -} - -sub check_import { - my ($col, $line, $linenr, $file) = @_; - my $word = "[a-zA-Z][_a-zA-Z0-9]*"; - my $fnam = "${word}(\\.${word})*"; - my $var = "${word}((\\[\\])?\.${word})*(\\[\\])?"; - return ®_words_check($col, $line, $linenr, $file, - "^${fnam}\\.def:(${var})?\$"); - return 0; -} - - -my $lines = &do_file($defname, "", ""); - -if ($lines == -1) { - die "There were irrecoverable errors in \"$defname\"!\n"; -} -if ($lines == 0) { - die "$defname:1: error: Resulting definition is empty!\n"; -} - -exit 0; |