X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/6832604efa0f175a70be700624c365547fb27878..34ff3af9f0024c6d5163f422ca5e1202a560efe3:/libguile/guile-func-name-check diff --git a/libguile/guile-func-name-check b/libguile/guile-func-name-check dissimilarity index 99% index 986d0d52d..8b4924e91 100644 --- a/libguile/guile-func-name-check +++ b/libguile/guile-func-name-check @@ -1,146 +1,65 @@ -;;; guile-func-name-check -*- scheme -*- - -;; Copyright (C) 2000, 2001, 2006, 2010 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 - -;;; Commentary: - -;; This is a Guile Scheme script based on the AWK script -;; originally by Greg J. Badros . -;; It has the following improvements: -;; - handle inhibition directives -;; - ignore a string literal ‘FUNC_NAME’ -;; - on error, exit failurefully (after file is scanned) -;; - written in Scheme :-D - -;;; Code: - -(use-modules - ((ice-9 regex) #:select (match:substring - match:end)) - ((ice-9 rdelim) #:select (read-line))) - -(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 +#!/usr/bin/awk -f +# +# 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, +# 11-Jan-2000 + +BEGIN { + filename = ARGV[1]; + in_a_func = 0; +} + +/^SCM_DEFINE/ { + 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 { + if (!match(last_line,/^#define[ \t]+FUNC_NAME[ \t]+/)) { + printf filename ":" NR ":***" > "/dev/stderr"; + print "Missing or erroneous `#define FUNC_NAME s_" func_name "'" > "/dev/stderr"; + } else { + sub(/^#define[ \t]+FUNC_NAME[ \t]+s_/, "", last_line); + sub(/[ \t]*$/,"",last_line); + 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 { + 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 { + next_line_better_be_undef = 1; +} + +{ last_line = $0; }