Modified client.scm
from [b8e0e236d3]
to [3b6119f752].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
;; C L I E N T S
;;======================================================================
(use srfi-18 extras tcp s11n srfi-1 posix regex srfi-69 hostinfo md5
message-digest matchable spiffy uri-common intarweb http-client
|
|
|
>
>
>
>
>
|
|
>
|
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
;; Copyright 2006-2012, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
;; C L I E N T S
;;======================================================================
(use srfi-18 extras tcp s11n srfi-1 posix regex srfi-69 hostinfo md5
message-digest matchable spiffy uri-common intarweb http-client
|
︙ | | | ︙ | |
Modified common.scm
from [ded8fa3dd3]
to [7382d07655].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
(use srfi-1 data-structures posix regex-case (prefix base64 base64:)
format dot-locking csv-xml z3 ;; sql-de-lite
hostinfo md5 message-digest typed-records directory-utils stack
matchable regex posix (srfi 18) extras ;; tcp
(prefix nanomsg nmsg:)
|
|
|
>
>
>
>
>
|
|
>
>
>
>
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
(use srfi-1 data-structures posix regex-case (prefix base64 base64:)
format dot-locking csv-xml z3 ;; sql-de-lite
hostinfo md5 message-digest typed-records directory-utils stack
matchable regex posix (srfi 18) extras ;; tcp
(prefix nanomsg nmsg:)
|
︙ | | | ︙ | |
Modified configf.scm
from [a0780f7710]
to [af30e1aa5d].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
;;======================================================================
;; Config file handling
;;======================================================================
(use regex regex-case) ;; directory-utils)
|
|
|
>
>
>
>
>
|
|
>
>
>
>
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
;;======================================================================
;; Config file handling
;;======================================================================
(use regex regex-case) ;; directory-utils)
|
︙ | | | ︙ | |
Modified dashboard-context-menu.scm
from [6e0d3fe684]
to [0a1e7c69d9].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
;;======================================================================
;; implementation of context menu that pops up on
;; right click on test cell in Runs & Runs Summary Tabs
;;======================================================================
|
|
|
>
>
>
>
>
|
|
>
>
>
>
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
;;======================================================================
;; implementation of context menu that pops up on
;; right click on test cell in Runs & Runs Summary Tabs
;;======================================================================
|
︙ | | | ︙ | |
Modified dashboard-tests.scm
from [531072a2c7]
to [2af1eb577e].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
;;======================================================================
;; Test info panel
;;======================================================================
(use format fmt)
|
|
|
>
>
>
>
>
|
|
>
>
>
>
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
;;======================================================================
;; Test info panel
;;======================================================================
(use format fmt)
|
︙ | | | ︙ | |
Modified datashare.scm
from [b7e3ad1287]
to [2c1663032f].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;; Copyright 2006-2013, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
(use ssax)
(use sxml-serializer)
(use sxml-modifications)
(use regex)
(use srfi-69)
(use regex-case)
|
|
|
>
>
>
>
>
|
|
>
|
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
;; Copyright 2006-2013, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
(use ssax)
(use sxml-serializer)
(use sxml-modifications)
(use regex)
(use srfi-69)
(use regex-case)
|
︙ | | | ︙ | |
Modified db_records.scm
from [6d9634427c]
to [d7347f8638].
1
2
3
4
5
6
7
|
;;======================================================================
;; dbstruct
;;======================================================================
;;
;; -path-|-megatest.db
;; |-db-|-main.db
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
;; dbstruct
;;======================================================================
;;
;; -path-|-megatest.db
;; |-db-|-main.db
|
︙ | | | ︙ | |
Modified env.scm
from [4c3e8315cb]
to [9fe24952ae].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;;======================================================================
;; Copyright 2006-2013, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
(declare (unit env))
(use sql-de-lite) ;; srfi-1 posix regex regex-case srfi-69 srfi-18 call-with-environment-variables)
(define (env:open-db fname)
|
|
|
>
>
>
>
>
|
|
>
>
>
>
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
;;======================================================================
;; Copyright 2006-2013, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
(declare (unit env))
(use sql-de-lite) ;; srfi-1 posix regex regex-case srfi-69 srfi-18 call-with-environment-variables)
(define (env:open-db fname)
|
︙ | | | ︙ | |
Modified fdb_records.scm
from [bbb0371221]
to [46b8612d29].
1
2
3
4
5
6
7
|
;; Single record for managing a filedb
;; make-vector-record "Filedb record" filedb fdb db dbpath pathcache idcache partcache
;; Filedb record
(define (make-filedb:fdb)(make-vector 5))
(define-inline (filedb:fdb-get-db vec) (vector-ref vec 0))
(define-inline (filedb:fdb-get-dbpath vec) (vector-ref vec 1))
(define-inline (filedb:fdb-get-pathcache vec) (vector-ref vec 2))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;; Single record for managing a filedb
;; make-vector-record "Filedb record" filedb fdb db dbpath pathcache idcache partcache
;; Filedb record
(define (make-filedb:fdb)(make-vector 5))
(define-inline (filedb:fdb-get-db vec) (vector-ref vec 0))
(define-inline (filedb:fdb-get-dbpath vec) (vector-ref vec 1))
(define-inline (filedb:fdb-get-pathcache vec) (vector-ref vec 2))
|
︙ | | | ︙ | |
Modified fs-transport.scm
from [28e812486e]
to [d1050dcefe].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
(require-extension (srfi 18) extras tcp s11n)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest)
(import (prefix sqlite3 sqlite3:))
(use spiffy uri-common intarweb http-client spiffy-request-vars)
|
|
|
>
>
>
>
>
|
|
>
|
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
;; Copyright 2006-2012, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
(require-extension (srfi 18) extras tcp s11n)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest)
(import (prefix sqlite3 sqlite3:))
(use spiffy uri-common intarweb http-client spiffy-request-vars)
|
︙ | | | ︙ | |
Modified ftail.scm
from [9cc65f192a]
to [96a7ff77a3].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;;======================================================================
;; Copyright 2017, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
(declare (unit ftail))
(module ftail
(
open-tail-db
|
|
|
>
>
>
>
>
|
|
>
>
>
>
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
;;======================================================================
;; Copyright 2017, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
(declare (unit ftail))
(module ftail
(
open-tail-db
|
︙ | | | ︙ | |
Modified genexample.scm
from [5460e217c0]
to [d3c1b1c11c].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
(declare (unit genexample))
(use posix regex)
(define genexample:example-logpro
#<<EOF
|
|
|
>
>
>
>
>
|
|
>
>
>
>
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
(declare (unit genexample))
(use posix regex)
(define genexample:example-logpro
#<<EOF
|
︙ | | | ︙ | |
Modified gentargets.sh
from [430721a6b7]
to [c202c87561].
1
2
3
4
5
6
|
#!/bin/bash
echo '[v1.63/tip/dev]'
echo 'x 1'
echo '[v1.64/tip/dev]'
echo 'x 1'
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
|
#!/bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
echo '[v1.63/tip/dev]'
echo 'x 1'
echo '[v1.64/tip/dev]'
echo 'x 1'
|
Modified get-config-settings.sh
from [3a902c0f68]
to [e5299a36bd].
1
2
|
grep configf:lookup *.scm | sed 's/^.*:lookup//; s/^-number//; s/^ //' | grep -v '^\(section\|test-conf\|tconfig\|testconfig\|dat\|config\|views-cfgdat\)' | perl -pe 's/^\s*(\*configdat\*|configdat|mtconf)//; s/^\s+//; s/\).*$//; s/"//g' | awk '{print $1,$2}' | sort | grep -v section | sort | uniq
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
|
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
grep configf:lookup *.scm | sed 's/^.*:lookup//; s/^-number//; s/^ //' | grep -v '^\(section\|test-conf\|tconfig\|testconfig\|dat\|config\|views-cfgdat\)' | perl -pe 's/^\s*(\*configdat\*|configdat|mtconf)//; s/^\s+//; s/\).*$//; s/"//g' | awk '{print $1,$2}' | sort | grep -v section | sort | uniq
|
Modified http-transport.scm
from [805ca7974c]
to [f419733524].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
(require-extension (srfi 18) extras tcp s11n)
(use srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest posix-extras)
(use spiffy uri-common intarweb http-client spiffy-request-vars intarweb spiffy-directory-listing)
|
|
|
>
>
>
>
>
|
|
>
|
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
;; Copyright 2006-2012, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
(require-extension (srfi 18) extras tcp s11n)
(use srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest posix-extras)
(use spiffy uri-common intarweb http-client spiffy-request-vars intarweb spiffy-directory-listing)
|
︙ | | | ︙ | |
Modified items.scm
from [f3b5b35708]
to [2265706948].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;; (define itemdat '((ripeness "green ripe overripe")
;; (temperature "cool medium hot")
;; (season "summer winter fall spring")))
(declare (unit items))
|
|
|
>
>
>
>
>
|
|
>
|
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
;; Copyright 2006-2012, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;; (define itemdat '((ripeness "green ripe overripe")
;; (temperature "cool medium hot")
;; (season "summer winter fall spring")))
(declare (unit items))
|
︙ | | | ︙ | |
Modified key_records.scm
from [39c7ed8168]
to [0f706e37f0].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
(define-inline (keys->valslots keys) ;; => ?,?,? ....
(string-intersperse (map (lambda (x) "?") keys) ","))
;; (define-inline (keys->key/field keys . additional)
;; (string-join (map (lambda (k)(conc k " TEXT"))
|
|
|
>
>
>
>
>
|
|
>
>
>
>
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
(define-inline (keys->valslots keys) ;; => ?,?,? ....
(string-intersperse (map (lambda (x) "?") keys) ","))
;; (define-inline (keys->key/field keys . additional)
;; (string-join (map (lambda (k)(conc k " TEXT"))
|
︙ | | | ︙ | |
Modified launch.scm
from [a20a5610e0]
to [f828709706].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;; Copyright 2006-2017, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
;; launch a task - this runs on the originating host, tests themselves
;;
;;======================================================================
(use regex regex-case base64 sqlite3 srfi-18 directory-utils posix-extras z3 call-with-environment-variables csv)
|
|
|
>
>
>
>
>
|
|
>
|
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
;; Copyright 2006-2017, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
;; launch a task - this runs on the originating host, tests themselves
;;
;;======================================================================
(use regex regex-case base64 sqlite3 srfi-18 directory-utils posix-extras z3 call-with-environment-variables csv)
|
︙ | | | ︙ | |
Modified margs.scm
from [22bfa302f5]
to [812fd1b225].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
|
;; Copyright 2007-2010, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
(declare (unit margs))
;; (declare (uses common))
(define args:arg-hash (make-hash-table))
(define (args:get-arg arg . default)
|
|
|
>
>
>
>
|
>
|
|
>
>
>
>
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
;; Copyright 2007-2010, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
(declare (unit margs))
;; (declare (uses common))
(define args:arg-hash (make-hash-table))
(define (args:get-arg arg . default)
|
︙ | | | ︙ | |
Modified minimt/direct.scm
from [54cabed7c0]
to [2dcccf845d].
1
2
3
4
5
6
7
|
;; direct API, call the db calls directly
(define rmt:create-run (statwrap 'create-run create-run))
(define rmt:create-step (statwrap 'create-step create-step))
(define rmt:create-test (statwrap 'create-test create-test))
(define rmt:get-test-id (statwrap 'get-test-id get-test-id))
(define rmt:get-run-id (statwrap 'get-run-id get-run-id))
(define rmt:open-create-db (statwrap 'open open-create-db))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;; direct API, call the db calls directly
(define rmt:create-run (statwrap 'create-run create-run))
(define rmt:create-step (statwrap 'create-step create-step))
(define rmt:create-test (statwrap 'create-test create-test))
(define rmt:get-test-id (statwrap 'get-test-id get-test-id))
(define rmt:get-run-id (statwrap 'get-run-id get-run-id))
(define rmt:open-create-db (statwrap 'open open-create-db))
|
︙ | | | ︙ | |
Modified minimt/queued.scm
from [71e1ba00f3]
to [922cfbae9a].
1
2
3
4
5
6
7
|
(use nanomsg defstruct srfi-18)
;;======================================================================
;; Commands
;;======================================================================
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
|
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
(use nanomsg defstruct srfi-18)
;;======================================================================
;; Commands
;;======================================================================
|
︙ | | | ︙ | |
Modified mlaunch.scm
from [dc94b7feb1]
to [5bcd34288f].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
|
;; Copyright 2006-2014, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
;;======================================================================
;; MLAUNCH
;;
;; take jobs from the given queue and keep launching them keeping
|
|
|
>
>
>
>
>
|
|
>
|
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
;; Copyright 2006-2014, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
;;======================================================================
;; MLAUNCH
;;
;; take jobs from the given queue and keep launching them keeping
|
︙ | | | ︙ | |
Modified monitor.scm
from [00d6efd991]
to [3df55c85ea].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
|
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking)
(import (prefix sqlite3 sqlite3:))
(declare (unit runs))
|
|
|
>
>
>
>
>
|
|
>
|
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
;; Copyright 2006-2012, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking)
(import (prefix sqlite3 sqlite3:))
(declare (unit runs))
|
︙ | | | ︙ | |
Modified newdashboard.scm
from [13138efda6]
to [3cc17ecae4].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
|
;;======================================================================
;; Copyright 2006-2013, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
;;======================================================================
;; Copyright 2006-2016, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
(use format)
(use (prefix iup iup:))
(use canvas-draw)
|
|
|
<
|
<
<
<
|
<
<
<
>
|
<
>
|
|
>
>
>
>
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
;;======================================================================
;; Copyright 2006-2016, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
(use format)
(use (prefix iup iup:))
(use canvas-draw)
|
︙ | | | ︙ | |
Modified oldsrc/debugger.scm
from [f446c83fb1]
to [0dc47fa240].
1
2
3
4
5
6
7
|
(use iup)
(define *debugger-control* #f)
(define *debugger-rownum* 0)
(define *debugger-matrix* #f)
(define *debugger* #f)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
(use iup)
(define *debugger-control* #f)
(define *debugger-rownum* 0)
(define *debugger-matrix* #f)
(define *debugger* #f)
|
︙ | | | ︙ | |
Modified oldsrc/multi-dboard.scm
from [de11d53f46]
to [8f63a105a2].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;;======================================================================
;; Copyright 2006-2013, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
(use format numbers sql-de-lite srfi-1 posix regex regex-case srfi-69 srfi-18 call-with-environment-variables)
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)
|
|
|
>
>
>
>
>
|
|
>
|
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
;;======================================================================
;; Copyright 2006-2013, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
(use format numbers sql-de-lite srfi-1 posix regex regex-case srfi-69 srfi-18 call-with-environment-variables)
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)
|
︙ | | | ︙ | |
Modified oldsrc/nmsg-transport.scm
from [b30844cb1a]
to [adedc287f0].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
(require-extension (srfi 18) extras tcp s11n)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest)
(import (prefix sqlite3 sqlite3:))
;; (use nanomsg)
|
>
>
>
|
<
>
>
>
|
|
>
>
>
>
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
;; Copyright 2006-2012, Matthew Welland.
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
(require-extension (srfi 18) extras tcp s11n)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest)
(import (prefix sqlite3 sqlite3:))
;; (use nanomsg)
|
︙ | | | ︙ | |
Modified portlogger-example.scm
from [bd21f0d600]
to [8741b3e748].
1
2
3
4
|
(declare (uses portlogger))
(print (apply portlogger:main (cdr (argv))))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
(declare (uses portlogger))
(print (apply portlogger:main (cdr (argv))))
|
Modified process.scm
from [70c3ca9d10]
to [3945f219f6].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
;;======================================================================
;; Process convience utils
;;======================================================================
(use regex)
|
|
|
>
>
>
>
>
|
|
>
>
>
>
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
;;======================================================================
;; Process convience utils
;;======================================================================
(use regex)
|
︙ | | | ︙ | |
Modified records-vs-vectors-vs-coops.scm
from [93fa590917]
to [23e52ff68b].
1
2
3
4
5
6
7
|
;; (include "vg.scm")
;; (declare (uses vg))
(use foof-loop defstruct coops)
(defstruct obj type fill-color angle)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;; (include "vg.scm")
;; (declare (uses vg))
(use foof-loop defstruct coops)
(defstruct obj type fill-color angle)
|
︙ | | | ︙ | |
Modified records.sh
from [b80709e1bc]
to [1efe70350b].
1
2
3
4
5
6
7
8
9
|
#! /bin/bash
# extents caches extents calculated on draw
# proc is called on draw and takes the obj itself as a parameter
# attrib is an alist of parameters
# libs: hash of name->lib, insts: hash of instname->inst
#
# Add -safe when doing development
#
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#! /bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
# extents caches extents calculated on draw
# proc is called on draw and takes the obj itself as a parameter
# attrib is an alist of parameters
# libs: hash of name->lib, insts: hash of instname->inst
#
# Add -safe when doing development
#
|
︙ | | | ︙ | |
Modified rmtdb.scm
from [afdb905959]
to [62ddf7898c].
1
2
3
4
5
6
7
8
9
10
11
|
;;======================================================================
;; Copyright 2006-2013, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
|
|
|
>
>
>
>
>
|
|
>
>
>
>
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
;;======================================================================
;; Copyright 2006-2013, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
|
Modified runconfig.scm
from [321959f4fb]
to [05844d6f1d].
1
2
3
4
5
6
7
|
;;======================================================================
;; read a config file, loading only the section pertinent
;; to this run field1val/field2val/field3val ...
;;======================================================================
(use format directory-utils)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
;; read a config file, loading only the section pertinent
;; to this run field1val/field2val/field3val ...
;;======================================================================
(use format directory-utils)
|
︙ | | | ︙ | |
Modified runs.scm
from [e70616f1e5]
to [f1caa0cd84].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;; Copyright 2006-2016, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18)
posix-extras directory-utils pathname-expand typed-records format)
(declare (unit runs))
|
|
|
>
>
>
>
>
|
|
>
|
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
;; Copyright 2006-2016, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18)
posix-extras directory-utils pathname-expand typed-records format)
(declare (unit runs))
|
︙ | | | ︙ | |
Modified sauth-common.scm
from [b29dfd627c]
to [b3f1e39c19].
1
2
3
4
5
6
7
|
;; Create the sqlite db
(define (sauthorize:db-do proc)
(if (or (not *db-path*)
(not (file-exists? *db-path*)))
(begin
(print 0 "[database]\nlocation " *db-path* " \n\n Is missing from the config file!")
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;; Create the sqlite db
(define (sauthorize:db-do proc)
(if (or (not *db-path*)
(not (file-exists? *db-path*)))
(begin
(print 0 "[database]\nlocation " *db-path* " \n\n Is missing from the config file!")
|
︙ | | | ︙ | |
Modified sdb.scm
from [87ccf30107]
to [3f78d1737e].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;;======================================================================
;; Copyright 2006-2013, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
;;======================================================================
;; Simple persistant strings lookup table. Keep out of the main db
;; so writes/reads don't slow down central access.
;;======================================================================
|
|
|
>
>
>
>
>
|
|
>
>
>
>
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
;;======================================================================
;; Copyright 2006-2013, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
;;======================================================================
;; Simple persistant strings lookup table. Keep out of the main db
;; so writes/reads don't slow down central access.
;;======================================================================
|
︙ | | | ︙ | |
Modified sharedat.scm
from [aee689d39a]
to [bb858ca5c8].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;; Copyright 2006-2013, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
(use defstruct)
;; (use ssax)
;; (use sxml-serializer)
;; (use sxml-modifications)
;; (use regex)
|
|
|
>
>
>
>
>
|
|
>
>
>
>
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
;; Copyright 2006-2013, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
(use defstruct)
;; (use ssax)
;; (use sxml-serializer)
;; (use sxml-modifications)
;; (use regex)
|
︙ | | | ︙ | |
Modified spublish.scm
from [c3ed2ff859]
to [ea3284440b].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;; Copyright 2006-2013, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
(use defstruct)
(use scsh-process)
(use refdb)
(use srfi-18)
(use srfi-19)
(use format)
|
|
|
>
>
>
>
>
|
|
>
|
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
;; Copyright 2006-2013, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
(use defstruct)
(use scsh-process)
(use refdb)
(use srfi-18)
(use srfi-19)
(use format)
|
︙ | | | ︙ | |
Modified subrun.scm
from [5a34831075]
to [f622aaf2d4].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;; Copyright 2006-2016, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18)
posix-extras directory-utils pathname-expand typed-records format
call-with-environment-variables)
(declare (unit subrun))
|
|
|
>
>
>
>
>
|
|
>
|
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
;; Copyright 2006-2016, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18)
posix-extras directory-utils pathname-expand typed-records format
call-with-environment-variables)
(declare (unit subrun))
|
︙ | | | ︙ | |
Modified task_records.scm
from [9c8b281be4]
to [ff61a823b3].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
;; make-vector-record tasks task id action owner state target name test item params creation_time execution_time
(define (make-tasks:task)(make-vector 11))
(define-inline (tasks:task-get-id vec) (vector-ref vec 0))
(define-inline (tasks:task-get-action vec) (vector-ref vec 1))
(define-inline (tasks:task-get-owner vec) (vector-ref vec 2))
|
|
|
>
>
>
>
>
|
|
>
|
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
;; make-vector-record tasks task id action owner state target name test item params creation_time execution_time
(define (make-tasks:task)(make-vector 11))
(define-inline (tasks:task-get-id vec) (vector-ref vec 0))
(define-inline (tasks:task-get-action vec) (vector-ref vec 1))
(define-inline (tasks:task-get-owner vec) (vector-ref vec 2))
|
︙ | | | ︙ | |
Modified tcmt.scm
from [75ab8b7c92]
to [17579f1f87].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;; Copyright 2006-2017, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;
;;======================================================================
;;
;; Wrapper to enable running Megatest flows under teamcity
;;
;; 1. Run the megatest process and pass it all the needed parameters
;; 2. Every five seconds check for state/status changes and print the info
;;
|
|
|
>
>
>
>
>
|
|
|
|
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
;; Copyright 2006-2017, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
;;
;; Wrapper to enable running Megatest flows under teamcity
;;
;; 1. Run the megatest process and pass it all the needed parameters
;; 2. Every five seconds check for state/status changes and print the info
;;
|
︙ | | | ︙ | |
Modified test_records.scm
from [9245906f33]
to [7ec9587d28].
1
2
3
4
5
6
7
|
;; make-vector-record tests testqueue testname testconfig waitons priority items
(define (make-tests:testqueue)(make-vector 7 #f))
(define-inline (tests:testqueue-get-testname vec) (vector-ref vec 0))
(define-inline (tests:testqueue-get-testconfig vec) (vector-ref vec 1))
(define-inline (tests:testqueue-get-waitons vec) (vector-ref vec 2))
(define-inline (tests:testqueue-get-priority vec) (vector-ref vec 3))
;; items: #f=no items, list=list of items remaining, proc=need to call to get items
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;; make-vector-record tests testqueue testname testconfig waitons priority items
(define (make-tests:testqueue)(make-vector 7 #f))
(define-inline (tests:testqueue-get-testname vec) (vector-ref vec 0))
(define-inline (tests:testqueue-get-testconfig vec) (vector-ref vec 1))
(define-inline (tests:testqueue-get-waitons vec) (vector-ref vec 2))
(define-inline (tests:testqueue-get-priority vec) (vector-ref vec 3))
;; items: #f=no items, list=list of items remaining, proc=need to call to get items
|
︙ | | | ︙ | |
Modified tests/ods-test.scm
from [08da0f4575]
to [2c992ac6c5].
1
2
3
4
5
6
7
|
(load "ods.scm")
(ods:list->ods
"testing"
"testing.ods"
'((Sheet1 ("Row 1,A" "Row 1,B")
("Row 2,A" "Row 2,B"))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
(load "ods.scm")
(ods:list->ods
"testing"
"testing.ods"
'((Sheet1 ("Row 1,A" "Row 1,B")
("Row 2,A" "Row 2,B"))
|
︙ | | | ︙ | |
Modified trackback.scm
from [4011884617]
to [99c1b5dc83].
1
2
3
4
5
6
7
|
(include "codescanlib.scm")
;; show call paths for named procedure
(define (traceback-proc in-procname)
(letrec* ((all-scm-files (glob "*.scm"))
(xref (get-xref all-scm-files))
(have (alist-ref (string->symbol in-procname) xref eq? #f))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
(include "codescanlib.scm")
;; show call paths for named procedure
(define (traceback-proc in-procname)
(letrec* ((all-scm-files (glob "*.scm"))
(xref (get-xref all-scm-files))
(have (alist-ref (string->symbol in-procname) xref eq? #f))
|
︙ | | | ︙ | |
Modified utils/Makefile.git.installall
from [d86762fc72]
to [a36c19bd4e].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
# Copyright 2013-2015 Matthew Welland.
#
# This program is made available under the GNU GPL version 2.0 or
# greater. See the accompanying file COPYING for details.
#
# This program is distributed WITHOUT ANY WARRANTY; without even the
# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
# PURPOSE.
help :
@echo You may need to do the following setup first:
@echo
@echo sudo apt-get install libreadline-dev
@echo sudo apt-get install libwebkitgtk-dev libfreetype6-dev libx11-dev libxpm-dev libxmu-dev \
libxft-dev libgtk2.0-dev libgl1-mesa-dev libglu1-mesa-dev libpangox-1.0-dev bison \
|
|
>
>
>
|
<
>
>
>
|
|
|
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
# Copyright 2013-2015 Matthew Welland.
#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
help :
@echo You may need to do the following setup first:
@echo
@echo sudo apt-get install libreadline-dev
@echo sudo apt-get install libwebkitgtk-dev libfreetype6-dev libx11-dev libxpm-dev libxmu-dev \
libxft-dev libgtk2.0-dev libgl1-mesa-dev libglu1-mesa-dev libpangox-1.0-dev bison \
|
︙ | | | ︙ | |
Modified utils/Makefile.installall
from [d681455015]
to [98a3761faa].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
# Copyright 2013-2015 Matthew Welland.
#
# This program is made available under the GNU GPL version 2.0 or
# greater. See the accompanying file COPYING for details.
#
# This program is distributed WITHOUT ANY WARRANTY; without even the
# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
# PURPOSE.
help :
@echo You may need to do the following setup first:
@echo
@echo sudo apt-get install libreadline-dev
@echo sudo apt-get install libwebkitgtk-dev libfreetype6-dev libx11-dev libxpm-dev libxmu-dev \
libxft-dev libgtk2.0-dev libgl1-mesa-dev libglu1-mesa-dev libpangox-1.0-dev bison \
|
>
>
>
|
<
>
>
>
|
|
|
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
# Copyright 2013-2015 Matthew Welland.
#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
help :
@echo You may need to do the following setup first:
@echo
@echo sudo apt-get install libreadline-dev
@echo sudo apt-get install libwebkitgtk-dev libfreetype6-dev libx11-dev libxpm-dev libxmu-dev \
libxft-dev libgtk2.0-dev libgl1-mesa-dev libglu1-mesa-dev libpangox-1.0-dev bison \
|
︙ | | | ︙ | |
Modified utils/Makefile.latest.installall
from [e858ad0d21]
to [dc72026b09].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
# Copyright 2013-2015 Matthew Welland.
#
# This program is made available under the GNU GPL version 2.0 or
# greater. See the accompanying file COPYING for details.
#
# This program is distributed WITHOUT ANY WARRANTY; without even the
# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
# PURPOSE.
help :
@echo You may need to do the following setup first:
@echo
@echo sudo apt-get install libreadline-dev
@echo sudo apt-get install libwebkitgtk-dev libfreetype6-dev libx11-dev libxpm-dev libxmu-dev \
libxft-dev libgtk2.0-dev libgl1-mesa-dev libglu1-mesa-dev libpangox-1.0-dev bison \
|
>
>
>
|
<
>
>
>
|
|
>
>
>
>
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
# Copyright 2013-2015 Matthew Welland.
#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
help :
@echo You may need to do the following setup first:
@echo
@echo sudo apt-get install libreadline-dev
@echo sudo apt-get install libwebkitgtk-dev libfreetype6-dev libx11-dev libxpm-dev libxmu-dev \
libxft-dev libgtk2.0-dev libgl1-mesa-dev libglu1-mesa-dev libpangox-1.0-dev bison \
|
︙ | | | ︙ | |
Modified utils/checkPreReqs
from [d13b8d802c]
to [073e0b79f9].
1
2
3
4
5
6
7
8
|
#!/bin/bash
SYSTEM_TYPE=$(lsb_release -irs |tr ' ' '_' |tr '\n' '-')$(uname -i)
file=`/bin/mktemp`
case $SYSTEM_TYPE in
Ubuntu-17.04-x86_64-std)
apt list --installed | cut -d/ -f 1 > $file
;;
Ubuntu-16.04-x86_64)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
SYSTEM_TYPE=$(lsb_release -irs |tr ' ' '_' |tr '\n' '-')$(uname -i)
file=`/bin/mktemp`
case $SYSTEM_TYPE in
Ubuntu-17.04-x86_64-std)
apt list --installed | cut -d/ -f 1 > $file
;;
Ubuntu-16.04-x86_64)
|
︙ | | | ︙ | |
Modified utils/cleanup-links-dir.sh
from [2e6a90f3c8]
to [6ef15fff8b].
1
2
3
4
5
6
7
8
9
|
#!/usr/bin/env bash
export LINKSDIR=$1
export RUNSDIR=$2
if [ "x$LINKSDIR" == "x" ];then
echo Usage: cleanup-links-dir /links/dir/path /runs/dir/path
exit
fi
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/usr/bin/env bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
export LINKSDIR=$1
export RUNSDIR=$2
if [ "x$LINKSDIR" == "x" ];then
echo Usage: cleanup-links-dir /links/dir/path /runs/dir/path
exit
fi
|
︙ | | | ︙ | |
Modified utils/cleanup-pkts.sh
from [4166ea994c]
to [959de99a1c].
1
2
3
4
5
6
7
8
9
|
#!/bin/bash
pushd $1
for x in *.pkt;do
if grep 'T configf' $x > /dev/null;then
rm $x
else
echo skip $x
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
pushd $1
for x in *.pkt;do
if grep 'T configf' $x > /dev/null;then
rm $x
else
echo skip $x
|
︙ | | | ︙ | |
Modified utils/deploy.sh
from [614579fd81]
to [b711663dc8].
1
2
3
4
5
6
7
8
9
|
#!/bin/bash
set -x
if [[ $DEPLOYTARG == "" ]] ; then
echo Installing into deploytarg
export DEPLOYTARG=$PWD/deploytarg
fi
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
set -x
if [[ $DEPLOYTARG == "" ]] ; then
echo Installing into deploytarg
export DEPLOYTARG=$PWD/deploytarg
fi
|
︙ | | | ︙ | |
Modified utils/editwiki
from [14b0c3cc25]
to [60a6e302de].
1
2
3
4
5
6
7
8
9
|
#!/bin/bash
wikiname=$1
FOSSILBIN=fossil
if [ x"$wikiname" == "x" ];then
echo "Usage: viwiki wikipagename"
exit
fi
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
wikiname=$1
FOSSILBIN=fossil
if [ x"$wikiname" == "x" ];then
echo "Usage: viwiki wikipagename"
exit
fi
|
︙ | | | ︙ | |
Modified utils/find-unused-globals.sh
from [54735d591a]
to [f9771fc47b].
1
2
3
4
5
6
7
8
9
|
#!/bin/bash
echo "Finding unused globals:"
for var in $(egrep '^\s*\(define\s+\*' *.scm|awk '{print $2}'|sort -u);do
if ! $(egrep -v '^\s*\(define' *scm| grep "$var" > /dev/null);then
echo "$var not used";
fi;
done
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
echo "Finding unused globals:"
for var in $(egrep '^\s*\(define\s+\*' *.scm|awk '{print $2}'|sort -u);do
if ! $(egrep -v '^\s*\(define' *scm| grep "$var" > /dev/null);then
echo "$var not used";
fi;
done
|
︙ | | | ︙ | |
Modified utils/homehost_check.sh
from [a5c58a17c8]
to [c621180388].
1
2
3
4
5
6
7
8
9
|
#! /bin/bash
#exits 1 when current host is not homehost.
if [[ ! -e .homehost ]]; then
exit 0
fi
homehostname=$( host `cat .homehost` | awk '{print $NF}' | sed 's/\.$//' )
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#! /bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
#exits 1 when current host is not homehost.
if [[ ! -e .homehost ]]; then
exit 0
fi
homehostname=$( host `cat .homehost` | awk '{print $NF}' | sed 's/\.$//' )
|
︙ | | | ︙ | |
Modified utils/installall.logpro
from [8a1c71a14c]
to [a8f269fddf].
1
2
3
4
5
6
7
8
9
10
|
;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com
;;
;; License GPL.
;; first ensure your run at least started
;;
(trigger "Body" #/^.*$/) ;; anything starts the body
;; (trigger "EndBody" #/This had better never match/)
(section "Body" "Body" "EndBody")
|
>
>
>
>
>
>
>
>
>
>
|
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;; first ensure your run at least started
;;
(trigger "Body" #/^.*$/) ;; anything starts the body
;; (trigger "EndBody" #/This had better never match/)
(section "Body" "Body" "EndBody")
|
︙ | | | ︙ | |
Modified utils/installall.sh
from [62802dad6a]
to [f674f29713].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
#! /usr/bin/env bash
# This file installs prerequisites for megatest (chicken, eggs, etc.)
# Before running this script, set PREFIX environment variable
# to chicken install target area. /opt/chicken is a typical value
# set -x
# Copyright 2007-2014, Matthew Welland.
#
# This program is made available under the GNU GPL version 2.0 or
# greater. See the accompanying file COPYING for details.
#
# This program is distributed WITHOUT ANY WARRANTY; without even the
# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
# PURPOSE.
# echo OPTION=$OPTION
# BKM for ubuntu 17.04:
# sudo dpkg -i libpng12-0_1.2.54-1ubuntu1_amd64.deb
# sudo dpkg -i libpng12-0_1.2.54-1ubuntu1_amd64.deb
|
>
>
>
|
<
>
>
>
|
|
|
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
|
#! /usr/bin/env bash
# This file installs prerequisites for megatest (chicken, eggs, etc.)
# Before running this script, set PREFIX environment variable
# to chicken install target area. /opt/chicken is a typical value
# set -x
# Copyright 2007-2014, Matthew Welland.
#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
# echo OPTION=$OPTION
# BKM for ubuntu 17.04:
# sudo dpkg -i libpng12-0_1.2.54-1ubuntu1_amd64.deb
# sudo dpkg -i libpng12-0_1.2.54-1ubuntu1_amd64.deb
|
︙ | | | ︙ | |
Modified utils/installck.sh
from [7eb094e9b0]
to [48b8bc3ef3].
1
2
3
4
5
6
7
8
9
|
#!/bin/bash
myhome=$(dirname $0)
if [[ $proxy == "" ]]; then
echo 'Please set the environment variable "proxy" to host.com:port (e.g. foo.com:1234) to use a proxy'
echo PROX=""
else
export http_proxy=http://$proxy
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
myhome=$(dirname $0)
if [[ $proxy == "" ]]; then
echo 'Please set the environment variable "proxy" to host.com:port (e.g. foo.com:1234) to use a proxy'
echo PROX=""
else
export http_proxy=http://$proxy
|
︙ | | | ︙ | |
Modified utils/loadrunner
from [ba6e3962e1]
to [65b681c599].
1
2
3
4
5
6
7
8
9
|
#!/bin/bash
LOADRUNNER=$0
# load=`uptime|awk '{print $10}'|cut -d, -f1`
load=$(uptime|perl -pe 's/.*: (\d+.\d+),.*/$1/')
load2=$(uptime|perl -pe 's/.*: (\d+.\d+), (\d+.\d+),.*/$2/')
# echo "load2=$load2, load=$load"
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
LOADRUNNER=$0
# load=`uptime|awk '{print $10}'|cut -d, -f1`
load=$(uptime|perl -pe 's/.*: (\d+.\d+),.*/$1/')
load2=$(uptime|perl -pe 's/.*: (\d+.\d+), (\d+.\d+),.*/$2/')
# echo "load2=$load2, load=$load"
|
︙ | | | ︙ | |
Modified utils/loadrunner.scm.notfinished
from [a8651ba3f3]
to [110a1f3c3c].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;; Copyright 2006-2013, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
(use ssax)
(use sxml-serializer)
(use sxml-modifications)
(use regex)
(use srfi-69)
(use regex-case)
|
|
|
>
>
>
>
>
|
|
>
|
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
;; Copyright 2006-2013, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
(use ssax)
(use sxml-serializer)
(use sxml-modifications)
(use regex)
(use srfi-69)
(use regex-case)
|
︙ | | | ︙ | |
Modified utils/lock-stats.sh
from [84d255afaf]
to [b9c8ebf3f2].
1
2
3
4
5
6
7
8
9
|
#!/bin/bash
while IFS=': ' read x x x x p x x i x; do
if ! [[ ${i}x == "x" ]];then
if ! $(echo $i|grep EOF >/dev/null);then
fname=$(find -L "/proc/$p/fd" -maxdepth 1 -inum "$i" -exec readlink {} \; -quit)
if $(echo $fname | grep megatest.db > /dev/null) || \
$(echo $fname | egrep '.db/\d+.db' > /dev/null);then
echo $fname
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
while IFS=': ' read x x x x p x x i x; do
if ! [[ ${i}x == "x" ]];then
if ! $(echo $i|grep EOF >/dev/null);then
fname=$(find -L "/proc/$p/fd" -maxdepth 1 -inum "$i" -exec readlink {} \; -quit)
if $(echo $fname | grep megatest.db > /dev/null) || \
$(echo $fname | egrep '.db/\d+.db' > /dev/null);then
echo $fname
|
︙ | | | ︙ | |
Modified utils/mk_wrapper
from [3b78e9fde2]
to [5902e7d1e5].
1
2
3
4
5
6
7
8
9
|
#!/bin/bash
prefix=$1
cmd=$2
target=$3
cfgfile="$prefix/bin/.$(lsb_release -sr)/cfg.sh"
if [ "$LD_LIBRARY_PATH" != "" ];then
echo "INFO: Using LD_LIBRARY_PATH=$LD_LIBRARY_PATH" >&2
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
prefix=$1
cmd=$2
target=$3
cfgfile="$prefix/bin/.$(lsb_release -sr)/cfg.sh"
if [ "$LD_LIBRARY_PATH" != "" ];then
echo "INFO: Using LD_LIBRARY_PATH=$LD_LIBRARY_PATH" >&2
|
︙ | | | ︙ | |
Modified utils/mt_ezstep
from [6865452478]
to [431c4b2cc0].
1
2
3
4
5
6
7
8
9
|
#!/bin/bash
usage="mt_ezstep stepname prevstepname command [args ...]"
if [[ "$MT_CMDINFO" == "" ]];then
if [[ -e megatest.sh ]];then
source megatest.sh
else
echo "ERROR: $0 should be run within a megatest test environment"
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
usage="mt_ezstep stepname prevstepname command [args ...]"
if [[ "$MT_CMDINFO" == "" ]];then
if [[ -e megatest.sh ]];then
source megatest.sh
else
echo "ERROR: $0 should be run within a megatest test environment"
|
︙ | | | ︙ | |
Modified utils/mt_laststep
from [b984c38ecb]
to [edb9b0d531].
1
2
3
4
5
6
7
8
9
|
#!/bin/bash
if [ $MT_CMDINFO == "" ];then
echo "ERROR: $0 should be run within a megatest test environment"
exit
fi
# Purpose: run a step, record start and end with exit codes, if sucessful
# update test status with PASS, else update with FAIL
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
if [ $MT_CMDINFO == "" ];then
echo "ERROR: $0 should be run within a megatest test environment"
exit
fi
# Purpose: run a step, record start and end with exit codes, if sucessful
# update test status with PASS, else update with FAIL
|
︙ | | | ︙ | |
Modified utils/mt_runstep
from [35ded54591]
to [c328fc41d6].
1
2
3
4
5
6
7
8
9
|
#!/bin/bash
# Purpose: run a step, record start and end with exit codes
#
# Call like this:
# mt_runstep stepname command ....
#
# This expects that you have a logpro file named stepname.logpro and must be run
# inside a test environment (click on xterm button on a test control panel
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
# Purpose: run a step, record start and end with exit codes
#
# Call like this:
# mt_runstep stepname command ....
#
# This expects that you have a logpro file named stepname.logpro and must be run
# inside a test environment (click on xterm button on a test control panel
|
︙ | | | ︙ | |
Modified utils/mt_xterm
from [40d98efdc8]
to [838f7f03df].
1
2
3
4
5
6
7
8
9
|
#!/bin/bash
MT_TMPDISPLAY=$DISPLAY
if [ -e megatest.sh ];then
source megatest.sh
fi
export DISPLAY=$MT_TMPDISPLAY
if [ x"$MT_XTERM_CMD" == "x" ];then
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
MT_TMPDISPLAY=$DISPLAY
if [ -e megatest.sh ];then
source megatest.sh
fi
export DISPLAY=$MT_TMPDISPLAY
if [ x"$MT_XTERM_CMD" == "x" ];then
|
︙ | | | ︙ | |
Modified utils/mtgetfile
from [071134089a]
to [6c34d55841].
1
2
3
4
5
6
7
8
9
|
#!/bin/bash
fullparams="$@"
function findfile () {
megatest $fullparams -repl <<EOF
(let* ((numargs (length remargs))
(path (if (> numargs 0)(car remargs) #f))
(scriptn (if (> numargs 1)(cadr remargs) #f))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
fullparams="$@"
function findfile () {
megatest $fullparams -repl <<EOF
(let* ((numargs (length remargs))
(path (if (> numargs 0)(car remargs) #f))
(scriptn (if (> numargs 1)(cadr remargs) #f))
|
︙ | | | ︙ | |
Modified utils/mtrept.sh
from [b1e7f25939]
to [ca771a03a8].
1
2
3
4
5
6
7
8
9
|
#!/bin/bash
#
# Rollup counts of calls to Megatest from a logging dat file
#
# Usage: mtrept.sh file [host]
if [[ "$2"x != "x" ]];then
host_name_grep="grep $2 | "
else
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/bin/bash
#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
# Rollup counts of calls to Megatest from a logging dat file
#
# Usage: mtrept.sh file [host]
if [[ "$2"x != "x" ]];then
host_name_grep="grep $2 | "
else
|
︙ | | | ︙ | |
Modified utils/mtrunner
from [ee53d3f91b]
to [3987b4602f].
1
2
3
4
5
6
7
8
9
|
#! /bin/bash
# Run megatest from within megatest
# Usage: mtrunner testsuite_dir megatest_bin_dir command args ....
for var in $(env | egrep "^MT_"|cut -d= -f1);do
unset ${var}
done
cd $1
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#! /bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
# Run megatest from within megatest
# Usage: mtrunner testsuite_dir megatest_bin_dir command args ....
for var in $(env | egrep "^MT_"|cut -d= -f1);do
unset ${var}
done
cd $1
|
︙ | | | ︙ | |
Modified utils/mtrunscript
from [e78e46f29a]
to [1a61a1f2c4].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
#!/usr/bin/env bash
# Copyright 2012, Matthew Welland.
#
# This program is made available under the GNU GPL version 2.0 or
# greater. See the accompanying file COPYING for details.
#
# This program is distributed WITHOUT ANY WARRANTY; without even the
# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
# PURPOSE.
#
# VERSION:
# set -e
# set -u
# set -x
# Usage: mtrunscript scriptname params
#
|
|
>
>
>
|
<
>
>
|
>
|
|
|
|
<
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
#!/usr/bin/env bash
# Copyright 2012, Matthew Welland.
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
# set -e
# set -u
# set -x
# Usage: mtrunscript scriptname params
#
|
︙ | | | ︙ | |
Modified utils/mtutils.csh
from [23f4997ab4]
to [2efb30a09e].
1
2
3
4
5
6
7
8
9
10
|
# Better to use the mt_* snippet scripts in utils
# To use the snippets set PREFIX then install with "make installall"
alias mt_runstep 'set argv=(\!*); \
set stepname = $1;shift; \
megatest -runstep $stepname -logpro ${stepname}.logpro "$*" || exit $?'
alias mt_laststep 'set argv=(\!*);set stepname = $1;shift; \
megatest -runstep $stepname -logpro ${stepname}.logpro "$*" ; \
set exitstatus = $? ; \
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
# Better to use the mt_* snippet scripts in utils
# To use the snippets set PREFIX then install with "make installall"
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
alias mt_runstep 'set argv=(\!*); \
set stepname = $1;shift; \
megatest -runstep $stepname -logpro ${stepname}.logpro "$*" || exit $?'
alias mt_laststep 'set argv=(\!*);set stepname = $1;shift; \
megatest -runstep $stepname -logpro ${stepname}.logpro "$*" ; \
set exitstatus = $? ; \
|
︙ | | | ︙ | |
Modified utils/nbfake
from [bfff85f08b]
to [93724ffeda].
1
2
3
4
5
6
7
8
|
#!/bin/bash
###############################################################################
#
# nbfake - capture command output in a logfile
#
# nbfake behavior can be changed by setting the following env vars:
# NBFAKE_HOST SSH to $NBFAKE_HOST and run command
# NBFAKE_LOG Logfile for nbfake output
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
###############################################################################
#
# nbfake - capture command output in a logfile
#
# nbfake behavior can be changed by setting the following env vars:
# NBFAKE_HOST SSH to $NBFAKE_HOST and run command
# NBFAKE_LOG Logfile for nbfake output
|
︙ | | | ︙ | |
Modified utils/nbfind
from [03c58ee4f1]
to [70ee171025].
1
2
3
4
5
6
7
8
9
|
#!/bin/bash
# load=`uptime|awk '{print $10}'|cut -d, -f1`
load=`uptime|perl -pe 's/.*: (\d+.\d+),.*/$1/'`
if which cpucheck > /dev/null;then
numcpu=`cpucheck|tail -1|awk '{print $6}'`
else
numcpu=`lscpu|grep "CPU.s.:"|awk '{print $2}'`
fi
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
# load=`uptime|awk '{print $10}'|cut -d, -f1`
load=`uptime|perl -pe 's/.*: (\d+.\d+),.*/$1/'`
if which cpucheck > /dev/null;then
numcpu=`cpucheck|tail -1|awk '{print $6}'`
else
numcpu=`lscpu|grep "CPU.s.:"|awk '{print $2}'`
fi
|
︙ | | | ︙ | |
Modified utils/remrun
from [836fc55fdd]
to [5637253c81].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
|
#!/bin/bash
###############################################################################
#
# remrun - same behavior as nbfake but first param is a hosthane
# (capture command output in a logfile)
#
# remrun behavior can be changed by setting the following env var:
# NBFAKE_LOG Logfile for nbfake output
#
###############################################################################
if [[ -z "$@" ]]; then
cat <<__EOF
remrun usage:
remrun hostname <command to run>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
#!/bin/bash
###############################################################################
#
# remrun - same behavior as nbfake but first param is a hosthane
# (capture command output in a logfile)
#
# remrun behavior can be changed by setting the following env var:
# NBFAKE_LOG Logfile for nbfake output
#
###############################################################################
#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
if [[ -z "$@" ]]; then
cat <<__EOF
remrun usage:
remrun hostname <command to run>
|
︙ | | | ︙ | |
Modified utils/runner
from [229dc9c405]
to [dc2634a4ff].
1
2
3
4
5
6
7
8
9
|
#!/usr/bin/perl -w
$starthr=`date +%k`;
$hrsper = 1;
$nexthr=$starthr + $hrsper;
$ltr='a';
while (1) {
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/usr/bin/perl -w
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
$starthr=`date +%k`;
$hrsper = 1;
$nexthr=$starthr + $hrsper;
$ltr='a';
while (1) {
|
︙ | | | ︙ | |
Deleted utils/trace/trace.import.scm version [937dcb55c1].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
;;;; trace.import.scm - GENERATED BY CHICKEN 4.9.0.1 -*- Scheme -*-
(eval '(import
scheme
chicken
csi
advice
extras
ports
data-structures
(except srfi-1 break)
miscmacros))
(##sys#register-compiled-module
'trace
(list)
'((breakpoint . trace#breakpoint)
(trace . trace#trace)
(untrace . trace#untrace)
(break . trace#break)
(unbreak . trace#unbreak)
(trace-output-port . trace#trace-output-port)
(continue . trace#continue)
(c . trace#c)
(traced? . trace#traced?)
(trace-module . trace#trace-module)
(untrace-module . trace#untrace-module)
(trace-verbose . trace#trace-verbose)
(trace/untrace . trace#trace/untrace))
(list)
(list))
;; END OF FILE
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
|
Deleted utils/trace/trace.meta version [9714181a62].
1
2
3
4
5
6
7
8
9
10
|
;;;; trace.meta -*- Scheme -*-
((category tools)
(synopsis "tracing and breakpoints")
(author "felix winkelmann")
(license "public domain")
(needs advice ; don't we all?
miscmacros)
(files "tests/run.scm" "trace.meta" "trace.release-info" "trace.scm" "trace.setup") )
|
<
<
<
<
<
<
<
<
<
<
|
|
|
Deleted utils/trace/trace.scm version [dc3560e035].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
|
;;;; trace.scm
(module trace (breakpoint
trace untrace
break unbreak
trace-output-port
continue c
traced?
trace-module untrace-module
trace-verbose
trace/untrace)
(import scheme chicken csi)
(use advice extras ports data-structures)
(require-library srfi-1)
(import (except srfi-1 break) miscmacros)
(define *last-breakpoint* #f)
(define *traced-procedures* '())
(define *broken-procedures* '())
(define *trace-indent-level* 0)
(define trace-output-port (make-parameter (current-output-port)))
(define trace-verbose (make-parameter #t))
(define (break-entry name args)
;; Does _not_ unwind!
(##sys#call-with-current-continuation
(lambda (c)
(let ((exn (##sys#make-structure
'condition
'(exn breakpoint)
(list '(exn . message) "*** breakpoint ***"
'(exn . arguments) (list (cons name args))
'(exn . location) name
'(exn . continuation) c) ) ) )
(set! *last-breakpoint* exn)
(signal exn) ) ) ) )
(define (break-resume exn)
(let ((a (member '(exn . continuation) (##sys#slot exn 2))))
(if a
((cadr a) (void))
(error "condition has no continuation" exn) ) ) )
(define (breakpoint #!optional (name 'breakpoint))
(break-entry name '()) )
(define (trace-indent)
(let ((port (trace-output-port)))
(do ((i (fxmin 3 *trace-indent-level*) (fx- i 1)))
((fx<= i 0))
(write-char #\space port) )
(fprintf port "[~a] " *trace-indent-level*) ) )
(define (traced-procedure-entry name args)
(let ((port (trace-output-port)))
(trace-indent)
(set! *trace-indent-level* (fx+ 1 *trace-indent-level*))
(write (cons name args) port)
(write ", Called from: " port)
(write (conc (car (reverse (get-call-chain)))))
(write-char #\newline port)
(flush-output port) ) )
(define (traced-procedure-exit name results)
(let ((port (trace-output-port)))
(set! *trace-indent-level* (fx- *trace-indent-level* 1))
(trace-indent)
(fprintf port "~a -> " name)
(if results
(for-each
(lambda (x)
(write x port)
(write-char #\space port) )
results)
(display "(escaping)" port))
(write-char #\newline port)
(flush-output port) ) )
(define (procedure-name proc)
(cond ((procedure-information proc) =>
(lambda (info)
(if (pair? info) (car info) info) ) )
(else '<unknown>)) )
(define (do-trace procs)
(for-each
(lambda (s)
(ensure procedure? s)
(cond ((traced? s)
(warning "procedure already traced" s) )
(else
(let ((name (procedure-name s)))
(when (trace-verbose)
(fprintf (current-error-port) "; tracing ~a~%" name))
(set! *traced-procedures* (cons (cons s name) *traced-procedures*))
(advise
'around s
(lambda (next args)
(let ((results #f))
(dynamic-wind
(cut traced-procedure-entry name args)
(lambda ()
(call-with-values (cut apply next args)
(lambda rs
(set! results rs)
(apply values rs))))
(cut traced-procedure-exit name results))))
'*trace*)))))
procs) )
(define (do-untrace-all)
(define (unadvise* p)
(ignore-errors (unadvise p '*trace*)))
(for-each
(lambda (proc)
(let ((proc (car proc)))
(when (trace-verbose)
(fprintf (current-error-port) "; untracing ~a~%" (procedure-name proc))
(unadvise* proc))))
*traced-procedures*)
(set! *traced-procedures* '()))
(define (do-untrace procs)
(for-each
(lambda (s)
(ensure procedure? s)
(let ((p (assq s *traced-procedures*))
(name (procedure-name s)))
(cond ((not p) (warning "procedure not traced" name))
(else
(when (trace-verbose)
(fprintf (current-error-port) "; untracing ~a~%" name))
(ignore-errors (unadvise s '*trace*))
(set! *traced-procedures*
(delete
p *traced-procedures*
eq?))))))
procs) )
(define (do-break procs)
(for-each
(lambda (s)
(let ((name (procedure-name s)))
(ensure procedure? s)
(cond ((assq s *broken-procedures*)
(warning "procedure already has break-point" name))
(else
(when (trace-verbose)
(fprintf (current-error-port) "; setting break-point in ~a~%" name))
(set! *broken-procedures* (cons (cons s name) *broken-procedures*))
(advise
'before s
(lambda (args)
(break-entry name args) )
'*break*) ) )))
procs) )
(define (do-unbreak procs)
(for-each
(lambda (s)
(ensure procedure? s)
(let ((p (assq s *broken-procedures*))
(name (procedure-name s)))
(cond ((not p) (warning "procedure has no breakpoint" name))
(else
(when (trace-verbose)
(fprintf (current-error-port) "; removing break-point in ~a~%" name))
(ignore-errors (unadvise s '*break*))
(set! *broken-procedures* (delete p *broken-procedures* eq?) ) ) ) ) )
procs) )
(define (do-unbreak-all)
(for-each
(lambda (bp)
(ignore-errors (unadvise (car bp) '*break*)))
*broken-procedures*)
(set! *broken-procedures* '())
(void))
(define (trace . procs)
(cond ((null? procs)
(when (pair? *traced-procedures*)
(printf "Traced:~%~%")
(for-each (lambda (p) (printf " ~a~%" (cdr p))) *traced-procedures*)) )
(else
(do-trace procs) ) ) )
(define (untrace . procs)
(cond ((null? procs) (do-untrace-all))
(else (do-untrace procs)))
(void))
(define (break . procs)
(cond ((null? procs)
(when (pair? *broken-procedures*)
(printf "Breakpoints:~%~%")
(for-each (lambda (p) (printf " ~a~%" (cdr p))) *broken-procedures*)) )
(else
(do-break procs) ) ) )
(define (unbreak . procs)
(cond ((null? procs) (do-unbreak-all))
(else (do-unbreak procs))))
(define (continue #!optional (bp *last-breakpoint*))
(cond (*last-breakpoint*
(let ((exn *last-breakpoint*))
(set! *last-breakpoint* #f)
(break-resume exn) ) )
(else (display "no breakpoint pending\n") ) ) )
(define c continue)
(define (traced? proc)
(assq proc *traced-procedures*))
(define (trace/untrace . procs)
(for-each
(lambda (proc)
((if (traced? proc) do-untrace do-trace) (list proc)))
procs))
(define (walk-module mname proc)
(let* ((m (##sys#find-module mname))
(exps (nth-value 1 (##sys#module-exports m))))
(for-each
(lambda (exp)
(let* ((realname (cdr exp))
(prim (get realname '##core#primitive)))
(if prim
(warning "export is a core-library primitive - not traced" (car exp))
(when (##sys#symbol-has-toplevel-binding? realname)
(let ((val (##sys#slot realname 0)))
(when (procedure? val)
(proc val)))))))
exps)))
(define (trace-module . mnames)
(for-each
(lambda (mname)
(walk-module mname trace))
mnames))
(define (untrace-module . mnames)
(for-each
(lambda (mname)
(walk-module
mname
(lambda (proc)
(when (traced? proc)
(do-untrace (list proc))))))
mnames))
)
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
|
Deleted utils/trace/trace.setup version [d222d610b4].
1
2
3
4
5
6
7
8
9
|
;;;; trace.setup -*- Scheme -*-
(compile -s trace.scm -O3 -d1 -j trace)
(compile -s trace.import.scm -O3 -d0)
(install-extension
'trace
'("trace.so" "trace.import.so"))
|
<
<
<
<
<
<
<
<
<
|
|
|
Modified utils/triage.rb
from [1b394ae2b3]
to [97159de683].
1
2
3
4
5
6
7
8
9
|
#!/usr/bin/env ruby
#dir = "."
#if ARGV.length == 1
# dir = ARGV[0]
#end
#puts dir
#exit 1
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/usr/bin/env ruby
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
#dir = "."
#if ARGV.length == 1
# dir = ARGV[0]
#end
#puts dir
#exit 1
|
︙ | | | ︙ | |
Modified utils/unlock_db.sh
from [c92810209b]
to [0c601fe6b4].
1
2
3
4
5
6
7
8
9
|
#!/bin/bash
## Enh :
# 1. if /tmp/repo exists, delte it or name it something else
# 2. compare the repo is successfully created
## Usage :
# unlock_db.sh <database-name/complete path>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
## Enh :
# 1. if /tmp/repo exists, delte it or name it something else
# 2. compare the repo is successfully created
## Usage :
# unlock_db.sh <database-name/complete path>
|
︙ | | | ︙ | |
Modified utils/viewscreen
from [df19e653be]
to [6536ae359b].
1
2
3
4
5
6
7
8
9
|
#!/bin/bash
if ! type screen &> /dev/null;then
xterm -geometry 180x20 -e "$*;echo Press any key to continue;bash -c 'read -n 1 -s'" &
exit
fi
if [[ $(screen -list | egrep 'Attached|Detached'|awk '{print $1}') == "" ]];then
# echo "No screen found for displaying to. Run \"screen\" in an xterm"
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
#!/bin/bash
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
if ! type screen &> /dev/null;then
xterm -geometry 180x20 -e "$*;echo Press any key to continue;bash -c 'read -n 1 -s'" &
exit
fi
if [[ $(screen -list | egrep 'Attached|Detached'|awk '{print $1}') == "" ]];then
# echo "No screen found for displaying to. Run \"screen\" in an xterm"
|
︙ | | | ︙ | |
Modified utils/watch-close-wait.sh
from [76c32422d7]
to [f30a310ea5].
1
2
3
4
5
6
7
|
psline=$(ps -F -u $USER | grep "mtest" |grep " -run " | egrep " -(target|reqtarg) "| head -1)
id=$(echo $psline|awk '{print $2}')
echo "Watching process for command line: $psline"
echo " with PID=$id"
while true;do
echo "CLOSE_WAIT: $(lsof -n | grep CLOSE_WAIT | grep $id | wc -l) ALL OPEN: $(lsof -n |grep $id|wc -l) ALL CLOSE_WAIT: $(netstat -ap 2> /dev/null| grep -i close_wait| wc -l)"
sleep 1
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Megatest is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see <http://www.gnu.org/licenses/>.
psline=$(ps -F -u $USER | grep "mtest" |grep " -run " | egrep " -(target|reqtarg) "| head -1)
id=$(echo $psline|awk '{print $2}')
echo "Watching process for command line: $psline"
echo " with PID=$id"
while true;do
echo "CLOSE_WAIT: $(lsof -n | grep CLOSE_WAIT | grep $id | wc -l) ALL OPEN: $(lsof -n |grep $id|wc -l) ALL CLOSE_WAIT: $(netstat -ap 2> /dev/null| grep -i close_wait| wc -l)"
sleep 1
|
︙ | | | ︙ | |
Deleted utils/wip/mtest-dbstop.scm version [f84335871c].
1
2
3
4
5
6
7
8
9
10
11
12
|
#!/p/foundry/env/pkgs/chicken/4.10.0_ext/bin/csi -s
(use chicken)
(use data-structures)
(include "/nfs/site/home/bjbarcla/bin2/mtest-repair-lib.scm")
(glib-color-mode 1)
(set! *this-cmd* "/nfs/site/home/bjbarcla/bin2/mtest-dbstop.scm")
(kill-in-db)
|
<
<
<
<
<
<
<
<
<
<
<
<
|
|
|
Deleted utils/wip/mtest-diag.scm version [7f6edef793].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
#!/p/foundry/env/pkgs/chicken/4.10.0_ext/bin/csi -s
(use chicken)
(use data-structures)
(include "/nfs/site/home/bjbarcla/bin2/mtest-repair-lib.scm")
(glib-color-mode 1)
;;; check mtver in xterm
(let ((mt-ver (do-or-die "megatest -version")))
(when (member mt-ver '("1.6309-738c" "1.6029"))
(iwarn "This xterm has an older version of megatest.")
(ierr "Please load latest megatest version to proceed.")
(print "eg.: source ../scripts/newrel-setup.csh 1.63/11b")
(exit 3)))
;;;; kill netbatch jobs from this megatest
;; TODO!
(define *diag* #t)
;;(define *user* (get-environment-variable "USER"))
(define *user* (do-or-die "ls -ld . | awk '{print $3}'"))
(print "user="*user*)
;;;; delete .homehost .homehost.config
;;;; if not on homehost, ssh homehost, cd here, killall mtest dboard
(if (not *diag*)
(when (file-exists? ".homehost.config")
(delete-db ".homehost.config")))
(when (file-exists? ".homehost")
(let* ((homehost (with-input-from-file ".homehost" (lambda () (read)))))
(let* ((homehostname (do-or-die "host `cat .homehost` | sed 's/.$//' | awk '{print $NF}' | awk -F. '{print $1}'"))
(thishostname (get-environment-variable "HOST")))
(when (not (equal? homehostname thishostname))
(let* ((this-exe-compiled (car (argv)))
(this-exe "/nfs/site/home/bjbarcla/bin2/mtest-diag.scm")
(cmd (conc "ssh "homehostname" 'cd "(get-environment-variable "PWD")" && "this-exe"'")))
(iwarn "Running on the homehost -- "homehostname)
;;(iwarn "eg: % ssh "homehostname" 'cd "(get-environment-variable "PWD")" && "(car (argv))"'")
(print "cmd="cmd)
;;(inote "sleeping for 5 seconds. hit ctrl-c now to run on homehost or wait to proceed.")
(system cmd)
(exit 0))))))
;;;; kill megatests and dashboards in this area
(define (kill-mtest-dboard)
(if *diag*
#f
(let* ((this-toppath (pid->cwd (current-process-id)))
(tmppath (toppath->tmppath this-toppath))
(config (let ((res (conc this-toppath "/megatest.config")))
(when (not (file-exists? res))
(ierr "This is not a megatest run area; "res" does not exist. Aborting.")
(exit 2))
res))
(mtest-procs (get-my-mtest-procs))
(dashboard-procs (get-my-dashboard-procs))
(all-pids (map proc-PID (append mtest-procs dashboard-procs)))
(our-pids (filter (lambda (pid)
(equal? (pid->cwd pid) this-toppath))
all-pids)))
(if (null? our-pids)
(inote "No mtest or dboard processes on this host in in this runarea.")
(begin
(iwarn "Killing all megatest and dashboard processes on this host.")
(gracefully-kill-pids our-pids)))
)))
(kill-mtest-dboard)
;;;; delete /tmp/.$USER-portlogger.db
(let ((plfile (conc "/tmp/."*user* "-portlogger.db")))
(if (safe-file-exists? plfile)
(if *diag*
(print "plfile exists - "plfile)
(begin
(inote "removing portlogger file")
(system (conc "rm "plfile))))))
;;;; move logs dir aside
(when (not *diag*)
(system (conc "mv logs logs-aside-`date +%s`"))
(system "mkdir logs"))
;;;; fixes for dependency diagram
(when (not *diag*)
(inote "Removing dep graph tmp files if they exist")
(system (conc "rm /tmp/."*user*"-*.dot"))
;;#ln -s /p/fdk/gwa/$USER/fossil/ext/<your flow>_ext ext
(let* ((toppath (pid->cwd (current-process-id)))
(flow (car (string-split
(car (reverse (string-split toppath "/")))
".")))
(extdir (conc "/p/fdk/gwa/"*user*
"/fossil/ext/"flow"_ext")))
(when (and (safe-file-exists? extdir)
(not (safe-file-exists? "ext")))
(inote "Linking in ext dir")
(system (conc "ln -s "extdir" ext")))))
;;;; check for 0 byte megatest{,_ref}.db in tmp. delete them
;;;; check for wal-mode megatest{,_ref}.db in tmp. delete them
(define (repair-dbs)
(let* ((this-toppath (pid->cwd (current-process-id)))
(tmppath (toppath->tmppath this-toppath))
(golden-mtest-file (conc this-toppath "/megatest.db"))
(golden-mtest-file-ok (check-db "megatest.db"))
(tmp-mtest-file (conc tmppath "/megatest.db"))
(tmp-mtestref-file (conc tmppath "/megatest_ref.db"))
(tmp-mtest-file-ok (check-db tmp-mtest-file))
(tmp-mtestref-file-ok (check-db tmp-mtestref-file))
)
;;;; check for megatest{,_ref}.db in tmp that die on .schema. delete them
(when (safe-file-exists? tmppath)
(if tmp-mtest-file-ok
(inote "tmp megatest db file ok")
(if *diag*
(print "diag: tmp megatest db broken - "tmp-mtest-file)
(delete-db tmp-mtest-file)))
(if tmp-mtestref-file-ok
(inote "tmp megatestref db file ok")
(if *diag*
(print "diag: tmpref megatest db broken - "tmp-mtestref-file)
(delete-db tmp-mtestref-file))))
;;;; check for megatest.db
(if golden-mtest-file-ok
(inote "golden megatest db file ok")
(if (not (file-exists? golden-mtest-file))
(inote "megatest.db not present. Continuing.")
(begin
;;;; if golden megatest db is broken, stop now!
(ierr "Golden megatest.db is broken. Please delete it or replace it from a backup version in .snapshot. If critical, contact env team to assist.")
(sendmail "bjbarcla" "!!Bad golden megatest.db" this-toppath)
(inote "Backups in .snapshot:")
(system "ls -l .snapshot/*/megatest.db")
(ierr "Not proceeding with any more checks.")
(exit 3))))
))
(repair-dbs)
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
|
Deleted utils/wip/mtest-nbstop.scm version [7b4c78c86f].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
|
#!/p/foundry/env/pkgs/chicken/4.10.0_ext/bin/csi -s
(use chicken)
(use data-structures)
(include "/nfs/site/home/bjbarcla/bin2/mtest-repair-lib.scm")
(glib-color-mode 1)
(set! *this-cmd* "/nfs/site/home/bjbarcla/bin2/mtest-nbstop.scm")
(inote "Killing local mtest/dboard in this run area.")
(kill-mtest-dboard)
;;;; move logs dir aside
(inote "move logs")
(system (conc "mv logs logs-aside-`date +%s`"))
(system "mkdir logs")
(inote "Killing netbatch mtest jobs launched from this run area.")
(let ((jobcount (kill-mtest-jobs-in-netbatch)))
(when (> jobcount 0)
(inote "Marking in-flight tests killed in db")
(when (db-islocked? "megatest.db")
(iwarn "Unlocking megatest.db")
(db-unlock "megaetest.db"))
(kill-in-db)))
(inote "Final reaping of mtest/dboard")
(kill-mtest-dboard)
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
|
Deleted utils/wip/mtest-reaper.scm version [b3b10d5f69].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
#!/p/foundry/env/pkgs/chicken/4.10.0_ext/bin/csi -s
(use general-lib)
(use typed-records)
(use regex-literals)
(use regex)
(use sql-de-lite)
(defstruct proc
(USER "")
(PID -1)
(%CPU -1.0)
(%MEM -1.0)
(VSZ -1)
(RSS -1)
(TTY "")
(STAT "")
(START "")
(TIME "")
(COMMAND ""))
(define (linux-get-process-info-records)
(let* ((raw (do-or-die "/bin/ps auwx"))
(all-lines (string-split raw "\n"))
(lines (cdr all-lines)) ;; skip title lines
(re #/^(\S+)\s+(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*)$/))
(filter
proc?
(map
(lambda (line)
(let ((match (string-match re line)))
(if match
(make-proc
USER: (list-ref match 1)
PID: (string->number (list-ref match 2))
%CPU: (string->number (list-ref match 3))
%MEM: (string->number (list-ref match 4))
VSZ: (string->number (list-ref match 5))
RSS: (string->number (list-ref match 6))
TTY: (string->number (list-ref match 7))
STAT: (list-ref match 8)
START: (list-ref match 9)
TIME: (list-ref match 10)
COMMAND: (list-ref match 11))
#f)))
lines))))
(define (get-my-mtest-server-procs)
(let* ((procs (linux-get-process-info-records))
(my-mtest-procs
(filter
(lambda (a-proc)
(and
(equal? (get-environment-variable "USER") (proc-USER a-proc))
(string-match #/^.*\/mtest\s+.*-server.*/ (proc-COMMAND a-proc))))
procs)))
my-mtest-procs))
(define (pid->environ-hash pid)
(let* ((envfile (conc "/proc/"pid"/environ"))
(ht (make-hash-table))
(rawdata (with-input-from-file envfile read-string))
(lines (string-split rawdata (make-string 1 #\nul ))))
(for-each
(lambda (line)
(let ((match (string-match #/(^[^=]+)=(.*)/ line)))
(if match
(hash-table-set! ht (list-ref match 1) (list-ref match 2)))))
lines)
ht))
(define (pid->cwd pid)
(read-symbolic-link (conc "/proc/"pid"/cwd")))
(define (pid->mtest-monitor-db-file pid)
(let* ((env (pid->environ-hash pid))
(ltdir (hash-table-ref/default env "MT_LINKTREE" #f))
(radir (hash-table-ref/default env "MT_RUN_AREA_HOME" #f))
(cwd (pid->cwd pid)))
(let ((res
(cond
(ltdir (conc ltdir "/.db/monitor.db"))
(radir (conc
(do-or-die
(conc "megatest -start-dir "radir" -show-config -section setup -var linktree"))
"/.db/monitor.db"))
(cwd (conc
(do-or-die
(conc "megatest -start-dir "cwd" -show-config -section setup -var linktree"))
"/.db/monitor.db"))
(else #f))))
res)))
(define (get-mdb-status mdb-file pid)
;; select state from servers where pid='4465';
(cond
((not (string? mdb-file)) (conc "mdb-file could not be determined for pid " pid ">>"mdb-file ))
((not (file-exists? mdb-file)) (conc "mdb-file does not exist for pid "pid" : "mdb-file))
(else
(let ((dbh (open-database mdb-file)))
(set-busy-handler! dbh 10000)
(let* ((sql-str "select state from servers where pid=?;")
(stm (sql dbh sql-str))
(alists (query fetch-alists stm (->string pid))))
(if (null? alists)
"server pid not in monitor.db"
(cdr (car (car alists)))))))))
(define (mtest-server-pid->status pid)
(let* ((mdb-file (pid->mtest-monitor-db-file pid)))
(if mdb-file
(get-mdb-status mdb-file pid)
"no monitor.db file could be found"
)))
(define (kill pid)
(print "KILL "pid)
(do-or-die (conc "kill -9 "pid)))
(define (reap-defunct-mtest-server-pid pid)
(let ((status (mtest-server-pid->status pid)))
(print pid"->"(mtest-server-pid->status pid))
(if (member status (list "running" "dbprep" "available" "collision"))
(print "pid="pid" in status "status" -- not killing")
(kill pid))))
(let* ((procs (get-my-mtest-server-procs))
(pids (map proc-PID procs))
)
(for-each reap-defunct-mtest-server-pid pids))
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
|
Deleted utils/wip/mtest-repair-lib.scm version [c317aec679].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
|
(use general-lib)
(use typed-records)
(use regex-literals)
(use regex)
(use sql-de-lite)
(use posix)
(use files)
(use s11n)
(use ports)
(use z3)
(use base64)
(use matchable)
(define (cli-arg arg #!key (default #f) (is-list #f))
(let* ((temp (skim-cmdline-opts-withargs-by-regex arg)))
(if (> (length temp) 0)
(if is-list
temp
(car temp))
default)))
(define (cli-switch arg)
(let ((temp (skim-cmdline-opts-noarg-by-regex arg)))
(if (> (length temp) 0)
(car temp)
#f)))
(defstruct nbjob
pool
jobid
owner
mtver
user
status
cmdline
execute)
(define (cmdline->execute cmdline)
(let* ((match (string-match ".*-execute\\s+(\\S+)" cmdline)))
(if match
(with-input-from-string (z3:decode-buffer (base64-decode (cadr match))) read)
#f)))
(define (nbjob-execute-ref nbjob key #!key (default #f))
(let ((execute (nbjob-execute nbjob)))
(if (list? execute)
(let* ((match (alist-ref key execute)))
(if match
(if (list? match) (car match) match)
default))
default)))
(define (nbjob-process pool nbstatus-line)
(let ((toks (string-split nbstatus-line ",")))
(if (eq? 4 (length toks))
(if (equal? (list-ref toks 1) "Jobid")
#f
(begin
(let ((res
(make-nbjob
pool: pool
status: (list-ref toks 0)
jobid: (list-ref toks 1)
user: (list-ref toks 2)
cmdline: (list-ref toks 3)
execute: (cmdline->execute (list-ref toks 3))
)))
res)))
#f)))
(define (get-mtest-nb-jobs user nbpools #!key (cmdline-filter "megatest"))
(let* ((res
(apply append
(map (lambda (pool)
(let* (;;(user-filter ".*")
(user-filter user)
(cmd
(conc "nbstatus jobs --tar "pool" --fields status,jobid,user,cmdline --format csv "
"'USER=~\""user-filter
"\"&&cmdline=~\""cmdline-filter"\"'"))
(res (do-or-die cmd)))
(filter nbjob?
(map (lambda (line)
(nbjob-process pool line))
(string-split res "\n")))))
nbpools))))
res))
;;(define foo (get-mtest-nb-jobs "bjbarcla" '("pdx_normal" "pdx_critical")))
(define (cmdline->execute cmdline)
(let* ((match (string-match ".*-execute\\s+(\\S+)" cmdline)))
(if match
(with-input-from-string (z3:decode-buffer (base64-decode (cadr match))) read)
#f)))
;;;; kill jobs in netbatch for this area
(define (kill-mtest-jobs-in-netbatch)
(let ((pwd (get-environment-variable "PWD"))
(jobs (get-mtest-nb-jobs (get-environment-variable "USER") '("pdx_normal" "pdx_critical") )))
(for-each
(lambda (job)
(let* ((jobid (nbjob-jobid job))
(pool (nbjob-pool job))
(status (nbjob-status job))
(cmd (conc "nbjob --target "pool" remove "jobid)))
;;(print status)
(print cmd)
(system cmd)))
;(pp (nbjob->alist job))
(filter
(lambda (job)
(equal? (nbjob-execute-ref job 'toppath) pwd))
jobs))
(length jobs)
))
;;;; kill megatest jobs in running in netbatch
(define (kill-in-db #!key (megatest_exe "megatest"))
(let* ((all-targ-patt (do-or-die "sqlite3 megatest.db \"select id from keys\" | tr \"\\n1234567890\" \"/%%%%%%%%%%\" | sed 's/\\/$//'"))
)
(for-each (lambda (state)
(let* ((cmd (conc megatest_exe " -state "state" -set-state-status KILLED,n/a -testpatt % -target "all-targ-patt" -runname %")))
(print cmd)
(system cmd)))
'("REMOTEHOSTSTART" "LAUNCHED" "RUNNING" "KEEP_TRYING" "PREQ_FAIL"))))
;;;; kill megatests and dashboards in this area running on this host
(define (kill-mtest-dboard)
(let* ((this-toppath (pid->cwd (current-process-id)))
(tmppath (toppath->tmppath this-toppath))
(config (let ((res (conc this-toppath "/megatest.config")))
(when (not (file-exists? res))
(ierr "This is not a megatest run area; "res" does not exist. Aborting.")
(exit 2))
res))
(mtest-procs (get-my-mtest-procs))
(dashboard-procs (get-my-dashboard-procs))
(all-pids (map proc-PID (append mtest-procs dashboard-procs)))
(our-pids (filter (lambda (pid)
;;(print (pid-COMMAND pid))
(and
(equal? (pid->cwd pid) this-toppath)
))
all-pids)))
(if (null? our-pids)
(inote "No mtest or dboard processes on this host in in this runarea.")
(begin
(iwarn "Killing all megatest and dashboard processes on this host.")
(gracefully-kill-pids our-pids)))
))
(define (db-mt-version dbpath)
(let* ((cmd (conc "sqlite3 "dbpath" 'select val from metadat where var=\"MEGATEST_VERSION\"'"))
(res (do-or-die cmd)))
res))
;; TODO
(define (db-islocked? dbpath)
(let-values (((ec so se) (isys (conc "sqlite3 "dbpath" vacuum"))))
(let* ((message se)
(is-locked (string-match "^.*database is locked.*$" message)))
(inote "dbfile - "dbpath "; message - "message)
is-locked)))
(define (db-unlock dbpath)
(system (conc "/nfs/site/bjbarcla/bin/unlock_db.sh " dbpath))
;; (let* ((temp-dbpath (conc "/tmp/"(get-environment-variable "USER")"-"(current-process-id)".db")))
;; (inote "Unlocking "dbpath)
;; (do-or-die (conc "cp "dbpath" "temp-dbpath))
;; (do-or-die (conc "rm -f "dbpath))
;; (let* ((cmd (conc "sqlite3 "temp-dbpath" .dump | sqlite3 "dbpath)))
;; (inote "Running: "cmd)
;; (system cmd))
;; ;;(do-or-die "sqlite3 "temp-dbpath" .dump | sqlite3 "dbpath)
;; (if (db-islocked? dbpath)
;; (begin
;; (ierr "Could not unlock "dbpath)
;; (exit 5))
;; (inote "Unlocked "dbpath))
;; #t)
)
(define *user* (do-or-die "ls -ld . | awk '{print $3}'"))
(define (false-on-exception thunk)
(handle-exceptions exn #f (thunk) ))
(define (safe-file-exists? path-string)
(false-on-exception (lambda () (file-exists? path-string))))
(defstruct proc
(USER "")
(PID -1)
(%CPU -1.0)
(%MEM -1.0)
(VSZ -1)
(RSS -1)
(TTY "")
(STAT "")
(START "")
(TIME "")
(COMMAND ""))
(define (toppath->tmppath toppath)
(let* ((user *user*)
(area (car (string-split
(car (reverse (string-split toppath "/")))
".")))
(dotified-path (string-substitute "/" "." toppath "all")))
(conc "/tmp/" user "/megatest_localdb/" area "/" dotified-path)))
(define (delete-db dbfile)
(let* ((db-files (glob (conc dbfile "*"))))
(for-each
(lambda (file)
(inote "delete file " file)
(if (delete-file* file)
(inote "Removed file - " file)
(iwarn "Could Not Remove file - " file))
)
db-files)))
(define (check-db dbfile)
(let* ((has-wal (safe-file-exists? (conc dbfile "-wal")))
(has-shm (safe-file-exists? (conc dbfile "-shm")))
(has-journal (safe-file-exists? (conc dbfile "-journal")))
(has-db (safe-file-exists? dbfile))
(ok-flag #t))
(when has-journal
(iwarn "Journal exists - "(conc dbfile "-journal"))
)
(when has-wal
(set! ok-flag #f)
(iwarn "Wal-mode db exists: "(conc dbfile "-wal")))
(if (not has-db)
(begin
(inote "db does not exists " dbfile)
(set! ok-flag #f))
(let* ((db-size (file-size dbfile)))
(inote "db size = " db-size " -- " dbfile)
(when (member db-size (list 0 1024))
(iwarn "db has bad size - "db-size" -- "dbfile)
(set! ok-flag #f))))
ok-flag))
(define (linux-get-process-info-records)
(let* ((raw (do-or-die "/bin/ps auwx"))
(all-lines (string-split raw "\n"))
(lines (cdr all-lines)) ;; skip title lines
(re (regexp "^(\\S+)\\s+(\\d+)\\s+(\\S+)\\s+(\\S+)\\s+(\\S+)\\s+(\\S+)\\s+(\\S+)\\s+(\\S+)\\s+(\\S+)\\s+(\\S+)\\s+(.*)$")))
(filter
proc?
(map
(lambda (line)
(let ((match (string-match re line)))
(if match
(make-proc
USER: (list-ref match 1)
PID: (string->number (list-ref match 2))
%CPU: (string->number (list-ref match 3))
%MEM: (string->number (list-ref match 4))
VSZ: (string->number (list-ref match 5))
RSS: (string->number (list-ref match 6))
TTY: (string->number (list-ref match 7))
STAT: (list-ref match 8)
START: (list-ref match 9)
TIME: (list-ref match 10)
COMMAND: (list-ref match 11))
#f)))
lines))))
(define (get-my-mtest-server-procs)
(let* ((procs (linux-get-process-info-records))
(my-mtest-procs
(filter
(lambda (a-proc)
(and
(equal? *user* (proc-USER a-proc))
(string-match "^.*/mtest\\s+.*-server.*" (proc-COMMAND a-proc))))
procs)))
my-mtest-procs))
(define (get-my-mtest-procs)
(let* ((procs (linux-get-process-info-records))
(my-mtest-procs
(filter
(lambda (a-proc)
(and
(equal? *user* (proc-USER a-proc))
(string-match "^.*/m(ega)?test .*" (proc-COMMAND a-proc))
(not (string-match "^.*/mtest-repair.*" (proc-COMMAND a-proc)))))
procs)))
my-mtest-procs))
(define (get-my-dashboard-procs)
(let* ((procs (linux-get-process-info-records))
(my-dboard-procs
(filter
(lambda (a-proc)
(and
(equal? *user* (proc-USER a-proc))
(string-match "^.*/dboard.*" (proc-COMMAND a-proc))))
procs)))
my-dboard-procs))
(define (pid->environ-hash pid)
(let* ((envfile (conc "/proc/"pid"/environ"))
(ht (make-hash-table))
(rawdata (with-input-from-file envfile read-string))
(lines (string-split rawdata (make-string 1 #\nul ))))
(for-each
(lambda (line)
(let ((match (string-match "(^[^=]+)=(.*)" line)))
(if match
(hash-table-set! ht (list-ref match 1) (list-ref match 2)))))
lines)
ht))
(define (pid->cwd pid)
(read-symbolic-link (conc "/proc/"pid"/cwd")))
(define (pid->mtest-monitor-db-file pid #!key (megatest_exe "megatest"))
(let* ((env (pid->environ-hash pid))
(ltdir (hash-table-ref/default env "MT_LINKTREE" #f))
(radir (hash-table-ref/default env "MT_RUN_AREA_HOME" #f))
(cwd (pid->cwd pid)))
(let ((res
(cond
(ltdir (conc ltdir "/.db/monitor.db"))
(radir (conc
(do-or-die
(conc megatest_exe " -start-dir "radir" -show-config -section setup -var linktree"))
"/.db/monitor.db"))
(cwd (conc
(do-or-die
(conc megatest_exe " -start-dir "cwd" -show-config -section setup -var linktree"))
"/.db/monitor.db"))
(else #f))))
res)))
(define (get-mdb-status mdb-file pid)
;; select state from servers where pid='4465';
(cond
((not (string? mdb-file)) (conc "mdb-file could not be determined for pid " pid ">>"mdb-file ))
((not (safe-file-exists? mdb-file)) (conc "mdb-file does not exist for pid "pid" : "mdb-file))
(else
(let ((dbh (open-database mdb-file)))
(set-busy-handler! dbh 10000)
(let* ((sql-str "select state from servers where pid=?;")
(stm (sql dbh sql-str))
(alists (query fetch-alists stm (->string pid))))
(if (null? alists)
"server pid not in monitor.db"
(cdr (car (car alists)))))))))
(define (mtest-server-pid->status pid)
(let* ((mdb-file (pid->mtest-monitor-db-file pid)))
(if mdb-file
(get-mdb-status mdb-file pid)
"no monitor.db file could be found"
)))
(define (gracefully-kill-pids pids)
(for-each (lambda (pid)
(print "kill "pid)
(system (conc "kill "pid)))
pids)
(sleep 5)
(let* ((procs-left (linux-get-process-info-records))
(pids-left (map proc-PID procs-left)))
(for-each (lambda (pid)
(when (member pid pids-left)
(print "kill -9"pid)
(system (conc "kill -9 "pid))))
pids)))
(define (kill pid)
(print "KILL "pid)
(do-or-die (conc "kill -9 "pid)))
(define (reap-defunct-mtest-server-pid pid)
(let ((status (mtest-server-pid->status pid)))
(print pid"->"(mtest-server-pid->status pid))
(if (member status (list "running" "dbprep" "available" "collision"))
(print "pid="pid" in status "status" -- not killing")
(kill pid))))
;; (let* ((procs (get-my-mtest-server-procs))
;; (pids (map proc-PID procs))
;; )
;; (for-each reap-defunct-mtest-server-pid pids))
(define (mtdbver->mtrelver mtdbver)
(let* ((table-alist '(
("1.5402" . "1.54/02")
("1.5406" . "1.54/05")
("1.5408" . "1.54/07")
("1.5409" . "1.54/09")
("1.5412" . "1.54/12")
("1.5413" . "1.54/13")
("1.5414" . "1.54/14")
("1.5415" . "1.54/15")
("1.5416" . "1.54/16")
("1.5417" . "1.54/17")
("1.5418" . "1.54/18")
("1.5419" . "1.54/19")
("1.5421" . "1.54/21")
("1.5411" . "1.54/support-for-skip")
("1.5522" . "1.55/22")
("1.5523" . "1.55/23")
("1.5524" . "1.55/24")
("1.5525" . "1.55/25")
("1.6001" . "1.60/01")
("1.6002" . "1.60/02")
("1.6003" . "1.60/03")
("1.6004" . "1.60/04")
("1.6005" . "1.60/05")
("1.6006" . "1.60/06")
("1.6007" . "1.60/07")
("1.6008" . "1.60/08")
("1.6009" . "1.60/09")
("1.6009" . "1.60/11")
("1.6012" . "1.60/12")
("1.6013" . "1.60/13")
("1.6014" . "1.60/14")
("1.6015" . "1.60/15")
("1.6016" . "1.60/16")
("1.6017" . "1.60/17")
("1.6018" . "1.60/18")
("1.6019" . "1.60/19")
("1.6021" . "1.60/21")
("1.6022" . "1.60/22")
("1.6023" . "1.60/23")
("1.6024" . "1.60/24")
("1.6025" . "1.60/25")
("1.6026" . "1.60/26")
("1.6027" . "1.60/27")
("1.6028" . "1.60/28")
;;("1.6029" . "1.60/29")
("1.6029" . "1.60/29a")
("1.6031" . "1.60/31")
("1.6101" . "1.61/01")
("1.6101" . "1.61/01a")
("1.6102-c2ba" . "1.61/02")
("1.6103-3e88" . "1.61/03")
("1.6104-ee53" . "1.61/04")
("1.6105-232b" . "1.61/05")
("1.6201-e652" . "1.62/01")
("1.6204-c74d" . "1.62/04")
("1.6205-aff0" . "1.62/05")
("1.6207-6f59" . "1.62/07")
("1.6301-fbf0" . "1.63/01")
("1.6302-da4a" . "1.63/02")
("1.6303-aa5f" . "1.63/03")
("1.6304-fa49" . "1.63/04")
("1.6305-a03b" . "1.63/05")
("1.6306-7a12" . "1.63/06")
("1.6307-fb5d" . "1.63/07")
("1.6308-35e0" . "1.63/08")
("1.6309-738c" . "1.63/09")
("1.6309-880c" . "1.63/09a")
("1.6309-b566" . "1.63/09b")
("1.6311-fb43" . "1.63/11")
("1.6311-fb43" . "1.63/11b")
("1.6311-8a6c" . "1.63/11b")
("1.6402-03c5" . "1.64/02")
)
)
(res (alist-ref mtdbver table-alist equal?)))
res))
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
|
Deleted utils/wip/mtest-repair.scm version [abac938a88].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
#!/p/foundry/env/pkgs/chicken/4.10.0_ext/bin/csi -s
(use chicken)
(use data-structures)
(include "/nfs/site/home/bjbarcla/bin2/mtest-repair-lib.scm")
(glib-color-mode 1)
;;(define this-cmd (car (argv)))
(define this-cmd "/nfs/site/home/bjbarcla/bin2/mtest-repair.scm")
;;; check mtver in xterm
;; note - 11b is 1.6311-fb43
(let ((mt-ver (do-or-die "megatest -version")))
(when (member mt-ver '("1.6309-738c" "1.6029" "1.6309-b566"))
(iwarn "This xterm has an older version of megatest.")
(ierr "Please load latest megatest version to proceed.")
(print "eg.: source ../scripts/newrel-setup.csh 1.63/11b")
(exit 3)))
;;;; kill netbatch jobs from this megatest
;;(kill-mtest-dboard)
;;(system "/nfs/site/home/bjbarcla/bin2/mtest-nbstop.scm")
;;;; delete .homehost .homehost.config
;;;; if not on homehost, ssh homehost, cd here, killall mtest dboard
(when (file-exists? ".homehost.config")
(delete-db ".homehost.config"))
(when (file-exists? ".homehost")
(let* ((homehost (with-input-from-file ".homehost" (lambda () (read)))))
(let* ((homehostname (do-or-die "host `cat .homehost` | sed 's/.$//' | awk '{print $NF}' | awk -F. '{print $1}'"))
(thishostname (get-environment-variable "HOST")))
(when (not (equal? homehostname thishostname))
(iwarn "Please also run this on the homehost -- "homehostname)
(iwarn "eg: % ssh "homehostname" 'cd "(get-environment-variable "PWD")" && "this-cmd"'")
(print "")
(inote "sleeping for 5 seconds. hit ctrl-c now to run on homehost or wait to proceed.")
(sleep 5)))))
(kill-mtest-dboard)
;;;; delete /tmp/.$USER-portlogger.db
(let ((plfile (conc "/tmp/."(get-environment-variable "USER") "-portlogger.db")))
(when (safe-file-exists? plfile)
(inote "removing portlogger file")
(system (conc "rm "plfile))))
;;;; move logs dir aside
(system (conc "mv logs logs-aside-`date +%s`"))
(system "mkdir logs")
;;;; fixes for dependency diagram
(inote "Removing dep graph tmp files if they exist")
(system (conc "rm /tmp/."(get-environment-variable "USER")"-*.dot"))
;;#ln -s /p/fdk/gwa/$USER/fossil/ext/<your flow>_ext ext
(let* ((toppath (pid->cwd (current-process-id)))
(flow (car (string-split
(car (reverse (string-split toppath "/")))
".")))
(extdir (conc "/p/fdk/gwa/"(get-environment-variable "USER")
"/fossil/ext/"flow"_ext")))
(when (and (safe-file-exists? extdir)
(not (safe-file-exists? "ext")))
(inote "Linking in ext dir")
(system (conc "ln -s "extdir" ext"))))
;;;; check for 0 byte megatest{,_ref}.db in tmp. delete them
;;;; check for wal-mode megatest{,_ref}.db in tmp. delete them
(define (repair-dbs)
(let* ((this-toppath (pid->cwd (current-process-id)))
(tmppath (toppath->tmppath this-toppath))
(golden-mtest-file (conc this-toppath "/megatest.db"))
(golden-mtest-file-ok (check-db "megatest.db"))
(tmp-mtest-file (conc tmppath "/megatest.db"))
(tmp-mtestref-file (conc tmppath "/megatest_ref.db"))
(tmp-mtest-file-ok (check-db tmp-mtest-file))
(tmp-mtestref-file-ok (check-db tmp-mtestref-file))
(alldbs (list tmp-mtest-file tmp-mtestref-file golden-mtest-file))
)
;;;; check for megatest{,_ref}.db in tmp that die on .schema. delete them
(when (safe-file-exists? tmppath)
(if tmp-mtest-file-ok
(inote "tmp megatest db file ok")
(delete-db tmp-mtest-file))
(if tmp-mtestref-file-ok
(inote "tmp megatestref db file ok")
(delete-db tmp-mtestref-file)))
;;;;; check for locked dbs
(for-each (lambda (dbfile)
(let* ((locked (db-islocked? dbfile)))
(if (db-islocked? dbfile)
(begin
(iwarn "db locked - "dbfile)
(db-unlock dbfile))
(inote "db not locked - "dbfile))))
alldbs)
;;;; check for megatest.db
(if golden-mtest-file-ok
(inote "golden megatest db file ok")
(if (not (file-exists? golden-mtest-file))
(inote "megatest.db not present. Continuing.")
(begin
;;;; if golden megatest db is broken, stop now!
(ierr "Golden megatest.db is broken. Please delete it or replace it from a backup version in .snapshot. If critical, contact env team to assist.")
(sendmail "bjbarcla" "!!Bad golden megatest.db" this-toppath)
(inote "Backups in .snapshot:")
(system "ls -l .snapshot/*/megatest.db")
(ierr "Not proceeding with any more checks.")
(exit 3))))
))
;; TODO: check for and fix locked megatest.db and locked monitor.db (ritika working on)
(repair-dbs)
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
|
Modified vg.scm
from [2067ad836c]
to [79994f610c].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;;
;; Copyright 2016 Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
(use typed-records srfi-1)
(declare (unit vg))
(use canvas-draw iup)
|
|
|
>
>
>
>
>
|
|
>
|
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
;;
;; Copyright 2016 Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
(use typed-records srfi-1)
(declare (unit vg))
(use canvas-draw iup)
|
︙ | | | ︙ | |
Modified widgets.scm
from [3d56925ea9]
to [2895969573].
1
2
3
4
5
6
7
|
(require-library srfi-4 iup)
(import srfi-4 iup iup-pplot iup-glcanvas) ;; iup-web
(define (popup dlg . args)
(apply show dlg #:modal? 'yes args)
(destroy! dlg))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
(require-library srfi-4 iup)
(import srfi-4 iup iup-pplot iup-glcanvas) ;; iup-web
(define (popup dlg . args)
(apply show dlg #:modal? 'yes args)
(destroy! dlg))
|
︙ | | | ︙ | |