diff --git a/lib/linguist/heuristics.rb b/lib/linguist/heuristics.rb index 392ab7f5..c512a38e 100644 --- a/lib/linguist/heuristics.rb +++ b/lib/linguist/heuristics.rb @@ -181,6 +181,14 @@ module Linguist end end + disambiguate "Common Lisp", "NewLisp" do |data| + if /^\s*\((defun|in-package|defpackage) /.match(data) + Language["Common Lisp"] + elsif /^\s*\(define /.match(data) + Language["NewLisp"] + end + end + disambiguate "TypeScript", "XML" do |data| if data.include?("'], # XML ['{-', '-}'], # Haskell ['(*', '*)'], # Coq - ['"""', '"""'] # Python + ['"""', '"""'], # Python + ["'''", "'''"] # Python ] START_SINGLE_LINE_COMMENT = Regexp.compile(SINGLE_LINE_COMMENTS.map { |c| diff --git a/samples/Common Lisp/sample.lsp b/samples/Common Lisp/sample.lsp new file mode 100644 index 00000000..9bef6781 --- /dev/null +++ b/samples/Common Lisp/sample.lsp @@ -0,0 +1,21 @@ +;;;; -*- lisp -*- + +(in-package :foo) + +;;; Header comment. +(defvar *foo*) + +(eval-when (:execute :compile-toplevel :load-toplevel) + (defun add (x &optional y &key z) + (declare (ignore z)) + ;; Inline comment. + (+ x (or y 1)))) + +#| +Multi-line comment. +|# + +(defmacro foo (x &body b) + (if x + `(1+ ,x) ;After-line comment. + 42)) diff --git a/samples/NewLisp/irc.lsp b/samples/NewLisp/irc.lsp new file mode 100644 index 00000000..0cac4034 --- /dev/null +++ b/samples/NewLisp/irc.lsp @@ -0,0 +1,239 @@ +#!/usr/bin/env newlisp + +;; @module IRC +;; @description a basic irc library +;; @version early alpha! 0.1 2013-01-02 20:11:22 +;; @author cormullion +;; Usage: +;; (IRC:init "newlithper") ; a username/nick (not that one obviously :-) +;; (IRC:connect "irc.freenode.net" 6667) ; irc/server +;; (IRC:join-channel {#newlisp}) ; join a room +;; either (IRC:read-irc-loop) ; loop - monitor only, no input +;; or (IRC:session) ; a command-line session, end with /QUIT + +(context 'IRC) + (define Inickname) + (define Ichannels) + (define Iserver) + (define Iconnected) + (define Icallbacks '()) + (define Idle-time 400) ; seconds + (define Itime-stamp) ; time since last message was processed + +(define (register-callback callback-name callback-function) + (println {registering callback for } callback-name { : } (sym (term callback-function) (prefix callback-function))) + (push (list callback-name (sym (term callback-function) (prefix callback-function))) Icallbacks)) + +(define (deregister-callback callback-name) + (println {deregistering callback for } callback-name) + (setf (assoc "idle-event" Icallbacks) nil) + (println {current callbacks: } Icallbacks)) + +(define (do-callback callback-name data) + (when (set 'func (lookup callback-name Icallbacks)) ; find first callback + (if-not (catch (apply func (list data)) 'error) + (println {error in callback } callback-name {: } error)))) + +(define (do-callbacks callback-name data) + (dolist (rf (ref-all callback-name Icallbacks)) + (set 'callback-entry (Icallbacks (first rf))) + (when (set 'func (last callback-entry)) + (if-not (catch (apply func (list data)) 'error) + (println {error in callback } callback-name {: } error))))) + +(define (init str) + (set 'Inickname str) + (set 'Iconnected nil) + (set 'Ichannels '()) + (set 'Itime-stamp (time-of-day))) + +(define (connect server port) + (set 'Iserver (net-connect server port)) + (net-send Iserver (format "USER %s %s %s :%s\r\n" Inickname Inickname Inickname Inickname)) + (net-send Iserver (format "NICK %s \r\n" Inickname)) + (set 'Iconnected true) + (do-callbacks "connect" (list (list "server" server) (list "port" port)))) + +(define (identify password) + (net-send Iserver (format "PRIVMSG nickserv :identify %s\r\n" password))) + +(define (join-channel channel) + (when (net-send Iserver (format "JOIN %s \r\n" channel)) + (push channel Ichannels) + (do-callbacks "join-channel" (list (list "channel" channel) (list "nickname" Inickname))))) + +(define (part chan) + (if-not (empty? chan) + ; leave specified + (begin + (net-send Iserver (format "PART %s\r\n" chan)) + (replace channel Ichannels) + (do-callbacks "part" (list (list "channel" channel)))) + ; leave all + (begin + (dolist (channel Ichannels) + (net-send Iserver (format "PART %s\r\n" channel)) + (replace channel Ichannels) + (do-callbacks "part" (list (list "channel" channel))))))) + +(define (do-quit message) + (do-callbacks "quit" '()) ; chance to do stuff before quit... + (net-send Iserver (format "QUIT :%s\r\n" message)) + (sleep 1000) + (set 'Ichannels '()) + (close Iserver) + (set 'Iconnected nil)) + +(define (privmsg user message) + (net-send Iserver (format "PRIVMSG %s :%s\r\n" user message))) + +(define (notice user message) + (net-send Iserver (format "NOTICE %s :%s\r\n" user message))) + +(define (send-to-server message (channel nil)) + (cond + ((starts-with message {/}) ; default command character + (set 'the-message (replace "^/" (copy message) {} 0)) ; keep original + (net-send Iserver (format "%s \r\n" the-message)) ; send it + ; do a quit + (if (starts-with (lower-case the-message) "quit") + (do-quit { enough}))) + (true + (if (nil? channel) + ; say to all channels + (dolist (c Ichannels) + (net-send Iserver (format "PRIVMSG %s :%s\r\n" c message))) + ; say to specified channel + (if (find channel Ichannels) + (net-send Iserver (format "PRIVMSG %s :%s\r\n" channel message)))))) + (do-callbacks "send-to-server" (list (list "channel" channel) (list "message" message)))) + +(define (process-command sender command text) + (cond + ((= sender "PING") + (net-send Iserver (format "PONG %s\r\n" command))) + ((or (= command "NOTICE") (= command "PRIVMSG")) + (process-message sender command text)) + ((= command "JOIN") + (set 'username (first (clean empty? (parse sender {!|:} 0)))) + (set 'channel (last (clean empty? (parse sender {!|:} 0)))) + (println {username } username { joined } channel) + (do-callbacks "join" (list (list "channel" channel) (list "username" username)))) + (true + nil))) + +(define (process-message sender command text) + (let ((username {} target {} message {})) + (set 'username (first (clean empty? (parse sender {!|:} 0)))) + (set 'target (trim (first (clean empty? (parse text {!|:} 0))))) + (set 'message (slice text (+ (find {:} text) 1))) + (cond + ((starts-with message "\001") + (process-ctcp username target message)) + ((find target Ichannels) + (cond + ((= command {PRIVMSG}) + (do-callbacks "channel-message" (list (list "channel" target) (list "username" username) (list "message" message)))) + ((= command {NOTICE}) + (do-callbacks "channel-notice" (list (list "channel" target) (list "username" username) (list "message" message)))))) + ((= target Inickname) + (cond + ((= command {PRIVMSG}) + (do-callbacks "private-message" (list (list "username" username) (list "message" message)))) + ((= command {NOTICE}) + (do-callbacks "private-notice" (list (list "username" username) (list "message" message)))))) + (true + nil)))) + +(define (process-ctcp username target message) + (cond + ((starts-with message "\001VERSION\001") + (net-send Iserver (format "NOTICE %s :\001VERSION %s\001\r\n" username message))) + ((starts-with message "\001PING") + (set 'data (first (rest (clean empty? (parse message { } 0))))) + (set 'data (trim data "\001" "\001")) + (net-send Iserver (format "NOTICE %s :\001PING %s\001\r\n" username data))) + ((starts-with message "\001ACTION") +; (set 'data (first (rest (clean empty? (parse message { } 0))))) +; (set 'data (join data { })) +; (set 'data (trim data "\001" "\001")) + (if (find target Ichannels) + (do-callbacks "channel-action" (list (list "username" username) (list "message" message)))) + (if (= target Inickname) + (do-callbacks "private-action" (list (list "username" username) (list "message" message))))) + ((starts-with message "\001TIME\001") + (net-send Iserver (format "NOTICE %s:\001TIME :%s\001\r\n" username (date)))))) + +(define (parse-buffer raw-buffer) + (let ((messages (clean empty? (parse raw-buffer "\r\n" 0))) + (sender {} command {} text {})) + ; check for elapsed time since last activity + (when (> (sub (time-of-day) Itime-stamp) (mul Idle-time 1000)) + (do-callbacks "idle-event") + (set 'Itime-stamp (time-of-day))) + (dolist (message messages) + (set 'message-parts (parse message { })) + (unless (empty? message-parts) + (set 'sender (first message-parts)) + (catch (set 'command (first (rest message-parts))) 'error) + (catch (set 'text (join (rest (rest message-parts)) { })) 'error)) + (process-command sender command text)))) + +(define (read-irc) + (let ((buffer {})) + (when (!= (net-peek Iserver) 0) + (net-receive Iserver buffer 8192 "\n") + (unless (empty? buffer) + (parse-buffer buffer))))) + +(define (read-irc-loop) ; monitoring + (let ((buffer {})) + (while Iconnected + (read-irc) + (sleep 1000)))) + +(define (print-raw-message data) ; example of using a callback + (set 'raw-data (lookup "message" data)) + (set 'channel (lookup "channel" data)) + (set 'message-text raw-data) + (println (date (date-value) 0 {%H:%M:%S }) username {> } message-text)) + +(define (print-outgoing-message data) + (set 'raw-data (lookup "message" data)) + (set 'channel (lookup "channel" data)) + (set 'message-text raw-data) + (println (date (date-value) 0 {%H:%M:%S }) Inickname {> } message-text)) + +(define (session); interactive terminal + ; must add callbacks to display messages + (register-callback "channel-message" 'print-raw-message) + (register-callback "send-to-server" 'print-outgoing-message) + (while Iconnected + (while (zero? (peek 0)) + (read-irc) + (sleep 1000)) + (send-to-server (string (read-line 0)))) + (println {finished session } (date)) + (exit)) + +; end of IRC code + +[text] + +simple bot code: +(load (string (env {HOME}) {/projects/programming/newlisp-projects/irc.lsp})) +(context 'BOT) +(define bot-name "bot") +(define (join-channel data) + (println {in BOT:join-channel with data: } data)) +(define (process-message data) + ????) +(IRC:register-callback "join-channel" 'join-channel) +(IRC:register-callback "channel-message" 'process-message) +(IRC:register-callback "idle-event" 'do-idle-event) +(IRC:register-callback "send-to-server" 'do-send-event) +(IRC:init bot-name) +(IRC:connect "irc.freenode.net" 6667) +(IRC:join-channel {#newlisp}) +(IRC:read-irc-loop) +[/text] \ No newline at end of file diff --git a/samples/NewLisp/log-to-database.lisp b/samples/NewLisp/log-to-database.lisp new file mode 100644 index 00000000..60af8406 --- /dev/null +++ b/samples/NewLisp/log-to-database.lisp @@ -0,0 +1,195 @@ +(module "sqlite3.lsp") ; loads the SQLite3 database module + +; FUNCTIONS------------------------------------------------- + +(define (displayln str-to-display) + (println str-to-display) +) + +(define (open-database sql-db-to-open) + (if (sql3:open (string sql-db-to-open ".db")) + (displayln "") + (displayln "There was a problem opening the database " sql-db-to-open ": " (sql3:error)))) + +(define (close-database) + (if (sql3:close) + (displayln "") + (displayln "There was a problem closing the database: " (sql3:error)))) + +;====== SAFE-FOR-SQL =============================================================== +; this function makes strings safe for inserting into SQL statements +; to avoid SQL injection issues +; it's simple right now but will add to it later +;=================================================================================== +(define (safe-for-sql str-sql-query) + (if (string? str-sql-query) (begin + (replace "&" str-sql-query "&") + (replace "'" str-sql-query "'") + (replace "\"" str-sql-query """) + )) + (set 'result str-sql-query)) + +(define (query sql-text) + (set 'sqlarray (sql3:sql sql-text)) ; results of query + (if sqlarray + (setq query-return sqlarray) + (if (sql3:error) + (displayln (sql3:error) " query problem ") + (setq query-return nil)))) + +(define-macro (create-record) + ; first save the values + (set 'temp-record-values nil) + (set 'temp-table-name (first (args))) + ;(displayln "
Arguments: " (args)) + (dolist (s (rest (args))) (push (eval s) temp-record-values -1)) + ; now save the arguments as symbols under the context "DB" + (dolist (s (rest (args))) + (set 'temp-index-num (string $idx)) ; we need to number the symbols to keep them in the correct order + (if (= (length temp-index-num) 1) (set 'temp-index-num (string "0" temp-index-num))) ; leading 0 keeps the max at 100. + (sym (string temp-index-num s) 'DB)) + ; now create the sql query + (set 'temp-sql-query (string "INSERT INTO " temp-table-name " (")) + ;(displayln "

TABLE NAME: " temp-table-name) + ;(displayln "

SYMBOLS: " (symbols DB)) + ;(displayln "
VALUES: " temp-record-values) + (dolist (d (symbols DB)) (extend temp-sql-query (rest (rest (rest (rest (rest (string d)))))) ", ")) + (set 'temp-sql-query (chop (chop temp-sql-query))) + (extend temp-sql-query ") VALUES (") + (dolist (q temp-record-values) + (if (string? q) (extend temp-sql-query "'")) ; only quote if value is non-numeric + (extend temp-sql-query (string (safe-for-sql q))) + (if (string? q) (extend temp-sql-query "'")) ; close quote if value is non-numeric + (extend temp-sql-query ", ")) ; all values are sanitized to avoid SQL injection + (set 'temp-sql-query (chop (chop temp-sql-query))) + (extend temp-sql-query ");") + ;(displayln "

***** SQL QUERY: " temp-sql-query) + (displayln (query temp-sql-query)) ; actually run the query against the database + (delete 'DB) ; we're done, so delete all symbols in the DB context. +) + +(define-macro (update-record) + ; first save the values + (set 'temp-record-values nil) + (set 'temp-table-name (first (args))) + (set 'continue true) ; debugging + (dolist (s (rest (args))) (push (eval s) temp-record-values -1)) + ; now save the arguments as symbols under the context "D2" + (dolist (st (rest (args))) + (set 'temp-index-num (string $idx)) ; we need to number the symbols to keep them in the correct order + (if (= (length temp-index-num) 1) (set 'temp-index-num (string "0" temp-index-num))) ; leading 0 keeps the max at 100. + ;(displayln "
SYMBOL>>>>" (string temp-index-num st) "<<<") ; debugging + (sym (string temp-index-num st) 'D2) + ) + (if continue (begin ; --- temporary debugging + ; now create the sql query + (set 'temp-sql-query (string "UPDATE " temp-table-name " SET ")) + ;(displayln "

TABLE NAME: " temp-table-name) + ;(displayln "

SYMBOLS: " (symbols D2)) + ;(displayln "
VALUES: " temp-record-values) + (dolist (d (rest (symbols D2))) ; ignore the first argument, as it will be the ConditionColumn for later + (extend temp-sql-query (rest (rest (rest (rest (rest (string d)))))) "=") + (set 'q (temp-record-values (+ $idx 1))) + (if (string? q) (extend temp-sql-query "'")) ; only quote if value is non-numeric + (extend temp-sql-query (string (safe-for-sql q))) + (if (string? q) (extend temp-sql-query "'")) ; close quote if value is non-numeric + (extend temp-sql-query ", ") ; all values are sanitized to avoid SQL injection + ) + (set 'temp-sql-query (chop (chop temp-sql-query))) + ; okay now add the ConditionColumn value + (extend temp-sql-query (string " WHERE " (rest (rest (rest (rest (rest (string (first (symbols D2)))))))) "=")) + (if (string? (first temp-record-values)) (extend temp-sql-query "'")) + (extend temp-sql-query (string (safe-for-sql (first temp-record-values)))) + (if (string? (first temp-record-values)) (extend temp-sql-query "'")) + (extend temp-sql-query ";") + ;(displayln "

***** SQL QUERY: " temp-sql-query) + (query temp-sql-query) ; actually run the query against the database + (delete 'D2) ; we're done, so delete all symbols in the DB context. + )) ; --- end temporary debugging +) + +(define-macro (delete-record) + (set 'temp-table-name (first (args))) + (set 'temp-record-values nil) + (dolist (s (rest (args))) (push (eval s) temp-record-values -1)) ; only one value for NOW... + (sym (first (rest (args))) 'DB) ; put the second argument (for now) into a symbol in the DB context + ; this will have to be in a dolist loop of (rest (args)) when I add more + (set 'temp-sql-query (string "DELETE FROM " temp-table-name " WHERE ")) + (dolist (d (symbols DB)) (extend temp-sql-query (rest (rest (rest (string d)))))) + (extend temp-sql-query "=") + ; why am I doing a loop here? There should be only one value, right? But maybe for future extension... + (dolist (q temp-record-values) + (if (string? q) (extend temp-sql-query "'")) ; only quote if value is non-numeric + (extend temp-sql-query (string (safe-for-sql q))) + (if (string? q) (extend temp-sql-query "'"))) ; close quote if value is non-numeric + (extend temp-sql-query ";") + ;(displayln "TEMP-DELETE-QUERY: " temp-sql-query) + (query temp-sql-query) + (delete 'DB) ; we're done, so delete all symbols in the DB context. +) + +(define-macro (get-record) + (set 'temp-table-name (first (args))) + ; if you have more arguments than just the table name, they become the elements of the WHERE clause + (if (> (length (args)) 1) (begin + (set 'temp-record-values nil) + (dolist (s (rest (args))) (push (eval s) temp-record-values -1)) ; only one value for NOW... + (sym (first (rest (args))) 'DB) ; put the second argument (for now) into a symbol in the DB context + ; this will have to be in a dolist loop of (rest (args)) when I add more + (set 'temp-sql-query (string "SELECT * FROM " temp-table-name " WHERE ")) + (dolist (d (symbols DB)) (extend temp-sql-query (rest (rest (rest (string d)))))) + (extend temp-sql-query "=") + ; why am I doing a loop here? There should be only one value, right? But maybe for future extension... + (dolist (q temp-record-values) + (if (string? q) (extend temp-sql-query "'")) ; only quote if value is non-numeric + (extend temp-sql-query (string (safe-for-sql q))) + (if (string? q) (extend temp-sql-query "'"))) ; close quote if value is non-numeric + (extend temp-sql-query ";") + ) + ; otherwise, just get everything in that table + (set 'temp-sql-query (string "SELECT * FROM " temp-table-name ";")) + ) + ;(displayln "TEMP-GET-QUERY: " temp-sql-query) + (delete 'DB) ; we're done, so delete all symbols in the DB context. + (set 'return-value (query temp-sql-query)) ; this returns a list of everything in the record +) + +; END FUNCTIONS =================== + + +(open-database "SERVER-LOGS") +(query "CREATE TABLE Logs (Id INTEGER PRIMARY KEY, IP TEXT, UserId TEXT, UserName TEXT, Date DATE, Request TEXT, Result TEXT, Size INTEGER, Referrer TEXT, UserAgent TEXT)") +;(print (query "SELECT * from SQLITE_MASTER;")) +(set 'access-log (read-file "/var/log/apache2/access.log")) +(set 'access-list (parse access-log "\n")) +(set 'max-items (integer (first (first (query "select count(*) from Logs"))))) +(println "Number of items in database: " max-items) +(println "Number of lines in log: " (length access-list)) +(dolist (line access-list) + (set 'line-list (parse line)) + ;(println "Line# " $idx " - " line-list) + ;(println "Length of line: " (length line-list)) + (if (> (length line-list) 0) (begin + (++ max-items) + (set 'Id max-items) (print $idx "/" (length access-list)) + (set 'IP (string (line-list 0) (line-list 1) (line-list 2))) + (set 'UserId (line-list 3)) + (set 'UserName (line-list 4)) + (set 'Date (line-list 5)) + (set 'Date (trim Date "[")) + (set 'Date (trim Date "]")) + ;(println "DATE: " Date) + (set 'date-parsed (date-parse Date "%d/%b/%Y:%H:%M:%S -0700")) + ;(println "DATE-PARSED: " date-parsed) + (set 'Date (date date-parsed 0 "%Y-%m-%dT%H:%M:%S")) + (println " " Date) + (set 'Request (line-list 6)) + (set 'Result (line-list 7)) + (set 'Size (line-list 8)) + (set 'Referrer (line-list 9)) + (set 'UserAgent (line-list 10)) + (create-record "Logs" Id IP UserId UserName Date Request Result Size Referrer UserAgent) + )) +) +(close-database) +(exit) \ No newline at end of file diff --git a/samples/Pascal/cwindirs.pp b/samples/Pascal/cwindirs.pp new file mode 100644 index 00000000..d97895e3 --- /dev/null +++ b/samples/Pascal/cwindirs.pp @@ -0,0 +1,121 @@ + +unit cwindirs; + + + + +interface + +uses + windows, + strings; + +Const + CSIDL_PROGRAMS = $0002; + CSIDL_PERSONAL = $0005; + CSIDL_FAVORITES = $0006; + CSIDL_STARTUP = $0007; + CSIDL_RECENT = $0008; + CSIDL_SENDTO = $0009; + CSIDL_STARTMENU = $000B; + CSIDL_MYMUSIC = $000D; + CSIDL_MYVIDEO = $000E; + CSIDL_DESKTOPDIRECTORY = $0010; + CSIDL_NETHOOD = $0013; + CSIDL_TEMPLATES = $0015; + CSIDL_COMMON_STARTMENU = $0016; + CSIDL_COMMON_PROGRAMS = $0017; + CSIDL_COMMON_STARTUP = $0018; + CSIDL_COMMON_DESKTOPDIRECTORY = $0019; + CSIDL_APPDATA = $001A; + CSIDL_PRINTHOOD = $001B; + CSIDL_LOCAL_APPDATA = $001C; + CSIDL_COMMON_FAVORITES = $001F; + CSIDL_INTERNET_CACHE = $0020; + CSIDL_COOKIES = $0021; + CSIDL_HISTORY = $0022; + CSIDL_COMMON_APPDATA = $0023; + CSIDL_WINDOWS = $0024; + CSIDL_SYSTEM = $0025; + CSIDL_PROGRAM_FILES = $0026; + CSIDL_MYPICTURES = $0027; + CSIDL_PROFILE = $0028; + CSIDL_PROGRAM_FILES_COMMON = $002B; + CSIDL_COMMON_TEMPLATES = $002D; + CSIDL_COMMON_DOCUMENTS = $002E; + CSIDL_COMMON_ADMINTOOLS = $002F; + CSIDL_ADMINTOOLS = $0030; + CSIDL_COMMON_MUSIC = $0035; + CSIDL_COMMON_PICTURES = $0036; + CSIDL_COMMON_VIDEO = $0037; + CSIDL_CDBURN_AREA = $003B; + CSIDL_PROFILES = $003E; + + CSIDL_FLAG_CREATE = $8000; + +Function GetWindowsSpecialDir(ID : Integer) : String; + +implementation + +uses + sysutils; + +Type + PFNSHGetFolderPath = Function(Ahwnd: HWND; Csidl: Integer; Token: THandle; Flags: DWord; Path: PChar): HRESULT; stdcall; + + +var + SHGetFolderPath : PFNSHGetFolderPath = Nil; + CFGDLLHandle : THandle = 0; + +Procedure InitDLL; + +Var + pathBuf: array[0..MAX_PATH-1] of char; + pathLength: Integer; +begin + { Load shfolder.dll using a full path, in order to prevent spoofing (Mantis #18185) + Don't bother loading shell32.dll because shfolder.dll itself redirects SHGetFolderPath + to shell32.dll whenever possible. } + pathLength:=GetSystemDirectory(pathBuf, MAX_PATH); + if (pathLength>0) and (pathLength0) then + begin + Pointer(ShGetFolderPath):=GetProcAddress(CFGDLLHandle,'SHGetFolderPathA'); + If @ShGetFolderPath=nil then + begin + FreeLibrary(CFGDLLHandle); + CFGDllHandle:=0; + end; + end; + end; + If (@ShGetFolderPath=Nil) then + Raise Exception.Create('Could not determine SHGetFolderPath Function'); +end; + +Function GetWindowsSpecialDir(ID : Integer) : String; + +Var + APath : Array[0..MAX_PATH] of char; + +begin + Result:=''; + if (CFGDLLHandle=0) then + InitDLL; + If (SHGetFolderPath<>Nil) then + begin + if SHGetFolderPath(0,ID or CSIDL_FLAG_CREATE,0,0,@APATH[0])=S_OK then + Result:=IncludeTrailingPathDelimiter(StrPas(@APath[0])); + end; +end; + +Initialization +Finalization + if CFGDLLHandle<>0 then + FreeLibrary(CFGDllHandle); +end. + diff --git a/samples/Pascal/gtkextra.pp b/samples/Pascal/gtkextra.pp deleted file mode 100644 index 9f2ebf8c..00000000 --- a/samples/Pascal/gtkextra.pp +++ /dev/null @@ -1,51 +0,0 @@ -{ $Id$ } -{ - --------------------------------------------------------------------------- - gtkextra.pp - GTK(2) widgetset - additional gdk/gtk functions - --------------------------------------------------------------------------- - - This unit contains missing gdk/gtk functions and defines for certain - versions of gtk or fpc. - - --------------------------------------------------------------------------- - - @created(Sun Jan 28th WET 2006) - @lastmod($Date$) - @author(Marc Weustink ) - - ***************************************************************************** - This file is part of the Lazarus Component Library (LCL) - - See the file COPYING.modifiedLGPL.txt, included in this distribution, - for details about the license. - ***************************************************************************** - } - -unit GtkExtra; - -{$mode objfpc}{$H+} - -interface - -{$I gtkdefines.inc} - -{$ifdef gtk1} -{$I gtk1extrah.inc} -{$endif} - -{$ifdef gtk2} -{$I gtk2extrah.inc} -{$endif} - - -implementation - -{$ifdef gtk1} -{$I gtk1extra.inc} -{$endif} - -{$ifdef gtk2} -{$I gtk2extra.inc} -{$endif} - -end. diff --git a/samples/Pascal/large.pp b/samples/Pascal/large.pp new file mode 100644 index 00000000..9e0f4867 --- /dev/null +++ b/samples/Pascal/large.pp @@ -0,0 +1,22 @@ +program large; + + const + max = 100000000; + + type + tlist = array[1..max] of longint; + + var + data : tlist; + i : integer; + +begin + + i := 0; + while(i < max) + do + begin + data[i] := 0; + Writeln(data[i]) + end +end. diff --git a/samples/Pascal/tw27294.pp b/samples/Pascal/tw27294.pp new file mode 100644 index 00000000..34d14f5d --- /dev/null +++ b/samples/Pascal/tw27294.pp @@ -0,0 +1,26 @@ +uses + uw27294; + +var + p : procedure; + +procedure test; + +begin + p:=@test; + writeln('OK'); +end; + +procedure global; +begin + p:=nil; + test; + p(); +end; + +begin + global; + uw27294.global; +end. + + diff --git a/test/test_heuristics.rb b/test/test_heuristics.rb index 785fe58e..b88d0fda 100644 --- a/test/test_heuristics.rb +++ b/test/test_heuristics.rb @@ -133,6 +133,13 @@ class TestHeuristcs < Minitest::Test }) end + def test_lsp_by_heuristics + assert_heuristics({ + "Common Lisp" => all_fixtures("Common Lisp"), + "NewLisp" => all_fixtures("NewLisp") + }) + end + def test_cs_by_heuristics assert_heuristics({ "C#" => all_fixtures("C#", "*.cs"), diff --git a/test/test_tokenizer.rb b/test/test_tokenizer.rb index 24a74105..339d5485 100644 --- a/test/test_tokenizer.rb +++ b/test/test_tokenizer.rb @@ -41,6 +41,8 @@ class TestTokenizer < Minitest::Test assert_equal %w(foo), tokenize("foo {- Comment -}") assert_equal %w(foo), tokenize("foo (* Comment *)") assert_equal %w(%), tokenize("2 % 10\n% Comment") + assert_equal %w(foo bar), tokenize("foo\n\"\"\"\nComment\n\"\"\"\nbar") + assert_equal %w(foo bar), tokenize("foo\n'''\nComment\n'''\nbar") end def test_sgml_tags