Source/t/ROBOTestFrame.pm

   1 # vi: ff=unix spell
   2 #****h* ROBODoc/ROBOTestFrame
   3 # FUNCTION
   4 #   A Perl module with a set of handy functions to create
   5 #   test scripts.
   6 #
   7 #   These function are:
   8 #   * runrobo
   9 #   * add_source
  10 #   * add_configuration
  11 #   * clean
  12 #   * mkdocdir
  13 #   * is_latex_balanced
  14 #   * read_hexdump
  15 #
  16 #*****
  17
  18 package ROBOTestFrame;
  19 require Exporter;
  20   @ISA    = qw(Exporter);
  21   @EXPORT = qw(
  22     runrobo
  23     add_source
  24     add_configuration
  25     clean mkdocdir
  26     is_latex_balanced
  27     read_hexdump
  28     );  # symbols to export on request
  29
  30 use strict;
  31 use warnings;
  32 # TODO  Try to get this to work without IPC::Run
  33 use IPC::Run 'run';
  34 use File::Path;
  35 use File::Basename;
  36 use IO::File;
  37
  38 #****f* ROBOTestFrame/robo_win, robo_unix
  39 # FUNCTION
  40 #   Location of the ROBODoc executable.
  41 # SOURCE
  42 #
  43 my $robo_win = "../robodoc.exe";
  44 my $robo_unix = "../robodoc";
  45 #****
  46
  47 #****f* ROBOTestFrame/source_directory
  48 # FUNCTION
  49 #   Name of the source directory used to test ROBODoc.
  50 # SOURCE
  51 #
  52 my $source_directory  = "Src";
  53 #*****
  54
  55 #****f* ROBOTestFrame/documentation_directory
  56 # FUNCTION
  57 #   Name of the documentation directory used to test ROBODoc.
  58 # SOURCE
  59 my $documentation_directory  = "Doc";
  60 #*****
  61
  62 #****f* ROBOTestFrame/configuration_directory
  63 # FUNCTION
  64 #   Name of the documentation directory used to test ROBODoc.
  65 # SOURCE
  66 my $configuration_directory = "Config";
  67 #*****
  68
  69 #****f* ROBOTestFrame/runrobo
  70 # FUNCTION
  71 #   Run robodoc with the given set of
  72 #   arguments and capture all output to
  73 #   stdout en stderr.
  74 # INPUTS
  75 #   A list of options for robodoc.exr
  76 # RETURNS
  77 #   stdout and stderr.
  78 # SOURCE
  79 #
  80 sub runrobo
  81 {
  82     my $robo = '';
  83     if ( $^O eq 'linux' ) {
  84         $robo = $robo_unix;
  85     } else {
  86         $robo = $robo_win;
  87     }
  88     run( [ $robo, @_ ], \my( $in, $out, $err ) );
  89     return ($out, $err);
  90 }
  91 #*****
  92
  93
  94 #****f* ROBOTestFrame/add_configuration
  95 # FUNCTION
  96 #   Add a configuration file somewhere in Config/
  97 # INPUTS
  98 #   - filepath -- path to a file.
  99 #   - configuration -- the content for this file
 100 #   - binary -- write the raw bytes.  [optional]
 101 # SOURCE
 102 #
 103 sub add_configuration
 104 {
 105     my $filepath = shift;
 106     my $configuration   = shift;
 107     my $binary     = shift;
 108     add_file( $configuration_directory, $filepath, $configuration, $binary )
 109 }
 110
 111 #*****
 112
 113 #****f* ROBOTestFrame/add_source
 114 # FUNCTION
 115 #   Add a single source file somewhere in Src/
 116 # INPUTS
 117 #   - filepath -- path to a file.
 118 #   - source_code -- the source code to go into this file
 119 #   - binary -- write the raw bytes. [optional]
 120 # SOURCE
 121 #
 122 sub add_source
 123 {
 124     my $filepath = shift;
 125     my $source_code   = shift;
 126     my $binary     = shift;
 127
 128     add_file( $source_directory, $filepath, $source_code, $binary )
 129 }
 130
 131 #*****
 132
 133 #****f* ROBOTestFrame/add_file
 134 # FUNCTION
 135 #   Add a single file somewhere in base_path.
 136 # INPUTS
 137 #   - base_path -- base path
 138 #   - filepath -- relative path to a file.
 139 #   - content  -- the content to go into this file
 140 #   - binary -- write the raw bytes. [optional]
 141 # SOURCE
 142 #
 143
 144 sub add_file
 145 {
 146     my $base_path = shift;
 147     my $filepath  = shift;
 148     my $content   = shift;
 149     my $binary    = shift;
 150
 151     my $path = $base_path . dirname( $filepath );
 152
 153     $path =~ s/\.$//;  # Fix for Perl 5.8.0 under Linux.
 154
 155     if ( ! -e "$path" ) {
 156         mkpath $path or die "can't create $path";
 157     }
 158
 159     my $full_filepath = "$base_path/$filepath";
 160     my $file = IO::File->new(">$full_filepath") or
 161          die "Can't open $full_filepath";
 162     if ( $binary and ( $binary eq 'binary' ) ) {
 163         binmode( $file );
 164     }
 165     print $file $content;
 166     $file->close();
 167 }
 168 #*****
 169
 170
 171 #****f* ROBOTestFrame/clean
 172 # FUNCTION
 173 #    Clean source and documentation directories.
 174 # SOURCE
 175 #
 176 sub clean
 177 {
 178     if ( -e $source_directory ) {
 179         rmtree( $source_directory ) or die;
 180     }
 181     if ( -e $documentation_directory ) {
 182         rmtree( $documentation_directory ) or die;
 183     }
 184     if ( -e $configuration_directory ) {
 185         rmtree( $configuration_directory ) or die;
 186     }
 187 }
 188
 189 #*****
 190
 191 #****f* ROBOTestFrame/mkdocdir
 192 # FUNCTION
 193 #   Create a empty documentation directory.
 194 #   This is handy for tests that use --singledoc.
 195 # SOURCE
 196 sub mkdocdir
 197 {
 198     if ( ! -e $documentation_directory ) {
 199         mkpath( $documentation_directory );
 200     }
 201 }
 202
 203 #****
 204
 205 #****f* ROBOTestFrame/is_latex_balanced
 206 # FUNCTION
 207 #   Test the balance of a latex file.
 208 #   A latex file is balanced if every
 209 #     /begin{xxxx}
 210 #   is ended with a
 211 #     /end{xxx}
 212 # INPUTS
 213 #   * path - path to a latex file.
 214 # RETURNS
 215 #   * 0 -- file is not balanced
 216 #   * 1 -- file is balanced
 217 # SOURCE
 218
 219 sub is_latex_balanced {
 220     my $path = shift;
 221     my @stack;
 222     local( $/ ) ;
 223     my $file = IO::File->new("<$path") or die "$path : $!";
 224     my $string = <$file>;
 225     $file->close();
 226
 227     while ( $string =~ m/(begin|end)\{([^}]+)\}/g ) {
 228         my $b_e  = $1;  # begin or end
 229         my $kind = $2;  # document, or equation, or ...
 230         if ( $b_e eq "begin" ) {
 231             push( @stack, $kind );
 232         } else {
 233             if ( pop( @stack ) eq $kind ) {
 234                 # OK.  begin and end matches.
 235             } else {
 236                 # Not OK!
 237                 #   begin{ something }
 238                 # followed by
 239                 #   end{ something else }
 240                 return 0;  # Failure.
 241             }
 242
 243         }
 244     }
 245     if ( scalar( @stack ) ) {
 246         # there are items left!
 247         return 0; # Not OK.
 248     }
 249     return 1;  # OK!
 250 }
 251 #******
 252
 253
 254 #****f* ROBOTestFrame/read_hexdump
 255 # FUNCTION
 256 #   Reads a hexdump made with xxd (part of vim http://www.vim.org/)
 257 #   This makes it possible to add files with all kinds of
 258 #   different formats and characters.
 259 #
 260 #   Storing it in hexdump format makes sure that these files are
 261 #   not changed when they are checked into cvs or unzipped.
 262 #
 263 #   This makes is possible to test cr/lf problems and internationalization
 264 #   issues.
 265 #
 266 # INPUTS
 267 #   * path - path to a hexdump file.
 268 # RETURNS
 269 #   The decoded content of the file as a single string.
 270 # SOURCE
 271
 272 sub read_hexdump {
 273     my $path = shift;
 274     my $file = IO::File->new("<$path") or die "$path : $!";
 275
 276     my $string = '';
 277     my @all_bytes = ();
 278     while ( my $line = <$file> ) {
 279         $line =~ s/^\S+:\s//; # remove address
 280         $line =~ s/\s\s+.*$//; # remove ascii
 281         $line =~ s/(\S\S)(\S\S)/$1 $2/g;
 282         # Now only the words are left.
 283         my @data = split( /\s/, $line );
 284         my @bytes = map { chr hex } @data;
 285         push( @all_bytes, @bytes );
 286     }
 287     # TODO try a join() here.
 288     foreach my $c ( @all_bytes ) {
 289         $string .= $c;
 290     }
 291
 292     $file->close();
 293     return $string;
 294 }
 295
 296 #******
 297
 298 1;