forked from epics_driver_modules/require
Merge branch 'translate_tcl_to_perl'
This commit is contained in:
@@ -149,7 +149,7 @@ SUBMODULES:=$(foreach f,$(wildcard .gitmodules),$(shell awk '/^\[submodule/ { pr
|
||||
VERSIONCHECKFILES = $(filter-out /% -none-, $(USERMAKEFILE) $(wildcard *.db *.template *.subs *.dbd *.cmd *.iocsh)
|
||||
VERSIONCHECKFILES += ${SOURCES} ${DBDS} ${TEMPLATES} ${SCRIPTS} $($(filter SOURCES_% DBDS_%,${.VARIABLES})))
|
||||
VERSIONCHECKFILES += ${SUBMODULES}
|
||||
VERSIONCHECKCMD = ${MAKEHOME}/getVersion.tcl ${VERSIONDEBUGFLAG} ${VERSIONCHECKFILES}
|
||||
VERSIONCHECKCMD = ${MAKEHOME}/getVersion.pl ${VERSIONDEBUGFLAG} ${VERSIONCHECKFILES}
|
||||
LIBVERSION = $(or $(filter-out test,$(shell ${VERSIONCHECKCMD} 2>/dev/null)),${USER},test)
|
||||
VERSIONDEBUGFLAG = $(if ${VERSIONDEBUG}, -d)
|
||||
|
||||
@@ -887,7 +887,7 @@ MODULEINFOS:
|
||||
# because it has too strict checks to be used for a loadable module.
|
||||
${MODULEDBD}: ${DBDFILES}
|
||||
@echo "Expanding $@"
|
||||
${MAKEHOME}expandDBD.tcl -$(basename ${EPICSVERSION}) ${DBDEXPANDPATH} $^ > $@
|
||||
${MAKEHOME}expandDBD.pl -$(basename ${EPICSVERSION}) ${DBDEXPANDPATH} $^ > $@
|
||||
|
||||
# Install everything.
|
||||
INSTALL_LIBS = $(addprefix ${INSTALL_LIB}/,${MODULELIB} $(notdir ${SHRLIBS}))
|
||||
|
||||
Executable
+122
@@ -0,0 +1,122 @@
|
||||
#!/usr/bin/env perl
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
use 5.010;
|
||||
|
||||
use File::Basename qw/basename/;
|
||||
use File::Spec::Functions qw/catfile/;
|
||||
|
||||
my $epicsversion = 0x030E0000; # 3.14
|
||||
my $quiet = 0;
|
||||
my @searchpath = ();
|
||||
my %filesDone = ();
|
||||
my @filesInput = ();
|
||||
|
||||
while (@ARGV) {
|
||||
my $arg = shift @ARGV;
|
||||
if ($arg =~ /^-(\d+(.\d+){0,3})$/) { $epicsversion = parseVersion($1); }
|
||||
elsif ($arg eq "-q") { $quiet = 1; }
|
||||
elsif ($arg =~ /^-I$/) { push @searchpath, shift @ARGV; }
|
||||
elsif ($arg =~ /^-I(.*)$/) { push @searchpath, $1; }
|
||||
else { push @filesInput, $arg; }
|
||||
}
|
||||
|
||||
##
|
||||
## Convert version string of version.revision.modification.patch format
|
||||
## to integer format 0Xvvrrmmpp (in hexadecimal)
|
||||
## 3.14.12.8 -> 0x030E0C08
|
||||
## 7.0.3 -> 0x07000300
|
||||
## This requires all parts of version number are in range 0-255,
|
||||
## which is true for EPICS base version number.
|
||||
##
|
||||
sub parseVersion {
|
||||
my @vi = split(/\./, shift); # version integers list
|
||||
my $vh = 0; # hexadecimal version
|
||||
foreach my $i (0..$#vi) {
|
||||
$vh |= $vi[$i] << (8 * (3-$i));
|
||||
}
|
||||
return $vh;
|
||||
}
|
||||
|
||||
##
|
||||
## Search given dbd file from @searchpath list.
|
||||
## If it is not found, return the file name as it is.
|
||||
##
|
||||
sub finddbd {
|
||||
my $name = shift;
|
||||
|
||||
foreach my $dir (@searchpath) {
|
||||
my $fullname = catfile($dir, $name);
|
||||
if ( -f $fullname) {
|
||||
return $fullname;
|
||||
}
|
||||
}
|
||||
|
||||
return $name;
|
||||
}
|
||||
|
||||
##
|
||||
## Read a dbd file and dump its contents to stdout.
|
||||
## File after "include" directive is read in too.
|
||||
##
|
||||
sub scanfile {
|
||||
my $name = shift; # dbd file to read
|
||||
my $includer = shift; # dbd file and lineno where this dbd file is included.
|
||||
my $lineno = shift; # they are undef for files from command line.
|
||||
|
||||
my $base = basename($name);
|
||||
|
||||
if (exists($filesDone{$base})) {
|
||||
if (!$quiet) {
|
||||
if ($includer) {
|
||||
say STDERR "Info: skipping duplicate file $name included from $includer line $lineno";
|
||||
}
|
||||
else {
|
||||
say STDERR "Info: skipping duplicate file $name from command line";
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
if ($base ne "dbCommon.dbd") {
|
||||
$filesDone{$base} = 1;
|
||||
}
|
||||
|
||||
my $fh;
|
||||
if (!(open $fh, "<", finddbd($name))) {
|
||||
if ($includer) {
|
||||
say STDERR "ERROR: file $name not found in path \"@searchpath\" called from $includer line $lineno";
|
||||
}
|
||||
else {
|
||||
say STDERR "ERROR: file $name not found in path \"@searchpath\"";
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
foreach (my $n=1;<$fh>;$n++) {
|
||||
chomp;
|
||||
|
||||
if (/^[ \t]*(#|%|$)/) {
|
||||
# skip
|
||||
}
|
||||
elsif (/include[ \t]+"?([^"]*)"?/) {
|
||||
return 0 unless scanfile($1, $name, $n);
|
||||
}
|
||||
elsif (/(registrar|variable|function)[ \t]*\([ \t]*"?([a-zA-Z0-9_]+)"?[ \t]*\)/) {
|
||||
say "$1($2)" if $epicsversion > 0x030D0000; # 3.13
|
||||
}
|
||||
elsif (/variable[ \t]*\([ \t]*"?([a-zA-Z0-9_]+)"?[ \t]*,[ \t]*"?([a-zA-Z0-9_]+)"?[ \t]*\)/) {
|
||||
say "variable($1,$2)" if $epicsversion > 0x030D0000; # 3.13
|
||||
}
|
||||
else {
|
||||
say;
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
foreach my $name (@filesInput) {
|
||||
exit 1 unless scanfile($name);
|
||||
}
|
||||
@@ -1,115 +0,0 @@
|
||||
#!/usr/bin/tclsh
|
||||
|
||||
package require Tclx
|
||||
|
||||
set global_context [scancontext create]
|
||||
|
||||
set epicsversion 3.14
|
||||
set quiet 0
|
||||
set recordtypes 0
|
||||
set seachpath {}
|
||||
set filesDone {}
|
||||
|
||||
while {[llength $argv]} {
|
||||
switch -glob -- [lindex $argv 0] {
|
||||
"-[0-9]*" { set epicsversion [string range [lindex $argv 0] 1 end]}
|
||||
"-q" { set quiet 1 }
|
||||
"-r" { set recordtypes 1; set quiet 1 }
|
||||
"-I" { lappend seachpath [lindex $argv 1]; set argv [lreplace $argv 0 1]; continue }
|
||||
"-I*" { lappend seachpath [string range [lindex $argv 0] 2 end] }
|
||||
"--" { set argv [lreplace $argv 0 0]; break }
|
||||
"-*" { puts stderr "Warning: Unknown option [lindex $argv 0] ignored" }
|
||||
default { break }
|
||||
}
|
||||
set argv [lreplace $argv 0 0]
|
||||
}
|
||||
|
||||
proc opendbd {name} {
|
||||
global seachpath
|
||||
foreach dir $seachpath {
|
||||
if ![catch {
|
||||
set file [open [file join $dir $name]]
|
||||
}] {
|
||||
return $file
|
||||
}
|
||||
}
|
||||
return -code error "file $name not found"
|
||||
}
|
||||
|
||||
scanmatch $global_context {^[ \t]*(#|%|$)} {
|
||||
continue
|
||||
}
|
||||
|
||||
if {$recordtypes} {
|
||||
scanmatch $global_context {include[ \t]+"?((.*)Record.dbd)"?} {
|
||||
if ![catch {
|
||||
close [opendbd $matchInfo(submatch0)]
|
||||
}] {
|
||||
puts $matchInfo(submatch1)
|
||||
}
|
||||
continue
|
||||
}
|
||||
|
||||
} else {
|
||||
|
||||
scanmatch $global_context {(registrar|variable|function)[ \t]*\([ \t]*"?([a-zA-Z0-9_]+)"?[ \t]*\)} {
|
||||
global epicsversion
|
||||
if {$epicsversion > 3.13} {puts $matchInfo(submatch0)($matchInfo(submatch1))}
|
||||
}
|
||||
scanmatch $global_context {variable[ \t]*\([ \t]*"?([a-zA-Z0-9_]+)"?[ \t]*,[ \t]*"?([a-zA-Z0-9_]+)"?[ \t]*\)} {
|
||||
global epicsversion
|
||||
if {$epicsversion > 3.13} {puts variable($matchInfo(submatch0),$matchInfo(submatch1))}
|
||||
}
|
||||
|
||||
scanmatch $global_context {
|
||||
puts $matchInfo(line)
|
||||
}
|
||||
}
|
||||
|
||||
scanmatch $global_context {include[ \t]+"?([^"]*)"?} {
|
||||
global seachpath
|
||||
global FileName
|
||||
global quiet
|
||||
if [catch {
|
||||
includeFile $global_context $matchInfo(submatch0)
|
||||
} msg] {
|
||||
if {!$quiet} {
|
||||
puts stderr "ERROR: $msg in path \"$seachpath\" called from $FileName($matchInfo(handle)) line $matchInfo(linenum)"
|
||||
exit 1
|
||||
}
|
||||
}
|
||||
continue
|
||||
}
|
||||
|
||||
proc includeFile {context filename} {
|
||||
global global_context FileName filesDone matchInfo quiet
|
||||
set basename [file tail $filename]
|
||||
if {[lsearch $filesDone $basename ] != -1} {
|
||||
if {!$quiet} {
|
||||
puts stderr "Info: skipping duplicate file $basename included from $FileName($matchInfo(handle))"
|
||||
}
|
||||
return
|
||||
}
|
||||
if {$filename != "dbCommon.dbd"} { lappend filesDone [file tail $filename] }
|
||||
set file [opendbd $filename]
|
||||
set FileName($file) $filename
|
||||
#puts "#include $filename from $FileName($matchInfo(handle))"
|
||||
scanfile $context $file
|
||||
close $file
|
||||
}
|
||||
|
||||
foreach filename $argv {
|
||||
global filesDone quiet
|
||||
set basename [file tail $filename]
|
||||
if {[lsearch $filesDone $basename] != -1} {
|
||||
if {!$quiet} {
|
||||
puts stderr "Info: skipping duplicate file $basename from command line"
|
||||
}
|
||||
continue
|
||||
}
|
||||
if {$basename != "dbCommon.dbd"} { lappend filesDone $basename }
|
||||
set file [open $filename]
|
||||
set FileName($file) $filename
|
||||
scanfile $global_context $file
|
||||
close $file
|
||||
}
|
||||
Executable
+283
@@ -0,0 +1,283 @@
|
||||
#!/usr/bin/env perl
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
use 5.010;
|
||||
|
||||
use File::Glob qw/bsd_glob/;
|
||||
use IPC::Open3;
|
||||
|
||||
# cvs status parsing state
|
||||
use constant {
|
||||
GLOBAL => 0,
|
||||
FILE => 1,
|
||||
SKIP => 2
|
||||
};
|
||||
|
||||
my $version;
|
||||
my $debug = 0;
|
||||
|
||||
# Check all files in top directory and all files specified explicitly in subdirectories
|
||||
my @files = glob("GNUmakefile makefile Makefile *.c *.cc *.cpp *.h *.dbd *.st *.stt *.gt");
|
||||
# perl glob keeps non-wildcard names even they don't match, which are removed manually.
|
||||
@files = grep(-f, @files);
|
||||
my @statusinfo;
|
||||
|
||||
while (@ARGV) {
|
||||
my $arg = shift @ARGV;
|
||||
if ($arg eq "-d") {
|
||||
$debug = 1;
|
||||
} else {
|
||||
push @files, $arg;
|
||||
}
|
||||
}
|
||||
# concatenate the files list to one space separatd string
|
||||
my $files = join(' ', @files);
|
||||
|
||||
sub check_output {
|
||||
my ($child_stdin, $child_stdout, $child_stderr);
|
||||
chomp(my $command = $_[0]);
|
||||
|
||||
# start the child process and wait for it to finish
|
||||
my $child_pid = open3($child_stdin, $child_stdout, $child_stderr, $command);
|
||||
waitpid($child_pid, 0);
|
||||
if ($? != 0) {
|
||||
my $error;
|
||||
foreach (<$child_stdout>) {
|
||||
$error .= $_;
|
||||
}
|
||||
die $error;
|
||||
}
|
||||
|
||||
# read child process output
|
||||
my @output = ();
|
||||
foreach my $line (<$child_stdout>) {
|
||||
push @output, $line;
|
||||
}
|
||||
|
||||
return @output;
|
||||
}
|
||||
|
||||
sub parse_cvs_output {
|
||||
my @output = @{$_[0]};
|
||||
my $scope = GLOBAL;
|
||||
my $file;
|
||||
my %rev;
|
||||
my %tag;
|
||||
my ($major, $minor, $patch);
|
||||
|
||||
foreach my $line (@output) {
|
||||
chomp($line);
|
||||
if ($scope == SKIP) {
|
||||
if ($line =~ /=================/) {
|
||||
$scope = GLOBAL;
|
||||
}
|
||||
}
|
||||
elsif ($scope == FILE) {
|
||||
if ($line =~ /Working revision:/) {
|
||||
$rev{$file} = (split " ", $line)[2];
|
||||
}
|
||||
elsif ($line =~ /Sticky Tag:.*_([0-9]+)_([0-9]+)(_([0-9]+))?[ \t]+\(revision: /) {
|
||||
$major = $1;
|
||||
$minor = $2;
|
||||
$patch = $4 || 0;
|
||||
$tag{$file} = (split " ", $line)[2] . " (sticky)";
|
||||
$scope = SKIP;
|
||||
}
|
||||
elsif ($line =~ /_([0-9]+)_([0-9]+)(_([0-9]+))?[ \t]+\(revision: ([\.0-9]+)\)/) {
|
||||
if ($rev{$file} eq $5) {
|
||||
my $Major = $1;
|
||||
my $Minor = $2;
|
||||
my $Patch = $4 || 0;
|
||||
if (!defined($major) ||
|
||||
$Major > $major ||
|
||||
($Major == $major && ($Minor > $minor
|
||||
|| ($Minor == $minor && $Patch > $patch)))) {
|
||||
$major = $Major;
|
||||
$minor = $Minor;
|
||||
$patch = $Patch;
|
||||
$tag{$file} = (split " ", $line)[0];
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif ($line =~ /=================/) {
|
||||
if (!defined($major)) {
|
||||
say STDERR "checking $file: revision $rev{$file} not tagged => version test";
|
||||
$version = "test";
|
||||
} else {
|
||||
say STDERR "checking $file: revision $rev{$file} tag $tag{$file} => version $major.$minor.$patch";
|
||||
if (!defined($version)) {
|
||||
$version = "$major.$minor.$patch";
|
||||
} else {
|
||||
if ($version ne "$major.$minor.$patch") {
|
||||
$version = "test";
|
||||
}
|
||||
}
|
||||
}
|
||||
$scope = GLOBAL;
|
||||
}
|
||||
}
|
||||
elsif ($scope == GLOBAL) {
|
||||
if ($line =~ /there is no version here/) {
|
||||
return;
|
||||
}
|
||||
elsif ($line =~ /cvs status: failed/) {
|
||||
say STDERR "Error: $line";
|
||||
return;
|
||||
}
|
||||
elsif ($line =~ /no such directory `(.*)'/) {
|
||||
say STDERR "checking directory $1: so such directory";
|
||||
return;
|
||||
}
|
||||
elsif ($line =~ /cvs \[status aborted\]: there is no version here/) {
|
||||
return;
|
||||
}
|
||||
elsif ($line =~ /^File: (\S+)\s+Status: Up-to-date/) {
|
||||
$file = $1;
|
||||
$major = undef();
|
||||
$minor = undef();
|
||||
$patch = undef();
|
||||
$scope = FILE;
|
||||
}
|
||||
elsif ($line =~ /^File: (\S+)\s+Status: (.*)/) {
|
||||
$file = $1;
|
||||
say STDERR "checking $file: $2 => verson test";
|
||||
$version = "test";
|
||||
}
|
||||
elsif ($line =~ /^\? .*/) {
|
||||
$file = (split " ", $line)[1];
|
||||
say STDERR "checking $file: not in cvs => version test";
|
||||
$version = "test";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub parse_git_output {
|
||||
my @output = @{$_[0]};
|
||||
|
||||
foreach my $line (@output) {
|
||||
chomp($line);
|
||||
if ($line =~ /fatal: Not a git repository/) {
|
||||
return;
|
||||
}
|
||||
elsif ($line =~ /^\?\? (.*)/) {
|
||||
say STDERR "$1: not in git => version test";
|
||||
$version = "test";
|
||||
}
|
||||
elsif ($line =~ /^ M (.*)/) {
|
||||
say STDERR "$1: locally modified => version test";
|
||||
$version = "test";
|
||||
}
|
||||
elsif ($line =~ /^D (.*)/) {
|
||||
say STDERR "$1: deleted (or renamed) but not committed => version test";
|
||||
$version = "test";
|
||||
}
|
||||
elsif ($line =~ /^ D (.*)/) {
|
||||
say STDERR "$1: locally deleted => version test";
|
||||
$version = "test";
|
||||
}
|
||||
elsif ($line =~ /^A (.*)/) {
|
||||
say STDERR "$1: locally added => version test";
|
||||
$version = "test";
|
||||
}
|
||||
elsif ($line =~ /^AM (.*)/) {
|
||||
say STDERR "$1: locally added and modified => version test";
|
||||
$version = "test";
|
||||
}
|
||||
elsif ($line =~ /^([ MADRCU][ MADRCU]) (.*)/) {
|
||||
say STDERR "$2: $1 (whatever that means) => version test";
|
||||
$version = "test";
|
||||
}
|
||||
elsif ($line =~ /fatal: No names found/) {
|
||||
say STDERR "no tag on this version => version test";
|
||||
$version = "test";
|
||||
}
|
||||
elsif ($line =~ /^([0-9]+)\.([0-9]+)(\.([0-9]+))?$/) {
|
||||
my $major = $1;
|
||||
my $minor = $2;
|
||||
my $patch = $4 || "0";
|
||||
$version = "$major.$minor.$patch";
|
||||
say STDERR "checking tag $line => version $version";
|
||||
}
|
||||
elsif ($line =~ /[a-zA-Z]+[a-zA-Z0-9]*_([0-9]+)_([0-9]+)(_([0-9]+))?$/) {
|
||||
my $major = $1;
|
||||
my $minor = $2;
|
||||
my $patch = $4 || "0";
|
||||
$version = "$major.$minor.$patch";
|
||||
say STDERR "checking tag $line => version $version";
|
||||
}
|
||||
elsif ($line =~ /(.*[0-9]+[_.][0-9]+([_.][0-9]+)?)-([0-9]+)-g/) {
|
||||
$version = "test";
|
||||
say STDERR "tag $1 is $3 commits old => version test";
|
||||
}
|
||||
elsif ($line =~ /Your branch is ahead of '(.*)\/(.*)'/) {
|
||||
say STDERR "branch \"$2\" not yet pushed to remote \"$1\" => version test";
|
||||
say STDERR "try: git push --tags $1 $2";
|
||||
$version = "test";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ($debug) {
|
||||
say STDERR "checking $files";
|
||||
}
|
||||
|
||||
eval {
|
||||
# fails if git command exits with error
|
||||
if ($debug) {
|
||||
say STDERR "git status --porcelain $files"
|
||||
}
|
||||
@statusinfo = check_output("git status --porcelain $files");
|
||||
parse_git_output(\@statusinfo);
|
||||
if ($version) {
|
||||
say $version;
|
||||
exit;
|
||||
}
|
||||
|
||||
if ($debug) {
|
||||
say STDERR "git describe --tags HEAD";
|
||||
}
|
||||
@statusinfo = check_output("git describe --tags HEAD");
|
||||
parse_git_output(\@statusinfo);
|
||||
if (!defined($version)) {
|
||||
say STDERR "Could not find out version tag => version test";
|
||||
$version = "test";
|
||||
}
|
||||
|
||||
if ($version ne "test") {
|
||||
if ($debug) {
|
||||
say STDERR "git status";
|
||||
}
|
||||
@statusinfo = check_output("git status");
|
||||
parse_git_output(\@statusinfo);
|
||||
}
|
||||
|
||||
say $version;
|
||||
exit;
|
||||
};
|
||||
|
||||
eval {
|
||||
# cvs bug: calling cvs status for files in other directories spoils status
|
||||
# information for local files.
|
||||
# fix: check local and non local files separately
|
||||
|
||||
# fails if we have no cvs or server has a problem
|
||||
if ($debug) {
|
||||
say STDERR "cvs status -l -v $files;"
|
||||
}
|
||||
@statusinfo = check_output("cvs status -l -v $files");
|
||||
# mark the finsh of the last file for the parser
|
||||
push @statusinfo, "===================================================================";
|
||||
parse_cvs_output(\@statusinfo);
|
||||
if (!defined($version)) {
|
||||
say STDERR "Could not find out version tag => version test";
|
||||
$version = "test";
|
||||
}
|
||||
|
||||
say $version;
|
||||
exit;
|
||||
};
|
||||
|
||||
say STDERR "No repository found => version test";
|
||||
say "test";
|
||||
@@ -1,287 +0,0 @@
|
||||
#!/usr/bin/tclsh
|
||||
|
||||
package require Tclx
|
||||
|
||||
set debug 0
|
||||
|
||||
set global_context [scancontext create]
|
||||
set file_context [scancontext create]
|
||||
set skip_context [scancontext create]
|
||||
|
||||
scanmatch $global_context {there is no version here} {
|
||||
return
|
||||
}
|
||||
|
||||
scanmatch $global_context {cvs status: failed} {
|
||||
puts stderr "Error: $matchInfo(line)"
|
||||
return
|
||||
}
|
||||
|
||||
scanmatch $global_context {no such directory `(.*)'} {
|
||||
puts stderr "checking directory $matchInfo(submatch0): so such directory"
|
||||
return
|
||||
}
|
||||
|
||||
scanmatch $global_context {cvs [status aborted]: there is no version here} {
|
||||
return
|
||||
}
|
||||
|
||||
scanmatch $global_context {^File: .*Up-to-date} {
|
||||
set file [lindex $matchInfo(line) 1]
|
||||
puts -nonewline stderr "checking $file: "
|
||||
catch {unset major minor patch}
|
||||
scanfile $file_context $matchInfo(handle)
|
||||
if {![info exists major]} {
|
||||
puts stderr "revision $rev($file) not tagged => version test"
|
||||
set version test
|
||||
continue
|
||||
}
|
||||
puts stderr "revision $rev($file) tag $tag($file) => version $major.$minor.$patch"
|
||||
if {![info exists version]} {
|
||||
set version $major.$minor.$patch
|
||||
} else {
|
||||
if ![cequal $major.$minor.$patch $version] {
|
||||
set version test
|
||||
continue
|
||||
}
|
||||
}
|
||||
continue
|
||||
}
|
||||
|
||||
scanmatch $global_context {^File: .*} {
|
||||
set file [lindex $matchInfo(line) 1]
|
||||
puts stderr "checking $file: [lrange $matchInfo(line) 3 end] => version test"
|
||||
set version test
|
||||
continue
|
||||
}
|
||||
|
||||
scanmatch $global_context {^\? .*} {
|
||||
set file [lindex $matchInfo(line) 1]
|
||||
puts stderr "checking $file: not in cvs => version test"
|
||||
set version test
|
||||
continue
|
||||
}
|
||||
|
||||
scanmatch $file_context {Working revision:} {
|
||||
set rev($file) [lindex $matchInfo(line) 2]
|
||||
}
|
||||
|
||||
scanmatch $file_context {Sticky Tag:.*_([0-9]+)_([0-9]+)_([0-9]+)[ \t]+\(revision: } {
|
||||
set major $matchInfo(submatch0)
|
||||
set minor $matchInfo(submatch1)
|
||||
set patch $matchInfo(submatch2)
|
||||
set tag($file) "[lindex $matchInfo(line) 2] (sticky)"
|
||||
scanfile $skip_context $matchInfo(handle)
|
||||
return
|
||||
}
|
||||
|
||||
scanmatch $file_context {Sticky Tag:.*_([0-9]+)_([0-9]+)[ \t]+\(revision: } {
|
||||
set major $matchInfo(submatch0)
|
||||
set minor $matchInfo(submatch1)
|
||||
set patch 0
|
||||
set tag($file) "[lindex $matchInfo(line) 2] (sticky)"
|
||||
scanfile $skip_context $matchInfo(handle)
|
||||
return
|
||||
}
|
||||
|
||||
scanmatch $file_context {_([0-9]+)_([0-9]+)(_([0-9]+))?[ \t]+\(revision: ([\.0-9]+)\)} {
|
||||
if [cequal $rev($file) $matchInfo(submatch4)] {
|
||||
set Major $matchInfo(submatch0)
|
||||
set Minor $matchInfo(submatch1)
|
||||
set Patch [expr $matchInfo(submatch3) + 0]
|
||||
if {![info exists major] ||
|
||||
$Major>$major ||
|
||||
($Major==$major && ($Minor>$minor
|
||||
|| ($Minor==$minor && $Patch>$patch)))} {
|
||||
set major $Major
|
||||
set minor $Minor
|
||||
set patch $Patch
|
||||
set tag($file) [lindex $matchInfo(line) 0]
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
scanmatch $skip_context {=================} {
|
||||
return
|
||||
}
|
||||
|
||||
scanmatch $file_context {=================} {
|
||||
return
|
||||
}
|
||||
|
||||
set git_context [scancontext create]
|
||||
|
||||
scanmatch $git_context {fatal: Not a git repository} {
|
||||
return
|
||||
}
|
||||
|
||||
scanmatch $git_context {^\?\? .*} {
|
||||
set file [lindex $matchInfo(line) 1]
|
||||
puts stderr "$file: not in git => version test"
|
||||
set version test
|
||||
continue
|
||||
}
|
||||
|
||||
scanmatch $git_context {^ M .*} {
|
||||
set file [lindex $matchInfo(line) 1]
|
||||
puts stderr "$file: locally modified => version test"
|
||||
set version test
|
||||
continue
|
||||
}
|
||||
|
||||
scanmatch $git_context {^D .*} {
|
||||
set file [lindex $matchInfo(line) 1]
|
||||
puts stderr "$file: deleted (or renamed) but not committed => version test"
|
||||
set version test
|
||||
continue
|
||||
}
|
||||
|
||||
scanmatch $git_context {^ D .*} {
|
||||
set file [lindex $matchInfo(line) 1]
|
||||
puts stderr "$file: locally deleted => version test"
|
||||
set version test
|
||||
continue
|
||||
}
|
||||
|
||||
scanmatch $git_context {^A .*} {
|
||||
set file [lindex $matchInfo(line) 1]
|
||||
puts stderr "$file: locally added => version test"
|
||||
set version test
|
||||
continue
|
||||
}
|
||||
|
||||
scanmatch $git_context {^AM .*} {
|
||||
set file [lindex $matchInfo(line) 1]
|
||||
puts stderr "$file: locally added and modified => version test"
|
||||
set version test
|
||||
continue
|
||||
}
|
||||
|
||||
scanmatch $git_context {^([ MADRCU][ MADRCU]) .*} {
|
||||
set file [lindex $matchInfo(line) 1]
|
||||
puts stderr "$file: $matchInfo(submatch0) (whatever that means) => version test"
|
||||
set version test
|
||||
continue
|
||||
}
|
||||
|
||||
scanmatch $git_context {fatal: No names found} {
|
||||
puts stderr "no tag on this version => version test"
|
||||
set version test
|
||||
}
|
||||
|
||||
scanmatch $git_context {^([0-9]+)\.([0-9]+)(\.([0-9]+))?$} {
|
||||
set major $matchInfo(submatch0)
|
||||
set minor $matchInfo(submatch1)
|
||||
set patch [expr $matchInfo(submatch3) + 0]
|
||||
set version $major.$minor.$patch
|
||||
puts stderr "checking tag $matchInfo(line) => version $version"
|
||||
}
|
||||
|
||||
scanmatch $git_context {[a-zA-Z]+[a-zA-Z0-9]*_([0-9]+)_([0-9]+)(_([0-9]+))?$} {
|
||||
set major $matchInfo(submatch0)
|
||||
set minor $matchInfo(submatch1)
|
||||
set patch [expr $matchInfo(submatch3) + 0]
|
||||
set version $major.$minor.$patch
|
||||
puts stderr "checking tag $matchInfo(line) => version $version"
|
||||
}
|
||||
|
||||
scanmatch $git_context {(.*[0-9]+[_.][0-9]+([_.][0-9]+)?)-([0-9]+)-g} {
|
||||
set version test
|
||||
puts stderr "tag $matchInfo(submatch0) is $matchInfo(submatch2) commits old => version test"
|
||||
}
|
||||
|
||||
scanmatch $git_context {Your branch is ahead of '(.*)/(.*)'} {
|
||||
puts stderr "branch \"$matchInfo(submatch1)\" not yet pushed to remote \"$matchInfo(submatch0)\" => version test"
|
||||
puts stderr "try: git push --tags $matchInfo(submatch0) $matchInfo(submatch1)"
|
||||
set version test
|
||||
}
|
||||
|
||||
if {[lindex $argv 0] == "-d"} {
|
||||
set debug 1
|
||||
set argv [lrange $argv 1 end]
|
||||
}
|
||||
|
||||
# Check all files in top directory and all files specified explicitly in subdirectories
|
||||
|
||||
set topfiles [glob -nocomplain GNUmakefile makefile Makefile *.c *.cc *.cpp *.h *.dbd *.st *.stt *.gt]
|
||||
|
||||
if {$debug} {
|
||||
puts stderr "checking $topfiles $argv"
|
||||
}
|
||||
|
||||
|
||||
if {[catch {
|
||||
# fails if we have no git:
|
||||
if {$debug} {
|
||||
puts stderr "git status --porcelain $topfiles $argv"
|
||||
}
|
||||
set statusinfo [open "|git status --porcelain $topfiles $argv 2>@ stdout"]
|
||||
scanfile $git_context $statusinfo
|
||||
# fails if this is no git repo
|
||||
close $statusinfo
|
||||
|
||||
if [info exists version] {
|
||||
puts $version
|
||||
exit
|
||||
}
|
||||
|
||||
if {$debug} {
|
||||
puts stderr "git describe --tags HEAD"
|
||||
}
|
||||
set statusinfo [open "|git describe --tags HEAD 2>@ stdout"]
|
||||
scanfile $git_context $statusinfo
|
||||
catch {close $statusinfo}
|
||||
|
||||
if ![info exists version] {
|
||||
puts stderr "Could not find out version tag => version test"
|
||||
set version test
|
||||
}
|
||||
|
||||
if {$version != "test"} {
|
||||
if {$debug} {
|
||||
puts stderr "git status"
|
||||
}
|
||||
set statusinfo [open "|git status 2>@ stdout"]
|
||||
scanfile $git_context $statusinfo
|
||||
catch {close $statusinfo}
|
||||
}
|
||||
|
||||
puts $version
|
||||
exit
|
||||
}] && $debug} { puts stderr "git: $errorInfo" }
|
||||
|
||||
|
||||
if {[catch {
|
||||
# cvs bug: calling cvs status for files in other directories spoils status
|
||||
# information for local files.
|
||||
# fix: check local and non local files separately
|
||||
|
||||
# fails if we have no cvs or server has a problem
|
||||
if {$debug} {
|
||||
puts stderr "cvs status -l -v $topfiles $argv"
|
||||
}
|
||||
set statusinfo [open "|cvs status -l -v $topfiles $argv 2>@ stdout"]
|
||||
scanfile $global_context $statusinfo
|
||||
# fails if this is no cvs repo
|
||||
close $statusinfo
|
||||
|
||||
# set files {}
|
||||
# foreach file $argv {
|
||||
# if {[file tail $file] != $file} {
|
||||
# lappend files $file
|
||||
# }
|
||||
# }
|
||||
# if [llength $files] {
|
||||
# set statusinfo [open "|cvs status -l -v $files 2>@ stdout"]
|
||||
# scanfile $global_context $statusinfo
|
||||
# close $statusinfo
|
||||
# }
|
||||
|
||||
puts $version
|
||||
exit
|
||||
}] && $debug} { puts stderr "cvs: $errorInfo" }
|
||||
|
||||
puts stderr "No repository found => version test"
|
||||
puts "test"
|
||||
|
||||
# $Header: /cvs/G/DRV/misc/App/tools/getVersion.tcl,v 1.3 2010/08/03 08:42:40 zimoch Exp $
|
||||
Reference in New Issue
Block a user