[Guile-commits] GNU Guile branch, master, updated. release_1-9-11-275-g6832604

[Thien-Thi Nguyen]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=6832604efa0f175a70be700624c365547fb27878

The branch, master has been updated
       via  6832604efa0f175a70be700624c365547fb27878 (commit)
      from  e6d67f1e6913acb884dbacc48670d312e9880782 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 6832604efa0f175a70be700624c365547fb27878
Author: Thien-Thi Nguyen <address@hidden>
Date:   Thu Aug 26 23:21:41 2010 +0200

    [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 address@hidden@/meta/guile’.
    * libguile/pairs.c: Add guile-func-name-check inhibition directive.

-----------------------------------------------------------------------

Summary of changes:
 libguile/guile-func-name-check |  211 +++++++++++++++++++++++++++------------
 libguile/guile-snarf-docs.in   |    2 +-
 libguile/pairs.c               |    1 +
 3 files changed, 148 insertions(+), 66 deletions(-)

diff --git a/libguile/guile-func-name-check b/libguile/guile-func-name-check
index 8b4924e..986d0d5 100644
--- a/libguile/guile-func-name-check
+++ b/libguile/guile-func-name-check
@@ -1,65 +1,146 @@
-#!/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, <address@hidden>
-# 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; }
+;;; 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 <address@hidden>.
+;; 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
diff --git a/libguile/guile-snarf-docs.in b/libguile/guile-snarf-docs.in
index c33a5ec..37e5d90 100755
--- a/libguile/guile-snarf-docs.in
+++ b/libguile/guile-snarf-docs.in
@@ -52,7 +52,7 @@ test "x$1" = x-- || bummer
 shift
 
 # 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.
 # If cpp fails, don't bother with tokenization.
diff --git a/libguile/pairs.c b/libguile/pairs.c
index 68fa4c9..0f40464 100644
--- a/libguile/pairs.c
+++ b/libguile/pairs.c
@@ -142,6 +142,7 @@ SCM_DEFINE (scm_set_cdr_x, "set-cdr!", 2, 0, 0,
   while (pattern_var);                                                  \
   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), "")
 {


hooks/post-receive
-- 
GNU Guile