X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/blobdiff_plain/d8ccdbcf736474f1f05e92ed439a56adbc52f216..6eb1203decdbf9770b36a9b2103d4e5a364edffe:/tools/sg_unit_extractor.pl diff --git a/tools/sg_unit_extractor.pl b/tools/sg_unit_extractor.pl index 37b702593e..031329acaa 100755 --- a/tools/sg_unit_extractor.pl +++ b/tools/sg_unit_extractor.pl @@ -1,30 +1,47 @@ #! /usr/bin/perl use strict; -use Fcntl ':flock'; -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; -} +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] [--path=where/to/search NOT WORKING] [--outdir=where/to/generate/files] infile [infile+]\n"; + exit $ret; +} + +my $path=undef; +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, + 'path=s' =>\$path, + '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|.*/([^/]*)$|$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 +49,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; @@ -48,18 +66,24 @@ sub process_one($) { next } - if (m/XBT_TEST_SUITE\(\w*"([^"]*)"\w*,(.*?)\);/) { #" { + if (m/XBT_TEST_SUITE\(\w*"([^"]*)"\w*, *(.*?)\);/) { #" { die "$progname: Multiple suites in the same file ($infile) are not supported yet\n" if length($suite_name); ($suite_name,$suite_title)=($1,$2); + die "$progname: Empty suite name in $infile" unless length($suite_name); + die "$progname: Empty suite title in $infile" unless length($suite_title); next; - } + } elsif (m/XBT_TEST_SUITE/) { + die "$progname: Parse error: This line seem to be a test suite declaration, but failed to parse it\n$_\n"; + } if (m/XBT_TEST_UNIT\(\w*"([^"]*)"\w*,([^,]*),(.*?)\)/) { #"{ die "$progname: multiply defined unit in file $infile: $1\n" if (defined($tests{$1})); - + my @t=($1,$2,$3); push @tests,\@t; $tests{$1} = 1; + } elsif (m/XBT_TEST_UNIT/) { + die "$progname: Parse error: This line seem to be a test unit, but failed to parse it\n$_\n"; } $unit_source .= $_ if $takeit; } @@ -86,14 +110,14 @@ sub process_one($) { print OUT "#include \n"; print OUT "#include \"xbt.h\"\n"; print OUT $GENERATED; - print OUT "# $beginline \"$infile\" \n"; + print OUT "#line $beginline \"$infile\" \n"; print OUT "$unit_source"; print OUT $GENERATED; 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"; @@ -124,11 +148,11 @@ int main(int argc, char *argv[]) { strcat(selection, \",\"); strcat(selection, p); } - } else if (!strncmp(argv[i],\"--dump-only\",strlen(\"--dump-only\"))|| - !strncmp(argv[i],\"--dump\", strlen(\"--dump\"))) { + } else if (!strcmp(argv[i], \"--dump-only\")|| + !strcmp(argv[i], \"--dump\")) { xbt_test_dump(selection); return 0; - } else if (!strncmp(argv[i],\"--help\",strlen(\"--help\"))) { + } else if (!strcmp(argv[i], \"--help\")) { printf( "Usage: testall [--help] [--tests=selection] [--dump-only]\\n\\n" "--help: display this help\\n" @@ -158,12 +182,11 @@ int main(int argc, char *argv[]) { res = xbt_test_run(selection); xbt_test_exit(); - xbt_exit(); return res; } EOF print OUT $GENERATED; - 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"; } print " Suite $suite_name: $suite_title (".(scalar @tests)." tests)\n"; @@ -176,7 +199,7 @@ EOF # add this suite to the main my $newmain=""; - open IN,"simgrid_units_main.c" || die "$progname: Cannot open main file 'simgrid_units_main.c': $!\n"; + open IN,"${outdir}simgrid_units_main.c" || die "$progname: Cannot open main file '${outdir}simgrid_units_main.c': $!\n"; # search prototypes while () { $newmain .= $_; @@ -217,7 +240,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 () { @@ -250,12 +273,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;