Compare commits

...

11 Commits

@ -23,7 +23,7 @@ $(CURDIR): ./data/builtin-stubs-index.eld.gz
$(RUN_EMACS) -l phpinspect-cache -f phpinspect-dump-stub-index $(RUN_EMACS) -l phpinspect-cache -f phpinspect-dump-stub-index
%.elc: %.el %.elc: %.el
$(RUN_EMACS) --eval '(setq byte-compile-error-on-warn t)' -f batch-byte-compile $< $(RUN_EMACS) --eval '(setq byte-compile-error-on-warn nil)' -f batch-byte-compile $<
.PHONY: deps .PHONY: deps
deps: ./.deps deps: ./.deps

@ -1,3 +1,26 @@
;;; stubs.el --- Benchmarks of phpinspect stub index dump and load times -*- lexical-binding: t; -*-
;; Copyright (C) 2023 Free Software Foundation, Inc
;; Author: Hugo Thunnissen <devel@hugot.nl>
;; Keywords: benchmark
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, 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 General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'phpinspect-cache) (require 'phpinspect-cache)

@ -21,11 +21,14 @@
;;; Commentary: ;;; Commentary:
;; FIXME: Storage mechanism for abstract methods is missing (@abstract-method)
;;; Code: ;;; Code:
(require 'phpinspect-project) (require 'phpinspect-project)
(require 'phpinspect-autoload) (require 'phpinspect-autoload)
(require 'phpinspect-worker) (require 'phpinspect-worker)
(require 'inline)
(defcustom phpinspect-load-stubs t (defcustom phpinspect-load-stubs t
"If and when phpinspect should load code stubs." "If and when phpinspect should load code stubs."
@ -172,7 +175,7 @@ currently opened projects."
(cl-defmethod phpinspect--cache-get-project-create (cl-defmethod phpinspect--cache-get-project-create
((cache phpinspect--cache) (project-root string)) ((cache phpinspect--cache) (project-root string))
"Get a project that is located in PROJECT-ROOT from CACHE. "Get a project that is located in PROJECT-ROOT from CACHE.
If no such project exists in the cache yet, it is created and If no such project exists in the cache yet, it is created and
then returned." then returned."
(let ((project (phpinspect--cache-get-project cache project-root))) (let ((project (phpinspect--cache-get-project cache project-root)))
@ -251,7 +254,9 @@ then returned."
(phpinspect-project-add-index builtin-project (phpinspect-build-stub-index)))) (phpinspect-project-add-index builtin-project (phpinspect-build-stub-index))))
(defun phpinspect-build-stub-index () (defun phpinspect-build-stub-index ()
(phpinspect--index-tokens (phpinspect-parse-file (expand-file-name "builtins.php" phpinspect-stub-directory)))) (phpinspect--index-tokens
(phpinspect-parse-file
(expand-file-name "builtins.php" phpinspect-stub-directory))))
(defun phpinspect-dump-stub-index () (defun phpinspect-dump-stub-index ()
(interactive) (interactive)
@ -286,5 +291,849 @@ then returned."
(puthash "builtins" project (phpinspect--cache-projects phpinspect-stub-cache)) (puthash "builtins" project (phpinspect--cache-projects phpinspect-stub-cache))
(setf (phpinspect--cache-read-only-p phpinspect-stub-cache) t))) (setf (phpinspect--cache-read-only-p phpinspect-stub-cache) t)))
(cl-defstruct (phpinspect-bidi-graph (:constructor phpinspect-make-bidi-graph))
"A bidirectional graph."
(rel (make-hash-table :test #'eq :size 2000 :rehash-size 2.0))
(rel-back (make-hash-table :test #'eq :size 2000 :rehash-size 2.0)))
(defun phpinspect-bidi-graph-link (graph obj1 obj2)
(let ((existing-rel (gethash obj1 (phpinspect-bidi-graph-rel graph)))
(existing-back-rel (gethash obj2 (phpinspect-bidi-graph-rel-back graph))))
(if existing-rel
(setcdr existing-rel (cons obj2 (cdr existing-rel)))
(puthash obj1 (list obj2) (phpinspect-bidi-graph-rel graph)))
(if existing-back-rel
(setcdr existing-back-rel (cons obj1 (cdr existing-back-rel)))
(puthash obj2 (list obj1) (phpinspect-bidi-graph-rel-back graph)))))
(defun phpinspect-bidi-graph-unlink-between (graph obj1 obj2)
(when-let ((rel (gethash obj1 (phpinspect-bidi-graph-rel graph)))
(back-rel (gethash obj2 (phpinspect-bidi-graph-rel-back graph))))
(puthash obj1 (delq obj2 rel) (phpinspect-bidi-graph-rel graph))
(puthash obj2 (delq obj1 back-rel) (phpinspect-bidi-graph-rel-back graph))))
(defun phpinspect-bidi-graph-unlink (graph obj)
(when-let ((obj-link (gethash obj (phpinspect-bidi-graph-rel graph))))
(dolist (back-rel obj-link)
(when-let ((back-link (gethash back-rel (phpinspect-bidi-graph-rel-back graph))))
(puthash back-rel (delq obj back-link) (phpinspect-bidi-graph-rel-back graph))))
(remhash obj (phpinspect-bidi-graph-rel graph))))
(defun phpinspect-bidi-graph-get-linking-from (graph obj)
(gethash obj (phpinspect-bidi-graph-rel graph)))
(defun phpinspect-bidi-graph-get-linking-to (graph obj)
(gethash obj (phpinspect-bidi-graph-rel-back graph)))
(cl-defstruct (phpinspect-cache (:constructor phpinspect-make-cache))
(groups (make-hash-table :test #'equal :size 2000 :rehash-size 1.2)))
(cl-defstruct (phpinspect-cache-type (:constructor phpinspect-make-cache-type))
(group nil)
(category nil)
(name nil)
(methods nil)
(variables nil))
(cl-defstruct (phpinspect-cache-namespace (:constructor phpinspect-make-cache-namespace))
(types nil)
(functions nil))
(cl-defstruct (phpinspect-cache-group (:constructor phpinspect-make-cache-group))
(spec nil)
(namespaces (make-hash-table :test #'eq :size 2000 :rehash-size 2.0))
(extends (phpinspect-make-bidi-graph))
(implements (phpinspect-make-bidi-graph)))
(eval-and-compile
(defconst phpinspect-cache-types '(@interface @trait @class @method @type
@abstract-method @function @variable @namespace)
"Types of entities that the cache can store.")
(defconst phpinspect-cache-containing-types '(@class @trait @interface)
"Types of entities that the cache can store members for.")
(defconst phpinspect-cache-member-types '(@method @abstract-method @function @variable)
"Types of entities that the cache can store as members."))
(defun phpinspect-cache-type-get-extends (type)
(phpinspect-cache-group-get-extends
(phpinspect-cache-type-group type)
(phpinspect-cache-type-name type)))
(defun phpinspect-cache-type-get-implements (type)
(phpinspect-cache-group-get-implements
(phpinspect-cache-type-group type)
(phpinspect-cache-type-name type)))
(defun phpinspect-cache-type-add-method (type method)
(push (cons (phpinspect--function-short-name-symbol method)
method)
(phpinspect-cache-type-methods type)))
(defun phpinspect-cache-group-get-extends (group type-name)
(phpinspect-bidi-graph-get-linking-from
(phpinspect-cache-group-extends group)
type-name))
(defun phpinspect-cache-group-get-implements (group type-name)
(phpinspect-bidi-graph-get-linking-from
(phpinspect-cache-group-implements group)
type-name))
(defun phpinspect-cache-group-get-extending (group type-name)
(phpinspect-bidi-graph-get-linking-to
(phpinspect-cache-group-extends group)
type-name))
(defun phpinspect-cache-group-get-implementing (group type-name)
(phpinspect-bidi-graph-get-linking-to
(phpinspect-cache-group-implements group)
type-name))
(defun phpinspect-cache-group-get-namespace (group namespace)
(gethash namespace (phpinspect-cache-group-namespaces group)))
(defun phpinspect-cache-group-get-namespace-create (group namespace)
(or (phpinspect-cache-group-get-namespace group namespace)
(puthash namespace (phpinspect-make-cache-namespace)
(phpinspect-cache-group-namespaces group))))
(defun phpinspect-cache-namespace-get-type-create (namespace type category group)
(or (phpinspect-cache-namespace-get-type namespace type category)
(cdar
(push (cons (phpinspect--type-short-name type)
(phpinspect-make-cache-type
:name (phpinspect--type-name-symbol type)
:category category
:group group))
(phpinspect-cache-namespace-types namespace)))))
(defun phpinspect-cache-namespace-get-type (namespace type category)
(when-let ((entity
(cdr (assq (phpinspect--type-short-name type)
(phpinspect-cache-namespace-types namespace)))))
(and (or (eq '@type category)
(eq category (phpinspect-cache-type-category entity)))
entity)))
(defun phpinspect-cache-namespace-delete-type (namespace type category)
(let ((types (phpinspect-cache-namespace-types namespace))
(name (phpinspect--type-short-name type))
cell-before)
(catch 'break
(while types
(let ((type-cell (car types)))
(when (eq (car type-cell) name)
(when (or (eq '@type category)
(eq category
(phpinspect-cache-type-category (cdr type-cell))))
(if cell-before
(setcdr cell-before (cdr types))
(setf (phpinspect-cache-namespace-types namespace) (cdr types)))
(throw 'break (cdr type-cell)))))
(setq cell-before types
types (cdr types))))))
(defun phpinspect-cache-namespace-delete-function (namespace function-name)
(let ((functions (phpinspect-cache-namespace-functions namespace))
(name (phpinspect-intern-name
(phpinspect-type-name-short
(phpinspect-name-string function-name))))
cell-before)
(catch 'break
(while functions
(let ((type-cell (car functions)))
(when (eq (car type-cell) name)
(if cell-before
(setcdr cell-before (cdr functions))
(setf (phpinspect-cache-namespace-functions namespace)
(cdr functions)))
(throw 'break (cdr type-cell))))
(setq cell-before functions
functions (cdr functions))))))
(defun phpinspect-cache-group-unlink-type-dependencies (group name)
(phpinspect-bidi-graph-unlink
(phpinspect-cache-group-extends group) name)
(phpinspect-bidi-graph-unlink
(phpinspect-cache-group-implements group) name))
(defmacro phpinspect--inline-wildcard-param-p (param)
`(let ((param ,param))
(and (inline-const-p param) (eq '* (inline-const-val param)))))
(define-inline phpinspect-cache-query--do-delete-type
(group param type _member namespace _implements _extends)
(setq type (inline-const-val type))
(inline-letevals (group param namespace)
(if (phpinspect--inline-wildcard-param-p param)
(if namespace
(inline-quote
(when-let ((namespace (phpinspect-cache-group-get-namespace
,group ,namespace)))
(let (resultset)
(setf (phpinspect-cache-namespace-types namespace)
(seq-filter
(lambda (type-cell)
(if ,(if (eq type '@type)
t
`(eq (phpinspect-cache-type-category (cdr type-cell))
(quote ,type)))
(progn
(push (cdr type-cell) resultset)
(phpinspect-cache-group-unlink-type-dependencies
,group (car type-cell))
nil)
t))
(phpinspect-cache-namespace-types namespace)))
(cons 'phpinspect-cache-multiresult resultset))))
(inline-quote
(let (resultset)
(dolist (namespace (hash-table-values
(phpinspect-cache-group-namespaces ,group)))
(let (new-types)
(dolist (type-cell (phpinspect-cache-namespace-types namespace))
(if ,(if (eq type '@type)
t
`(eq (phpinspect-cache-type-category
(cdr type-cell))
(quote ,type)))
(progn
(push (cdr type-cell) resultset)
(phpinspect-cache-group-unlink-type-dependencies
,group (car type-cell))
nil)
(push type-cell new-types)))
(setf (phpinspect-cache-namespace-types namespace) new-types)))
(cons 'phpinspect-cache-multiresult resultset))))
(inline-quote
(when-let* ((namespace (phpinspect-cache-group-get-namespace-create
,group
(or ,namespace
(phpinspect--type-namespace ,param))))
(result (phpinspect-cache-namespace-delete-type
namespace ,param (quote ,type))))
(phpinspect-cache-group-unlink-type-dependencies
,group (phpinspect-cache-type-name result))
result)))))
(define-inline phpinspect-cache-query--do-delete-function
(group param _type _member namespace _implements _extends)
(inline-letevals (group param namespace)
(if (phpinspect--inline-wildcard-param-p param)
(if namespace
(inline-quote
(when-let ((namespace (phpinspect-cache-group-get-namespace
,group ,namespace)))
(let ((resultset
(cons 'phpinspect-cache-multiresult
(mapcar #'cdr
(phpinspect-cache-namespace-functions
namespace)))))
(setf (phpinspect-cache-namespace-functions namespace) nil)
resultset)))
(inline-quote
(let (resultset)
(dolist (namespace (hash-table-values
(phpinspect-cache-group-namespaces ,group)))
(setq resultset
(nconc
(mapcar #'cdr
(phpinspect-cache-namespace-functions
namespace))
resultset)))
(cons 'phpinspect-cache-multiresult resultset))))
(inline-quote
(when-let ((namespace
(phpinspect-cache-group-get-namespace
,group (or ,namespace
(phpinspect-intern-name
(phpinspect-type-name-namespace
(phpinspect-name-string ,param)))))))
(phpinspect-cache-namespace-delete-function
namespace ,param))))))
(defun phpinspect--assq-delete (key alist)
(let* ((result (cons nil nil))
(result-rear result)
deleted)
(catch 'break
(while alist
(if (eq key (caar alist))
(progn
(setcdr result-rear (cdr alist))
(setq deleted (car alist))
(throw 'break nil))
(setq result-rear (setcdr result-rear (cons (car alist) nil)))
(setq alist (cdr alist)))))
(list deleted (cdr result))))
;; OPTIMIZE: this is probably not optimal for large numbers of keys
(defun phpinspect--assq-delete-multi (keys alist)
(let (all-deleted)
(dolist (key keys)
(pcase-let ((`(,deleted ,filtered) (phpinspect--assq-delete key alist)))
(push deleted all-deleted)
(setq alist filtered)))
(list all-deleted alist)))
(defun phpinspect--alist-values (alist)
(let* ((vals (cons nil nil))
(vals-rear vals))
(dolist (cell alist)
(setq vals-rear (setcdr vals-rear (cons (cdr cell) nil))))
(cdr vals)))
(defun phpinspect-cache-query--do-delete-method (cache group param type member)
(when-let ((member-type
(car
(phpinspect-cache-transact cache (list (phpinspect-cache-group-spec group))
:get member :as @type))))
(cond ((eq '* param)
(let ((deleted (phpinspect--alist-values
(phpinspect-cache-type-methods member-type))))
(setf (phpinspect-cache-type-methods member-type) nil)
(cons 'phpinspect-cache-multiresult deleted)))
((and (listp param) (not (phpinspect-name-p param)))
(pcase-let ((`(,deleted ,filtered)
(phpinspect--assq-delete-multi
param (phpinspect-cache-type-methods member-type))))
(setf (phpinspect-cache-type-methods member-type) filtered)
(cons 'phpinspect-cache-multiresult deleted)))
(t
(pcase-let ((`(,deleted ,filtered)
(phpinspect--assq-delete
param (phpinspect-cache-type-methods member-type))))
(setf (phpinspect-cache-type-methods member-type) filtered)
deleted)))))
(defun phpinspect-cache-query--do-delete-variable (cache group param type member)
(when-let ((member-type
(car
(phpinspect-cache-transact cache (list (phpinspect-cache-group-spec group))
:get member :as @type))))
(cond ((eq '* param)
(let ((deleted (phpinspect--alist-values
(phpinspect-cache-type-variables member-type))))
(setf (phpinspect-cache-type-variables member-type) nil)
(cons 'phpinspect-cache-multiresult deleted)))
((and (listp param) (not (phpinspect-name-p param)))
(pcase-let ((`(,deleted ,filtered)
(phpinspect--assq-delete-multi
param (phpinspect-cache-type-variables member-type))))
(setf (phpinspect-cache-type-variables member-type) filtered)
(cons 'phpinspect-cache-multiresult deleted)))
(t
(pcase-let ((`(,deleted ,filtered)
(phpinspect--assq-delete
param (phpinspect-cache-type-variables member-type))))
(setf (phpinspect-cache-type-variables member-type) filtered)
deleted)))))
(define-inline phpinspect-cache-query--do-delete-member
(cache group param type member namespace implements extends)
(inline-letevals (cache group param member)
(setq type (inline-const-val type))
(pcase type
((or '@function '@method)
(inline-quote
(phpinspect-cache-query--do-delete-method ,cache ,group ,param (quote ,type) ,member)))
('@variable
(inline-quote
(phpinspect-cache-query--do-delete-variable ,cache ,group ,param (quote ,type) ,member)))
(_ (error "Delete not supported for member type %s" type)))))
(defmacro phpinspect-cache-query--do-delete
(cache group param type member namespace implements extends)
(cl-assert (symbolp type))
(cond
((memq type (cons '@type phpinspect-cache-containing-types))
`(phpinspect-cache-query--do-delete-type
,group ,param (quote ,type) ,member ,namespace ,implements ,extends))
((and (eq '@function type) (not member))
`(phpinspect-cache-query--do-delete-function
,group ,param (quote ,type) ,member ,namespace ,implements ,extends))
((and (memq type phpinspect-cache-member-types) member)
`(phpinspect-cache-query--do-delete-member
,cache ,group ,param (quote ,type) ,member ,namespace ,implements ,extends))
(t (error "Delete not supported for entity type %s" type))))
(defun phpinspect-cache-namespace-get-function (namespace func-name)
(cdr (assq func-name (phpinspect-cache-namespace-functions namespace))))
(defun phpinspect-cache-group-register-extends (group type extends)
(if (listp extends)
(dolist (ext extends)
(phpinspect-cache-group-register-extends type ext))
(phpinspect-bidi-graph-link
(phpinspect-cache-group-extends group)
(phpinspect--type-name-symbol type)
(phpinspect--type-name-symbol extends))))
(defun phpinspect-cache-group-register-implements (group type implements)
(if (listp implements)
(dolist (ext implements)
(phpinspect-cache-group-register-implements type ext))
(phpinspect-bidi-graph-link
(phpinspect-cache-group-implements group)
(phpinspect--type-name-symbol type)
(phpinspect--type-name-symbol implements))))
(defun phpinspect-cache-type-add-variable (type variable)
(push (cons (phpinspect--variable-name-symbol variable)
variable)
(phpinspect-cache-type-variables type)))
(define-inline phpinspect-cache-query--do-insert-method
(cache group param type member namespace)
(setq type (inline-const-val type))
(inline-letevals (cache group param member namespace)
(inline-quote
(let ((member-type
(car
(phpinspect-cache-transact ,cache (list (phpinspect-cache-group-spec ,group))
:get ,member
:in ,namespace
:as @type)))
resultset)
,(pcase type
((or '@function '@method)
`(if (listp ,param)
(progn
(dolist (method ,param)
(push method resultset)
(phpinspect-cache-type-add-method member-type method))
(cons 'phpinspect-cache-multiresult resultset))
(cdar (phpinspect-cache-type-add-method member-type ,param))))
('@variable
`(if (listp ,param)
(progn
(dolist (variable ,param)
(push variable resultset)
(phpinspect-cache-type-add-variable member-type variable))
(cons 'phpinspect-cache-multiresult resultset))
(cdar (phpinspect-cache-type-add-variable member-type ,param))))
(_ (error "Insert not supported for member type %s" type)))))))
(defun phpinspect-cache-query--do-insert-function (cache group param namespace)
(let ((namespace
(phpinspect-cache-group-get-namespace-create
group (or namespace
(phpinspect--function-namespace param)))))
(or (when-let ((existing (assq (phpinspect--function-name-symbol param)
(phpinspect-cache-namespace-functions namespace))))
(cdar (setcdr existing (cons param (cdr existing)))))
(cdar (push (cons (phpinspect--function-short-name-symbol param) param)
(phpinspect-cache-namespace-functions namespace))))))
(define-inline phpinspect-cache-query--do-insert-member
(cache group param type member namespace implements extends)
(if member
(inline-quote
(phpinspect-cache-query--do-insert-method
,cache ,group ,param ,type ,member ,namespace))
;; Else: insert function in namespace
(inline-quote
(phpinspect-cache-query--do-insert-function ,cache ,group ,param ,namespace))))
(defmacro phpinspect-cache-query--do-insert
(cache group param type member namespace implements extends)
(cl-assert (symbolp type))
(cond
((memq type (cons '@type phpinspect-cache-containing-types))
`(let* ((namespace (phpinspect-cache-group-get-namespace-create
,group
(or ,namespace (phpinspect--type-namespace ,param)))))
,(when extends
`(phpinspect-cache-group-register-extends ,group ,param ,extends))
,(when implements
`(phpinspect-cache-group-register-implements ,group ,param ,implements))
(phpinspect-cache-namespace-get-type-create
namespace ,param (quote ,type) ,group)))
((memq type phpinspect-cache-member-types)
`(phpinspect-cache-query--do-insert-member
,cache ,group ,param (quote ,type) ,member ,namespace ,implements ,extends))
(t (error "Insert not supported for entity type %s" type))))
(defun phpinspect-cache-query--do-get-type-wildcard (group param type namespace)
(if namespace
(when-let ((namespace (phpinspect-cache-group-get-namespace group namespace)))
(cons 'phpinspect-cache-multiresult
(mapcar #'cdr (phpinspect-cache-namespace-types namespace))))
(cons
'phpinspect-cache-multiresult
(mapcan
(lambda (namespace)
(mapcar #'cdr (phpinspect-cache-namespace-types namespace)))
(hash-table-values (phpinspect-cache-group-namespaces group))))))
(defun phpinspect-cache-query--do-get-type
(group param type member namespace implements extends)
(let ((result
(if (eq '* param)
(phpinspect-cache-query--do-get-type-wildcard group param type namespace)
(when-let* ((namespace (phpinspect-cache-group-get-namespace
group
(or namespace
(phpinspect--type-namespace param)))))
(phpinspect-cache-namespace-get-type namespace param type)))))
;; OPTIMIZE: Performance of these filters won't be very good when using
;; wildcards without namespace parameter. Probably worth optimizing when
;; this becomes a frequent use case.
(when implements
(setq result
(let ((implementing (phpinspect-cache-group-get-implementing group implements))
filtered)
(when result
(if (and (consp result)
(eq 'phpinspect-cache-multiresult (car result)))
(progn
(dolist (res (cdr result))
(when (memq (phpinspect-cache-type-name res) implementing)
(push res filtered)))
(cons 'phpinspect-cache-multiresult filtered))
(when (memq (phpinspect-cache-type-name result) implementing)
result))))))
(when extends
(setq result
(let ((extending (phpinspect-cache-group-get-extending group extends))
filtered)
(when result
(if (and (consp result)
(eq 'phpinspect-cache-multiresult (car result)))
(progn
(dolist (res (cdr result))
(when (memq (phpinspect-cache-type-name res) extending)
(push res filtered)))
(cons 'phpinspect-cache-multiresult filtered))
(when (memq (phpinspect-cache-type-name result) extending)
result))))))
result))
(define-inline phpinspect-cache-query--do-get-function
(group param type member namespace implements extends)
(inline-letevals (group param member namespace implements extends)
(if (phpinspect--inline-wildcard-param-p param)
(if namespace
(inline-quote
(when-let ((namespace (phpinspect-cache-group-get-namespace
,group ,namespace)))
(cons 'phpinspect-cache-multiresult
(mapcar #'cdr
(phpinspect-cache-namespace-functions namespace)))))
(inline-quote
(let (resultset)
(dolist (namespace (hash-table-values
(phpinspect-cache-group-namespaces ,group)))
(setq resultset
(nconc
(mapcar #'cdr
(phpinspect-cache-namespace-functions namespace))
resultset)))
(cons 'phpinspect-cache-multiresult resultset))))
(if namespace
(inline-quote
(when-let ((namespace (phpinspect-cache-group-get-namespace
,group ,namespace)))
(phpinspect-cache-namespace-get-function namespace ,param)))
(inline-quote
(let* ((name-string (phpinspect-name-string ,param))
(namespace-name (phpinspect-intern-name
(phpinspect-type-name-namespace name-string)))
(short-name (phpinspect-intern-name
(phpinspect-type-name-short name-string))))
(if (string-match-p "^\\\\" (phpinspect-name-string ,param))
(when-let ((namespace (phpinspect-cache-group-get-namespace
,group namespace-name)))
(phpinspect-cache-namespace-get-function namespace short-name))
(let (resultset)
(dolist (namespace (hash-table-values
(phpinspect-cache-group-namespaces ,group)))
(when-let ((func (phpinspect-cache-namespace-get-function
namespace short-name)))
(push func resultset)))
(cons 'phpinspect-cache-multiresult resultset)))))))))
(defun phpinspect-cache-type-get-method (type method-name)
(cdr (assq method-name (phpinspect-cache-type-methods type))))
(defun phpinspect-cache-type-get-variable (type method-name)
(cdr (assq method-name (phpinspect-cache-type-variables type))))
(define-inline phpinspect-cache-query--do-get-member (cache group param type member namespace)
(inline-letevals (cache group param member namespace)
(setq type (inline-const-val type))
(inline-quote
(when-let ((member-type
(car
(phpinspect-cache-transact ,cache (list (phpinspect-cache-group-spec ,group))
:get ,member
:as @type
:in ,namespace))))
,(pcase type
((or '@function '@method)
(if (phpinspect--inline-wildcard-param-p param)
`(cons 'phpinspect-cache-multiresult
(phpinspect--alist-values (phpinspect-cache-type-methods member-type)))
`(phpinspect-cache-type-get-method member-type ,param)))
('@variable
(if (phpinspect--inline-wildcard-param-p param)
`(cons 'phpinspect-cache-multiresult
(phpinspect--alist-values (phpinspect-cache-type-variables member-type)))
`(phpinspect-cache-type-get-variable member-type ,param)))
(_ (error "Get not supported for member entity type %s" type)))))))
(defmacro phpinspect-cache-query--do-get
(cache group param type member namespace implements extends)
(cl-assert (symbolp type))
(cond
((memq type (cons '@type phpinspect-cache-containing-types))
`(phpinspect-cache-query--do-get-type
,group ,param (quote ,type) ,member ,namespace ,implements ,extends))
((and (eq '@function type) (not member))
`(phpinspect-cache-query--do-get-function
,group ,param ,type ,member ,namespace ,implements ,extends))
((and (memq type phpinspect-cache-member-types) member)
`(phpinspect-cache-query--do-get-member
,cache ,group ,param (quote ,type) ,member ,namespace))
(t (error "Get not supported for entity type %s" type))))
(defmacro phpinspect-cache-query--wrap-action
(action cache group param type member namespace implements extends)
(let* ((param-sym (gensym "param")))
`(let ((,param-sym ,param))
(if (and (sequencep ,param-sym) (not (phpinspect-name-p ,param-sym)))
(let* ((result (cons 'phpinspect-cache-multiresult nil))
(result-rear result))
(seq-doseq (p ,param-sym)
(when-let ((action-result
(,action ,cache ,group p ,type ,member
,namespace ,implements ,extends)))
(setq result-rear
(setcdr result-rear
(cons action-result nil)))))
result)
(,action ,cache ,group ,param ,type ,member ,namespace ,implements ,extends)))))
(defun phpinspect-cache-query--compile-groups (cache group-specs intent)
(cl-assert (phpinspect-cache-p cache))
(let (groups)
(if group-specs
(dolist (spec group-specs)
(cl-assert (listp spec))
(cl-assert (memq (car spec) '(project label))
t "Spec car must be the symbol `project' or `label'")
(let ((group (gethash spec (phpinspect-cache-groups cache))))
(when (and (eq :insert intent) (not group))
(setq group (puthash spec (phpinspect-make-cache-group :spec spec)
(phpinspect-cache-groups cache))))
(push group groups)))
(if (eq :insert intent)
(error "Cannot insert without defining cache group")
(setq groups (hash-table-values (phpinspect-cache-groups cache)))))
groups))
(defmacro phpinspect-cache-transact (cache group-specs &rest query)
(declare (indent 2))
(cl-assert (listp query))
(let (type intent intent-param member namespace implements extends key value)
(while (setq key (pop query))
(cl-assert (keywordp key) t "Query keys must be keywords, %s provided" key)
(setq value (pop query))
;; Namespace is allowed to be dynamic/nil
(unless (eq :in key)
(cl-assert value t "Key %s has no value" key))
(pcase key
((or :insert :get :delete)
(when intent
(error "Defined duplicate intent: %s, %s" intent key))
(setq intent key
intent-param value))
(:as (unless (and (symbolp value)
(memq value phpinspect-cache-types))
(error ":type must be one of %s, %s provided"
phpinspect-cache-types value))
(setq type value))
(:member-of (setq member value))
(:in (setq namespace value))
(:implementing (setq implements value))
(:extending (setq extends value))
(_ (error "Unexpected query keyword %s" key))))
;; Query validation
(unless type
(error "Providing entity type with keyword :as is required."))
(when (and member (not (memq type phpinspect-cache-member-types)))
(error "Keyword :member-of can only be used for types %s"
phpinspect-cache-member-types))
(when (and extends (not (memq type '(@class @trait @interface @type))))
(error "Keyword :extending cannot be used for types other than %s"
'(class trait interface)))
(when (eq :insert intent)
(when (and (memq type '(@variable @method @abstract-method)) (not member))
(error "Variable and methods must be member of %s."
phpinspect-cache-containing-types))
(when (eq '@type type)
(error ":as @type cannot be used for insertions.")))
(when (and intent (not intent-param))
(error "Intent %s must have a parameter %s" intent))
(let ((group-specs-sym (make-symbol "group-specs"))
(intent-param-sym (make-symbol "intent-param"))
(cache-sym (make-symbol "cache"))
(member-sym (make-symbol "member"))
(namespace-sym (make-symbol "namespace"))
(implements-sym (make-symbol "implements"))
(extends-sym (make-symbol "extends"))
(resultset-sym (make-symbol "resultset"))
(groups-sym (make-symbol "groups")))
(let* ((action-args
`(,(if (eq '* intent-param) `(quote ,intent-param) intent-param-sym)
,type
,(if member member-sym nil)
,(if namespace namespace-sym nil)
,(if implements implements-sym nil)
,(if extends extends-sym nil)))
(validate-args
`(,(if (eq '* intent-param) `(quote ,intent-param) intent-param-sym)
(quote ,type)
,(if member member-sym nil)
,(if namespace namespace-sym nil)
,(if implements implements-sym nil)
,(if extends extends-sym nil)))
(action (pcase intent
(:insert 'phpinspect-cache-query--do-insert)
(:delete 'phpinspect-cache-query--do-delete)
(:get 'phpinspect-cache-query--do-get)
(_ (error "Invalid intent %s" intent)))))
`(let* ,(seq-filter
(lambda (val) val)
`((,group-specs-sym ,group-specs)
,(unless (eq '* intent-param) `(,intent-param-sym ,intent-param))
,(when cache `(,cache-sym ,cache))
,(when member `(,member-sym ,member))
,(when namespace `(,namespace-sym ,namespace))
,(when implements `(,implements-sym ,implements))
,(when extends `(,extends-sym ,extends))
(,groups-sym (phpinspect-cache-query--compile-groups ,cache ,group-specs ,intent))
,resultset-sym))
,(cons 'phpinspect-cache-query--validate (cons intent validate-args))
(dolist (group ,groups-sym)
(when-let ((result ,(cons 'phpinspect-cache-query--wrap-action
(cons action (cons cache (cons 'group action-args))))))
(if (and (listp result) (eq 'phpinspect-cache-multiresult (car result)))
(setq ,resultset-sym (nconc ,resultset-sym (cdr result)))
(push result ,resultset-sym))))
,resultset-sym)))))
(defun phpinspect-cache-query--validate
(intent intent-param type member namespace implements extends)
(and
;; Validate intent-param
(cond
((phpinspect--type-p intent-param)
(cond
((not (memq type '(@class @trait @interface @type)))
(error "Cannot use intent-param of type phpinspect--type when querying for %s" type))
((and (phpinspect--type-fully-qualified intent-param)
namespace)
(error "Use of fully qualified type %s while specifying namespace %s in query"
intent-param namespace)))
t)
((phpinspect-name-p intent-param) t)
((listp intent-param)
(if (memq type '(@class @trait @interface @type))
(unless (seq-every-p #'phpinspect--type-p intent-param)
(error "Each intent param must be of type `phpinspect--type'. Got: %s" intent-param))
(pcase intent
(:insert
(unless (or (seq-every-p #'phpinspect--variable-p intent-param)
(seq-every-p #'phpinspect--function-p intent-param))
(error "Each intent param must be an instance of `phpinspect--function' or `phpinspect--variable'")))
(:get
(unless (seq-every-p #'phpinspect-name-p intent-param)
(error "Each intent param must be a name, got: %s" intent-param)))
(:delete
(unless (or (seq-every-p #'phpinspect-name-p intent-param))
(error "Each intent param must be an instance of `phpinspect--function', `phpinspect--variable' or `phpinspect-name'")))))
t)
((eq '* intent-param)
(unless (memq intent '(:get :delete))
(error "Wildcard '* cannot be used with intent %s" intent)))
((phpinspect--function-p intent-param)
(cond
((not (memq intent '(:insert :delete)))
(error "`phpinspect--function' can only be used as parameter for :insert and :delete intents."))
((not (memq type '(@function @method @abstract-method)))
(error "Inserting/deleting `phpinspect--function' as type %s is not supported" type)))
t)
(t (error "Unsupported intent-param %s" intent-param)))
;; Validate member
(cond
((phpinspect--type-p member) t)
((not member) t)
(t (error "unsupported member type (allowed `phpinspect--type'): %s" member)))
;; Validate namespace
(cond
((phpinspect-name-p namespace) t)
((not namespace) t)
(t (error "unsupported namespace type (allowed `phpinspect-name'): %s" namespace)))
;; Validate implements
(cond
((listp implements)
(unless (seq-every-p #'phpinspect--type-p implements)
(error "Each parameter of :implementing must be of type `phpinspect--type'. Got: %s" implements))
t)
((phpinspect--type-p implements) t)
((not implements) t)
(t (error "unsupported parameter for :implementing (allowed `phpinspect--type': %s" implements)))
;; Validate extends
(cond
((listp extends)
(unless (seq-every-p #'phpinspect--type-or-name-p extends)
(error "Each parameter of :extending must be of type `phpinspect--type'. Got: %s" extends))
t)
((phpinspect--type-p extends) t)
((not extends) t)
(t (error "unsupported parameter for :extending (allowed `phpinspect--type': %s" extends)))))
;;; phpinspect.el ends here ;;; phpinspect.el ends here
(provide 'phpinspect-cache) (provide 'phpinspect-cache)

@ -218,9 +218,7 @@ Conditionally executes BODY depending on
(let ((existing (gethash (phpinspect--function-name-symbol method) (let ((existing (gethash (phpinspect--function-name-symbol method)
(phpinspect--class-static-methods class)))) (phpinspect--class-static-methods class))))
(if existing (if existing
(phpinspect--merge-method (phpinspect--merge-method (phpinspect--class-name class) existing method extended)
(alist-get 'class-name (phpinspect--class-index class))
existing method extended)
(setf (phpinspect--function--inherited method) extended) (setf (phpinspect--function--inherited method) extended)
(phpinspect--class-set-static-method class method))))) (phpinspect--class-set-static-method class method)))))
@ -232,9 +230,7 @@ Conditionally executes BODY depending on
(phpinspect--class-methods class)))) (phpinspect--class-methods class))))
(if existing (if existing
(phpinspect--merge-method (phpinspect--merge-method (phpinspect--class-name class) existing method extended)
(alist-get 'class-name (phpinspect--class-index class))
existing method extended)
(setf (phpinspect--function--inherited method) extended) (setf (phpinspect--function--inherited method) extended)
(phpinspect--class-set-method class method))))) (phpinspect--class-set-method class method)))))

@ -275,38 +275,38 @@ Returns list of `phpinspect--completion'."
(defun phpinspect-complete-at-point () (defun phpinspect-complete-at-point ()
(let ((comp-list (phpinspect-completion-query-execute (phpinspect--get-completion-query))) (catch 'phpinspect-parse-interrupted
strings) (let ((comp-list (phpinspect-completion-query-execute (phpinspect--get-completion-query)))
(obarray-map (lambda (sym) (push (symbol-name sym) strings)) (phpinspect--completion-list-completions comp-list)) strings)
(and (phpinspect--completion-list-has-candidates comp-list) (obarray-map (lambda (sym) (push (symbol-name sym) strings)) (phpinspect--completion-list-completions comp-list))
(list (phpinspect--completion-list-completion-start comp-list) (and (phpinspect--completion-list-has-candidates comp-list)
(phpinspect--completion-list-completion-end comp-list) (list (phpinspect--completion-list-completion-start comp-list)
strings (phpinspect--completion-list-completion-end comp-list)
:affixation-function strings
(lambda (completions) :affixation-function
(let (affixated completion) (lambda (completions)
(dolist (comp completions) (let (affixated completion)
(setq completion (phpinspect--completion-list-get-metadata comp-list comp)) (dolist (comp completions)
(push (list comp (phpinspect--prefix-for-completion completion) (setq completion (phpinspect--completion-list-get-metadata comp-list comp))
(phpinspect--completion-meta completion)) (push (list comp (phpinspect--prefix-for-completion completion)
affixated)) (phpinspect--completion-meta completion))
(nreverse affixated))) affixated))
:exit-function (nreverse affixated)))
(lambda (comp-name state) :exit-function
(let ((comp (phpinspect--completion-list-get-metadata (lambda (comp-name state)
phpinspect--last-completion-list (let ((comp (phpinspect--completion-list-get-metadata
comp-name))) phpinspect--last-completion-list
(when (and (eq 'finished state) comp-name)))
(eq 'function (phpinspect--completion-kind comp))) (when (and (eq 'finished state)
(insert "(") (eq 'function (phpinspect--completion-kind comp)))
(when (= 0 (length (phpinspect--function-arguments (insert "(")
(phpinspect--completion-target comp)))) (when (= 0 (length (phpinspect--function-arguments
(insert ")"))))) (phpinspect--completion-target comp))))
:company-kind (lambda (comp-name) (insert ")")))))
(phpinspect--completion-kind :company-kind (lambda (comp-name)
(phpinspect--completion-list-get-metadata (phpinspect--completion-kind
phpinspect--last-completion-list (phpinspect--completion-list-get-metadata
comp-name))))))) phpinspect--last-completion-list
comp-name))))))))
(provide 'phpinspect-completion) (provide 'phpinspect-completion)

@ -106,9 +106,6 @@ buffer position to insert the use statement at."
buffer namespace-token)) buffer namespace-token))
(t (phpinspect-message "No import found for type %s" typename)))))) (t (phpinspect-message "No import found for type %s" typename))))))
(defun phpinspect-namespace-part-of-typename (typename)
(string-trim-right typename "\\\\?[^\\]+"))
(defalias 'phpinspect-fix-uses-interactive #'phpinspect-fix-imports (defalias 'phpinspect-fix-uses-interactive #'phpinspect-fix-imports
"Alias for backwards compatibility") "Alias for backwards compatibility")

@ -60,6 +60,27 @@ of TYPE, if available."
(or (not type) (or (not type)
(phpinspect--type= type phpinspect--object-type))) (phpinspect--type= type phpinspect--object-type)))
(defun phpinspect--index-function-declaration (declaration type-resolver add-used-types)
(let (current name function-args return-type)
(catch 'break
(while (setq current (pop declaration))
(cond ((and (phpinspect-word-p current)
(phpinspect-word-p (car declaration))
(string= "function" (cadr current)))
(setq name (cadr (pop declaration))))
((phpinspect-list-p current)
(setq function-args
(phpinspect--index-function-arg-list
type-resolver current add-used-types))
(when (setq return-type (seq-find #'phpinspect-word-p declaration))
(setq return-type (funcall type-resolver
(phpinspect--make-type :name (cadr return-type)))))
(throw 'break nil)))))
(list name function-args return-type)))
(defun phpinspect--index-function-from-scope (type-resolver scope comment-before &optional add-used-types namespace) (defun phpinspect--index-function-from-scope (type-resolver scope comment-before &optional add-used-types namespace)
"Index a function inside SCOPE token using phpdoc metadata in COMMENT-BEFORE. "Index a function inside SCOPE token using phpdoc metadata in COMMENT-BEFORE.
@ -69,9 +90,16 @@ function (think \"new\" statements, return types etc.)."
(phpinspect--log "Indexing function") (phpinspect--log "Indexing function")
(let* ((php-func (cadr scope)) (let* ((php-func (cadr scope))
(declaration (cadr php-func)) (declaration (cadr php-func))
(type (if (phpinspect-word-p (car (last declaration))) name type arguments)
(funcall type-resolver
(phpinspect--make-type :name (cadar (last declaration))))))) (pcase-setq `(,name ,arguments ,type)
(phpinspect--index-function-declaration
declaration type-resolver add-used-types))
;; FIXME: Anonymous functions should not be indexed! (or if they are, they
;; should at least not be visible from various UIs unless assigned to a
;; variable as a closure).
(unless name (setq name "anonymous"))
(phpinspect--log "Checking function return annotations") (phpinspect--log "Checking function return annotations")
@ -114,12 +142,9 @@ function (think \"new\" statements, return types etc.)."
(phpinspect--make-function (phpinspect--make-function
:scope `(,(car scope)) :scope `(,(car scope))
:token php-func :token php-func
:name (concat (if namespace (concat namespace "\\") "") (cadadr (cdr declaration))) :name (concat (if namespace (concat namespace "\\") "") name)
:return-type (or type phpinspect--null-type) :return-type (or type phpinspect--null-type)
:arguments (phpinspect--index-function-arg-list :arguments arguments)))
type-resolver
(phpinspect-function-argument-list php-func)
add-used-types))))
(define-inline phpinspect--safe-cadr (list) (define-inline phpinspect--safe-cadr (list)
(inline-letevals (list) (inline-letevals (list)

@ -55,6 +55,20 @@ that the collection is expected to contain")
`(phpinspect--make-type-generated `(phpinspect--make-type-generated
,@(phpinspect--wrap-plist-name-in-symbol property-list))) ,@(phpinspect--wrap-plist-name-in-symbol property-list)))
(defun phpinspect-type-name-namespace (typename)
(let ((ns (string-trim-right typename "\\\\?[^\\]+")))
(if (string= "" ns)
"\\"
ns)))
(defun phpinspect--type-namespace (type)
(phpinspect-intern-name
(phpinspect-type-name-namespace (phpinspect--type-name type))))
(defun phpinspect--type-short-name (type)
(phpinspect-intern-name
(phpinspect-type-name-short (phpinspect--type-name type))))
(defun phpinspect--make-types (type-names) (defun phpinspect--make-types (type-names)
(mapcar (lambda (name) (phpinspect--make-type :name name)) (mapcar (lambda (name) (phpinspect--make-type :name name))
type-names)) type-names))
@ -125,12 +139,12 @@ See https://wiki.php.net/rfc/static_return_type ."
(cl-defmethod phpinspect--type-name ((type phpinspect--type)) (cl-defmethod phpinspect--type-name ((type phpinspect--type))
(phpinspect-name-string (phpinspect--type-name-symbol type))) (phpinspect-name-string (phpinspect--type-name-symbol type)))
(defun phpinspect--get-bare-class-name-from-fqn (fqn) (defun phpinspect-type-name-short (fqn)
(car (last (split-string fqn "\\\\")))) (car (last (split-string fqn "\\\\"))))
(cl-defmethod phpinspect--type-bare-name ((type phpinspect--type)) (cl-defmethod phpinspect--type-bare-name ((type phpinspect--type))
"Return just the name, without namespace part, of TYPE." "Return just the name, without namespace part, of TYPE."
(phpinspect--get-bare-class-name-from-fqn (phpinspect--type-name type))) (phpinspect-type-name-short (phpinspect--type-name type)))
(cl-defmethod phpinspect--type= ((type1 phpinspect--type) (type2 phpinspect--type)) (cl-defmethod phpinspect--type= ((type1 phpinspect--type) (type2 phpinspect--type))
(eq (phpinspect--type-name-symbol type1) (phpinspect--type-name-symbol type2))) (eq (phpinspect--type-name-symbol type1) (phpinspect--type-name-symbol type2)))
@ -248,6 +262,12 @@ as first element and the type as second element.")
"A phpinspect--type object representing the the "A phpinspect--type object representing the the
return type of the function.")) return type of the function."))
(defun phpinspect--function-namespace (func)
(let ((namespace (phpinspect-type-name-namespace (phpinspect--function-name func))))
(when (string= "" namespace)
(setq namespace "\\"))
(phpinspect-intern-name namespace)))
(defmacro phpinspect--make-function (&rest property-list) (defmacro phpinspect--make-function (&rest property-list)
`(phpinspect--make-function-generated `(phpinspect--make-function-generated
,@(phpinspect--wrap-plist-name-in-symbol property-list))) ,@(phpinspect--wrap-plist-name-in-symbol property-list)))
@ -258,6 +278,14 @@ return type of the function."))
(define-inline phpinspect--function-name (func) (define-inline phpinspect--function-name (func)
(inline-quote (phpinspect-name-string (phpinspect--function-name-symbol ,func)))) (inline-quote (phpinspect-name-string (phpinspect--function-name-symbol ,func))))
(define-inline phpinspect--function-short-name (func)
(inline-quote (phpinspect-type-name-short
(phpinspect-name-string
(phpinspect--function-name-symbol ,func)))))
(defun phpinspect--function-short-name-symbol (func)
(phpinspect-intern-name (phpinspect--function-short-name func)))
(cl-defstruct (phpinspect--variable (:constructor phpinspect--make-variable)) (cl-defstruct (phpinspect--variable (:constructor phpinspect--make-variable))
"A PHP Variable." "A PHP Variable."
(name nil (name nil
@ -293,6 +321,9 @@ mutability of the variable")
(not (or (phpinspect--variable-static-p variable) (not (or (phpinspect--variable-static-p variable)
(phpinspect--variable-const-p variable)))) (phpinspect--variable-const-p variable))))
(defun phpinspect--variable-name-symbol (variable)
(phpinspect-intern-name (phpinspect--variable-name variable)))
(defun phpinspect--use-to-type (use) (defun phpinspect--use-to-type (use)
(let* ((fqn (cadr (cadr use))) (let* ((fqn (cadr (cadr use)))
(type (phpinspect--make-type :name (if (string-match "^\\\\" fqn) (type (phpinspect--make-type :name (if (string-match "^\\\\" fqn)

@ -128,6 +128,12 @@ level of START-FILE in stead of `default-directory`."
(or (gethash name phpinspect-names) (or (gethash name phpinspect-names)
(puthash name name phpinspect-names))) (puthash name name phpinspect-names)))
(define-inline phpinspect-name-p (name)
(inline-letevals (name)
(inline-quote
(and (consp ,name)
(eq 'phpinspect-name (car ,name))))))
(defsubst phpinspect--wrap-plist-name-in-symbol (property-list) (defsubst phpinspect--wrap-plist-name-in-symbol (property-list)
(let ((new-plist) (let ((new-plist)
(wrap-value)) (wrap-value))
@ -238,8 +244,8 @@ it evaluates to a non-nil value."
(,match-sym (cons nil nil)) (,match-sym (cons nil nil))
(,match-rear-sym ,match-sym)) (,match-rear-sym ,match-sym))
(and (= ,sequence-length (length ,sequence)) (and (= ,sequence-length (length ,sequence))
,@checkers) ,@checkers
(cdr ,match-sym)))) (cdr ,match-sym)))))
(defun phpinspect--pattern-concat (pattern1 pattern2) (defun phpinspect--pattern-concat (pattern1 pattern2)
(let* ((pattern1-sequence-length (/ (length (phpinspect--pattern-code pattern1)) 2))) (let* ((pattern1-sequence-length (/ (length (phpinspect--pattern-code pattern1)) 2)))

@ -224,7 +224,8 @@ Example configuration for `company-mode':
(add-hook \\='php-mode-hook #\\='my-php-personal-hook) (add-hook \\='php-mode-hook #\\='my-php-personal-hook)
;; End example configuration." ;; End example configuration."
:after-hook (phpinspect--mode-function)) :after-hook (phpinspect--mode-function)
:keymap (list (cons (kbd "C-c u") #'phpinspect-fix-imports)))
(defun phpinspect--suggest-at-point () (defun phpinspect--suggest-at-point ()
(phpinspect--log "Entering suggest at point. Point: %d" (point)) (phpinspect--log "Entering suggest at point. Point: %d" (point))

@ -1,19 +0,0 @@
#!/bin/bash
rm ./**/*.elc
rm *.elc
for file in ./*.el; do
echo 'Compiling '"$file"' ...'
cask emacs -batch -L . --eval '(setq byte-compile-error-on-warn t)' -f batch-byte-compile "$file" || break
done
for file in ./**/*.el; do
echo 'Compiling '"$file"' ...'
cask emacs -batch -L . --eval '(setq byte-compile-error-on-warn t)' -f batch-byte-compile "$file" || break
done
if [[ -z $NO_REMOVE_ELC ]]; then
rm ./**/*.elc
rm *.elc
fi

@ -1,4 +1,26 @@
;;; install-deps.el --- Install dependencies -*- lexical-binding: t -*- ;;; install-deps.el --- Install package dependencies -*- lexical-binding: t; -*-
;; Copyright (C) 2023 Free Software Foundation, Inc
;; Author: Hugo Thunnissen <devel@hugot.nl>
;; Keywords: script
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, 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 General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'lisp-mnt) (require 'lisp-mnt)

@ -5,12 +5,12 @@ rm *.elc
for file in ./*.el; do for file in ./*.el; do
echo 'Compiling '"$file"' ...' echo 'Compiling '"$file"' ...'
cask emacs -batch -L . --eval '(progn '"(require 'comp)"' (setq byte-compile-error-on-warn t native-compile-target-directory (car native-comp-eln-load-path)) (nreverse native-comp-eln-load-path))' -f batch-byte+native-compile "$file" || break emacs -batch -L . --eval '(progn '"(require 'comp)"' (setq byte-compile-error-on-warn t native-compile-target-directory (car native-comp-eln-load-path)) (nreverse native-comp-eln-load-path))' -f batch-byte+native-compile "$file" || break
done done
for file in ./**/*.el; do for file in ./**/*.el; do
echo 'Compiling '"$file"' ...' echo 'Compiling '"$file"' ...'
cask emacs -batch -L . --eval '(progn '"(require 'comp)"' (setq byte-compile-error-on-warn t native-compile-target-directory (car native-comp-eln-load-path)) (nreverse native-comp-eln-load-path))' -f batch-byte+native-compile "$file" || break emacs -batch -L . --eval '(progn '"(require 'comp)"' (setq byte-compile-error-on-warn t native-compile-target-directory (car native-comp-eln-load-path)) (nreverse native-comp-eln-load-path))' -f batch-byte+native-compile "$file" || break
done done

@ -0,0 +1,516 @@
; test-cache.el --- Unit tests for phpinspect.el -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2023 Free Software Foundation, Inc.
;; Author: Hugo Thunnissen <devel@hugot.nl>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, 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 General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'ert)
(require 'phpinspect-cache)
(ert-deftest phpinspect-cache-insert-type ()
(let ((cache (phpinspect-make-cache))
result)
(phpinspect-cache-transact cache '((label test))
:insert (phpinspect--make-type :name "\\TestClass") :as @class)
(setq result
(phpinspect-cache-transact cache '((label test))
:get (phpinspect--make-type :name "\\TestClass") :as @class))
(should result)
(should (listp result))
(should (= 1 (length result)))
(should (phpinspect-cache-type-p (car result)))
(phpinspect-cache-transact cache '((label test))
:insert (phpinspect--make-type :name "\\TestInterface") :as @interface)
(setq result
(phpinspect-cache-transact cache '((label test))
:get (phpinspect--make-type :name "\\TestInterface") :as @interface))
(should result)
(should (listp result))
(should (= 1 (length result)))
(should (phpinspect-cache-type-p (car result)))
;; When a query defines an entity category other than the one the existing
;; entity was inserted as, nothing should be returned.
(setq result
(phpinspect-cache-transact cache '((label test))
:get (phpinspect--make-type :name "\\TestInterface") :as @class))
(should-not result)
(setq result
(phpinspect-cache-transact cache '((label test))
:get (phpinspect--make-type :name "\\TestInterface") :as @type))
(should result)
(setq result
(phpinspect-cache-transact cache '((label test))
:get `(,(phpinspect--make-type :name "\\TestInterface")
,(phpinspect--make-type :name "\\TestClass"))
:as @type))
(should result)
(should (= 2 (length result)))
(should (seq-every-p #'phpinspect-cache-type-p result))
(setq result
(phpinspect-cache-transact cache '((label test))
:get `(,(phpinspect--make-type :name "\\TestInterface")
,(phpinspect--make-type :name "\\TestClass"))
:as @interface))
(should result)
(should (= 1 (length result)))
(should (seq-every-p #'phpinspect-cache-type-p result))
(setq result
(phpinspect-cache-transact cache '((label test))
:get * :as @type))
(should result)
(should (= 2 (length result)))
(should (seq-every-p #'phpinspect-cache-type-p result))
(setq result
(phpinspect-cache-transact cache '((label test))
:get (phpinspect--make-type :name "\\TestClass") :as @type))
(should result)
(setq result
(phpinspect-cache-transact cache '((label test))
:delete (phpinspect--make-type :name "\\TestClass") :as @type))
(should result)
(should (phpinspect-cache-type-p (car result)))
(setq result
(phpinspect-cache-transact cache '((label test))
:get (phpinspect--make-type :name "\\TestClass") :as @type))
(should-not result)
(setq result
(phpinspect-cache-transact cache '((label test))
:delete (phpinspect--make-type :name "\\TestClass") :as @type))
(should-not result)
(setq result
(phpinspect-cache-transact cache '((label test))
:get (phpinspect--make-type :name "\\TestInterface") :as @type))
(should result)
(setq result
(phpinspect-cache-transact cache '((label test))
:delete (phpinspect--make-type :name "\\TestInterface") :as @class))
(should-not result)
(setq result
(phpinspect-cache-transact cache '((label test))
:get (phpinspect--make-type :name "\\TestInterface") :as @type))
(should result)
(setq result
(phpinspect-cache-transact cache '((label test))
:delete (phpinspect--make-type :name "\\TestInterface") :as @interface))
(should result)
(setq result
(phpinspect-cache-transact cache '((label test))
:get (phpinspect--make-type :name "\\TestInterface") :as @type))
(should-not result)))
(ert-deftest phpinspect-cache-namespace-query ()
(let ((cache (phpinspect-make-cache))
result)
(phpinspect-cache-transact cache '((label test))
:insert (list (phpinspect--make-type :name "\\Namespace1\\TestClass")
(phpinspect--make-type :name "\\Namespace2\\TestClass")
(phpinspect--make-type :name "\\Namespace2\\TestClass1"))
:as @class)
(setq result (phpinspect-cache-transact cache '((label test))
:get * :as @class :in (phpinspect-intern-name "\\Namespace1")))
(should result)
(should (= 1 (length result)))
(should (eq (phpinspect-intern-name "\\Namespace1\\TestClass")
(phpinspect-cache-type-name (car result))))
(setq result (phpinspect-cache-transact cache '((label test))
:get * :as @class :in (phpinspect-intern-name "\\Namespace2")))
(should result)
(should (= 2 (length result)))))
(ert-deftest phpinspect-cache-delete-wildcard-types ()
(let ((cache (phpinspect-make-cache))
result)
(phpinspect-cache-transact cache '((label test))
:insert (list (phpinspect--make-type :name "\\Namespace1\\TestClass")
(phpinspect--make-type :name "\\Namespace2\\TestClass")
(phpinspect--make-type :name "\\Namespace2\\TestClass1"))
:as @class)
(phpinspect-cache-transact cache '((label test))
:delete * :as @class)
(should-not (phpinspect-cache-transact cache '((label test))
:get * :as @class))))
(ert-deftest phpinspect-cache-delete-wildcard-namespace-types ()
(let ((cache (phpinspect-make-cache))
result)
(phpinspect-cache-transact cache '((label test))
:insert (list (phpinspect--make-type :name "\\Namespace1\\TestClass")
(phpinspect--make-type :name "\\Namespace2\\TestClass")
(phpinspect--make-type :name "\\Namespace2\\TestClass1"))
:as @class)
(phpinspect-cache-transact cache '((label test))
:delete * :as @class :in (phpinspect-intern-name "\\Namespace2"))
(setq result (phpinspect-cache-transact cache '((label test)) :get * :as @class))
(should result)
(should (= 1 (length result)))
(should (eq (phpinspect-intern-name "\\Namespace1\\TestClass")
(phpinspect-cache-type-name (car result))))))
(ert-deftest phpinspect-cache-insert-function ()
(let ((cache (phpinspect-make-cache))
result)
(setq result (phpinspect-cache-transact cache '((label test))
:insert (phpinspect--make-function :name "test_func")
:as @function))
(should result)
(should (phpinspect--function-p (car result)))
(should (= 1 (length result)))
(setq result (phpinspect-cache-transact cache '((label test))
:insert (list (phpinspect--make-function :name "test_func")
(phpinspect--make-function :name "other_func"))
:as @function
:in (phpinspect-intern-name "\\Namespace1")))
(should result)
(should (= 2 (length result)))
(setq result (phpinspect-cache-transact cache '((label test))
:get (phpinspect-intern-name "\\test_func")
:as @function))
(should result)
(should (phpinspect--function-p (car result)))
(should (= 1 (length result)))
(setq result (phpinspect-cache-transact cache '((label test))
:delete (phpinspect-intern-name "\\test_func")
:as @function))
(should result)
(should (phpinspect--function-p (car result)))
(should (= 1 (length result)))
(setq result (phpinspect-cache-transact cache '((label test))
:get *
:as @function
:in (phpinspect-intern-name "\\Namespace1")))
(should result)
(should (= 2 (length result)))
(setq result (phpinspect-cache-transact cache '((label test))
:delete *
:as @function
:in (phpinspect-intern-name "\\Namespace1")))
(should result)
(should (= 2 (length result)))
(phpinspect-cache-transact cache '((label test))
:insert (list (phpinspect--make-function :name "\\Ns\\test_func")
(phpinspect--make-function :name "\\Ns\\other_func")
(phpinspect--make-function :name "\\root_func"))
:as @function)
(setq result (phpinspect-cache-transact cache '((label test))
:get * :as @function :in (phpinspect-intern-name "\\Ns")))
(should result)
(should (= 2 (length result)))
(setq result (phpinspect-cache-transact cache '((label test))
:get * :as @function :in (phpinspect-intern-name "\\")))
(should result)
(should (= 1 (length result)))
(setq result (phpinspect-cache-transact cache '((label test))
:get * :as @function))
(should result)
(should (= 3 (length result)))
(setq result (phpinspect-cache-transact cache '((label test))
:delete * :as @function))
(should result)
(should (= 3 (length result)))))
(ert-deftest phpinspect-insert-type-extending/implementing ()
(let ((cache (phpinspect-make-cache))
result)
(setq result
(phpinspect-cache-transact cache '((label test))
:insert (phpinspect--make-type :name "\\Namespace1\\TestClass")
:as @class
:extending (phpinspect--make-type :name "\\App\\TestClassAbstract")
:implementing (phpinspect--make-type :name "\\App\\TestInterface")))
(should result)
(should (= 1 (length result)))
(setq result (car result))
(should (phpinspect-cache-type-get-implements result))
(should (= 1 (length (phpinspect-cache-type-get-implements result))))
(should (eq (phpinspect-intern-name "\\App\\TestInterface")
(car (phpinspect-cache-type-get-implements result))))
(setq result (phpinspect-cache-transact cache '((label test))
:get *
:implementing (phpinspect-intern-name "\\App\\TestInterface")
:as @type))
(should result)
(should (= 1 (length result)))
(should (eq (phpinspect-intern-name "\\Namespace1\\TestClass")
(phpinspect-cache-type-name (car result))))
(setq result (phpinspect-cache-transact cache '((label test))
:get *
:extending (phpinspect-intern-name "\\App\\TestClassAbstract")
:as @type))
(should result)
(should (= 1 (length result)))
(should (eq (phpinspect-intern-name "\\Namespace1\\TestClass")
(phpinspect-cache-type-name (car result))))
(setq result (phpinspect-cache-transact cache '((label test))
:get *
:extending (phpinspect-intern-name "\\App\\TestClass")
:as @type))
(should-not result)
(setq result (phpinspect-cache-transact cache '((label test))
:delete (phpinspect--make-type :name "\\Namespace1\\TestClass")
:as @type))
(should result)
(setq result (phpinspect-cache-transact cache '((label test))
:get *
:extending (phpinspect-intern-name "\\App\\TestClassAbstract")
:as @type))
(should-not result)
(phpinspect-cache-transact cache '((label test))
:insert (phpinspect--make-type :name "\\Namespace1\\TestClass")
:as @class)
(setq result (phpinspect-cache-transact cache '((label test))
:get *
:extending (phpinspect-intern-name "\\App\\TestClassAbstract")
:as @type))
(should-not result)
(setq result (phpinspect-cache-transact cache '((label test))
:get *
:implementing (phpinspect-intern-name "\\App\\TestInterface")
:as @type))
(should-not result)))
(ert-deftest phpinspect-cache-insert-method ()
(let ((cache (phpinspect-make-cache))
result)
(phpinspect-cache-transact cache '((label test))
:insert (phpinspect--make-type :name "\\TestClass")
:as @class)
(setq result (phpinspect-cache-transact cache '((label test))
:insert (phpinspect--make-function :name "testMethod")
:as @method
:member-of (phpinspect--make-type :name "\\TestClass")))
(should result)
(setq result (phpinspect-cache-transact cache '((label test))
:get (phpinspect-intern-name "testMethod")
:as @method
:member-of (phpinspect--make-type :name "\\TestClass")))
(should result)
(should (= 1 (length result)))
(should (phpinspect--function-p (car result)))
(setq result (phpinspect-cache-transact cache '((label test))
:get (phpinspect-intern-name "testMethod")
:as @method
:member-of (phpinspect--make-type :name "\\Banana")))
(should-not result)
(phpinspect-cache-transact cache '((label test))
:insert (phpinspect--make-function :name "newTestMethod")
:as @method
:member-of (phpinspect--make-type :name "\\TestClass"))
(setq result (phpinspect-cache-transact cache '((label test))
:get (phpinspect-intern-name "testMethod")
:as @method
:member-of (phpinspect--make-type :name "\\TestClass")))
(should result)
(should (= 1 (length result)))
(should (phpinspect--function-p (car result)))
(setq result (phpinspect-cache-transact cache '((label test))
:get *
:as @method
:member-of (phpinspect--make-type :name "\\TestClass")))
(should result)
(should (= 2 (length result)))
(setq result (phpinspect-cache-transact cache '((label test))
:delete (phpinspect-intern-name "testMethod")
:as @method
:member-of (phpinspect--make-type :name "\\TestClass")))
(should result)
(should (= 1 (length result)))
(phpinspect-cache-transact cache '((label test))
:insert (phpinspect--make-function :name "testMethod")
:as @method
:member-of (phpinspect--make-type :name "\\TestClass"))
(setq result (phpinspect-cache-transact cache '((label test))
:delete *
:as @function
:member-of (phpinspect--make-type :name "\\TestClass")))
(should result)
(should (= 2 (length result)))
(should-not
(phpinspect-cache-transact cache '((label test))
:get *
:as @method
:member-of (phpinspect--make-type :name "\\TestClass")))))
(ert-deftest phpinspect-cache-delete-method-multi ()
(let ((cache (phpinspect-make-cache))
result)
(phpinspect-cache-transact cache '((label test))
:insert (phpinspect--make-type :name "\\TestClass") :as @class)
(phpinspect-cache-transact cache '((label test))
:insert (list (phpinspect--make-function :name "test1")
(phpinspect--make-function :name "test3")
(phpinspect--make-function :name "test2"))
:as @method
:member-of (phpinspect--make-type :name "\\TestClass"))
(setq result (phpinspect-cache-transact cache '((label test))
:delete (list (phpinspect-intern-name "test1")
(phpinspect-intern-name "test2"))
:as @method
:member-of (phpinspect--make-type :name "\\TestClass")))
(should result)
(should (= 2 (length result)))
(setq result (phpinspect-cache-transact cache '((label test))
:get *
:as @method
:member-of (phpinspect--make-type :name "\\TestClass")))
(should result)
(should (= 1 (length result)))
(should (string= "test3" (phpinspect--function-name (car result))))))
(ert-deftest phpinspect-cache-insert-variable ()
(let ((cache (phpinspect-make-cache))
result)
(phpinspect-cache-transact cache '((label test))
:insert (phpinspect--make-type :name "\\TestClass") :as @class)
(setq result (phpinspect-cache-transact cache '((label test))
:insert (list (phpinspect--make-variable :name "test1")
(phpinspect--make-variable :name "test3")
(phpinspect--make-variable :name "test2"))
:as @variable
:member-of (phpinspect--make-type :name "\\TestClass")))
(should result)
(should (= 3 (length result)))
(setq result (phpinspect-cache-transact cache '((label test))
:get *
:as @variable
:member-of (phpinspect--make-type :name "\\TestClass")))
(should result)
(should (= 3 (length result)))
(setq result (phpinspect-cache-transact cache '((label test))
:get (phpinspect-intern-name "test2")
:as @variable
:member-of (phpinspect--make-type :name "\\TestClass")))
(should result)
(should (= 1 (length result)))
(setq result (phpinspect-cache-transact cache '((label test))
:delete (phpinspect-intern-name "test2")
:as @variable
:member-of (phpinspect--make-type :name "\\TestClass")))
(should result)
(should (= 1 (length result)))
(setq result (phpinspect-cache-transact cache '((label test))
:delete *
:as @variable
:member-of (phpinspect--make-type :name "\\TestClass")))
(should result)
(should (= 2 (length result)))
(should-not (phpinspect-cache-transact cache '((label test))
:get *
:as @variable
:member-of (phpinspect--make-type :name "\\TestClass")))))

@ -48,3 +48,10 @@
(should (equal '(:m "a" :m * :m "b" :f stringp :m * :m "D") (phpinspect--pattern-code result))) (should (equal '(:m "a" :m * :m "b" :f stringp :m * :m "D") (phpinspect--pattern-code result)))
(should (phpinspect--pattern-match result '("a" "anything" "b" "astring" nil "D"))))) (should (phpinspect--pattern-match result '("a" "anything" "b" "astring" nil "D")))))
(ert-deftest phpinspect--pattern-match-partially ()
(let ((result (phpinspect--match-sequence '((:variable "this") (:object-attrib (:word "em")))
:m '(:variable "this")
:m '(:object-attrib (:word "not-a-match")))))
(should-not result)))

Loading…
Cancel
Save