Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Hugo Ishimaru
asdf
Commits
bd121420
Commit
bd121420
authored
May 03, 2015
by
Francois-Rene Rideau
Browse files
Fix find-standard-case-symbol.
Add relevant tests.
parent
9120cf7a
Changes
2
Hide whitespace changes
Inline
Side-by-side
test/test-utilities.script
View file @
bd121420
...
...
@@ -347,3 +347,29 @@
#+mkcl (DBG :os i q s (assoc q s))
(assert-equal i (second (assoc q s))))))
(assert-equal (get-optimization-settings) settings))
(DBG :standard-case-symbol-name)
(if (or #+allegro (eq excl:*current-case-mode* :case-sensitive-lower))
(push :modern-syntax *features*)
(setf *features* (remove :modern-syntax *features*)))
(assert-equal (standard-case-symbol-name "foo") #-modern-syntax "FOO" #+modern-syntax "foo")
(assert-equal (standard-case-symbol-name "BaR") #-modern-syntax "BAR" #+modern-syntax "BaR")
(assert-equal (standard-case-symbol-name "BAZ") #-modern-syntax "BAZ" #+modern-syntax "BAZ")
(assert-equal (standard-case-symbol-name :foo) #-modern-syntax "FOO" #+modern-syntax "foo")
(assert-equal (standard-case-symbol-name 'BaR) #-modern-syntax "BAR" #+modern-syntax "BaR")
(assert-equal (standard-case-symbol-name '#:BAZ) #-modern-syntax "BAZ" #+modern-syntax "BAZ")
(assert-equal (standard-case-symbol-name :|foo|) "foo")
(assert-equal (standard-case-symbol-name '|BaR|) "BaR")
(assert-equal (standard-case-symbol-name '#:|BAZ|) "BAZ")
(DBG :find-standard-case-symbol)
(assert-equal 'symbol (find-standard-case-symbol "symbol" "asdf-test"))
(assert-equal 'Symbol (find-standard-case-symbol "Symbol" "asdf-test"))
(assert-equal 'SYMBOL (find-standard-case-symbol "SYMBOL" "asdf-test"))
(assert-equal '|lowercase| (find-standard-case-symbol :|lowercase| :asdf-test))
(assert-equal '|CamelCase| (find-standard-case-symbol :|CamelCase| :asdf-test))
(assert-equal '|UPPER-CASE| (find-standard-case-symbol :|UPPER-CASE| :asdf-test))
(assert-equal #-modern-syntax '|THIS_SYMBOL| #+modern-syntax '|This_Symbol|
(find-standard-case-symbol "This_Symbol" "asdf-test"))
uiop/utility.lisp
View file @
bd121420
...
...
@@ -332,22 +332,24 @@ the two results passed to STRCAT always reconstitute the original string"
(
when
x
(
c
+crlf+
)
(
c
+lf+
)
(
c
+cr+
)
(
values
x
nil
)))))
(
defun
standard-case-symbol-name
(
name-designator
)
"Given a NAME-DESIGNATOR for a symbol, convert it to a string, using STRING-UPCASE on an ANSI CL
platform, or STRING on a so-called \"modern\" platform such as Allegro with modern syntax."
"Given a NAME-DESIGNATOR for a symbol, if it is a symbol, convert it to a string using STRING;
if it is a string, use STRING-UPCASE on an ANSI CL platform, or STRING on a so-called \"modern\"
platform such as Allegro with modern syntax."
(
check-type
name-designator
(
or
string
symbol
))
(
cond
((
or
(
symbolp
name-designator
)
#+
allegro
(
eq
excl:*current-case-mode*
:case-sensitive-lower
))
(
string
name-designator
))
;; Should we be doing something on CLISP?
#+
allegro
((
eq
excl:*current-case-mode*
:case-sensitive-lower
)
(
string
name-designator
))
(
t
(
string-upcase
name-designator
))))
(
defun
find-standard-case-symbol
(
name-designator
package-designator
&optional
(
error
t
))
"Find a symbol in a package the name of which is designated by NAME-DESIGNATOR;
NAME-DESIGNATOR and PACKAGE-DESIGNATOR will be converted to a string using STRING-DESIGNATOR on an
ANSI CL platform, or STRING on a so-called \"modern\" platform such as Allegro with modern syntax.
"Find a symbol designated by NAME-DESIGNATOR in a package designated by PACKAGE-DESIGNATOR,
where STANDARD-CASE-SYMBOL-NAME is used to transform them if these designators are strings.
If optional ERROR argument is NIL, return NIL instead of an error when the symbol is not found."
(
find-symbol*
(
standard-case-symbol-name
name-designator
)
(
etypecase
package-designator
((
or
package
nul
l
)
package-designator
)
(
(
or
string
symbol
)))
((
or
package
symbo
l
)
package-designator
)
(
string
(
standard-case-symbol-name
package-designator
)))
error
)))
;;; stamps: a REAL or a boolean where NIL=-infinity, T=+infinity
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment