mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
[build] Rewrite guile-func-name-check in Scheme, adding features.
* libguile/guile-func-name-check: Rewrite in Scheme; add inhibition directives, string-literal handling, failureful exit on error. * libguile/guile-snarf-docs.in: Use ‘@top_builddir@/meta/guile’. * libguile/pairs.c: Add guile-func-name-check inhibition directive.
This commit is contained in:
Thien-Thi Nguyen
parent
e6d67f1e69
commit
6832604efa
3 changed files with 142 additions and 60 deletions
|
|
@ -1,65 +1,146 @@
|
||||||
#!/usr/bin/awk -f
|
;;; guile-func-name-check -*- scheme -*-
|
||||||
#
|
|
||||||
# Copyright (C) 2000, 2001, 2006 Free Software Foundation, Inc.
|
|
||||||
#
|
|
||||||
# This program is free software; you can redistribute it and/or modify
|
|
||||||
# it under the terms of the GNU Lesser General Public License as
|
|
||||||
# published by the Free Software Foundation; either version 3, or (at
|
|
||||||
# your option) any later version.
|
|
||||||
#
|
|
||||||
# This program 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
|
|
||||||
# Lesser General Public License for more details.
|
|
||||||
#
|
|
||||||
# You should have received a copy of the GNU Lesser General Public
|
|
||||||
# License along with this software; see the file COPYING.LESSER. If
|
|
||||||
# not, write to the Free Software Foundation, Inc., 51 Franklin
|
|
||||||
# Street, Fifth Floor, Boston, MA 02110-1301 USA
|
|
||||||
#
|
|
||||||
# Written by Greg J. Badros, <gjb@cs.washington.edu>
|
|
||||||
# 11-Jan-2000
|
|
||||||
|
|
||||||
BEGIN {
|
;; Copyright (C) 2000, 2001, 2006, 2010 Free Software Foundation, Inc.
|
||||||
filename = ARGV[1];
|
;;
|
||||||
in_a_func = 0;
|
;; This program is free software; you can redistribute it and/or modify
|
||||||
}
|
;; it under the terms of the GNU Lesser General Public License as
|
||||||
|
;; published by the Free Software Foundation; either version 3, or (at
|
||||||
|
;; your option) any later version.
|
||||||
|
;;
|
||||||
|
;; This program 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
|
||||||
|
;; Lesser General Public License for more details.
|
||||||
|
;;
|
||||||
|
;; You should have received a copy of the GNU Lesser General Public
|
||||||
|
;; License along with this software; see the file COPYING.LESSER. If
|
||||||
|
;; not, write to the Free Software Foundation, Inc., 51 Franklin
|
||||||
|
;; Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||||
|
|
||||||
/^SCM_DEFINE/ {
|
;;; Commentary:
|
||||||
func_name = $0;
|
|
||||||
sub(/^[^\(\n]*\([ \t]*/,"", func_name);
|
|
||||||
sub(/[ \t]*,.*/,"", func_name);
|
|
||||||
# print func_name; # GJB:FIXME:: flag to do this to list primitives?
|
|
||||||
in_a_func = 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
/^\{/ && in_a_func {
|
;; This is a Guile Scheme script based on the AWK script
|
||||||
if (!match(last_line,/^#define[ \t]+FUNC_NAME[ \t]+/)) {
|
;; originally by Greg J. Badros <gjb@cs.washington.edu>.
|
||||||
printf filename ":" NR ":***" > "/dev/stderr";
|
;; It has the following improvements:
|
||||||
print "Missing or erroneous `#define FUNC_NAME s_" func_name "'" > "/dev/stderr";
|
;; - handle inhibition directives
|
||||||
} else {
|
;; - ignore a string literal ‘FUNC_NAME’
|
||||||
sub(/^#define[ \t]+FUNC_NAME[ \t]+s_/, "", last_line);
|
;; - on error, exit failurefully (after file is scanned)
|
||||||
sub(/[ \t]*$/,"",last_line);
|
;; - written in Scheme :-D
|
||||||
if (last_line != func_name) {
|
|
||||||
printf filename ":" NR ":***" > "/dev/stderr";
|
|
||||||
print "Mismatching FUNC_NAME. Should be: `#define FUNC_NAME s_" func_name "'" > "/dev/stderr";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
1 == next_line_better_be_undef {
|
;;; Code:
|
||||||
if (!match($0,/^#undef FUNC_NAME[ \t]*$/)) {
|
|
||||||
printf filename ":" NR ":***" > "/dev/stderr";
|
|
||||||
print "Missing or erroneous #undef for " func_name ": "
|
|
||||||
"Got `" $0 "' instead." > "/dev/stderr";
|
|
||||||
}
|
|
||||||
in_a_func = "";
|
|
||||||
func_name = "";
|
|
||||||
next_line_better_be_undef = 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
/^\}/ && in_a_func {
|
(use-modules
|
||||||
next_line_better_be_undef = 1;
|
((ice-9 regex) #:select (match:substring
|
||||||
}
|
match:end))
|
||||||
|
((ice-9 rdelim) #:select (read-line)))
|
||||||
|
|
||||||
{ last_line = $0; }
|
(define fse ; "format string to error-port"
|
||||||
|
(let ((cep (current-error-port)))
|
||||||
|
(lambda (s . args)
|
||||||
|
(apply simple-format cep s args))))
|
||||||
|
|
||||||
|
;; Global non-procedure variables have LOUD names.
|
||||||
|
(define FILENAME (cadr (command-line)))
|
||||||
|
(define FUNC-NAME "")
|
||||||
|
(define IN-A-FUNC? #f)
|
||||||
|
(define INHIBIT? #f)
|
||||||
|
(define LAST-LINE #f)
|
||||||
|
(define NEXT-LINE-BETTER-BE-UNDEF #f)
|
||||||
|
(define EXIT-VALUE #t)
|
||||||
|
|
||||||
|
(define (fatal lno s . args)
|
||||||
|
(fse "~A:~A:*** " FILENAME lno)
|
||||||
|
(apply fse s args)
|
||||||
|
(fse "~%")
|
||||||
|
(set! EXIT-VALUE #f))
|
||||||
|
|
||||||
|
(define MOE "Missing or erroneous") ; constant
|
||||||
|
|
||||||
|
;; By default, processing is uninhibited. In the scanned file, the comment:
|
||||||
|
;; /* guile-func-name-check: TEXT */
|
||||||
|
;; inhibits processing if TEXT is anything but "ok", and displays TEXT to stderr.
|
||||||
|
;; This is used in pairs.c, for example.
|
||||||
|
(define check-directive
|
||||||
|
(let ((rx (make-regexp "^.. guile-func-name-check: (.+) ..$")))
|
||||||
|
(lambda (line lno)
|
||||||
|
(and=> (regexp-exec rx line)
|
||||||
|
(lambda (m)
|
||||||
|
(set! INHIBIT? (not (string=? "ok" (match:substring m 1))))
|
||||||
|
(fse "~A:~A: ~A~%" FILENAME lno
|
||||||
|
(substring line 3 (match:end m 1))))))))
|
||||||
|
|
||||||
|
;; Extract the function name from "SCM_DEFINE (foo, ...".
|
||||||
|
;; FIXME: This loses if the open paren is on the next line.
|
||||||
|
(define check-SCM_DEFINE
|
||||||
|
(let ((rx (make-regexp "^SCM_DEFINE *.([^,]+)")))
|
||||||
|
(lambda (line)
|
||||||
|
(and=> (regexp-exec rx line)
|
||||||
|
(lambda (m)
|
||||||
|
(set! FUNC-NAME (match:substring m 1))
|
||||||
|
(or INHIBIT? (set! IN-A-FUNC? #t)))))))
|
||||||
|
|
||||||
|
;; Check that for "SCM_DEFINE (foo, ...)", we see:
|
||||||
|
;; #define FUNC_NAME s_foo
|
||||||
|
;; {
|
||||||
|
;; FIXME: This loses if #define is inside the curly brace.
|
||||||
|
(define check-curly-open
|
||||||
|
(let ((rx-curly (make-regexp "^\\{"))
|
||||||
|
(rx-string (make-regexp "\".+\""))
|
||||||
|
(rx-hash-define (make-regexp "^#define[ \t]+FUNC_NAME[ \t]+s_([^ \t]+)")))
|
||||||
|
(define (proper)
|
||||||
|
(string-append "#define FUNC_NAME s_" FUNC-NAME))
|
||||||
|
(lambda (line lno)
|
||||||
|
(and=> (and IN-A-FUNC? (regexp-exec rx-curly line))
|
||||||
|
(lambda (m)
|
||||||
|
(cond
|
||||||
|
((regexp-exec rx-string LAST-LINE)
|
||||||
|
;; Do nothing for C string-literal:
|
||||||
|
;; #define FUNC_NAME "foo"
|
||||||
|
)
|
||||||
|
((regexp-exec rx-hash-define LAST-LINE)
|
||||||
|
;; Found a well-formed #define, but does its name match?
|
||||||
|
=> (lambda (m)
|
||||||
|
(or (string=? (match:substring m 1) FUNC-NAME)
|
||||||
|
(fatal lno "Mismatching FUNC_NAME. Should be: `~A'"
|
||||||
|
(proper)))))
|
||||||
|
(else
|
||||||
|
(fatal lno "~A `~A'" MOE (proper)))))))))
|
||||||
|
|
||||||
|
;; If previous line closed the function, check that we see "#undef FUNC_NAME".
|
||||||
|
;; FIXME: This loses if #undef is inside the curly brace.
|
||||||
|
(define check-undef
|
||||||
|
(let ((rx (make-regexp "^#undef FUNC_NAME[ \t]*$")))
|
||||||
|
(lambda (line lno)
|
||||||
|
(cond (NEXT-LINE-BETTER-BE-UNDEF
|
||||||
|
(or (regexp-exec rx line)
|
||||||
|
(fatal lno "~A #undef for ~A: Got `~A' instead."
|
||||||
|
MOE FUNC-NAME line))
|
||||||
|
(set! IN-A-FUNC? #f)
|
||||||
|
(set! FUNC-NAME "")
|
||||||
|
(set! NEXT-LINE-BETTER-BE-UNDEF #f))))))
|
||||||
|
|
||||||
|
;; Note function closing.
|
||||||
|
(define check-curly-close
|
||||||
|
(let ((rx (make-regexp "^\\}")))
|
||||||
|
(lambda (line)
|
||||||
|
(and IN-A-FUNC? (regexp-exec rx line)
|
||||||
|
(set! NEXT-LINE-BETTER-BE-UNDEF #t)))))
|
||||||
|
|
||||||
|
;; The main loop.
|
||||||
|
(let ((p (open-input-file FILENAME)))
|
||||||
|
(let loop ((lno 1))
|
||||||
|
(let ((line (read-line p)))
|
||||||
|
(or (eof-object? line)
|
||||||
|
(begin (check-directive line lno)
|
||||||
|
(check-SCM_DEFINE line)
|
||||||
|
(check-curly-open line lno)
|
||||||
|
(check-undef line lno)
|
||||||
|
(check-curly-close line)
|
||||||
|
;; Remember this line for the next cycle.
|
||||||
|
(set! LAST-LINE line)
|
||||||
|
(loop (1+ lno))))))
|
||||||
|
(close-port p))
|
||||||
|
|
||||||
|
(exit EXIT-VALUE)
|
||||||
|
|
||||||
|
;;; guile-func-name-check ends here
|
||||||
|
|
|
||||||
|
|
@ -52,7 +52,7 @@ test "x$1" = x-- || bummer
|
||||||
shift
|
shift
|
||||||
|
|
||||||
# Before snarfing, do the function name check.
|
# Before snarfing, do the function name check.
|
||||||
${AWK} -f '@srcdir@/guile-func-name-check' "$input" || exit 1
|
'@top_builddir@/meta/guile' -s '@srcdir@/guile-func-name-check' "$input" || exit 1
|
||||||
|
|
||||||
# Snarfing takes two steps: cpp and tokenization.
|
# Snarfing takes two steps: cpp and tokenization.
|
||||||
# If cpp fails, don't bother with tokenization.
|
# If cpp fails, don't bother with tokenization.
|
||||||
|
|
|
||||||
|
|
@ -142,6 +142,7 @@ SCM_DEFINE (scm_set_cdr_x, "set-cdr!", 2, 0, 0,
|
||||||
while (pattern_var); \
|
while (pattern_var); \
|
||||||
return tree
|
return tree
|
||||||
|
|
||||||
|
/* guile-func-name-check: no thanks (rest of file: c[ad]r procs) */
|
||||||
|
|
||||||
SCM_DEFINE (scm_cdr, "cdr", 1, 0, 0, (SCM x), "")
|
SCM_DEFINE (scm_cdr, "cdr", 1, 0, 0, (SCM x), "")
|
||||||
{
|
{
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue