diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-07-13 11:36:17 +0200 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-07-13 11:36:17 +0200 |
| commit | 997f33a4973091569d487363419704f38b3d6c65 (patch) | |
| tree | 4699e73945b70c30690e5e6f9935c83c41d159c0 | |
| parent | Stringification operator now escapes quotes and backslashes. (diff) | |
| download | calp-997f33a4973091569d487363419704f38b3d6c65.tar.gz calp-997f33a4973091569d487363419704f38b3d6c65.tar.xz | |
Fix _Pragma, and non-standard pragma directives.
| -rw-r--r-- | module/c/preprocessor2.scm | 4 | ||||
| -rw-r--r-- | tests/test/cpp/preprocessor2.scm | 39 |
2 files changed, 33 insertions, 10 deletions
diff --git a/module/c/preprocessor2.scm b/module/c/preprocessor2.scm index ee6f2d9f..2677c42e 100644 --- a/module/c/preprocessor2.scm +++ b/module/c/preprocessor2.scm @@ -407,8 +407,8 @@ (_ (err))))) (else (format (current-output-port) - "Non-standard #Pragma: ~s~%" - (unlex (list tokens))) + "Non-standard #Pragma: ~a" + (unlex tokens)) environment)))) diff --git a/tests/test/cpp/preprocessor2.scm b/tests/test/cpp/preprocessor2.scm index 9b71e1ca..5e1bb736 100644 --- a/tests/test/cpp/preprocessor2.scm +++ b/tests/test/cpp/preprocessor2.scm @@ -769,16 +769,39 @@ X (test-group "Pragma" (test-group "#pragma" (test-equal "#Pragma STDC FP_CONTRACT ON" - (with-output-to-string (lambda () (run "#pragma STDC FP_CONTRACT ON")))) + (with-output-to-string (lambda () (run "#pragma STDC FP_CONTRACT ON"))))) - ) (test-group "_Pragma" - (test-equal "#Pragma STDC FP_CONTRACT ON" - (with-output-to-string - (lambda () (run "_Pragma(\"STDC FP_CONTRACT ON\")" - (extend-environment (make-environment) - (list - (@ (c preprocessor2) _Pragma-macro))))))))) + (let ((e (extend-environment (make-environment) + (list + (@ (c preprocessor2) _Pragma-macro))))) + (test-equal "#Pragma STDC FP_CONTRACT ON" + (with-output-to-string + (lambda () (run "_Pragma(\"STDC FP_CONTRACT ON\")" e)))) + + ;; 6.10.9 example + (test-group "Non-standard #Pragma: listing on \"..\\\\listing.dir\"" + ;; source: LISTING( ..\listing.dir ) + ;; dest: _Pragma( "listing on \"..\\listing.dir\"") + + (test-equal "Dry-run" + "pragma(\"listing on \\\"..\\\\\\\\listing.dir\\\"\")" + (unlex (run " +#define LISTING(x) PRAGMA(listing on #x) +#define PRAGMA(x) pragma(#x) +LISTING(..\\listing.dir)")) + ) + + (test-equal "With _Pragma" + "Non-standard #Pragma: listing on \"..\\\\listing.dir\"" + (with-output-to-string + (lambda () + (run " +#define LISTING(x) PRAGMA(listing on #x) +#define PRAGMA(x) _Pragma(#x) +LISTING(..\\listing.dir) +" e)))))) + )) ;; TODO ;; if |