regression_test/XML/XER/checkit.pl

   1 #!/usr/bin/perl -w
   2 ###############################################################################
   3 # Copyright (c) 2000-2014 Ericsson Telecom AB
   4 # All rights reserved. This program and the accompanying materials
   5 # are made available under the terms of the Eclipse Public License v1.0
   6 # which accompanies this distribution, and is available at
   7 # http://www.eclipse.org/legal/epl-v10.html
   8 ###############################################################################
   9
  10
  11 use strict;
  12
  13 if ($] < 5.006) {
  14   # ancient perl, we must be on Solaris :(
  15   my @perlloc = qw( /proj/TTCN/Tools/perl-5.10.1/bin/perl /mnt/TTCN/Tools/perl-5.10.1/bin/perl );
  16   foreach (@perlloc) {
  17     if (-x $_) {
  18       warn "Let's try with $_ instead";
  19       exec( $_, $0, @ARGV ) or die "That didn't work either: $!";
  20     }
  21   }
  22 }
  23 else {
  24   require Test::More;
  25   Test::More->import('no_plan');
  26 }
  27
  28 #use re qw(debug);
  29
  30 my %versions = (
  31 'converter'    => '',
  32 'UTF8'         => '',
  33 'Txerasntypes' => 'R8A',
  34 'Txerboolean'  => 'R8B',
  35 'Txerenum'     => 'R8E',
  36 'Txerfloat'    => 'R8F',
  37 'Txerint'      => 'R8J',
  38 'Txernested'   => 'R8N',
  39 'Txerobjclass' => '',
  40 'Txersets'     => '',
  41 'Txerstring'   => 'R8Z',
  42 'Txerbinstr'   => 'R99999A',
  43 'Asntypes'     => '',
  44 'AsnValues'    => '',
  45 'EmptyUnion'   => '',
  46 'ObjectClass'  => '',
  47 'ObjectClassWithSyntax' => '',
  48 'Sets'      => '',
  49 'SetValues' => '',
  50 'junk' => '',
  51 # built-in modules for the logger
  52 'TitanLoggerApi' => '',
  53 'TitanLoggerControl' => '',
  54 );
  55
  56
  57
  58 while ( <> ) {
  59   chomp;
  60
  61   if ( my ($mod, $type, $md5, $rev) =
  62     m/^
  63     (\w+) # module name
  64     \s+
  65     (TTCN-3|ASN\.1) # type
  66     \s+
  67     (?: # dodge the compilation date
  68     # Hopefully not affected by i18n: this is American style mm dd yyyy
  69     [A-Z][a-z][a-z] # month
  70     \s
  71     [\s\d]\d # day of the month
  72     \s
  73     \d{4} # year
  74     \s
  75     \d\d # hour
  76     :
  77     \d\d # min
  78     :
  79     \d\d # sec
  80     \s+
  81     )?
  82     ([0-9a-fA-F]{32})?
  83     \s*
  84     (R\d+\w?)?/x ) {
  85     $md5 ||= '';
  86     $rev ||= '';
  87     #print "$mod\t, $type\t, $md5, $rev";
  88     if (ok(exists $versions{$mod}, " \tKnown module $mod")) {
  89       #    got, exp, name
  90       is ($rev, $versions{$mod}, " \tVersion for  $mod");
  91       delete $versions{$mod};
  92     }
  93     else {
  94       #die "Unknown module name $mod";
  95       SKIP: {
  96       skip( " \tversion check for unknown module $mod", 1 );
  97       }
  98     }
  99   }
 100   #else {warn $_;}
 101 }
 102
 103 #done_testing();