X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/blobdiff_plain/8cabab2212c60733053696558fe70447e8c421c9..9fd6cbc6c3b06f4b09e3c3339ffb3cc8a68f9bfa:/tools/sg_unit_extractor.pl diff --git a/tools/sg_unit_extractor.pl b/tools/sg_unit_extractor.pl index 24a1168ceb..33e2920d57 100755 --- a/tools/sg_unit_extractor.pl +++ b/tools/sg_unit_extractor.pl @@ -1,38 +1,60 @@ -#! /usr/bin/perl +#! /usr/bin/env perl + +# Copyright (c) 2005-2018. The SimGrid Team. All rights reserved. + +# 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 Fcntl ':flock'; +use Getopt::Long qw(GetOptions); + +my $progname="sg_unit_extractor"; +# Get the args -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; +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 $progname="sg_unit_extractor"; -# Get the args -die "USAGE: $progname infile [infile+]\n" - if (scalar @ARGV == 0); +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)=("","",""); my (%tests); # to detect multiple definition 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; my $beginline=0; @@ -60,7 +82,7 @@ sub process_one($) { 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; @@ -80,7 +102,7 @@ sub process_one($) { } die "$progname: no suite defined in $infile\n" unless (length($suite_name)); - + # Write the test my ($GENERATED)=("/*******************************/\n". @@ -92,52 +114,55 @@ 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"; 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; # print OUT "# 93 \"sg_unit_extractor.pl\"\n"; print OUT <) { $newmain .= $_; @@ -196,7 +220,7 @@ EOF last if (/SGU: END PROTOTYPES/ || /SGU: BEGIN FILE $infile/); $newmain .= $_; } - if (/SGU: BEGIN FILE $infile/) { # found an old section for this file. Kill it + if (/SGU: BEGIN FILE $infile/) { # found an old section for this file. Kill it while () { last if /SGU: END FILE/; } @@ -211,26 +235,26 @@ EOF my ($name,$func,$title) = @{$_}; $newmain .= " void $func(void);\n" } @tests; - + $newmain .= " /* SGU: END FILE */\n\n"; if ($old_ =~ /SGU: BEGIN FILE/ || $old_ =~ /SGU: END PROTOTYPES/) { $newmain .= $old_; } - + # pass remaining prototypes, search declarations while () { $newmain .= $_ unless /SGU: END PROTOTYPES/; 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 () { last if (/SGU: END SUITES DECLARATION/ || /SGU: BEGIN FILE $infile/); $newmain .= $_; } - if (/SGU: BEGIN FILE $infile/) { # found an old section for this file. Kill it + if (/SGU: BEGIN FILE $infile/) { # found an old section for this file. Kill it while () { last if /SGU: END FILE/; } @@ -246,22 +270,22 @@ EOF my ($name,$func,$title) = @{$_}; $newmain .= " xbt_test_suite_push(suite, \"$name\", $func, $title);\n"; } @tests; - + $newmain .= " /* SGU: END FILE */\n\n"; if ($old_ =~ /SGU: BEGIN FILE/ || $old_ =~ /SGU: END SUITES DECLARATION/) { $newmain .= $old_; } - - # pass the remaining + + # pass the remaining 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;