X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/blobdiff_plain/174d02656fd194d1773e8fd5b4f6d51c159839cd..047872771f0685df5ad0db3422b3333e26696330:/tools/sg_unit_extractor.pl diff --git a/tools/sg_unit_extractor.pl b/tools/sg_unit_extractor.pl index 4b96fd8502..8b2083fffc 100755 --- a/tools/sg_unit_extractor.pl +++ b/tools/sg_unit_extractor.pl @@ -1,30 +1,51 @@ -#! /usr/bin/perl +#! /usr/bin/env perl -use strict; -use Fcntl ':flock'; +# Copyright (c) 2005-2012, 2014-2017. The SimGrid Team. All rights reserved. -open SELF, "< $0" or die "Cannot open the lock file"; -if (!flock SELF, LOCK_EX | LOCK_NB) { - print STDERR "sg_unit_extractor already running. Cancelling...\n"; - exit; -} +# This program is free software; you can redistribute it and/or modify it +# under the terms of the license (GNU LGPL) which comes with this package. + +use strict; +use Getopt::Long qw(GetOptions); my $progname="sg_unit_extractor"; # Get the args -die "USAGE: $progname infile [infile+]\n" - if (scalar @ARGV == 0); + +sub usage($) { + my $ret; + print "USAGE: $progname [--root=part/to/cut] [--outdir=where/to/generate/files] infile [infile+]\n\n"; + print "This program is in charge of extracting the unit tests out of the SimGrid source code.\n"; + print "See http://simgrid.gforge.inria.fr/doc/latest/inside_tests.html for more details.\n"; + exit $ret; +} + +my $outdir=undef; +my $root; +my $help; + +Getopt::Long::config('permute','no_getopt_compat', 'no_auto_abbrev'); +GetOptions( + 'help|h' => sub {usage(0)}, + 'root=s' =>\$root, + 'outdir=s' =>\$outdir) or usage(1); + +usage(1) if (scalar @ARGV == 0); map {process_one($_)} @ARGV; sub process_one($) { - my $infile = shift; my $outfile; + $infile =~ s|src/|| unless (-e $infile); + $outfile = $infile; $outfile =~ s/\.c$/_unit.c/; + $outfile =~ s/\.cpp$/_unit.cpp/; $outfile =~ s|.*/([^/]*)$|$1| if $outfile =~ m|/|; + $outfile = "$outdir$outfile"; + print "$progname: processing $infile (generating $outfile)...\n"; # Get the unit data my ($unit_source,$suite_name,$suite_title)=("","",""); @@ -32,6 +53,7 @@ sub process_one($) { my (@tests); # actual content open IN, "$infile" || die "$progname: Cannot open input file '$infile': $!\n"; + $infile =~ s|$root|| if defined($root); my $takeit=0; my $line=0; @@ -98,12 +120,13 @@ sub process_one($) { close OUT || die "$progname: Cannot close output file '$outfile': $!\n"; # write the main skeleton if needed - if (! -e "simgrid_units_main.c") { - open OUT,">simgrid_units_main.c" || die "$progname: Cannot open main file 'simgrid_units_main.c': $!\n"; + if (! -e "${outdir}simgrid_units_main.c") { + open OUT,">${outdir}simgrid_units_main.c" || die "$progname: Cannot open main file '${outdir}simgrid_units_main.c': $!\n"; print OUT $GENERATED; print OUT "#include \n\n"; print OUT "#include \"xbt.h\"\n\n"; print OUT "extern xbt_test_unit_t _xbt_current_unit;\n\n"; + print OUT "#define STRLEN 1024\n"; print OUT "/* SGU: BEGIN PROTOTYPES */\n"; print OUT "/* SGU: END PROTOTYPES */\n\n"; print OUT $GENERATED; @@ -111,9 +134,11 @@ sub process_one($) { print OUT <) { $newmain .= $_; @@ -222,7 +247,7 @@ EOF last if /SGU: BEGIN SUITES DECLARATION/; } - ### Done with prototypes. And now, the actual code + ### Done with prototypes. And now, the actual code # search my prototype while () { @@ -255,12 +280,12 @@ EOF while () { $newmain .= $_; } - close IN || die "$progname: Cannot close main file 'simgrid_units_main.c': $!\n"; + close IN || die "$progname: Cannot close main file '${outdir}simgrid_units_main.c': $!\n"; # write it back to main - open OUT,">simgrid_units_main.c" || die "$progname: Cannot open main file 'simgrid_units_main.c': $!\n"; + open OUT,">${outdir}simgrid_units_main.c" || die "$progname: Cannot open main file '${outdir}simgrid_units_main.c': $!\n"; print OUT $newmain; - close OUT || die "$progname: Cannot close main file 'simgrid_units_main.c': $!\n"; + close OUT || die "$progname: Cannot close main file '${outdir}simgrid_units_main.c': $!\n"; } # end if process_one($) 0;