~ chicken-core (chicken-5) 2c34b3f049e9304f96bc55661e1722a4f3fdc5ac

commit 2c34b3f049e9304f96bc55661e1722a4f3fdc5ac
Author:     LemonBoy <thatlemon@gmail.com>
AuthorDate: Wed May 3 21:06:11 2017 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Sun May 7 13:11:29 2017 +1200

    Fix the check for valid C identifiers
    
    We want to check the whole identifier, do not exit after the first
    successful check.
    
    We also add some tests for valid-c-identifier?
    
    Signed-off-by: Peter Bex <peter@more-magic.net>
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/distribution/manifest b/distribution/manifest
index 97f41d79..7e9c3adb 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -117,6 +117,7 @@ build-version.c
 buildid
 buildtag.h
 tests/clustering-tests.scm
+tests/c-id-valid.scm
 tests/data-structures-tests.scm
 tests/environment-tests.scm
 tests/gobble.scm
diff --git a/support.scm b/support.scm
index e8d70c63..3d2f413b 100644
--- a/support.scm
+++ b/support.scm
@@ -252,8 +252,8 @@
     (and (pair? str)
 	 (let ([c0 (car str)])
 	   (and (or (char-alphabetic? c0) (char=? #\_ c0))
-		(any (lambda (c) (or (char-alphabetic? c) (char-numeric? c) (char=? #\_ c)))
-		     (cdr str) ) ) ) ) ) )
+		(every (lambda (c) (or (char-alphabetic? c) (char-numeric? c) (char=? #\_ c)))
+		       (cdr str)))))))
 
 ;; TODO: Move these to (chicken memory)?
 (define bytes->words (foreign-lambda int "C_bytestowords" int))
diff --git a/tests/c-id-valid.scm b/tests/c-id-valid.scm
new file mode 100644
index 00000000..65c811fc
--- /dev/null
+++ b/tests/c-id-valid.scm
@@ -0,0 +1,14 @@
+(import (chicken compiler support))
+
+(define +invalid-ids+
+  '("-foo"
+    "foo?"
+    "7foo"
+    "foo-bar"
+    "ba!r"
+    "foo$"))
+
+(for-each
+  (lambda (x)
+    (assert (not (valid-c-identifier? x)) "invalid C identifier" x))
+  +invalid-ids+)
diff --git a/tests/runtests.bat b/tests/runtests.bat
index 714d1b52..6e1b9928 100644
--- a/tests/runtests.bat
+++ b/tests/runtests.bat
@@ -111,7 +111,7 @@ fft2 1000 7
 if errorlevel 1 exit /b 1
 
 echo ======================================== callback tests ...
-%compile% callback-tests.scm
+%compile% -extend c-id-valid.scm callback-tests.scm
 if errorlevel 1 exit /b 1
 a.out
 if errorlevel 1 exit /b 1
diff --git a/tests/runtests.sh b/tests/runtests.sh
index c3e16cdb..16fcb97f 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -131,7 +131,7 @@ echo "specialized:"
 $time ./fft2 1000 7
 
 echo "======================================== callback tests ..."
-$compile callback-tests.scm
+$compile -extend c-id-valid.scm callback-tests.scm
 ./a.out
 
 if ./a.out twice; then