├── fortls ├── parsers │ ├── __init__.py │ └── internal │ │ ├── __init__.py │ │ ├── include.py │ │ ├── program.py │ │ ├── do.py │ │ ├── if_block.py │ │ ├── enum.py │ │ ├── where.py │ │ ├── module.py │ │ ├── block.py │ │ ├── imports.py │ │ ├── use.py │ │ ├── interface.py │ │ ├── diagnostics.py │ │ ├── select.py │ │ ├── keywords.json │ │ ├── associate.py │ │ ├── base.py │ │ ├── submodule.py │ │ ├── statements.json │ │ ├── method.py │ │ └── function.py ├── __main__.py ├── version.py ├── __init__.py ├── schema.py ├── json_templates.py ├── constants.py └── ftypes.py ├── test ├── test_source │ ├── include │ │ └── empty.h │ ├── excldir │ │ ├── sub2 │ │ │ └── fake2.f90 │ │ └── sub1 │ │ │ └── tmp.f90 │ ├── pp │ │ ├── .fortls │ │ ├── preproc_keywords.F90 │ │ ├── .pp_conf.json │ │ ├── include │ │ │ ├── petscerror.h │ │ │ └── petscpc.h │ │ ├── preproc_else.F90 │ │ ├── preproc.F90 │ │ ├── preproc_if_nested.F90 │ │ ├── preproc_if_elif_else.F90 │ │ ├── preproc_if_elif_skip.F90 │ │ ├── preproc_elif_elif_skip.F90 │ │ └── preproc_elif.F90 │ ├── wrong_syntax.json │ ├── parse │ │ ├── .fortls │ │ ├── submodule.f90 │ │ ├── mixed │ │ │ ├── preproc_and_normal_syntax.F90 │ │ │ └── multilines.F90 │ │ ├── trailing_semicolon.f90 │ │ ├── line_continuations.f90 │ │ ├── test_incomplete_dims.f90 │ │ └── test_kinds_and_dims.f90 │ ├── subdir │ │ ├── test_inc2.f90 │ │ ├── test_vis.f90 │ │ ├── test_abstract.f90 │ │ ├── test_inherit.f90 │ │ ├── test_rename.F90 │ │ ├── test_select.f90 │ │ ├── test_fixed.f │ │ ├── test_submod.F90 │ │ ├── test_generic.f90 │ │ └── test_free.f90 │ ├── hover │ │ ├── pointers.f90 │ │ ├── complicated_kind_spec.f90 │ │ ├── multiline_lexical_tokens.f90 │ │ ├── spaced_keywords.f90 │ │ ├── associate_block_2.f90 │ │ ├── types.f90 │ │ ├── intent.f90 │ │ ├── associate_block.f90 │ │ ├── recursive.f90 │ │ ├── parameters.f90 │ │ └── functions.f90 │ ├── diag │ │ ├── conf_long_lines.json │ │ ├── test_import.f90 │ │ ├── test_implicit_none.f90 │ │ ├── test_critical.f90 │ │ ├── test_function.f90 │ │ ├── test_visibility.f90 │ │ ├── test_scope_end_name_var.f90 │ │ ├── test_variable.f90 │ │ ├── test_contains.f90 │ │ ├── test_mixed_case_interface_sub_child.f90 │ │ ├── test_enum.f90 │ │ ├── test_external.f90 │ │ ├── test_use_ordering.f90 │ │ ├── test_forall.f90 │ │ ├── test_lines.f90 │ │ ├── test_var_shadowing_keyword_arg.f90 │ │ ├── test_where.f90 │ │ ├── test_semicolon.f90 │ │ ├── test_scope_overreach.f90 │ │ └── test_function_arg_list.f90 │ ├── test.f90 │ ├── use │ │ ├── comment_after_use.f90 │ │ └── use.f90 │ ├── test_submodule.f90 │ ├── test_inc.f90 │ ├── fixed │ │ └── comment_as_reference.f │ ├── test_nonintrinsic.f90 │ ├── rename │ │ ├── test_rename_imp_type_bound_proc.f90 │ │ ├── test_rename_nested.f90 │ │ └── test_rename_intrinsic.f90 │ ├── completion │ │ ├── test_vis_mod_completion.f90 │ │ └── use_only_interface.f90 │ ├── .fortls │ ├── signature │ │ ├── nested_sigs.f90 │ │ └── help.f90 │ ├── test_import.f90 │ ├── vis │ │ └── private.f90 │ ├── docs │ │ ├── test_module_and_type_doc.f90 │ │ ├── test_ford.f90 │ │ └── test_doxygen.f90 │ ├── test_block.f08 │ ├── imp │ │ ├── submodule.f90 │ │ └── import.f90 │ ├── test_prog.f08 │ ├── f90_config.json │ └── test_diagnostic_int.f90 ├── test_server_init.py ├── test_server_messages.py ├── test_preproc_parser.py ├── test_regex_patterns.py ├── setup_tests.py ├── test_server_references.py ├── test_parser.py ├── test_preproc.py ├── test_server_implementation.py └── test_server_signature_help.py ├── .github ├── CODEOWNERS ├── dependabot.yml ├── workflows │ ├── docs.yml │ ├── docs_preview.yml │ ├── update-intrinsics.yml │ ├── main.yml │ ├── python-publish.yml │ └── codeql-analysis.yml ├── FUNDING.yml └── ISSUE_TEMPLATE │ ├── feature_request.md │ └── bug_report.md ├── docs ├── html_extra │ ├── CNAME │ ├── google3e426562ce42e98f.html │ └── robots.txt ├── modules.rst ├── fortls.parsers.rst ├── Makefile ├── contact.rst ├── make.bat ├── contributing.rst ├── fortls.rst ├── quickstart.rst ├── features.rst ├── conf.py ├── index.rst └── fortls.parsers.internal.rst ├── setup.cfg ├── assets ├── logo.png ├── lsp │ ├── hover.png │ ├── hover2.png │ ├── rename.gif │ ├── rename.mp4 │ ├── rename2.gif │ ├── rename2.mp4 │ ├── sig-help.gif │ ├── sig-help.mp4 │ ├── symbols.png │ ├── completion.png │ ├── symbols-doc.png │ ├── completion-ani.gif │ ├── completion-ani.mp4 │ ├── diagnostics1.png │ ├── doc-highlight.png │ ├── symbols-crop.png │ ├── definition-goto.gif │ ├── definition-goto.mp4 │ ├── definition-peek.png │ ├── references-peek.png │ └── symbols-workspace.png ├── animations │ └── intro-demo.gif ├── README.md ├── symbol-class.svg ├── f.svg └── icon.svg ├── setup.py ├── .gitignore ├── .coveragerc ├── CITATION.cff ├── SECURITY.md ├── .pre-commit-config.yaml ├── licenses └── fortran-language-server-license.txt ├── LICENSE ├── pyproject.toml ├── CONTRIBUTING.md └── CODE_OF_CONDUCT.md /fortls/parsers/__init__.py: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /test/test_source/include/empty.h: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /.github/CODEOWNERS: -------------------------------------------------------------------------------- 1 | * @gnikit 2 | -------------------------------------------------------------------------------- /fortls/parsers/internal/__init__.py: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /test/test_source/excldir/sub2/fake2.f90: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /test/test_source/pp/.fortls: -------------------------------------------------------------------------------- 1 | .pp_conf.json -------------------------------------------------------------------------------- /docs/html_extra/CNAME: -------------------------------------------------------------------------------- 1 | fortls.fortran-lang.org 2 | -------------------------------------------------------------------------------- /test/test_source/wrong_syntax.json: -------------------------------------------------------------------------------- 1 | { 2 | "source_dirs", "s" 3 | } 4 | -------------------------------------------------------------------------------- /setup.cfg: -------------------------------------------------------------------------------- 1 | [flake8] 2 | max-line-length = 88 3 | extend-ignore = E203, E722 4 | -------------------------------------------------------------------------------- /assets/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/logo.png -------------------------------------------------------------------------------- /test/test_source/parse/.fortls: -------------------------------------------------------------------------------- 1 | { 2 | "excl_paths": [ 3 | "mixed" 4 | ] 5 | } 6 | -------------------------------------------------------------------------------- /fortls/__main__.py: -------------------------------------------------------------------------------- 1 | from . import main 2 | 3 | if __name__ == "__main__": 4 | main() 5 | -------------------------------------------------------------------------------- /test/test_source/parse/submodule.f90: -------------------------------------------------------------------------------- 1 | submodule (p1) val 2 | end 3 | 4 | submodule (p2) 5 | -------------------------------------------------------------------------------- /test/test_source/subdir/test_inc2.f90: -------------------------------------------------------------------------------- 1 | INTEGER :: val2 2 | REAL :: cross 3 | 4 | val1 5 | -------------------------------------------------------------------------------- /assets/lsp/hover.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/hover.png -------------------------------------------------------------------------------- /assets/lsp/hover2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/hover2.png -------------------------------------------------------------------------------- /assets/lsp/rename.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/rename.gif -------------------------------------------------------------------------------- /assets/lsp/rename.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/rename.mp4 -------------------------------------------------------------------------------- /assets/lsp/rename2.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/rename2.gif -------------------------------------------------------------------------------- /assets/lsp/rename2.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/rename2.mp4 -------------------------------------------------------------------------------- /assets/lsp/sig-help.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/sig-help.gif -------------------------------------------------------------------------------- /assets/lsp/sig-help.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/sig-help.mp4 -------------------------------------------------------------------------------- /assets/lsp/symbols.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/symbols.png -------------------------------------------------------------------------------- /docs/html_extra/google3e426562ce42e98f.html: -------------------------------------------------------------------------------- 1 | google-site-verification: google3e426562ce42e98f.html 2 | -------------------------------------------------------------------------------- /assets/lsp/completion.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/completion.png -------------------------------------------------------------------------------- /assets/lsp/symbols-doc.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/symbols-doc.png -------------------------------------------------------------------------------- /test/test_source/hover/pointers.f90: -------------------------------------------------------------------------------- 1 | program pointers 2 | INTEGER, POINTER :: val1 3 | end program 4 | -------------------------------------------------------------------------------- /assets/lsp/completion-ani.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/completion-ani.gif -------------------------------------------------------------------------------- /assets/lsp/completion-ani.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/completion-ani.mp4 -------------------------------------------------------------------------------- /assets/lsp/diagnostics1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/diagnostics1.png -------------------------------------------------------------------------------- /assets/lsp/doc-highlight.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/doc-highlight.png -------------------------------------------------------------------------------- /assets/lsp/symbols-crop.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/symbols-crop.png -------------------------------------------------------------------------------- /assets/lsp/definition-goto.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/definition-goto.gif -------------------------------------------------------------------------------- /assets/lsp/definition-goto.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/definition-goto.mp4 -------------------------------------------------------------------------------- /assets/lsp/definition-peek.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/definition-peek.png -------------------------------------------------------------------------------- /assets/lsp/references-peek.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/references-peek.png -------------------------------------------------------------------------------- /docs/html_extra/robots.txt: -------------------------------------------------------------------------------- 1 | User-agent: * 2 | Disallow: 3 | Sitemap: https://fortls.fortran-lang.org/sitemap.xml 4 | -------------------------------------------------------------------------------- /assets/animations/intro-demo.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/animations/intro-demo.gif -------------------------------------------------------------------------------- /assets/lsp/symbols-workspace.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fortran-lang/fortls/HEAD/assets/lsp/symbols-workspace.png -------------------------------------------------------------------------------- /test/test_source/diag/conf_long_lines.json: -------------------------------------------------------------------------------- 1 | { 2 | "max_line_length": 80, 3 | "max_comment_line_length": 100 4 | } 5 | -------------------------------------------------------------------------------- /test/test_source/diag/test_import.f90: -------------------------------------------------------------------------------- 1 | program test_diagnostic_import 2 | import some 3 | end program test_diagnostic_import 4 | -------------------------------------------------------------------------------- /setup.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | 3 | """Builds the fortls Language Server""" 4 | 5 | import setuptools 6 | 7 | setuptools.setup() 8 | -------------------------------------------------------------------------------- /test/test_source/diag/test_implicit_none.f90: -------------------------------------------------------------------------------- 1 | program test_imp 2 | implicit none 3 | 4 | end program test_imp 5 | implicit none 6 | -------------------------------------------------------------------------------- /test/test_source/test.f90: -------------------------------------------------------------------------------- 1 | PROGRAM myprog 2 | USE test_free, ONLY: scaled_vector 3 | TYPE(scaled_vector) :: myvec 4 | CALL myvec%set_scale(scale) 5 | END PROGRAM myprog 6 | -------------------------------------------------------------------------------- /test/test_source/parse/mixed/preproc_and_normal_syntax.F90: -------------------------------------------------------------------------------- 1 | 2 | USE base_hooks 3 | #if VAR < 8 || VAR == 8 && VAR2 < 3 4 | #define OMP_DEFAULT_NONE_WITH_OOP NONE 5 | #endif 6 | -------------------------------------------------------------------------------- /test/test_source/hover/complicated_kind_spec.f90: -------------------------------------------------------------------------------- 1 | program complicated_kind_spec 2 | real(int(sin(0.5))+8+len("ab((c")-3) :: y 3 | real(int(sin(0.5))+8+len("ab))c")-3) :: z 4 | end program 5 | -------------------------------------------------------------------------------- /fortls/parsers/internal/include.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | from .scope import Scope 4 | 5 | 6 | class Include(Scope): 7 | def get_desc(self): 8 | return "INCLUDE" 9 | -------------------------------------------------------------------------------- /fortls/parsers/internal/program.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | from .module import Module 4 | 5 | 6 | class Program(Module): 7 | def get_desc(self): 8 | return "PROGRAM" 9 | -------------------------------------------------------------------------------- /test/test_source/diag/test_critical.f90: -------------------------------------------------------------------------------- 1 | program test_critical 2 | implicit none 3 | if (.true.) then 4 | critical 5 | end critical 6 | end if 7 | end program test_critical 8 | -------------------------------------------------------------------------------- /test/test_source/diag/test_function.f90: -------------------------------------------------------------------------------- 1 | module test_functions 2 | contains 3 | subroutine foo(val) 4 | integer, intent(in) :: bar 5 | end subroutine 6 | end module test_functions 7 | -------------------------------------------------------------------------------- /test/test_source/diag/test_visibility.f90: -------------------------------------------------------------------------------- 1 | program test_visibility 2 | use nonexisting_module ! Info: missing module 3 | implicit none 4 | use mod 5 | end program test_visibility 6 | public 7 | -------------------------------------------------------------------------------- /test/test_source/parse/trailing_semicolon.f90: -------------------------------------------------------------------------------- 1 | program trailing_semicolon_in_end_scope 2 | integer :: i 3 | do i=1, 3 4 | print *, "Hello World!" 5 | end do; 6 | end program trailing_semicolon_in_end_scope 7 | -------------------------------------------------------------------------------- /test/test_source/use/comment_after_use.f90: -------------------------------------------------------------------------------- 1 | module dep_mod 2 | integer :: dep_variable 3 | end module dep_mod 4 | 5 | module user_mod 6 | use dep_mod, only: dep_variable ! disabling comment 7 | end module user_mod 8 | -------------------------------------------------------------------------------- /test/test_source/diag/test_scope_end_name_var.f90: -------------------------------------------------------------------------------- 1 | program scope_end_named_var 2 | implicit none 3 | integer :: end, endif 4 | if (.true.) then 5 | end = 10 6 | end if 7 | end program scope_end_named_var 8 | -------------------------------------------------------------------------------- /test/test_source/diag/test_variable.f90: -------------------------------------------------------------------------------- 1 | program test_variable 2 | integer :: val 3 | contains 4 | subroutine foo() 5 | integer :: val ! Warn: shadows parent 6 | end subroutine 7 | end program test_variable 8 | -------------------------------------------------------------------------------- /test/test_source/hover/multiline_lexical_tokens.f90: -------------------------------------------------------------------------------- 1 | program multiline_lexical_token 2 | implicit none 3 | inte& 4 | &ger & 5 | :: i 6 | RE& 7 | &AL(int(sin(0.5))& 8 | &+8+len("ab)& 9 | &)c")-3) :: Z 10 | end program 11 | -------------------------------------------------------------------------------- /test/test_source/pp/preproc_keywords.F90: -------------------------------------------------------------------------------- 1 | program test_preproc_keywords 2 | REAL & 3 | #ifdef HAVE_CONTIGUOUS 4 | , CONTIGUOUS & 5 | #endif 6 | , POINTER :: & 7 | var1(:), & 8 | var2(:) 9 | 10 | end program test_preproc_keywords 11 | -------------------------------------------------------------------------------- /test/test_source/test_submodule.f90: -------------------------------------------------------------------------------- 1 | submodule( foo_module ) submodule1 2 | implicit none 3 | contains 4 | module procedure foo1 5 | WRITE(*,"(A)") "testing :: "// trim(a) // "::"// trim(b) 6 | end procedure foo1 7 | end submodule submodule1 8 | -------------------------------------------------------------------------------- /test/test_source/test_inc.f90: -------------------------------------------------------------------------------- 1 | MODULE test_mod 2 | 3 | include "subdir/test_inc2.f90" 4 | 5 | REAL(8) :: val1 6 | 7 | CONTAINS 8 | 9 | SUBROUTINE test_sub 10 | 11 | val2 12 | END SUBROUTINE test_sub 13 | include 'mpi.f' 14 | 15 | END MODULE test_mod 16 | -------------------------------------------------------------------------------- /docs/modules.rst: -------------------------------------------------------------------------------- 1 | Documentation 2 | ========================== 3 | 4 | .. toctree:: 5 | :maxdepth: 4 6 | 7 | fortls 8 | 9 | 10 | Indices and tables 11 | ================== 12 | 13 | * :ref:`genindex` 14 | * :ref:`modindex` 15 | 16 | .. * :ref:`search` 17 | -------------------------------------------------------------------------------- /test/test_source/hover/spaced_keywords.f90: -------------------------------------------------------------------------------- 1 | subroutine spaced_keywords(arg1, arg2) 2 | real, dimension (:, :), intent (in) :: arg1 3 | real, dimension ( size(arg1, 1), maxval([size(arg1, 2), size(arg1, 1)]) ), intent (out) :: arg2 4 | end subroutine spaced_keywords 5 | -------------------------------------------------------------------------------- /test/test_source/fixed/comment_as_reference.f: -------------------------------------------------------------------------------- 1 | program comment_as_reference 2 | C Comment with variable name gets picked as a ref: variable_to_reference 3 | real variable_to_reference 4 | variable_to_reference = 1 5 | end program comment_as_reference 6 | -------------------------------------------------------------------------------- /test/test_source/hover/associate_block_2.f90: -------------------------------------------------------------------------------- 1 | program associate_block_2 2 | implicit none 3 | associate (hi => say_hi()) 4 | if (hi) print *, 'Bye' 5 | end associate 6 | contains 7 | logical function say_hi() 8 | say_hi = .true. 9 | end 10 | end program 11 | -------------------------------------------------------------------------------- /test/test_source/hover/types.f90: -------------------------------------------------------------------------------- 1 | module some_mod 2 | implicit none 3 | 4 | type, abstract :: base_t 5 | end type 6 | 7 | type, abstract, extends(base_t) :: extends_t 8 | end type 9 | 10 | type, extends(extends_t) :: a_t 11 | end type 12 | end module 13 | -------------------------------------------------------------------------------- /test/test_source/subdir/test_vis.f90: -------------------------------------------------------------------------------- 1 | module test_vis_mod 2 | 3 | implicit none 4 | private 5 | 6 | type :: some_type 7 | end type some_type 8 | integer :: some_var 9 | public some_var 10 | 11 | contains 12 | subroutine some_sub 13 | end subroutine some_sub 14 | end module test_vis_mod 15 | -------------------------------------------------------------------------------- /test/test_source/parse/line_continuations.f90: -------------------------------------------------------------------------------- 1 | subroutine parse_line_continuations 2 | call report_test("[adaptivity output]", .false., .false., "Congratulations! & 3 | & The output from adaptivity might even be OK if you get this far.") 4 | end subroutine parse_line_continuations 5 | -------------------------------------------------------------------------------- /test/test_source/diag/test_contains.f90: -------------------------------------------------------------------------------- 1 | program test_contains 2 | implicit none 3 | contains 4 | contains 5 | end program test_contains 6 | contains 7 | 8 | module test_contains2 9 | subroutine foo() ! Err: before contains 10 | end subroutine 11 | contains 12 | end module test_contains2 13 | -------------------------------------------------------------------------------- /test/test_source/hover/intent.f90: -------------------------------------------------------------------------------- 1 | subroutine intent(arg1, arg2, arg3, arg4, arg5) 2 | implicit none 3 | integer(4), intent(in) :: arg1 4 | integer, intent(out) :: arg2 5 | integer(4), intent(inout) :: arg3 6 | integer(4), intent(in out) :: arg4 7 | real, optional, intent(in) :: arg5 8 | end subroutine intent 9 | -------------------------------------------------------------------------------- /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | version: 2 2 | updates: 3 | - package-ecosystem: "github-actions" 4 | directory: "/" 5 | schedule: 6 | interval: "daily" 7 | 8 | # Check for updates Python updates via pip in case we pin a dependency 9 | - package-ecosystem: "pip" 10 | directory: "/" 11 | schedule: 12 | interval: "weekly" 13 | -------------------------------------------------------------------------------- /test/test_source/subdir/test_abstract.f90: -------------------------------------------------------------------------------- 1 | MODULE test_abstract 2 | ABSTRACT INTERFACE 3 | SUBROUTINE abs_interface(a,b) 4 | INTEGER(4), DIMENSION(3,6), INTENT(in) :: a 5 | REAL(8), INTENT(out) :: b(4) 6 | END SUBROUTINE abs_interface 7 | END INTERFACE 8 | PROCEDURE(abs_interface) :: test 9 | END MODULE test_abstract 10 | -------------------------------------------------------------------------------- /test/test_source/test_nonintrinsic.f90: -------------------------------------------------------------------------------- 1 | module test_nonint_mod 2 | private 3 | integer, parameter, public :: DP = kind(0.0D0) 4 | end module test_nonint_mod 5 | 6 | program nonint 7 | use, non_intrinsic :: test_nonint_mod, only : DP 8 | implicit none 9 | real(DP) :: x 10 | x = 0.0_DP 11 | end program nonint 12 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.pyc 2 | .vscode 3 | *.egg-info 4 | venv/ 5 | dist/ 6 | build/ 7 | docs/_build/ 8 | docs/fortls_changes.md 9 | fortls/_version.py 10 | 11 | .idea 12 | 13 | *.o 14 | *.mod 15 | *.smod 16 | *.log 17 | 18 | .coverage 19 | coverage.xml 20 | 21 | # Ignore M_intrinsics repo 22 | M_intrinsics 23 | benchmarks/ 24 | scripts/ 25 | -------------------------------------------------------------------------------- /test/test_source/diag/test_mixed_case_interface_sub_child.f90: -------------------------------------------------------------------------------- 1 | module mixed_case_interface_sub_child 2 | implicit none 3 | 4 | contains 5 | subroutine foo(Func) 6 | interface 7 | function Func() 8 | end function Func 9 | end interface 10 | end subroutine foo 11 | end module mixed_case_interface_sub_child 12 | -------------------------------------------------------------------------------- /test/test_source/diag/test_enum.f90: -------------------------------------------------------------------------------- 1 | program test_enum 2 | implicit none 3 | enum, bind(c) 4 | 5 | enumerator :: red =1, blue, black =5 6 | enumerator yellow 7 | enumerator gold, silver, bronze 8 | enumerator :: purple 9 | enumerator :: pink, lavender 10 | 11 | endenum 12 | end program test_enum 13 | -------------------------------------------------------------------------------- /docs/fortls.parsers.rst: -------------------------------------------------------------------------------- 1 | fortls.parsers package 2 | ====================== 3 | 4 | Subpackages 5 | ----------- 6 | 7 | .. toctree:: 8 | :maxdepth: 4 9 | 10 | fortls.parsers.internal 11 | 12 | Module contents 13 | --------------- 14 | 15 | .. automodule:: fortls.parsers 16 | :members: 17 | :undoc-members: 18 | :show-inheritance: 19 | -------------------------------------------------------------------------------- /test/test_source/rename/test_rename_imp_type_bound_proc.f90: -------------------------------------------------------------------------------- 1 | module mod 2 | implicit none 3 | 4 | type :: t 5 | contains 6 | procedure :: foo 7 | end type t 8 | 9 | contains 10 | 11 | subroutine foo(self) 12 | class(t), intent(in) :: self 13 | call self%foo() 14 | end subroutine foo 15 | end module mod 16 | -------------------------------------------------------------------------------- /test/test_source/rename/test_rename_nested.f90: -------------------------------------------------------------------------------- 1 | module mod 2 | implicit none 3 | contains 4 | 5 | subroutine fi() 6 | contains 7 | subroutine phi() 8 | integer :: a(5) 9 | print*, size(a) ! this is an intrinsic 10 | end subroutine phi 11 | end subroutine fi 12 | end module mod 13 | -------------------------------------------------------------------------------- /test/test_source/pp/.pp_conf.json: -------------------------------------------------------------------------------- 1 | { 2 | "lowercase_intrinsics": true, 3 | "use_signature_help": true, 4 | "variable_hover": true, 5 | "hover_signature": true, 6 | "enable_code_actions": true, 7 | "pp_suffixes": [".h", ".F90"], 8 | "incl_suffixes": [".h"], 9 | "include_dirs": ["include"], 10 | "pp_defs": { "HAVE_CONTIGUOUS": "" } 11 | } 12 | -------------------------------------------------------------------------------- /test/test_source/pp/include/petscerror.h: -------------------------------------------------------------------------------- 1 | #if !defined (PETSCERRORDEF_H) 2 | #define PETSCERRORDEF_H 3 | 4 | #define PETSC_ERR_MEM 55 5 | #define PETSC_ERR_INT_OVERFLOW 84 6 | #define PETSC_ERR_FLOP_COUNT 90 7 | 8 | #if defined PETSC_ERR_MEM || defined PETSC_ERR_INT_OVERFLOW 9 | #define SUCCESS .true. 10 | #endif 11 | 12 | #endif 13 | -------------------------------------------------------------------------------- /test/test_source/completion/test_vis_mod_completion.f90: -------------------------------------------------------------------------------- 1 | module foo 2 | implicit none 3 | public :: length 4 | private 5 | integer :: len 6 | integer :: length 7 | end module foo 8 | 9 | program test_private 10 | use foo, only: length 11 | use test_vis_mod 12 | implicit none 13 | print*, some_var, length 14 | end program test_private 15 | -------------------------------------------------------------------------------- /test/test_source/diag/test_external.f90: -------------------------------------------------------------------------------- 1 | program test_external 2 | implicit none 3 | REAL, EXTERNAL :: VAL 4 | REAL VAR_A 5 | EXTERNAL VAR_A 6 | EXTERNAL VAR_B 7 | REAL VAR_B 8 | EXTERNAL VAR_B ! throw error 9 | REAL VAR_A ! throw error 10 | EXTERNAL VAR_C 11 | end program test_external 12 | -------------------------------------------------------------------------------- /test/test_source/pp/preproc_else.F90: -------------------------------------------------------------------------------- 1 | subroutine preprocessor_else(var) 2 | 3 | #if 0 4 | #define MYTYPE logical 5 | #else 6 | #define MYTYPE integer 7 | #endif 8 | 9 | MYTYPE :: var0 10 | 11 | #undef MYTYPE 12 | 13 | #if 1 14 | #define MYTYPE real 15 | #else 16 | #define MYTYPE character 17 | #endif 18 | 19 | MYTYPE :: var1 20 | 21 | endsubroutine preprocessor_else 22 | -------------------------------------------------------------------------------- /test/test_source/diag/test_use_ordering.f90: -------------------------------------------------------------------------------- 1 | module mod_a 2 | integer, parameter :: q_a = 4 3 | end module 4 | 5 | module mod_b 6 | use mod_a 7 | integer, parameter :: q_b = 8 8 | end module 9 | 10 | program test_use_ordering 11 | use mod_b, only: q_b 12 | use mod_a 13 | 14 | real(q_a) :: r_a 15 | real(q_b) :: r_b 16 | end program test_use_ordering 17 | -------------------------------------------------------------------------------- /test/test_source/parse/test_incomplete_dims.f90: -------------------------------------------------------------------------------- 1 | 2 | ! Tests that the parser will not break, when parsing incomplete variables 3 | ! constructs. This is particularly important for autocompletion. 4 | program test_incomplete_dims 5 | implicit none 6 | integer :: dim_val(1, 2 7 | character :: char_val*(10 8 | integer :: ( 9 | end program test_incomplete_dims 10 | -------------------------------------------------------------------------------- /test/test_source/.fortls: -------------------------------------------------------------------------------- 1 | { 2 | // Directories to be scanned for source files 3 | "source_dirs": [ 4 | "**/" 5 | ], 6 | // These are regular expressions, files and paths that can be ignored 7 | "excl_paths": [ 8 | "excldir/**", 9 | "./diag/", 10 | "docs", 11 | "rename", 12 | "parse", 13 | "parse/mixed/**", 14 | "vis" 15 | ] 16 | 17 | } 18 | -------------------------------------------------------------------------------- /test/test_source/diag/test_forall.f90: -------------------------------------------------------------------------------- 1 | program test_forall 2 | implicit none 3 | integer :: i, j, dim=3, a(10) = 2 4 | 5 | select case (dim) 6 | case(3) 7 | forall(i=1:10) 8 | a(i) = a(i) **2 9 | forall (j=1:i) a(j) = a(j) ** 2 10 | end forall 11 | case default 12 | call abort() 13 | end select 14 | end program test_forall 15 | -------------------------------------------------------------------------------- /test/test_source/diag/test_lines.f90: -------------------------------------------------------------------------------- 1 | program test_lines 2 | implicit none 3 | character(len=123) :: val = "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Nam sodales imperdiet dolor, sit amet venenatis magna dictum id." 4 | ! Lorem ipsum dolor sit amet, consectetur adipiscing elit. Nam sodales imperdiet dolor, sit amet venenatis magna dictum id. 5 | end program test_lines 6 | -------------------------------------------------------------------------------- /test/test_source/subdir/test_inherit.f90: -------------------------------------------------------------------------------- 1 | MODULE test_inherit 2 | USE :: test_free, ONLY: scaled_vector 3 | IMPLICIT NONE 4 | ! 5 | TYPE, EXTENDS(scaled_vector) :: myvec 6 | REAL(8) :: x 7 | END TYPE myvec 8 | CONTAINS 9 | SUBROUTINE inherit_completion(self) 10 | TYPE(myvec), INTENT(INOUT) :: self 11 | self%scale%val 12 | END SUBROUTINE inherit_completion 13 | END MODULE test_inherit 14 | -------------------------------------------------------------------------------- /fortls/version.py: -------------------------------------------------------------------------------- 1 | try: 2 | from importlib.metadata import PackageNotFoundError, version 3 | except ModuleNotFoundError: 4 | from importlib_metadata import PackageNotFoundError, version 5 | try: 6 | __version__ = version(__package__) 7 | except PackageNotFoundError: 8 | from setuptools_scm import get_version 9 | 10 | __version__ = get_version(root="..", relative_to=__file__) 11 | -------------------------------------------------------------------------------- /test/test_source/pp/include/petscpc.h: -------------------------------------------------------------------------------- 1 | #if !defined (PETSCPCDEF_H) 2 | #define PETSCPCDEF_H 3 | 4 | #include "petscerror.h" 5 | 6 | #define PC type(tPC) 7 | #define PCType character*(80) 8 | #define ewrite(priority, format) if (priority <= 3) write((priority), format) 9 | #define ewrite2(priority, format) \ 10 | if (priority <= 3) write((priority), format) 11 | #define varVar \ 12 | 55 13 | #endif 14 | -------------------------------------------------------------------------------- /.coveragerc: -------------------------------------------------------------------------------- 1 | [run] 2 | omit = 3 | fortls/__init__.py 4 | fortls/debug.py 5 | fortls/version.py 6 | fortls/schema.py 7 | concurrency = multiprocessing 8 | parallel = true 9 | sigterm = true 10 | 11 | [report] 12 | exclude_lines = 13 | if debug: 14 | log.debug 15 | except: 16 | if not PY3K: 17 | def update_m_intrinsics 18 | update_m_intrinsics() 19 | 20 | [html] 21 | show_contexts = True 22 | -------------------------------------------------------------------------------- /test/test_source/hover/associate_block.f90: -------------------------------------------------------------------------------- 1 | PROGRAM test_associate_block 2 | IMPLICIT NONE 3 | REAL :: A(5), B(5,5), C, III = 1 4 | ASSOCIATE (X => A, Y => C) 5 | PRINT*, X, Y, III 6 | END ASSOCIATE 7 | ASSOCIATE (X => 1) 8 | PRINT*, X 9 | END ASSOCIATE 10 | ASSOCIATE (ARRAY => B(:,1)) 11 | ARRAY (3) = ARRAY (1) + ARRAY (2) 12 | END ASSOCIATE 13 | END PROGRAM test_associate_block 14 | -------------------------------------------------------------------------------- /test/test_source/use/use.f90: -------------------------------------------------------------------------------- 1 | module use_mod 2 | integer :: val1, val2, val3 3 | contains 4 | end module use_mod 5 | module use_mod_all 6 | integer :: val4, val5 7 | contains 8 | end module use_mod_all 9 | 10 | program use_main 11 | use use_mod, only: val1, val2 12 | use use_mod, only: val3_renamed => val3 13 | use use_mod_all, only: val4 14 | use use_mod_all, only: val4, val5 15 | print*, val3_renamed 16 | print*, val4 17 | end program use_main 18 | -------------------------------------------------------------------------------- /test/test_source/diag/test_var_shadowing_keyword_arg.f90: -------------------------------------------------------------------------------- 1 | module var_shadowing_keyword_arg 2 | character(len=6), parameter :: TEST = "4.10.4" 3 | character(len=6, kind=4), parameter :: TEST2 = "4.10.4" 4 | real(kind=8) :: a 5 | end module var_shadowing_keyword_arg 6 | 7 | program program_var_shadowing_keyword_arg 8 | use var_shadowing_keyword_arg 9 | integer :: len 10 | integer :: kind 11 | end program program_var_shadowing_keyword_arg 12 | -------------------------------------------------------------------------------- /test/test_source/signature/nested_sigs.f90: -------------------------------------------------------------------------------- 1 | program test_nan 2 | use, intrinsic :: iso_fortran_env, only: sp=>real32, dp=>real64, qp=>real128 3 | use, intrinsic :: ieee_arithmetic, only: ieee_value, ieee_quiet_nan, ieee_is_nan 4 | implicit none 5 | 6 | complex(qp) :: nan_zp 7 | 8 | nan_zp = ieee_value(1.,ieee_quiet_nan) 9 | print '(A4,2X,F5.1,6X,L1,2X,Z32)','zp',real(nan_zp), ieee_is_nan(real(nan_zp)),nan_zp 10 | end program test_nan 11 | -------------------------------------------------------------------------------- /test/test_source/pp/preproc.F90: -------------------------------------------------------------------------------- 1 | program preprocessor 2 | 3 | #include "petscpc.h" 4 | #ifdef PETSCPCDEF_H 5 | integer, parameter :: var = 1000 6 | PCType :: tmp 7 | print*, 999, 3.14, "some", var, PETSC_ERR_MEM 8 | print*, PETSC_ERR_INT_OVERFLOW, varVar 9 | ewrite(1,*) 'Assemble EP P1 matrix and rhs sytem' 10 | ewrite2(1,*) 'Assemble EP P1 matrix and rhs sytem' 11 | print*, SUCCESS 12 | 13 | #endif 14 | end program preprocessor 15 | -------------------------------------------------------------------------------- /test/test_source/subdir/test_rename.F90: -------------------------------------------------------------------------------- 1 | module rename_mod1 2 | real(8) :: var1 3 | end module rename_mod1 4 | ! 5 | module rename_mod2 6 | use rename_mod1, only: renamed_var1 => var1 7 | integer :: originalname 8 | end module rename_mod2 9 | ! 10 | subroutine test_rename_sub() 11 | use rename_mod2, only : localname => originalname, renamed_var2 => renamed_var1 12 | implicit none 13 | ! 14 | localname = 4 15 | renamed_var2 = 4 16 | end subroutine test_rename_sub 17 | -------------------------------------------------------------------------------- /test/test_source/test_import.f90: -------------------------------------------------------------------------------- 1 | module mymod 2 | implicit none 3 | private 4 | public mytype, mytype2 5 | integer, public :: int1, int2, int3, int4, int5 6 | type :: mytype 7 | integer :: comp 8 | end type mytype 9 | type :: mytype2 10 | integer :: comp 11 | end type mytype2 12 | interface 13 | subroutine sub() 14 | import int1 15 | import mytype, int2 16 | type(mytype) :: some 17 | end subroutine sub 18 | end interface 19 | end module mymod 20 | -------------------------------------------------------------------------------- /CITATION.cff: -------------------------------------------------------------------------------- 1 | # This CITATION.cff file was generated with cffinit. 2 | # Visit https://bit.ly/cffinit to generate yours today! 3 | 4 | cff-version: 1.2.0 5 | title: fortls - Fortran Language Server 6 | message: >- 7 | If you use this software, please cite it using the 8 | metadata from this file. 9 | type: software 10 | authors: 11 | - family-names: Nikiteas 12 | name-suffix: Ioannis 13 | email: gnikit@duck.com 14 | affiliation: Imperial College London 15 | orcid: 'https://orcid.org/0000-0001-9811-9250' 16 | -------------------------------------------------------------------------------- /test/test_source/vis/private.f90: -------------------------------------------------------------------------------- 1 | module visibility 2 | private :: name 3 | private :: generic_interf 4 | interface name 5 | module procedure :: name_sp 6 | end interface name 7 | interface 8 | subroutine generic_interf(noop) 9 | integer, intent(in) :: noop 10 | end subroutine generic_interf 11 | end interface 12 | contains 13 | subroutine name_sp(val) 14 | real(4), intent(in) :: val 15 | print *, 'name_sp', val 16 | end subroutine name_sp 17 | end module visibility 18 | -------------------------------------------------------------------------------- /fortls/parsers/internal/do.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | from typing import TYPE_CHECKING 4 | 5 | from fortls.constants import DO_TYPE_ID 6 | 7 | from .block import Block 8 | 9 | if TYPE_CHECKING: 10 | from .ast import FortranAST 11 | 12 | 13 | class Do(Block): 14 | def __init__(self, file_ast: FortranAST, line_number: int, name: str): 15 | super().__init__(file_ast, line_number, name) 16 | 17 | def get_type(self, no_link=False): 18 | return DO_TYPE_ID 19 | 20 | def get_desc(self): 21 | return "DO" 22 | -------------------------------------------------------------------------------- /fortls/parsers/internal/if_block.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | from typing import TYPE_CHECKING 4 | 5 | from fortls.constants import IF_TYPE_ID 6 | 7 | from .block import Block 8 | 9 | if TYPE_CHECKING: 10 | from .ast import FortranAST 11 | 12 | 13 | class If(Block): 14 | def __init__(self, file_ast: FortranAST, line_number: int, name: str): 15 | super().__init__(file_ast, line_number, name) 16 | 17 | def get_type(self, no_link=False): 18 | return IF_TYPE_ID 19 | 20 | def get_desc(self): 21 | return "IF" 22 | -------------------------------------------------------------------------------- /test/test_source/diag/test_where.f90: -------------------------------------------------------------------------------- 1 | program test_where 2 | implicit none 3 | ! Example variables 4 | real:: A(5),B(5),C(5) 5 | A = 0.0 6 | B = 1.0 7 | C = [0.0, 4.0, 5.0, 10.0, 0.0] 8 | 9 | ! Oneliner 10 | WHERE(B .GT. 0.0) B = SUM(A, DIM=1) 11 | 12 | ! Simple where construct use 13 | where (C/=0) 14 | A=B/C 15 | elsewhere 16 | A=0.0 17 | end where 18 | 19 | ! Named where construct 20 | named: where (C/=0) 21 | A=B/C 22 | elsewhere 23 | A=0.0 24 | end where named 25 | end program test_where 26 | -------------------------------------------------------------------------------- /fortls/parsers/internal/enum.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | from typing import TYPE_CHECKING 4 | 5 | from fortls.constants import ENUM_TYPE_ID 6 | 7 | from .block import Block 8 | 9 | if TYPE_CHECKING: 10 | from .ast import FortranAST 11 | 12 | 13 | class Enum(Block): 14 | def __init__(self, file_ast: FortranAST, line_number: int, name: str): 15 | super().__init__(file_ast, line_number, name) 16 | 17 | def get_type(self, no_link=False): 18 | return ENUM_TYPE_ID 19 | 20 | def get_desc(self): 21 | return "ENUM" 22 | -------------------------------------------------------------------------------- /fortls/parsers/internal/where.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | from typing import TYPE_CHECKING 4 | 5 | from fortls.constants import WHERE_TYPE_ID 6 | 7 | from .block import Block 8 | 9 | if TYPE_CHECKING: 10 | from .ast import FortranAST 11 | 12 | 13 | class Where(Block): 14 | def __init__(self, file_ast: FortranAST, line_number: int, name: str): 15 | super().__init__(file_ast, line_number, name) 16 | 17 | def get_type(self, no_link=False): 18 | return WHERE_TYPE_ID 19 | 20 | def get_desc(self): 21 | return "WHERE" 22 | -------------------------------------------------------------------------------- /test/test_source/docs/test_module_and_type_doc.f90: -------------------------------------------------------------------------------- 1 | !> module doc for doxygen_doc_mod 2 | !! 3 | !! with info 4 | module doxygen_doc_mod 5 | implicit none 6 | 7 | !> Doc for a_t 8 | type :: a_t 9 | end type 10 | end module 11 | 12 | 13 | module ford_doc_mod 14 | !! Doc for ford_doc_mod 15 | implicit none 16 | 17 | type :: b_t 18 | !! Doc for b_t 19 | end type 20 | 21 | end module 22 | 23 | 24 | program main 25 | use doxygen_doc_mod 26 | use ford_doc_mod 27 | 28 | type(a_t) :: a 29 | type(b_t) :: b 30 | end program 31 | -------------------------------------------------------------------------------- /SECURITY.md: -------------------------------------------------------------------------------- 1 | # Security Policy 2 | 3 | ## Supported Versions 4 | 5 | `fortls` supports **ONLY** the latest Release. An autoupdate function is enabled by default to fetch the newest updates from `PyPi`. 6 | For Anaconda environments the autoupdate functionality is disabled and it is up to the user to update to the latest version. 7 | 8 | 9 | ## Reporting a Vulnerability 10 | 11 | The codebase is regularly scanned and patched for any potential security vulnerabilities. 12 | If you manage to find a vulnerability in the Language Server please open an [Bug Report](https://github.com/fortran-lang/fortls/issues) with prefix: **SECURITY:**. 13 | -------------------------------------------------------------------------------- /fortls/parsers/internal/module.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | from fortls.constants import MODULE_TYPE_ID 4 | 5 | from .scope import Scope 6 | 7 | 8 | class Module(Scope): 9 | def get_type(self, no_link=False): 10 | return MODULE_TYPE_ID 11 | 12 | def get_desc(self): 13 | return "MODULE" 14 | 15 | def get_hover(self, long=False, drop_arg=-1) -> tuple[str, str]: 16 | hover = f"{self.get_desc()} {self.name}" 17 | doc_str = self.get_documentation() 18 | return hover, doc_str 19 | 20 | def check_valid_parent(self) -> bool: 21 | return self.parent is None 22 | -------------------------------------------------------------------------------- /.github/workflows/docs.yml: -------------------------------------------------------------------------------- 1 | name: "Docs" 2 | on: [push, pull_request] 3 | 4 | jobs: 5 | docs: 6 | runs-on: ubuntu-latest 7 | steps: 8 | - uses: actions/checkout@v4 9 | - uses: actions/setup-python@v5 10 | with: 11 | python-version: "3.11" 12 | - name: Build docs 13 | run: | 14 | pip install -e .[dev,docs] 15 | make -C docs html 16 | - name: Deploy 17 | uses: peaceiris/actions-gh-pages@v4 18 | if: github.ref == 'refs/heads/master' 19 | with: 20 | github_token: ${{ secrets.GITHUB_TOKEN }} 21 | publish_dir: docs/_build/html 22 | -------------------------------------------------------------------------------- /test/test_source/diag/test_semicolon.f90: -------------------------------------------------------------------------------- 1 | program test_semicolon 2 | implicit none 3 | integer :: a = 1; character(len=1) :: v; real, parameter :: p = 0.1E-4; character(len=10), parameter :: str = "a;val;that" 4 | character(len=100), parameter :: str2 = "a;string;"& 5 | "that;becomes"// & 6 | ";"& 7 | &"multiline";integer& 8 | :: b;real & 9 | &,& 10 | parameter& 11 | ::& 12 | c& 13 | =& 14 | 100& 15 | &0090;real :: d;real::e;real::f 16 | print*, "one"; 17 | print*, str2 18 | print*, a; print*, p; ! a; comment; that;contains; semi-colons 19 | end program test_semicolon 20 | -------------------------------------------------------------------------------- /test/test_source/test_block.f08: -------------------------------------------------------------------------------- 1 | SUBROUTINE block_sub() 2 | INTEGER :: res0,i,j,end_var 3 | res0 = 0 4 | add1 : BLOCK 5 | INTEGER :: res1 6 | res1 = res0 + 1 7 | BLOCK 8 | INTEGER :: res2,blockVar 9 | res2 = res1 + 1 10 | blockVar = res0 + 1 11 | END BLOCK 12 | END BLOCK add1 13 | ! 14 | outer: DO i=1,10 15 | DO j=1,i 16 | res0=res0+1 17 | END DO 18 | END DO outer 19 | ! 20 | IF(res0>10)THEN 21 | i=res0 22 | END IF 23 | ! 24 | ASSOCIATE( x=>1 ) 25 | i=i+x 26 | END ASSOCIATE 27 | ! Test variables/labels starting with "end" 28 | end_var= 1 29 | end_label: DO i=1,3 30 | end_var = end_var + i 31 | END DO end_label 32 | END SUBROUTINE block_sub 33 | -------------------------------------------------------------------------------- /test/test_source/completion/use_only_interface.f90: -------------------------------------------------------------------------------- 1 | module some_mod 2 | implicit none 3 | private 4 | public :: some_sub 5 | interface some_sub 6 | module procedure a_subroutine 7 | module procedure b_subroutine 8 | end interface 9 | contains 10 | subroutine a_subroutine(x) 11 | integer, intent(in) :: x 12 | write(*,*) 'x = ', x 13 | end subroutine a_subroutine 14 | subroutine b_subroutine(x, y) 15 | integer, intent(in) :: x, y 16 | write(*,*) 'x = ', x 17 | write(*,*) 'y = ', y 18 | end subroutine b_subroutine 19 | end module some_mod 20 | 21 | program main 22 | use some_mod, only: some_sub 23 | implicit none 24 | end program main 25 | -------------------------------------------------------------------------------- /fortls/parsers/internal/block.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | import copy 4 | from typing import TYPE_CHECKING 5 | 6 | from fortls.constants import BLOCK_TYPE_ID 7 | 8 | from .scope import Scope 9 | 10 | if TYPE_CHECKING: 11 | from .ast import FortranAST 12 | 13 | 14 | class Block(Scope): 15 | def __init__(self, file_ast: FortranAST, line_number: int, name: str): 16 | super().__init__(file_ast, line_number, name) 17 | 18 | def get_type(self, no_link=False): 19 | return BLOCK_TYPE_ID 20 | 21 | def get_desc(self): 22 | return "BLOCK" 23 | 24 | def get_children(self, public_only=False): 25 | return copy.copy(self.children) 26 | 27 | def req_named_end(self): 28 | return True 29 | -------------------------------------------------------------------------------- /test/test_source/subdir/test_select.f90: -------------------------------------------------------------------------------- 1 | MODULE test_select 2 | IMPLICIT NONE 3 | ! 4 | TYPE :: parent 5 | INTEGER(4) :: n 6 | END TYPE parent 7 | ! 8 | TYPE, EXTENDS(parent) :: child1 9 | REAL(8) :: a 10 | END TYPE child1 11 | ! 12 | TYPE, EXTENDS(parent) :: child2 13 | COMPLEX(8) :: a 14 | END TYPE child2 15 | CONTAINS 16 | ! 17 | SUBROUTINE test_select_sub(self) 18 | CLASS(parent), INTENT(inout) :: self 19 | ! Select statement with binding 20 | SELECT TYPE(this=>self) 21 | TYPE IS(child1) 22 | this%a 23 | CLASS IS(child2) 24 | this%a 25 | CLASS DEFAULT 26 | this%n 27 | END SELECT 28 | ! Select statement without binding 29 | SELECT TYPE(self) 30 | TYPE IS(child1) 31 | self%a 32 | END SELECT 33 | END SUBROUTINE test_select_sub 34 | END MODULE test_select 35 | -------------------------------------------------------------------------------- /test/test_source/imp/submodule.f90: -------------------------------------------------------------------------------- 1 | module parent_mod 2 | implicit none 3 | type :: typ 4 | real(kind=8) :: value 5 | contains 6 | procedure :: method1 => submod_method1 7 | end type typ 8 | interface 9 | module subroutine submod_method1(this) 10 | class(typ), intent(inout) :: this 11 | end subroutine submod_method1 12 | module subroutine submod_method2(this, value) 13 | class(typ), intent(inout) :: this 14 | real, intent(in) :: value 15 | end subroutine submod_method2 16 | end interface 17 | end module parent_mod 18 | submodule(parent_mod) submod 19 | contains 20 | module subroutine submod_method1(this) 21 | class(typ), intent(inout) :: this 22 | this%value = 0 23 | end subroutine submod_method1 24 | end submodule submod 25 | -------------------------------------------------------------------------------- /test/test_source/pp/preproc_if_nested.F90: -------------------------------------------------------------------------------- 1 | subroutine preprocessor_if_nested() 2 | 3 | ! This file, as used in test_preproc, tests that when there are nested 4 | ! if-else preprocessor blocks, only the branches are used where ALL 5 | ! statements leading to the definition evaluate to true. 6 | 7 | #if 0 8 | #if 1 9 | #define PART1 1 10 | #else 11 | #define PART2 1 12 | #endif 13 | #else 14 | #if 1 15 | #define PART3 1 16 | #else 17 | #define PART4 1 18 | #endif 19 | #endif 20 | 21 | #ifndef PART1 22 | #define PART1 0 23 | #endif 24 | #ifndef PART2 25 | #define PART2 0 26 | #endif 27 | #ifndef PART3 28 | #define PART3 0 29 | #endif 30 | #ifndef PART4 31 | #define PART4 0 32 | #endif 33 | 34 | integer, parameter :: res = PART1+PART2+PART3+PART4 35 | 36 | endsubroutine preprocessor_if_nested 37 | -------------------------------------------------------------------------------- /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: # Replace with up to 4 GitHub Sponsors-enabled usernames e.g., [user1, user2] 4 | patreon: # Replace with a single Patreon username 5 | open_collective: # Replace with a single Open Collective username 6 | ko_fi: # Replace with a single Ko-fi username 7 | tidelift: # pypi/fortls 8 | community_bridge: # Replace with a single Community Bridge project-name e.g., cloud-foundry 9 | liberapay: # Replace with a single Liberapay username 10 | issuehunt: # Replace with a single IssueHunt username 11 | otechie: # Replace with a single Otechie username 12 | lfx_crowdfunding: # Replace with a single LFX Crowdfunding project-name e.g., cloud-foundry 13 | custom: # Replace with up to 4 custom sponsorship URLs e.g., ['link1', 'link2'] 14 | -------------------------------------------------------------------------------- /assets/README.md: -------------------------------------------------------------------------------- 1 | # Info about Licenses 2 | 3 | All the contents of this directory (original URL: ) and any subsequent directories or links or copies of this directory 4 | are licensed under the 5 | [Creative Commons Attribution-NonCommercial-NoDerivatives 4.0 International](https://creativecommons.org/licenses/by-nc-nd/4.0/) license. 6 | 7 | The `symbol-class.svg` is licensed by Microsoft under a [Creative Commons Attribution 4.0 International License](https://creativecommons.org/licenses/by/4.0/legalcode), 8 | which allows for derivative works to change the original license. 9 | 10 | The owner of this repository reserve all other rights, whether under their respective copyrights, patents, or trademarks, whether by implication, estoppel or otherwise. 11 | -------------------------------------------------------------------------------- /test/test_source/diag/test_scope_overreach.f90: -------------------------------------------------------------------------------- 1 | module m 2 | interface 3 | module subroutine sub(arg) 4 | integer :: arg 5 | end subroutine 6 | end interface 7 | end module m 8 | 9 | submodule (m) n 10 | 11 | use, intrinsic :: iso_fortran_env, only: int8, int16, int32, int64 12 | implicit none 13 | 14 | integer, parameter :: sp = selected_real_kind(6) 15 | integer, parameter :: dp = selected_real_kind(15) 16 | 17 | contains 18 | 19 | pure recursive module function foo_sp(x) result(fi) 20 | real(sp), intent(in) :: x 21 | real(sp) :: fi 22 | end function foo_sp 23 | 24 | pure recursive module function foo_dp(x) result(fi) 25 | real(dp), intent(in) :: x 26 | real(dp) :: fi 27 | end function foo_dp 28 | end submodule n 29 | -------------------------------------------------------------------------------- /test/test_source/pp/preproc_if_elif_else.F90: -------------------------------------------------------------------------------- 1 | subroutine preprocessor_if_elif_else() 2 | 3 | ! This file, as used in test_preproc, and together with the two similar files, 4 | ! tests that when there is an if-elif-elif-else, only the first branch that 5 | ! evaluates to true is used, and the others ignored. Also when multiple 6 | ! conditions evaluate to true. 7 | 8 | #if 0 9 | #define PART1 0 10 | #elif 0 11 | #define PART2 0 12 | #elif 0 13 | #define PART3 0 14 | #else 15 | #define PART4 1 16 | #endif 17 | 18 | #ifndef PART1 19 | #define PART1 0 20 | #endif 21 | #ifndef PART2 22 | #define PART2 0 23 | #endif 24 | #ifndef PART3 25 | #define PART3 0 26 | #endif 27 | #ifndef PART4 28 | #define PART4 0 29 | #endif 30 | 31 | integer, parameter :: res = PART1+PART2+PART3+PART4 32 | 33 | endsubroutine preprocessor_if_elif_else 34 | -------------------------------------------------------------------------------- /test/test_source/pp/preproc_if_elif_skip.F90: -------------------------------------------------------------------------------- 1 | subroutine preprocessor_if_elif_skip() 2 | 3 | ! This file, as used in test_preproc, and together with the two similar files, 4 | ! tests that when there is an if-elif-elif-else, only the first branch that 5 | ! evaluates to true is used, and the others ignored. Also when multiple 6 | ! conditions evaluate to true. 7 | 8 | #if 1 9 | #define PART1 1 10 | #elif 0 11 | #define PART2 0 12 | #elif 1 13 | #define PART3 0 14 | #else 15 | #define PART4 0 16 | #endif 17 | 18 | #ifndef PART1 19 | #define PART1 0 20 | #endif 21 | #ifndef PART2 22 | #define PART2 0 23 | #endif 24 | #ifndef PART3 25 | #define PART3 0 26 | #endif 27 | #ifndef PART4 28 | #define PART4 0 29 | #endif 30 | 31 | integer, parameter :: res = PART1+PART2+PART3+PART4 32 | 33 | end subroutine preprocessor_if_elif_skip 34 | -------------------------------------------------------------------------------- /test/test_source/pp/preproc_elif_elif_skip.F90: -------------------------------------------------------------------------------- 1 | subroutine preprocessor_elif_elif_skip() 2 | 3 | ! This file, as used in test_preproc, and together with the two similar files, 4 | ! tests that when there is an if-elif-elif-else, only the first branch that 5 | ! evaluates to true is used, and the others ignored. Also when multiple 6 | ! conditions evaluate to true. 7 | 8 | #if 0 9 | #define PART1 0 10 | #elif 1 11 | #define PART2 1 12 | #elif 1 13 | #define PART3 0 14 | #else 15 | #define PART4 0 16 | #endif 17 | 18 | #ifndef PART1 19 | #define PART1 0 20 | #endif 21 | #ifndef PART2 22 | #define PART2 0 23 | #endif 24 | #ifndef PART3 25 | #define PART3 0 26 | #endif 27 | #ifndef PART4 28 | #define PART4 0 29 | #endif 30 | 31 | integer, parameter :: res = PART1+PART2+PART3+PART4 32 | 33 | end subroutine preprocessor_elif_elif_skip 34 | -------------------------------------------------------------------------------- /test/test_source/docs/test_ford.f90: -------------------------------------------------------------------------------- 1 | module test_fortd 2 | implicit none 3 | 4 | contains 5 | 6 | subroutine feed_pets(cats, dogs, food, angry) 7 | !! Feeds your cats and dogs, if enough food is available. If not enough 8 | !! food is available, some of your pets will get angry. 9 | 10 | ! Arguments 11 | integer, intent(in) :: cats 12 | !! The number of cats to keep track of. 13 | integer, intent(in) :: dogs 14 | !! The number of dogs to keep track of. 15 | real, intent(inout) :: food 16 | !! The amount of pet food (in kilograms) which you have on hand. 17 | integer, intent(out) :: angry 18 | !! The number of pets angry because they weren't fed. 19 | 20 | return 21 | end subroutine feed_pets 22 | end module test_fortd 23 | -------------------------------------------------------------------------------- /test/test_source/rename/test_rename_intrinsic.f90: -------------------------------------------------------------------------------- 1 | module test_rename_intrinsic 2 | implicit none 3 | interface size 4 | module procedure size_comp 5 | end interface size 6 | contains 7 | 8 | subroutine size_comp(val, ret) 9 | integer, intent(in) :: val(:) 10 | integer, intent(out) :: ret 11 | integer, dimension(5) :: fixed 12 | ret = maxval([size(val), size(fixed)]) 13 | end subroutine size_comp 14 | 15 | end module test_rename_intrinsic 16 | 17 | program driver 18 | use test_rename_intrinsic 19 | implicit none 20 | integer, dimension(10) :: val 21 | integer, dimension(5) :: tmp 22 | integer :: sz 23 | call size(val, sz) ! This is fortran_sub and should be renamed 24 | print*, size(val) ! This is an intrinsic, should be skipped in renaming 25 | end program driver 26 | -------------------------------------------------------------------------------- /test/test_source/excldir/sub1/tmp.f90: -------------------------------------------------------------------------------- 1 | module oumods 2 | use, intrinsic :: iso_c_binding 3 | implicit integer(c_int) (i-k), integer(c_int) (m,n), & 4 | & real(c_double) (a-h), real(c_double) (l), real(c_double) (o-z) 5 | 6 | TYPE :: ex_type 7 | INTEGER :: A = 0 8 | CONTAINS 9 | FINAL :: del_ex_type 10 | PROCEDURE :: sub => ex_sub 11 | END TYPE ex_type 12 | 13 | contains 14 | subroutine zI12(t,c,alpha,beta,r) 15 | complex(c_double_complex) c,r, x,y,z 16 | z = c*t 17 | y = exp(z) 18 | x = (2.0_c_double * cosh((z - cmplx(0._c_double,3.14159265358979324_c_double, kind(1._c_double))) & 19 | & /2._c_double )) / (c / exp((z + cmplx(0._c_double,3.14159265358979324_c_double,kind(1._c_double)))/2._c_double)) 20 | r = beta*r+alpha*((t*y - x)/c) 21 | end subroutine 22 | end module 23 | -------------------------------------------------------------------------------- /.pre-commit-config.yaml: -------------------------------------------------------------------------------- 1 | # See https://pre-commit.com for more information 2 | # See https://pre-commit.com/hooks.html for more hooks 3 | repos: 4 | - repo: https://github.com/pre-commit/pre-commit-hooks 5 | rev: v4.6.0 6 | hooks: 7 | - id: trailing-whitespace 8 | - id: end-of-file-fixer 9 | - id: check-yaml 10 | - id: check-added-large-files 11 | args: ['--maxkb=2000'] 12 | - repo: https://github.com/PyCQA/flake8 13 | rev: 7.0.0 14 | hooks: 15 | - id: flake8 16 | - repo: https://github.com/asottile/pyupgrade 17 | rev: v3.15.2 18 | hooks: 19 | - id: pyupgrade 20 | - repo: https://github.com/pycqa/isort 21 | rev: 5.13.2 22 | hooks: 23 | - id: isort 24 | name: isort (python) 25 | - repo: https://github.com/psf/black 26 | rev: 24.4.2 27 | hooks: 28 | - id: black 29 | -------------------------------------------------------------------------------- /test/test_source/pp/preproc_elif.F90: -------------------------------------------------------------------------------- 1 | subroutine preprocessor_elif(var, var3, var4, var5, var6) 2 | 3 | ! This file, as used in test_preproc, checks that 4 | ! 1. the steps after the preprocessor parsing has fully finished, are only 5 | ! using content from the parts within the preprocessor if-elif-else that 6 | ! should be used. To do this, it has some regular fortran code within the 7 | ! #if and #elif. 8 | ! 2. the #endif correctly concludes the if-elif, so any new #define statements 9 | ! that come after the #endif, are picked up during the preprocessor parsing. 10 | 11 | #if 0 12 | integer, intent(in) :: var 13 | #elif 1 14 | integer, intent(inout) :: var 15 | var = 3 16 | #else 17 | integer, intent(out) :: var 18 | var = 5 19 | #endif 20 | 21 | #define OTHERTYPE integer 22 | 23 | OTHERTYPE :: var2 24 | 25 | PRINT*, var 26 | 27 | endsubroutine preprocessor_elif 28 | -------------------------------------------------------------------------------- /docs/Makefile: -------------------------------------------------------------------------------- 1 | # Minimal makefile for Sphinx documentation 2 | # 3 | 4 | # You can set these variables from the command line, and also 5 | # from the environment for the first two. 6 | SPHINXOPTS ?= 7 | SPHINXBUILD ?= sphinx-build 8 | SPHINXAPIDOC ?= sphinx-apidoc 9 | PANDOC ?= pandoc 10 | SOURCEDIR = . 11 | BUILDDIR = _build 12 | 13 | # Put it first so that "make" without argument is like "make help". 14 | help: 15 | @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) 16 | 17 | .PHONY: help Makefile 18 | 19 | # Catch-all target: route all unknown targets to Sphinx using the new 20 | # "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS). 21 | %: Makefile 22 | @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) 23 | 24 | modules: 25 | @$(SPHINXAPIDOC) -f -H "Developers' documentations" ../fortls -o . 26 | -------------------------------------------------------------------------------- /test/test_source/subdir/test_fixed.f: -------------------------------------------------------------------------------- 1 | double precision function myfun(n,xval) 2 | integer i,n 3 | c ********** 4 | double precision xval 5 | integer ieq1(2), ieq2(2) 6 | double precision req(2) 7 | character*(LEN=200) bob 8 | character dave*(20) 9 | equivalence (req(1),ieq1(1)) 10 | equivalence (req(2),ieq2(1)) 11 | c 12 | data req(1) /1.0000000d-16/ 13 | data req(2) /1.0000000d-308/ 14 | c 15 | myfun = xval 16 | bob(1:20) = dave 17 | do 10 i = 1, n 18 | 10 myfun = myfun + xval 19 | return 20 | c 21 | end 22 | c 23 | subroutine glob_sub(n,xval,yval) 24 | integer i,n 25 | c ********** 26 | double complex xval,yval 27 | c 28 | yval = xval 29 | do 20 i = 1, n 30 | yval = yval + xval 31 | 20 continue 32 | return 33 | c 34 | end 35 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/feature_request.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Feature request 3 | about: Suggest an idea for this project 4 | title: '' 5 | labels: enhancement 6 | assignees: '' 7 | 8 | --- 9 | 10 | 14 | 15 | **Is your feature request related to a problem? Please describe.** 16 | A clear and concise description of what the problem is. Ex. I'm always frustrated when [...] 17 | 18 | **Describe the solution you'd like** 19 | A clear and concise description of what you want to happen. 20 | 21 | **Describe alternatives you've considered** 22 | A clear and concise description of any alternative solutions or features you've considered. 23 | 24 | **Additional context** 25 | Add any other context or screenshots about the feature request here. 26 | -------------------------------------------------------------------------------- /test/test_source/signature/help.f90: -------------------------------------------------------------------------------- 1 | module sig_help_markdown 2 | implicit none 3 | private 4 | 5 | contains 6 | !> Top level Doc 7 | subroutine sub2call(arg1, arg2) 8 | integer, intent(in) :: arg1 !< Doc for arg1 9 | integer, intent(in), optional :: arg2 !< Doc for arg2 10 | print*, "sub2call: arg1=", arg1 11 | if (present(arg2)) print*, "sub2call: arg2=", arg2 12 | end subroutine sub2call 13 | 14 | !> Top level Doc 15 | function fun2fcall(arg1, arg2) result(res) 16 | integer, intent(in) :: arg1 !< Doc for arg1 17 | integer, intent(in), optional :: arg2 !< Doc for arg2 18 | integer :: res 19 | res = arg1 20 | if (present(arg2)) res = res + arg2 21 | end function fun2fcall 22 | 23 | subroutine calling() 24 | call sub2call(1, 2) 25 | print*, "fun2fcall(1, 2)=", fun2fcall(1, 2) 26 | end subroutine calling 27 | 28 | end module sig_help_markdown 29 | -------------------------------------------------------------------------------- /docs/contact.rst: -------------------------------------------------------------------------------- 1 | Contact Us 2 | =============== 3 | 4 | Are you a company that uses ``fortls``? 5 | Do you need technical support? 6 | Is there a feature missing that you would like to see or have you spotted a bug? 7 | 8 | **Reach out and let us know!** 9 | 10 | 11 | You can reach out in a number of ways: 12 | 13 | - Start a `GitHub Discussion `__. 14 | - Ask a question on `Fortran Language Discourse `__ and tag `@gnikit `__ in your post. 15 | - For Feature Requests open an issue on `GitHub `__. 16 | - For Bug Reports, open a bug report on `GitHub `__. Make sure to check the open GitHub issues! 17 | - For any other inquiry contact ``gnikit [@] duck [.] com`` 18 | -------------------------------------------------------------------------------- /docs/make.bat: -------------------------------------------------------------------------------- 1 | @ECHO OFF 2 | 3 | pushd %~dp0 4 | 5 | REM Command file for Sphinx documentation 6 | 7 | if "%SPHINXBUILD%" == "" ( 8 | set SPHINXBUILD=sphinx-build 9 | ) 10 | set SOURCEDIR=. 11 | set BUILDDIR=_build 12 | 13 | if "%1" == "" goto help 14 | 15 | %SPHINXBUILD% >NUL 2>NUL 16 | if errorlevel 9009 ( 17 | echo. 18 | echo.The 'sphinx-build' command was not found. Make sure you have Sphinx 19 | echo.installed, then set the SPHINXBUILD environment variable to point 20 | echo.to the full path of the 'sphinx-build' executable. Alternatively you 21 | echo.may add the Sphinx directory to PATH. 22 | echo. 23 | echo.If you don't have Sphinx installed, grab it from 24 | echo.https://www.sphinx-doc.org/ 25 | exit /b 1 26 | ) 27 | 28 | %SPHINXBUILD% -M %1 %SOURCEDIR% %BUILDDIR% %SPHINXOPTS% %O% 29 | goto end 30 | 31 | :help 32 | %SPHINXBUILD% -M help %SOURCEDIR% %BUILDDIR% %SPHINXOPTS% %O% 33 | 34 | :end 35 | popd 36 | -------------------------------------------------------------------------------- /.github/workflows/docs_preview.yml: -------------------------------------------------------------------------------- 1 | name: Docs Preview 2 | 3 | permissions: 4 | pull-requests: write 5 | 6 | on: 7 | pull_request: 8 | types: 9 | - opened 10 | - synchronize 11 | - reopened 12 | - edited 13 | - closed 14 | paths: 15 | - "docs/**" 16 | - "fortls/interface.py" 17 | workflow_dispatch: 18 | 19 | concurrency: preview-${{github.ref}} 20 | 21 | jobs: 22 | deploy-preview: 23 | runs-on: ubuntu-latest 24 | steps: 25 | - uses: actions/checkout@v4 26 | - uses: actions/setup-python@v5 27 | with: 28 | python-version: "3.11" 29 | - name: Build docs 30 | run: | 31 | pip install -e .[dev,docs] 32 | make -C docs html 33 | - name: Deploy Preview 34 | uses: rossjrw/pr-preview-action@v1.6.0 35 | with: 36 | source-dir: docs/_build/html 37 | preview-branch: gh-pages 38 | custom-url: fortls.fortran-lang.org 39 | -------------------------------------------------------------------------------- /test/test_source/hover/recursive.f90: -------------------------------------------------------------------------------- 1 | module tree 2 | type tree_inode 3 | integer :: value = 0 4 | type (tree_inode), pointer :: left=>null() 5 | type (tree_inode), pointer :: right=>null() 6 | type (tree_inode), pointer :: parent=>null() 7 | end type tree_inode 8 | 9 | contains 10 | recursive subroutine recursive_assign_descending(node, vector, current_loc) 11 | type(tree_inode), pointer, intent(in) :: node 12 | integer, dimension(:), intent(inout) :: vector 13 | integer, intent(inout) :: current_loc 14 | 15 | if (associated(node)) then 16 | call recursive_assign_descending(node%right, vector, current_loc) 17 | vector(current_loc) = node%value 18 | current_loc = current_loc + 1 19 | call recursive_assign_descending(node%left, vector, current_loc) 20 | end if 21 | return 22 | end subroutine recursive_assign_descending 23 | end module tree 24 | -------------------------------------------------------------------------------- /test/test_source/test_prog.f08: -------------------------------------------------------------------------------- 1 | PROGRAM test_program 2 | ! Here is a commonly included unicode character "–" 3 | USE test_free, ONLY: vector, scaled_vector, module_variable, test_sig_sub 4 | IMPLICIT NONE 5 | ! 6 | CHARACTER(LEN=*) :: test_str1 = "i2.2,':',i2.2", test_str2 = 'i2.2,":",i2.2' 7 | INTEGER(4) :: n,a,b,c,d 8 | REAL(8) :: x,y 9 | COMPLEX(8) :: xc,yc 10 | TYPE(vector) :: loc_vector 11 | TYPE(scaled_vector) :: stretch_vector, vector1d(1) 12 | ! 13 | y = myfun(n,x) 14 | CALL glob_sub(n,xc,yc) 15 | ! 16 | CALL loc_vector%create(n) 17 | x = loc_vector%norm() 18 | CALL loc_vector%bound_nopass(a,x) 19 | CALL loc_vector%bound_pass(n) 20 | ! 21 | CALL stretch_vector%create(n) 22 | CALL stretch_vector%set_scale(loc_vector%norm(self)) 23 | x = stretch_vector%norm() 24 | y = stretch_vector%scale%val 25 | ! 26 | CALL test_sig_Sub(a,b,opt2=c,opt3=d) 27 | PRINT*, module_variable 28 | y = stretch_vector%scale % val 29 | y = stretch_vector % scale % val 30 | y = vector1d( 1 ) % scale % val 31 | END PROGRAM test_program 32 | -------------------------------------------------------------------------------- /test/test_server_init.py: -------------------------------------------------------------------------------- 1 | import os 2 | import tempfile 3 | 4 | import pytest 5 | from setup_tests import Path, run_request, write_rpc_request 6 | 7 | from fortls.constants import Severity 8 | 9 | 10 | @pytest.fixture() 11 | def setup_tmp_file(): 12 | levels = 2000 13 | fd, filename = tempfile.mkstemp(suffix=".f90") 14 | try: 15 | with os.fdopen(fd, "w") as tmp: 16 | tmp.write( 17 | "program nested_if\n" 18 | + str("if (.true.) then\n" * levels) 19 | + str("end if\n" * levels) 20 | + "end program nested_if" 21 | ) 22 | yield filename 23 | finally: 24 | os.remove(filename) 25 | 26 | 27 | def test_recursion_error_handling(setup_tmp_file): 28 | root = Path(setup_tmp_file).parent 29 | request_string = write_rpc_request(1, "initialize", {"rootPath": str(root)}) 30 | errcode, results = run_request(request_string) 31 | assert errcode == 0 32 | assert results[0]["type"] == Severity.error 33 | -------------------------------------------------------------------------------- /test/test_source/diag/test_function_arg_list.f90: -------------------------------------------------------------------------------- 1 | program test_arg_names_as_keywords 2 | implicit none 3 | integer, parameter :: impure = 8 4 | contains 5 | subroutine foo(recursive, ierr) 6 | integer, intent(in) :: recursive 7 | integer, intent(out) :: ierr 8 | print*, recursive 9 | end subroutine foo 10 | real(8) impure elemental function foo2(recursive, elemental) result(pure) 11 | integer, intent(in) :: recursive, elemental 12 | end function foo2 13 | real( kind = impure ) pure elemental function foo3(recursive) result(pure) 14 | integer, intent(in) :: recursive 15 | end function foo3 16 | subroutine foo4(& 17 | recursive, & 18 | ierr) 19 | integer, intent(in) :: recursive 20 | integer, intent(out) :: ierr 21 | print*, recursive 22 | end subroutine foo4 23 | pure real(impure) function foo5(recursive) result(val) 24 | integer, intent(in) :: recursive 25 | end function foo5 26 | end program test_arg_names_as_keywords 27 | -------------------------------------------------------------------------------- /test/test_source/hover/parameters.f90: -------------------------------------------------------------------------------- 1 | program params 2 | implicit none 3 | integer, parameter :: var = & 4 | 1000, & 5 | var2 = 23, var3 = & 6 | var*var2, & 7 | var4 = 123 8 | double precision, parameter :: somevar = 23.12, some = 1e-19 9 | logical(kind=8), parameter :: long_bool = .true. 10 | character(len=5), parameter :: sq_str = '12345' 11 | character(len=5), parameter :: dq_str = "12345" 12 | integer, parameter :: var_no_space=123 13 | integer, parameter :: var_more_space = 123 14 | integer, parameter :: var_sum1 = 1 + 23 15 | integer, parameter :: var_ex1 = 1 - 23 16 | integer, parameter :: var_mul1 = 1 * 23 17 | integer, parameter :: var_div1 = 1/1 18 | INTEGER, PARAMETER :: var_multi2 = 1 * & 19 | 23 + & 20 | 2 /1 ! comment 21 | INTEGER(4), PARAMETER :: SIG$ERR = -1 22 | end program params 23 | -------------------------------------------------------------------------------- /test/test_server_messages.py: -------------------------------------------------------------------------------- 1 | from setup_tests import run_request, test_dir, write_rpc_request 2 | 3 | 4 | def check_msg(ref, res): 5 | assert ref["type"] == res["type"] 6 | assert ref["message"] == res["message"] 7 | 8 | 9 | # def test_config_file_non_existent(): 10 | # string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) 11 | # errcode, results = run_request(string, ["-c", "fake.json"]) 12 | # 13 | # ref = {"type": 1, "message": "Configuration file 'fake.json' not found"} 14 | # assert errcode == 0 15 | # check_msg(ref, results[0]) 16 | 17 | 18 | def test_config_file_non_existent_options(): 19 | string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) 20 | errcode, results = run_request(string, ["-c", "wrong_syntax.json"]) 21 | 22 | ref = { 23 | "type": 1, 24 | "message": ( 25 | 'Error: ":2 Unexpected "," at column 18" while reading' 26 | ' "wrong_syntax.json" Configuration file' 27 | ), 28 | } 29 | assert errcode == 0 30 | check_msg(ref, results[0]) 31 | -------------------------------------------------------------------------------- /test/test_source/f90_config.json: -------------------------------------------------------------------------------- 1 | { 2 | "nthreads": 8, 3 | "notify_init": true, 4 | "incremental_sync": true, 5 | "recursion_limit": 1500, 6 | "sort_keywords": true, 7 | "disable_autoupdate": true, 8 | 9 | "source_dirs": ["subdir", "pp/**"], 10 | "incl_suffixes": [".FF", ".fpc", ".h", "f20"], 11 | "excl_suffixes": ["_tmp.f90", "_h5hut_tests.F90"], 12 | "excl_paths": ["excldir", "hover/**"], 13 | 14 | "autocomplete_no_prefix": true, 15 | "autocomplete_no_snippets": true, 16 | "autocomplete_name_only": true, 17 | "lowercase_intrinsics": true, 18 | "use_signature_help": true, 19 | 20 | "variable_hover": true, 21 | "hover_signature": true, 22 | "hover_language": "FortranFreeForm", 23 | 24 | "max_line_length": 80, 25 | "max_comment_line_length": 80, 26 | "disable_diagnostics": true, 27 | 28 | "pp_suffixes": [".h", ".fh"], 29 | "include_dirs": ["./include/**"], 30 | "pp_defs": { 31 | "HAVE_PETSC": "", 32 | "HAVE_ZOLTAN": "", 33 | "Mat": "type(tMat)" 34 | }, 35 | 36 | "symbol_skip_mem": true, 37 | 38 | "enable_code_actions": true 39 | } 40 | -------------------------------------------------------------------------------- /test/test_source/test_diagnostic_int.f90: -------------------------------------------------------------------------------- 1 | module test_int 2 | 3 | implicit none 4 | 5 | contains 6 | 7 | subroutine foo(f, arg2) 8 | interface 9 | function f(x) 10 | real, intent(in) :: x 11 | real :: f 12 | end function 13 | end interface 14 | integer, intent(in) :: arg2 15 | real :: y 16 | y = 1. 17 | print*, f(y) 18 | end subroutine foo 19 | 20 | function foo2(f, g, h) result(arg3) 21 | interface 22 | function f(x) result(z) 23 | real, intent(in) :: x 24 | real :: z 25 | end function 26 | function g(x) result(z) 27 | real, intent(in) :: x 28 | real :: z 29 | end function 30 | end interface 31 | interface 32 | function h(x) result(z) 33 | real, intent(in) :: x 34 | real :: z 35 | end function h 36 | end interface 37 | real :: y 38 | real :: arg3 39 | y = 1. 40 | arg3 = f(g(h(y))) 41 | end function foo2 42 | 43 | end module test_int 44 | -------------------------------------------------------------------------------- /fortls/__init__.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | import sys 4 | from multiprocessing import freeze_support 5 | 6 | from .debug import ( 7 | DebugError, 8 | debug_lsp, 9 | debug_parser, 10 | debug_preprocessor, 11 | is_debug_mode, 12 | ) 13 | from .interface import cli 14 | from .jsonrpc import JSONRPC2Connection, ReadWriter 15 | from .langserver import LangServer 16 | from .version import __version__ 17 | 18 | __all__ = ["__version__"] 19 | 20 | 21 | def main(): 22 | freeze_support() 23 | args = cli(__name__).parse_args() 24 | 25 | try: 26 | if args.debug_parser: 27 | debug_parser(args) 28 | 29 | elif args.debug_preproc: 30 | debug_preprocessor(args) 31 | 32 | elif is_debug_mode(args): 33 | debug_lsp(args, vars(args)) 34 | 35 | else: 36 | stdin, stdout = sys.stdin.buffer, sys.stdout.buffer 37 | LangServer( 38 | conn=JSONRPC2Connection(ReadWriter(stdin, stdout)), 39 | settings=vars(args), 40 | ).run() 41 | except DebugError as e: 42 | print(f"ERROR: {e}") 43 | sys.exit(-1) 44 | -------------------------------------------------------------------------------- /licenses/fortran-language-server-license.txt: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright 2017-2019 Chris Hansen 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /.github/workflows/update-intrinsics.yml: -------------------------------------------------------------------------------- 1 | on: 2 | # fire at 00:00 every 7th day of the month 3 | schedule: 4 | - cron: "0 0 */7 * *" 5 | workflow_dispatch: 6 | 7 | name: Check M_intrinsics for updates 8 | jobs: 9 | update-intrinsics: 10 | runs-on: ubuntu-latest 11 | steps: 12 | - uses: actions/checkout@v4 13 | 14 | - name: Setup 15 | run: | 16 | python3 -m pip install --upgrade pip 17 | pip install .[dev] 18 | 19 | - name: Download M_intrinsics 20 | run: | 21 | git clone https://github.com/urbanjost/M_intrinsics 22 | 23 | - name: Update Markdown intrinsics 24 | run: | 25 | python3 scripts/update_m_intrinsics.py 26 | 27 | - name: Create Pull Request 28 | uses: peter-evans/create-pull-request@v7 29 | with: 30 | token: ${{ secrets.GITHUB_TOKEN }} 31 | commit-message: "docs: update M_intrinsics" 32 | title: Update M_intrinsics 33 | body: | 34 | Auto-generated Pull Request to update M_intrinsics JSON definitions. 35 | branch: docs/update-intrinsics 36 | delete-branch: true 37 | reviewers: gnikit 38 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright 2017-2019 Chris Hansen 4 | 5 | Copyright 2021-2022 Giannis Nikiteas 6 | 7 | Permission is hereby granted, free of charge, to any person obtaining a copy 8 | of this software and associated documentation files (the "Software"), to deal 9 | in the Software without restriction, including without limitation the rights 10 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 11 | copies of the Software, and to permit persons to whom the Software is 12 | furnished to do so, subject to the following conditions: 13 | 14 | The above copyright notice and this permission notice shall be included in all 15 | copies or substantial portions of the Software. 16 | 17 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 18 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 19 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 20 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 21 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 23 | SOFTWARE. 24 | -------------------------------------------------------------------------------- /test/test_source/parse/mixed/multilines.F90: -------------------------------------------------------------------------------- 1 | program multiline_tests 2 | implicit none 3 | integer :: result 4 | character(len=100) :: str 5 | 6 | ! Test: Simple multi-line continuation 7 | result = 1 + & 8 | 2 + & 9 | 3 10 | 11 | ! Test: Multi-line continuation with a preprocessor directive 12 | result = 10 + & 13 | #ifdef TEST 14 | 20 + & 15 | #endif 16 | 30 17 | 18 | ! Test: Multi-line continuation with string concatenation 19 | str = 'Hello' // & 20 | & ' ' // & 21 | & 'World' 22 | 23 | ! Test: Multi-line continuation with mixed preprocessor and arithmetic operations 24 | result = & 25 | #ifdef MULT 26 | (10*2) + & 27 | #else 28 | (10 * 3) + & 29 | #endif 30 | & 10 * 4 31 | 32 | ! Test: Multi-line continuation with C preprocessor && sequence 33 | result = 100 + & 34 | #if defined(TEST) && defined(MULT) 35 | &(20) + & 36 | #endif 37 | &10 38 | 39 | ! Test: multiplee Multi-line continuation with C preprocessor and comments 40 | result = 1000 + & ! Comment 0 41 | #if defined( TEST ) && defined( MULT ) 42 | &100 + & ! Comment 1 43 | &200+& !! Comment 2 44 | #else 45 | 500 + & !!! Comment 3 46 | #endif 47 | &600 48 | 49 | end program multiline_tests 50 | -------------------------------------------------------------------------------- /fortls/parsers/internal/imports.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | from typing import TYPE_CHECKING 4 | 5 | from .use import Use 6 | 7 | if TYPE_CHECKING: 8 | from .module import Module 9 | from .scope import Scope 10 | 11 | 12 | class ImportTypes: 13 | DEFAULT = -1 14 | NONE = 0 15 | ALL = 1 16 | ONLY = 2 17 | 18 | 19 | class Import(Use): 20 | """AST node for IMPORT statement""" 21 | 22 | def __init__( 23 | self, 24 | name: str, 25 | import_type: ImportTypes = ImportTypes.DEFAULT, 26 | only_list: set[str] = None, 27 | rename_map: dict[str, str] = None, 28 | line_number: int = 0, 29 | ): 30 | if only_list is None: 31 | only_list = set() 32 | if rename_map is None: 33 | rename_map = {} 34 | super().__init__(name, only_list, rename_map, line_number) 35 | self.import_type = import_type 36 | self._scope: Scope | Module | None = None 37 | 38 | @property 39 | def scope(self): 40 | """Parent scope of IMPORT statement i.e. parent of the interface""" 41 | return self._scope 42 | 43 | @scope.setter 44 | def scope(self, scope: Scope): 45 | self._scope = scope 46 | -------------------------------------------------------------------------------- /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | name: Tests 2 | 3 | on: 4 | [push, pull_request] 5 | # Allows you to run this workflow manually from the Actions tab 6 | # workflow_dispatch: 7 | 8 | jobs: 9 | build: 10 | strategy: 11 | matrix: 12 | os: [ubuntu-latest, windows-latest] 13 | python-version: ["3.8", "3.9", "3.10", "3.11", "3.12", "3.13"] 14 | fail-fast: false 15 | runs-on: ${{ matrix.os }} 16 | 17 | steps: 18 | - uses: actions/checkout@v4 19 | - uses: actions/setup-python@v5 20 | with: 21 | python-version: ${{ matrix.python-version }} 22 | architecture: x64 23 | 24 | - name: Setup 25 | run: pip install .[dev] 26 | 27 | - name: Lint 28 | run: black --diff --check --verbose . 29 | 30 | - name: Check schema is up to date 31 | run: | 32 | python3 -m fortls.schema 33 | git diff --exit-code ./fortls/fortls.schema.json 34 | 35 | - name: Unittests 36 | run: pytest --doctest-modules -n auto 37 | 38 | - name: Upload coverage to Codecov 39 | uses: codecov/codecov-action@v5.4.0 40 | with: 41 | fail_ci_if_error: true 42 | verbose: true 43 | env: 44 | CODECOV_TOKEN: ${{ secrets.CODECOV_TOKEN }} 45 | -------------------------------------------------------------------------------- /fortls/schema.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | import json 4 | import pathlib 5 | 6 | from pydantic import Field, create_model 7 | 8 | from fortls.interface import cli 9 | 10 | 11 | def create_schema(root: pathlib.Path | None = None): 12 | if not root: 13 | root = pathlib.Path(__file__).parent 14 | 15 | parser = cli("fortls") 16 | only_vals = {} 17 | for arg in parser._actions: 18 | if ( 19 | arg.dest == "help" 20 | or arg.dest == "version" 21 | or arg.help == "==SUPPRESS==" 22 | or (arg.dest.startswith("debug") and arg.dest != "debug_log") 23 | ): 24 | continue 25 | val = arg.default 26 | desc: str = arg.help.replace("%(default)s", str(val)) # type: ignore 27 | only_vals[arg.dest] = (type(val), Field(val, description=desc)) # type: ignore 28 | 29 | m = create_model("fortls schema", **only_vals) 30 | m.__doc__ = "Schema for the fortls Fortran Language Server" 31 | 32 | with open(str(root / "fortls.schema.json"), "w", encoding="utf-8") as f: 33 | print(json.dumps(m.model_json_schema(), indent=2), file=f) 34 | print(f"Created schema file: {root / 'fortls.schema.json'}") 35 | 36 | 37 | if __name__ == "__main__": 38 | create_schema() 39 | -------------------------------------------------------------------------------- /test/test_preproc_parser.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | from fortls.parsers.internal.parser import preprocess_file 4 | 5 | 6 | def test_pp_leading_spaces(): 7 | lines = [ 8 | " #define LEADING_SPACES_INDENT 1", 9 | " # define LEADING_SPACES_INDENT2", 10 | " # define FILE_ENCODING ,encoding='UTF-8'", 11 | "program pp_intentation", 12 | " implicit none", 13 | " print*, LEADING_SPACES_INDENT", 14 | " open(unit=1,file='somefile.txt' FILE_ENCODING)", 15 | "end program pp_intentation", 16 | ] 17 | _, _, _, defs = preprocess_file(lines) 18 | ref = { 19 | "LEADING_SPACES_INDENT": "1", 20 | "LEADING_SPACES_INDENT2": "True", 21 | "FILE_ENCODING": ",encoding='UTF-8'", 22 | } 23 | assert defs == ref 24 | 25 | 26 | def test_pp_macro_expansion(): 27 | lines = [ 28 | "# define WRAP(PROCEDURE) PROCEDURE , wrap_/**/PROCEDURE", 29 | "generic, public :: set => WRAP(abc)", 30 | "procedure :: WRAP(abc)", 31 | ] 32 | ref = [ 33 | "# define WRAP(PROCEDURE) PROCEDURE , wrap_/**/PROCEDURE", 34 | "generic, public :: set => abc , wrap_/**/abc", 35 | "procedure :: abc , wrap_/**/abc", 36 | ] 37 | output, _, _, _ = preprocess_file(lines) 38 | assert output == ref 39 | -------------------------------------------------------------------------------- /docs/contributing.rst: -------------------------------------------------------------------------------- 1 | 2 | Contributing to fortls 3 | ====================== 4 | 5 | There are a few ways you can support the ``fortls`` project. 6 | 7 | Financial Support 8 | ------------------ 9 | 10 | You can fiscally support Fortran-lang by donating to the project, see 11 | `Fortran-lang - NumFOCUS`_. 12 | 13 | .. _Fortran-lang - NumFOCUS: https://numfocus.org/donate-for-fortran-lang 14 | 15 | 16 | .. .. grid:: 2 17 | .. :gutter: 0 18 | .. :class-container: sd-text-center sd-pt-4 19 | .. :class-row: sd-align-minor-center 20 | 21 | .. .. grid-item:: 22 | .. .. button-link:: https://github.com/sponsors/gnikit 23 | .. :ref-type: ref 24 | .. :outline: 25 | .. :color: danger 26 | .. :class: sd-px-2 sd-fs-4 27 | 28 | .. Become a **Sponsor** 29 | .. :octicon:`mark-github;2em;sd-text-black` 30 | .. :octicon:`heart-fill;2em;sd-text-danger` 31 | 32 | .. .. grid-item:: 33 | .. .. button-link:: https://www.paypal.com/paypalme/inikit 34 | .. :ref-type: ref 35 | .. :color: primary 36 | .. :class: sd-px-2 sd-fs-5 37 | 38 | .. Make a **Donation** 39 | .. :fa:`fa-paypal` 40 | 41 | 42 | Contributing Code 43 | ----------------- 44 | 45 | .. include:: ./../CONTRIBUTING.md 46 | :parser: myst_parser.sphinx_ 47 | :start-line: 2 48 | -------------------------------------------------------------------------------- /test/test_regex_patterns.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | import pytest 4 | 5 | from fortls.regex_patterns import create_src_file_exts_regex 6 | 7 | 8 | @pytest.mark.parametrize( 9 | "input_exts, input_files, matches", 10 | [ 11 | ( 12 | [], 13 | [ 14 | "test.f", 15 | "test.F", 16 | "test.f90", 17 | "test.F90", 18 | "test.f03", 19 | "test.F03", 20 | "test.f18", 21 | "test.F18", 22 | "test.f77", 23 | "test.F77", 24 | "test.f95", 25 | "test.F95", 26 | "test.for", 27 | "test.FOR", 28 | "test.fpp", 29 | "test.FPP", 30 | ], 31 | [True] * 16, 32 | ), 33 | ([], ["test.ff", "test.f901", "test.f90.ff"], [False, False, False]), 34 | ([r"\.inc"], ["test.inc", "testinc", "test.inc2"], [True, False, False]), 35 | (["inc.*"], ["test.inc", "testinc", "test.inc2"], [True, True, True]), 36 | ], 37 | ) 38 | def test_src_file_exts( 39 | input_exts: list[str], 40 | input_files: list[str], 41 | matches: list[bool], 42 | ): 43 | regex = create_src_file_exts_regex(input_exts) 44 | results = [bool(regex.search(file)) for file in input_files] 45 | assert results == matches 46 | -------------------------------------------------------------------------------- /test/test_source/docs/test_doxygen.f90: -------------------------------------------------------------------------------- 1 | module test_doxygen 2 | implicit none 3 | 4 | contains 5 | 6 | !> @brief inserts a value into an ordered array 7 | !! 8 | !! An array "list" consisting of n ascending ordered values. The method insert a 9 | !! "new_entry" into the array. 10 | !! hint: use cshift and eo-shift 11 | !! 12 | !! @param[in,out] list a real array, size: max_size 13 | !! @param[in] n current values in the array 14 | !! @param[in] max_size size if the array 15 | !! @param[in] new_entry the value to insert 16 | subroutine insert(list, n, max_size, new_entry) 17 | real, dimension (:), intent (inout) :: list 18 | integer, intent (in) :: n, max_size 19 | real, intent (in) :: new_entry 20 | end subroutine insert 21 | 22 | !> @brief calcs the angle between two given vectors 23 | !! 24 | !! using the standard formula: 25 | !! \f$\cos \theta = \frac{ \vec v \cdot \vec w}{\abs{v}\abs{w}}\f$. 26 | !! 27 | !! @param[in] \f$v,w\f$ real vectors 28 | !! size: n 29 | !! @return a real value describing the angle. 0 if \f$\abs v\f$ or \f$\abs w\f$ below a 30 | !! threshold. 31 | pure function calc_angle(v, w) result (theta) 32 | real, dimension (:), intent (in) :: v, w 33 | real :: theta 34 | end function calc_angle 35 | 36 | end module test_doxygen 37 | -------------------------------------------------------------------------------- /fortls/parsers/internal/use.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | 4 | # Helper classes 5 | class Use: 6 | """AST node for USE statement""" 7 | 8 | def __init__( 9 | self, 10 | mod_name: str, 11 | only_list: set[str] = None, 12 | rename_map: dict[str, str] = None, 13 | line_number: int = 0, 14 | ): 15 | if only_list is None: 16 | only_list = set() 17 | if rename_map is None: 18 | rename_map = {} 19 | self.mod_name: str = mod_name.lower() 20 | self._line_no: int = line_number 21 | self.only_list: set[str] = only_list 22 | self.rename_map: dict[str, str] = rename_map 23 | if only_list: 24 | self.only_list: set[str] = {only.lower() for only in only_list} 25 | if rename_map: 26 | self.rename_map = {k.lower(): v.lower() for k, v in rename_map.items()} 27 | 28 | @property 29 | def line_number(self): 30 | return self._line_no 31 | 32 | @line_number.setter 33 | def line_number(self, line_number: int): 34 | self._line_no = line_number 35 | 36 | def rename(self, only_list: list[str] = None): 37 | """Rename ONLY:, statements""" 38 | if only_list is None: 39 | only_list = [] 40 | if not only_list: 41 | only_list = self.only_list 42 | return [self.rename_map.get(only_name, only_name) for only_name in only_list] 43 | -------------------------------------------------------------------------------- /fortls/parsers/internal/interface.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | from typing import TYPE_CHECKING 4 | 5 | from fortls.constants import INTERFACE_TYPE_ID 6 | 7 | from .scope import Scope 8 | from .utilities import find_in_scope 9 | 10 | if TYPE_CHECKING: 11 | from .ast import FortranAST 12 | 13 | 14 | class Interface(Scope): 15 | def __init__( 16 | self, 17 | file_ast: FortranAST, 18 | line_number: int, 19 | name: str, 20 | abstract: bool = False, 21 | ): 22 | super().__init__(file_ast, line_number, name) 23 | self.mems = [] 24 | self.abstract = abstract 25 | self.external = name.startswith("#GEN_INT") and (not abstract) 26 | 27 | def get_type(self, no_link=False): 28 | return INTERFACE_TYPE_ID 29 | 30 | def get_desc(self): 31 | return "INTERFACE" 32 | 33 | def is_callable(self): 34 | return True 35 | 36 | def is_external_int(self): 37 | return self.external 38 | 39 | def is_abstract(self): 40 | return self.abstract 41 | 42 | def resolve_link(self, obj_tree): 43 | if self.parent is None: 44 | return 45 | self.mems = [] 46 | for member in self.members: 47 | mem_obj = find_in_scope(self.parent, member, obj_tree) 48 | if mem_obj is not None: 49 | self.mems.append(mem_obj) 50 | 51 | def require_link(self): 52 | return True 53 | -------------------------------------------------------------------------------- /test/test_source/subdir/test_submod.F90: -------------------------------------------------------------------------------- 1 | module points 2 | type :: point 3 | real :: x, y 4 | end type point 5 | 6 | interface 7 | module function point_dist(a, b) result(distance) 8 | type(point), intent(in) :: a, b 9 | real :: distance 10 | end function point_dist 11 | 12 | module logical function is_point_equal_a(a, b) 13 | type(point), intent(in) :: a, b 14 | end function is_point_equal_a 15 | 16 | module subroutine is_point_equal_sub(a, b, test) 17 | type(point), intent(in) :: a, b 18 | logical, intent(out) :: test 19 | end subroutine is_point_equal_sub 20 | end interface 21 | contains 22 | logical function is_point_equal(a, b) 23 | type(point), intent(in) :: a, b 24 | is_point_equal = merge(.true., .false., a%x == b%x .and. a%y == b%y) 25 | end function is_point_equal 26 | end module points 27 | #define __PARENT_MOD__ points 28 | submodule (__PARENT_MOD__) points_a 29 | contains 30 | module function point_dist(a, b) 31 | type(point), intent(in) :: a, b 32 | distance = sqrt((a%x - b%x)**2 + (a%y - b%y)**2) 33 | end function point_dist 34 | 35 | module procedure is_point_equal_a 36 | type(point) :: c 37 | is_point_equal_a = merge(.true., .false., a%x == b%x .and. a%y == b%y) 38 | end procedure is_point_equal_a 39 | 40 | module procedure is_point_equal_sub 41 | type(point) :: c 42 | test = is_point_equal(a,b) 43 | end procedure is_point_equal_sub 44 | end submodule points_a 45 | -------------------------------------------------------------------------------- /test/test_source/subdir/test_generic.f90: -------------------------------------------------------------------------------- 1 | MODULE test_generic 2 | TYPE :: test_gen_type 3 | CONTAINS 4 | GENERIC :: my_gen => gen1,gen2 5 | GENERIC :: ASSIGNMENT(=) => assign1, assign2 6 | GENERIC :: OPERATOR(+) => plusop1, plusop2 7 | GENERIC, PRIVATE :: my_gen2 => gen3, gen4 8 | END TYPE test_gen_type 9 | CONTAINS 10 | ! 11 | SUBROUTINE gen1(self,a,b) 12 | CLASS(test_gen_type) :: self 13 | REAL(8), INTENT(IN) :: a 14 | REAL(8), INTENT(OUT) :: b 15 | CALL self% 16 | END SUBROUTINE gen1 17 | ! 18 | SUBROUTINE gen2(self,a,b,c) 19 | CLASS(test_gen_type) :: self 20 | REAL(8), INTENT(IN) :: a,c 21 | REAL(8), INTENT(OUT) :: b 22 | END SUBROUTINE gen2 23 | ! 24 | SUBROUTINE assign1(outvar,invar) 25 | REAL(8) :: outvar 26 | CLASS(test_gen_type) :: invar 27 | END SUBROUTINE assign1 28 | ! 29 | SUBROUTINE assign2(outvar,invar) 30 | LOGICAL :: outvar 31 | CLASS(test_gen_type) :: invar 32 | END SUBROUTINE assign2 33 | ! 34 | REAL(8) FUNCTION plusop1(var1,var2) 35 | REAL(8) :: var1 36 | CLASS(test_gen_type) :: var2 37 | END FUNCTION plusop1 38 | ! 39 | LOGICAL FUNCTION plusop2(var1,var2) 40 | LOGICAL :: var1 41 | CLASS(test_gen_type) :: var2 42 | END FUNCTION plusop2 43 | ! 44 | SUBROUTINE gen3(self,a,b) 45 | CLASS(test_gen_type) :: self 46 | REAL(8), INTENT(IN) :: a 47 | REAL(8), INTENT(OUT) :: b 48 | CALL self% 49 | END SUBROUTINE gen3 50 | ! 51 | SUBROUTINE gen4(self,a,b,c) 52 | CLASS(test_gen_type) :: self 53 | REAL(8), INTENT(IN) :: a,c 54 | REAL(8), INTENT(OUT) :: b 55 | END SUBROUTINE gen4 56 | END MODULE test_generic 57 | -------------------------------------------------------------------------------- /test/test_source/imp/import.f90: -------------------------------------------------------------------------------- 1 | module import_mod 2 | implicit none 3 | type :: type1 4 | real(kind=8) :: value 5 | contains 6 | procedure :: abs_int => abs_int1 7 | end type type1 8 | type :: type2 9 | type(type1) :: t 10 | end type type2 11 | interface 12 | subroutine abs_int1(this) 13 | import type1 14 | class(type1), intent(inout) :: this ! only type1 15 | end subroutine abs_int1 16 | subroutine abs_int2(this) 17 | import, only: type2 18 | class(type2), intent(inout) :: this ! only type2 19 | end subroutine abs_int2 20 | subroutine abs_int3(this) 21 | import, none 22 | class(type1), intent(inout) :: this ! no comp results 23 | end subroutine abs_int3 24 | subroutine abs_int4(this) 25 | import, all 26 | class(type1), intent(inout) :: this ! type1 and type2 27 | end subroutine abs_int4 28 | subroutine abs_int5(this) 29 | import 30 | class(type1), intent(inout) :: this ! type1 and type2 31 | end subroutine abs_int5 32 | subroutine abs_int6(this) 33 | import type1 34 | import type2 35 | class(type1), intent(inout) :: this ! type1 and type2 36 | end subroutine abs_int6 37 | subroutine abs_int7(this) 38 | import :: type1, type2 39 | class(type1), intent(inout) :: this ! type1 and type2 40 | end subroutine abs_int7 41 | end interface 42 | end module import_mod 43 | 44 | program main 45 | use import_mod 46 | type(type1) :: obj 47 | call obj%abs_int() 48 | end program main 49 | -------------------------------------------------------------------------------- /fortls/json_templates.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | 4 | def range_json(sln: int, sch: int, eln: int = None, ech: int = None): 5 | return { 6 | "range": { 7 | "start": {"line": sln, "character": sch}, 8 | "end": {"line": eln if eln else sln, "character": ech if ech else sch}, 9 | } 10 | } 11 | 12 | 13 | def diagnostic_json(sln: int, sch: int, eln: int, ech: int, msg: str, sev: int): 14 | return {**range_json(sln, sch, eln, ech), "message": msg, "severity": sev} 15 | 16 | 17 | def uri_json(uri: str, sln: int, sch: int, eln: int = None, ech: int = None): 18 | return {"uri": uri, **range_json(sln, sch, eln, ech)} 19 | 20 | 21 | def location_json(uri: str, sln: int, sch: int, eln: int = None, ech: int = None): 22 | return {"location": uri_json(uri, sln, sch, eln, ech)} 23 | 24 | 25 | def symbol_json( 26 | name: str, 27 | kind: int, 28 | uri: str, 29 | sln: int, 30 | sch: int, 31 | eln: int = None, 32 | ech: int = None, 33 | container_name: str = None, 34 | ): 35 | if container_name: 36 | return { 37 | "name": name, 38 | "kind": kind, 39 | **location_json(uri, sln, sch, eln, ech), 40 | "containerName": container_name, 41 | } 42 | return {"name": name, "kind": kind, **location_json(uri, sln, sch, eln, ech)} 43 | 44 | 45 | def change_json(new_text: str, sln: int, sch: int, eln: int = None, ech: int = None): 46 | return {**range_json(sln, sch, eln, ech), "newText": new_text} 47 | -------------------------------------------------------------------------------- /test/test_source/parse/test_kinds_and_dims.f90: -------------------------------------------------------------------------------- 1 | subroutine normal_kinds() 2 | integer, parameter :: r15 = selected_real_kind(15) 3 | integer(kind=4) :: a, b(3,4) 4 | integer*8 aa, bb(3,4) 5 | integer(8) :: aaa, bbb(3,4) 6 | real(kind=r15) :: r 7 | real(kind(0.d0)) :: rr 8 | end subroutine normal_kinds 9 | 10 | real*8 function foo(val) result(r) 11 | real(8), intent(in) :: val 12 | r = val 13 | end function foo 14 | 15 | real(kind=8) function phi(val) result(r) 16 | real(8), intent(in) :: val 17 | r = val 18 | end function phi 19 | 20 | subroutine character_len_parsing(input) 21 | ! global variable_type * length variable_name1, variable_name2,... 22 | CHARACTER*17 A, B(3,4), V(9) 23 | CHARACTER*(6+3) C 24 | CHARACTER*10D(3,4) 25 | CHARACTER*(LEN(B))DD(3,4) 26 | ! local variable_type variable_name1 * length, variable_name2 * length,... 27 | CHARACTER AA*17, BB(3,4)*17, VV(9)*17 28 | CHARACTER CC*(6+3) 29 | CHARACTER AAA*(LEN(A)) 30 | CHARACTER INPUT(*)*10 31 | ! explicit len and kind for characters 32 | CHARACTER(LEN=200) F 33 | CHARACTER(KIND=4, LEN=200) FF(3,4) 34 | CHARACTER(KIND=4, LEN=200) AAAA(3,4)*100 35 | 36 | ! override global length with local length 37 | CHARACTER*10 BBB(3,4)*(LEN(B)) ! has the length of len(b) 38 | CHARACTER*10CCC(3,4)*(LEN(B)) ! no-space 39 | CHARACTER(KIND=4) BBBB(3,4)*(LEN(B)) ! cannot have *10(kind=4) or vice versa 40 | 41 | INTEGER((4)) INT_KIND_IMP ! FIXME: (()) trips up the regex 42 | end subroutine character_len_parsing 43 | -------------------------------------------------------------------------------- /assets/symbol-class.svg: -------------------------------------------------------------------------------- 1 | 2 | 42 | -------------------------------------------------------------------------------- /fortls/parsers/internal/diagnostics.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | from fortls.json_templates import diagnostic_json, location_json 4 | from fortls.jsonrpc import path_to_uri 5 | 6 | 7 | class Diagnostic: 8 | def __init__( 9 | self, sline: int, message: str, severity: int = 1, find_word: str = None 10 | ): 11 | self.sline: int = sline 12 | self.message: str = message 13 | self.severity: int = severity 14 | self.find_word: str = find_word 15 | self.has_related: bool = False 16 | self.related_path = None 17 | self.related_line = None 18 | self.related_message = None 19 | 20 | def add_related(self, path: str, line: int, message: str): 21 | self.has_related = True 22 | self.related_path = path 23 | self.related_line = line 24 | self.related_message = message 25 | 26 | def build(self, file_obj): 27 | schar = echar = 0 28 | if self.find_word is not None: 29 | self.sline, obj_range = file_obj.find_word_in_code_line( 30 | self.sline, self.find_word 31 | ) 32 | if obj_range.start >= 0: 33 | schar = obj_range.start 34 | echar = obj_range.end 35 | diag = diagnostic_json( 36 | self.sline, schar, self.sline, echar, self.message, self.severity 37 | ) 38 | if self.has_related: 39 | diag["relatedInformation"] = [ 40 | { 41 | **location_json( 42 | path_to_uri(self.related_path), self.related_line, 0 43 | ), 44 | "message": self.related_message, 45 | } 46 | ] 47 | return diag 48 | -------------------------------------------------------------------------------- /.github/workflows/python-publish.yml: -------------------------------------------------------------------------------- 1 | # This workflow will upload a Python Package using Twine when a release is created 2 | # For more information see: https://help.github.com/en/actions/language-and-framework-guides/using-python-with-github-actions#publishing-to-package-registries 3 | 4 | # This workflow uses actions that are not certified by GitHub. 5 | # They are provided by a third-party and are governed by 6 | # separate terms of service, privacy policy, and support 7 | # documentation. 8 | 9 | name: PyPi Release 10 | 11 | on: 12 | release: 13 | types: [published] 14 | 15 | jobs: 16 | deploy: 17 | runs-on: ubuntu-latest 18 | 19 | steps: 20 | - uses: actions/checkout@v4 21 | - name: Set up Python 22 | uses: actions/setup-python@v5 23 | with: 24 | python-version: "3.x" 25 | 26 | - uses: softprops/action-gh-release@master 27 | if: startsWith(github.ref, 'refs/tags/v') 28 | with: 29 | files: ./fortls/fortls.schema.json 30 | 31 | - name: Install dependencies 32 | run: | 33 | python -m pip install --upgrade pip 34 | pip install build 35 | 36 | - name: Build package 37 | run: python -m build 38 | 39 | - name: Publish to Test PyPi 40 | if: startsWith(github.ref, 'refs/tags') 41 | uses: pypa/gh-action-pypi-publish@release/v1 42 | with: 43 | user: __token__ 44 | password: ${{ secrets.TEST_PYPI_API_TOKEN }} 45 | repository-url: https://test.pypi.org/legacy/ 46 | - name: Publish to PyPi 47 | if: startsWith(github.ref, 'refs/tags') 48 | uses: pypa/gh-action-pypi-publish@release/v1 49 | with: 50 | user: __token__ 51 | password: ${{ secrets.PYPI_API_TOKEN }} 52 | -------------------------------------------------------------------------------- /fortls/constants.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | import logging 4 | 5 | from fortls.regex_patterns import FortranRegularExpressions 6 | 7 | log = logging.getLogger(__name__) 8 | 9 | # Global variables 10 | sort_keywords = True 11 | 12 | # Keyword identifiers 13 | KEYWORD_LIST = [ 14 | "pointer", 15 | "allocatable", 16 | "optional", 17 | "public", 18 | "private", 19 | "nopass", 20 | "target", 21 | "save", 22 | "parameter", 23 | "contiguous", 24 | "deferred", 25 | "dimension", 26 | "intent", 27 | "pass", 28 | "pure", 29 | "impure", 30 | "elemental", 31 | "recursive", 32 | "abstract", 33 | "external", 34 | ] 35 | KEYWORD_ID_DICT = {keyword: ind for (ind, keyword) in enumerate(KEYWORD_LIST)} 36 | 37 | # Type identifiers 38 | BASE_TYPE_ID = -1 39 | MODULE_TYPE_ID = 1 40 | SUBROUTINE_TYPE_ID = 2 41 | FUNCTION_TYPE_ID = 3 42 | CLASS_TYPE_ID = 4 43 | INTERFACE_TYPE_ID = 5 44 | VAR_TYPE_ID = 6 45 | METH_TYPE_ID = 7 46 | SUBMODULE_TYPE_ID = 8 47 | BLOCK_TYPE_ID = 9 48 | SELECT_TYPE_ID = 10 49 | DO_TYPE_ID = 11 50 | WHERE_TYPE_ID = 12 51 | IF_TYPE_ID = 13 52 | ASSOC_TYPE_ID = 14 53 | ENUM_TYPE_ID = 15 54 | 55 | 56 | class Severity: 57 | error = 1 58 | warn = 2 59 | info = 3 60 | 61 | 62 | #: A string used to mark literals e.g. 10, 3.14, "words", etc. 63 | #: The description name chosen is non-ambiguous and cannot naturally 64 | #: occur in Fortran (with/out C preproc) code 65 | #: It is invalid syntax to define a type starting with numerics 66 | #: it cannot also be a comment that requires !, c, d 67 | #: and ^= (xor_eq) operator is invalid in Fortran C++ preproc 68 | FORTRAN_LITERAL = "0^=__LITERAL_INTERNAL_DUMMY_VAR_" 69 | 70 | # Fortran Regular Expressions dataclass variable, immutable 71 | FRegex = FortranRegularExpressions() 72 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/bug_report.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Bug report 3 | about: Create a report to help us improve 4 | title: '' 5 | labels: bug 6 | assignees: '' 7 | 8 | --- 9 | 10 | **Describe the bug** 11 | A clear and concise description of what the bug is. 12 | 13 | **To Reproduce** 14 | Try and reproduce the `fortls` error through the debug interface, for more see `fortls --debug_help`. Usually debug requests start like `fortls --debug_filepath your_file.f90 --debug_rootpath . ...`. 15 | 16 | Start with posting: 17 | 1. a **Minimal Working Example** to demonstrate the bug 18 | 2. the `fortls` command to reproduce the issue, or your `fortls` 19 | 3. the output of the `fortls` command 20 | 4. Any additional JSONRPC requests like the ones produced with `--debug_log` 21 | 22 | Alternatively, you can try and describe the steps that you followed to encounter the bug: 23 | 1. Go to '...' 24 | 2. Click on '....' 25 | 3. Scroll down to '....' 26 | 4. See error 27 | 28 | **Expected behavior** 29 | A clear and concise description of what you expected to happen. 30 | 31 | **Screenshots & Animations** 32 | If applicable, add screenshots or GIF/MP4 animations to help explain your problem. 33 | 34 | **Setup information (please complete the following information):** 35 | - OS: [e.g. Linux, Mac] 36 | - Python Version [e.g. 3.10] 37 | - fortls Version [e.g. 2.3] 38 | - Code editor used [e.g. VS Code, Vim] 39 | - the Fortran extension for the code editor and its version [e.g. Modern Fortran v3.0.0] (if applicable) 40 | 41 | **Configuration information (please complete the following information):** 42 | - Your `.fortlsrc` or `.fortls.json` or `.fortls` configuration file OR any other JSON config being used (if any) 43 | - Any settings specified through your extension [e.g. for VS Code settings from `settings.json`] 44 | 45 | **Additional context** 46 | Add any other context about the problem here. 47 | -------------------------------------------------------------------------------- /test/test_source/hover/functions.f90: -------------------------------------------------------------------------------- 1 | ! simple function 2 | function fun1(arg) 3 | integer, intent(in) :: arg 4 | integer :: fun1 5 | end function fun1 6 | 7 | ! function with type on definition, implied result 8 | integer function fun2(arg) 9 | integer, intent(in) :: arg 10 | end function fun2 11 | 12 | ! function with return 13 | function fun3(arg) result(retval) 14 | integer, intent(in) :: arg 15 | integer :: retval 16 | end function fun3 17 | 18 | ! function with type on definition and return 19 | integer function fun4(arg) result(retval) 20 | integer, intent(in) :: arg 21 | end function fun4 22 | 23 | ! function with type on definition, return and keywords 24 | pure integer elemental function fun5(arg) result(retval) 25 | integer, intent(in) :: arg 26 | end function fun5 27 | 28 | ! function with type on definition and return 29 | function fun6(arg) result(retval) 30 | integer, intent(in) :: arg 31 | integer, dimension(10,10) :: retval 32 | end function fun6 33 | 34 | ! functions with complex result type 35 | pure function outer_product(x, y) 36 | real, dimension(:), intent(in) :: x, y 37 | real, dimension(size(x), size(y)) :: outer_product 38 | integer :: i, j 39 | forall (i=1:size(x)) 40 | forall (j=1:size(y)) 41 | outer_product(i, j) = x(i) * y(j) 42 | end forall 43 | end forall 44 | end function outer_product 45 | 46 | ! functions with no result type, common in interfaces 47 | function dlamch(CMACH) 48 | character :: CMACH 49 | end function dlamch 50 | 51 | ! intrinsic functions like c_loc display a return type 52 | function fun7() result(val) 53 | use, intrinsic :: iso_c_binding 54 | integer, dimension(1), target :: ar 55 | type(c_ptr) :: val 56 | val = c_loc(ar) 57 | end function fun7 58 | 59 | real function foobar(val1, & 60 | val2) & 61 | result(val4) 62 | integer, intent(in) :: val1, val2 63 | end function foobar 64 | -------------------------------------------------------------------------------- /test/setup_tests.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | import shlex 4 | import subprocess 5 | import sys 6 | from io import StringIO 7 | from pathlib import Path 8 | 9 | root_dir = Path(__file__).parent.parent.resolve() 10 | sys.path.insert(0, root_dir) 11 | 12 | # Compromise since isort does not respect noqa 13 | from fortls.jsonrpc import path_to_uri # noqa: E402, F401 14 | from fortls.jsonrpc import read_rpc_messages # noqa: E402 15 | from fortls.jsonrpc import write_rpc_notification # noqa: E402, F401 16 | from fortls.jsonrpc import write_rpc_request # noqa: E402, F401 17 | 18 | test_dir = root_dir / "test" / "test_source" 19 | 20 | 21 | def check_post_msg(result: dict, msg: str, severity: int): 22 | assert result["type"] == severity 23 | assert result["message"] == msg 24 | 25 | 26 | def run_request(request, fortls_args: list[str] = None): 27 | command = [ 28 | sys.executable, 29 | "-m", 30 | "fortls", 31 | "--incremental_sync", 32 | ] 33 | if fortls_args: 34 | # Input args might not be sanitised, fix that 35 | for i in fortls_args: 36 | command.extend(shlex.split(i, posix=False)) 37 | 38 | pid = subprocess.Popen( 39 | command, 40 | stdin=subprocess.PIPE, 41 | stdout=subprocess.PIPE, 42 | stderr=subprocess.PIPE, 43 | ) 44 | results = pid.communicate(input=request.encode()) 45 | tmp_file = StringIO(results[0].decode()) 46 | results = read_rpc_messages(tmp_file) 47 | parsed_results = [] 48 | for result in results: 49 | try: 50 | parsed_results.append(result["result"]) 51 | except KeyError: 52 | try: 53 | # Present in `method`s 54 | parsed_results.append(result["params"]) 55 | except Exception as exc: 56 | raise RuntimeError( 57 | "Only 'result' and 'params' keys have been implemented for testing." 58 | " Please add the new key." 59 | ) from exc 60 | except Exception as exc: 61 | raise RuntimeError( 62 | "Unexpected error encountered trying to extract server results" 63 | ) from exc 64 | errcode = pid.poll() 65 | return errcode, parsed_results 66 | -------------------------------------------------------------------------------- /docs/fortls.rst: -------------------------------------------------------------------------------- 1 | fortls package 2 | ============== 3 | 4 | Subpackages 5 | ----------- 6 | 7 | .. toctree:: 8 | :maxdepth: 4 9 | 10 | fortls.parsers 11 | 12 | Submodules 13 | ---------- 14 | 15 | fortls.constants module 16 | ----------------------- 17 | 18 | .. automodule:: fortls.constants 19 | :members: 20 | :undoc-members: 21 | :show-inheritance: 22 | 23 | fortls.debug module 24 | ------------------- 25 | 26 | .. automodule:: fortls.debug 27 | :members: 28 | :undoc-members: 29 | :show-inheritance: 30 | 31 | fortls.ftypes module 32 | -------------------- 33 | 34 | .. automodule:: fortls.ftypes 35 | :members: 36 | :undoc-members: 37 | :show-inheritance: 38 | 39 | fortls.helper\_functions module 40 | ------------------------------- 41 | 42 | .. automodule:: fortls.helper_functions 43 | :members: 44 | :undoc-members: 45 | :show-inheritance: 46 | 47 | fortls.interface module 48 | ----------------------- 49 | 50 | .. automodule:: fortls.interface 51 | :members: 52 | :undoc-members: 53 | :show-inheritance: 54 | 55 | fortls.json\_templates module 56 | ----------------------------- 57 | 58 | .. automodule:: fortls.json_templates 59 | :members: 60 | :undoc-members: 61 | :show-inheritance: 62 | 63 | fortls.jsonrpc module 64 | --------------------- 65 | 66 | .. automodule:: fortls.jsonrpc 67 | :members: 68 | :undoc-members: 69 | :show-inheritance: 70 | 71 | fortls.langserver module 72 | ------------------------ 73 | 74 | .. automodule:: fortls.langserver 75 | :members: 76 | :undoc-members: 77 | :show-inheritance: 78 | 79 | fortls.regex\_patterns module 80 | ----------------------------- 81 | 82 | .. automodule:: fortls.regex_patterns 83 | :members: 84 | :undoc-members: 85 | :show-inheritance: 86 | 87 | fortls.schema module 88 | -------------------- 89 | 90 | .. automodule:: fortls.schema 91 | :members: 92 | :undoc-members: 93 | :show-inheritance: 94 | 95 | fortls.version module 96 | --------------------- 97 | 98 | .. automodule:: fortls.version 99 | :members: 100 | :undoc-members: 101 | :show-inheritance: 102 | 103 | Module contents 104 | --------------- 105 | 106 | .. automodule:: fortls 107 | :members: 108 | :undoc-members: 109 | :show-inheritance: 110 | -------------------------------------------------------------------------------- /test/test_source/subdir/test_free.f90: -------------------------------------------------------------------------------- 1 | MODULE test_free 2 | USE, INTRINSIC :: iso_fortran_env, ONLY: error_unit 3 | IMPLICIT NONE 4 | ! ą 5 | TYPE :: scale_type 6 | REAL(8) :: val = 1.d0 7 | END TYPE scale_type 8 | ! 9 | TYPE :: vector 10 | INTEGER(4) :: n 11 | REAL(8), POINTER, DIMENSION(:) :: v => NULL() 12 | PROCEDURE(fort_wrap), NOPASS, POINTER :: bound_nopass => NULL() 13 | CONTAINS 14 | PROCEDURE :: create => vector_create !< Doc 1 15 | PROCEDURE :: norm => vector_norm !< Doc 2 16 | PROCEDURE, PASS(self) :: bound_pass => bound_pass !< Doc 3 17 | END TYPE vector 18 | ! 19 | TYPE, EXTENDS(vector) :: scaled_vector 20 | TYPE(scale_type) :: scale 21 | CONTAINS 22 | PROCEDURE :: set_scale => scaled_vector_set !< 23 | PROCEDURE :: norm => scaled_vector_norm !< Doc 3 24 | END TYPE scaled_vector 25 | ! 26 | INTERFACE 27 | SUBROUTINE fort_wrap(a,b) 28 | INTEGER(4), INTENT(in) :: a 29 | REAL(8), INTENT(out) :: b 30 | END SUBROUTINE fort_wrap 31 | END INTERFACE 32 | ! 33 | LOGICAL :: module_variable 34 | CONTAINS 35 | !> Doc 4 36 | SUBROUTINE vector_create(self, n) 37 | CLASS(vector), INTENT(inout) :: self 38 | INTEGER(4), INTENT(in) :: n !! Doc 5 39 | self%n=n 40 | ALLOCATE(self%v(n)) 41 | self%v=0.d0 42 | END SUBROUTINE vector_create 43 | !> Doc 6 44 | FUNCTION vector_norm(self) RESULT(norm) 45 | CLASS(vector), INTENT(in) :: self 46 | REAL(8) :: norm 47 | norm = SQRT(DOT_PRODUCT(self%v,self%v)) 48 | END FUNCTION vector_norm 49 | !> Doc 7 50 | SUBROUTINE scaled_vector_set(self, scale) 51 | CLASS(scaled_vector), INTENT(inout) :: self ! no documentation 52 | REAL(8), INTENT(in) :: scale !< Doc 8 53 | self%scale%val = scale 54 | END SUBROUTINE scaled_vector_set 55 | !> Top level docstring 56 | FUNCTION scaled_vector_norm(self) RESULT(norm) 57 | CLASS(scaled_vector), INTENT(in) :: self !< self value docstring 58 | REAL(8) :: norm !< return value docstring 59 | norm = self%scale%val*SQRT(DOT_PRODUCT(self%v,self%v)) 60 | END FUNCTION scaled_vector_norm 61 | ! 62 | PURE REAL(8) FUNCTION unscaled_norm(self) 63 | CLASS(scaled_vector), INTENT(in) :: self 64 | ! REAL(8) :: unscaled_norm 65 | unscaled_norm = SQRT(DOT_PRODUCT(self%v,self%v)) 66 | END FUNCTION unscaled_norm 67 | ! 68 | SUBROUTINE test_sig_Sub(arg1,arg2,opt1,opt2,opt3) 69 | INTEGER, INTENT(in) :: arg1,arg2 70 | INTEGER, OPTIONAL, INTENT(in) :: opt1,opt2,opt3 71 | END SUBROUTINE test_sig_Sub 72 | ! 73 | SUBROUTINE bound_pass(arg1, self) 74 | INTEGER(4), INTENT(in) :: arg1 !< Doc 9 75 | !! Doc 10 76 | 77 | !> Doc 11 78 | !! Doc 12 79 | CLASS(vector), INTENT(inout) :: self 80 | self%n = arg1 81 | END SUBROUTINE bound_pass 82 | END MODULE test_free 83 | -------------------------------------------------------------------------------- /.github/workflows/codeql-analysis.yml: -------------------------------------------------------------------------------- 1 | # For most projects, this workflow file will not need changing; you simply need 2 | # to commit it to your repository. 3 | # 4 | # You may wish to alter this file to override the set of languages analyzed, 5 | # or to provide custom queries or build logic. 6 | # 7 | # ******** NOTE ******** 8 | # We have attempted to detect the languages in your repository. Please check 9 | # the `language` matrix defined below to confirm you have the correct set of 10 | # supported CodeQL languages. 11 | # 12 | name: "CodeQL" 13 | 14 | on: 15 | push: 16 | branches: [ master, dev ] 17 | pull_request: 18 | # The branches below must be a subset of the branches above 19 | branches: [ master, dev ] 20 | schedule: 21 | - cron: '24 7 * * 2' 22 | 23 | jobs: 24 | analyze: 25 | name: Analyze 26 | runs-on: ubuntu-latest 27 | permissions: 28 | actions: read 29 | contents: read 30 | security-events: write 31 | 32 | strategy: 33 | fail-fast: false 34 | matrix: 35 | language: [ 'python' ] 36 | # CodeQL supports [ 'cpp', 'csharp', 'go', 'java', 'javascript', 'python', 'ruby' ] 37 | # Learn more about CodeQL language support at https://git.io/codeql-language-support 38 | 39 | steps: 40 | - name: Checkout repository 41 | uses: actions/checkout@v4 42 | 43 | # Initializes the CodeQL tools for scanning. 44 | - name: Initialize CodeQL 45 | uses: github/codeql-action/init@v3 46 | with: 47 | languages: ${{ matrix.language }} 48 | # If you wish to specify custom queries, you can do so here or in a config file. 49 | # By default, queries listed here will override any specified in a config file. 50 | # Prefix the list here with "+" to use these queries and those in the config file. 51 | # queries: ./path/to/local/query, your-org/your-repo/queries@main 52 | 53 | # Autobuild attempts to build any compiled languages (C/C++, C#, or Java). 54 | # If this step fails, then you should remove it and run the build manually (see below) 55 | - name: Autobuild 56 | uses: github/codeql-action/autobuild@v3 57 | 58 | # ℹ️ Command-line programs to run using the OS shell. 59 | # 📚 https://git.io/JvXDl 60 | 61 | # ✏️ If the Autobuild fails above, remove it and uncomment the following three lines 62 | # and modify them (or add more) to build your code if your project 63 | # uses a compiled language 64 | 65 | #- run: | 66 | # make bootstrap 67 | # make release 68 | 69 | - name: Perform CodeQL Analysis 70 | uses: github/codeql-action/analyze@v3 71 | -------------------------------------------------------------------------------- /fortls/parsers/internal/select.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | from typing import TYPE_CHECKING 4 | 5 | from fortls.constants import SELECT_TYPE_ID 6 | 7 | from .block import Block 8 | from .variable import Variable 9 | 10 | if TYPE_CHECKING: 11 | from .ast import FortranAST 12 | 13 | 14 | class Select(Block): 15 | def __init__( 16 | self, 17 | file_ast: FortranAST, 18 | line_number: int, 19 | name: str, 20 | select_info, 21 | ): 22 | super().__init__(file_ast, line_number, name) 23 | self.select_type = select_info.type 24 | self.binding_name = None 25 | self.bound_var = None 26 | self.binding_type = None 27 | if self.select_type == 2: 28 | binding_split = select_info.binding.split("=>") 29 | if len(binding_split) == 1: 30 | self.bound_var = binding_split[0].strip() 31 | elif len(binding_split) == 2: 32 | self.binding_name = binding_split[0].strip() 33 | self.bound_var = binding_split[1].strip() 34 | elif self.select_type == 3: 35 | self.binding_type = select_info.binding 36 | # Close previous "TYPE IS" region if open 37 | if ( 38 | (file_ast.current_scope is not None) 39 | and (file_ast.current_scope.get_type() == SELECT_TYPE_ID) 40 | and file_ast.current_scope.is_type_region() 41 | ): 42 | file_ast.end_scope(line_number) 43 | 44 | def get_type(self, no_link=False): 45 | return SELECT_TYPE_ID 46 | 47 | def get_desc(self): 48 | return "SELECT" 49 | 50 | def is_type_binding(self): 51 | return self.select_type == 2 52 | 53 | def is_type_region(self): 54 | return self.select_type in [3, 4] 55 | 56 | def create_binding_variable(self, file_ast, line_number, var_desc, case_type): 57 | if self.parent.get_type() != SELECT_TYPE_ID: 58 | return None 59 | binding_name = None 60 | bound_var = None 61 | if (self.parent is not None) and self.parent.is_type_binding(): 62 | binding_name = self.parent.binding_name 63 | bound_var = self.parent.bound_var 64 | # Check for default case 65 | if (binding_name is not None) and (case_type != 4): 66 | bound_var = None 67 | # Create variable 68 | if binding_name is not None: 69 | return Variable( 70 | file_ast, line_number, binding_name, var_desc, [], link_obj=bound_var 71 | ) 72 | elif bound_var is not None: 73 | return Variable(file_ast, line_number, bound_var, var_desc, []) 74 | return None 75 | -------------------------------------------------------------------------------- /test/test_server_references.py: -------------------------------------------------------------------------------- 1 | from pathlib import Path 2 | 3 | from setup_tests import path_to_uri, run_request, test_dir, write_rpc_request 4 | 5 | 6 | def validate_refs(result_array, checks): 7 | def find_in_results(uri, sline): 8 | for i, result in enumerate(result_array): 9 | if (result["uri"] == uri) and (result["range"]["start"]["line"] == sline): 10 | del result_array[i] 11 | return result 12 | return None 13 | 14 | assert len(result_array) == len(checks) 15 | for check in checks: 16 | result = find_in_results(path_to_uri(check[0]), check[1]) 17 | assert result is not None 18 | assert result["range"]["start"]["character"] == check[2] 19 | assert result["range"]["end"]["character"] == check[3] 20 | 21 | 22 | def ref_req(uri: Path, ln: int, ch: int): 23 | return write_rpc_request( 24 | 2, 25 | "textDocument/references", 26 | { 27 | "textDocument": {"uri": str(uri)}, 28 | "position": {"line": ln - 1, "character": ch - 1}, 29 | }, 30 | ) 31 | 32 | 33 | def test_references(): 34 | string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) 35 | file_path = test_dir / "test_prog.f08" 36 | string += ref_req(file_path, 10, 9) 37 | errcode, results = run_request(string) 38 | assert errcode == 0 39 | # 40 | free_path = str(test_dir / "subdir" / "test_free.f90") 41 | validate_refs( 42 | results[1], 43 | ( 44 | [str(test_dir / "test_prog.f08"), 2, 21, 27], 45 | [str(test_dir / "test_prog.f08"), 9, 5, 11], 46 | [free_path, 8, 8, 14], 47 | [free_path, 16, 9, 15], 48 | [free_path, 18, 14, 20], 49 | [free_path, 36, 6, 12], 50 | [free_path, 44, 6, 12], 51 | [free_path, 78, 6, 12], 52 | ), 53 | ) 54 | 55 | 56 | def test_references_ignore_comments_fixed(): 57 | string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "fixed")}) 58 | file_path = test_dir / "fixed" / "comment_as_reference.f" 59 | string += ref_req(file_path, 3, 22) 60 | errcode, results = run_request(string) 61 | assert errcode == 0 62 | assert len(results[1]) == 2 63 | 64 | 65 | def test_references_ignore_comments_on_use_import(): 66 | string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "use")}) 67 | file_path = test_dir / "use" / "comment_after_use.f90" 68 | string += ref_req(file_path, 6, 31) 69 | errcode, results = run_request(string, ["-n", "1"]) 70 | assert errcode == 0 71 | validate_refs( 72 | results[1], 73 | ( 74 | [str(file_path), 1, 15, 27], 75 | [str(file_path), 5, 23, 35], 76 | ), 77 | ) 78 | -------------------------------------------------------------------------------- /pyproject.toml: -------------------------------------------------------------------------------- 1 | [build-system] 2 | requires = ["setuptools >= 61", "wheel", "setuptools_scm[toml] >= 7.0"] 3 | build-backend = "setuptools.build_meta" 4 | 5 | [project] 6 | name = "fortls" 7 | description = "fortls - Fortran Language Server" 8 | readme = "README.md" 9 | authors = [{ name = "Giannis Nikiteas", email = "giannis.nikiteas@gmail.com" }] 10 | license = { text = "MIT" } 11 | classifiers = [ 12 | "Development Status :: 4 - Beta", 13 | "Intended Audience :: Developers", 14 | "Intended Audience :: Science/Research", 15 | "License :: OSI Approved :: MIT License", 16 | "Natural Language :: English", 17 | "Programming Language :: Python", 18 | "Programming Language :: Python :: 3", 19 | "Programming Language :: Python :: 3.7", 20 | "Programming Language :: Python :: 3.8", 21 | "Programming Language :: Python :: 3.9", 22 | "Programming Language :: Python :: 3.10", 23 | "Programming Language :: Python :: 3.11", 24 | "Programming Language :: Python :: 3.12", 25 | "Programming Language :: Fortran", 26 | "Operating System :: Microsoft :: Windows", 27 | "Operating System :: POSIX", 28 | "Operating System :: Unix", 29 | "Operating System :: MacOS", 30 | ] 31 | keywords = [ 32 | "fortran", 33 | "language server", 34 | "language server protocol", 35 | "lsp", 36 | "fortls", 37 | ] 38 | dynamic = ["version"] 39 | requires-python = ">=3.7" 40 | dependencies = [ 41 | "json5", 42 | "packaging", 43 | "importlib-metadata; python_version < '3.8'", 44 | "typing-extensions; python_version < '3.8'", 45 | ] 46 | 47 | [project.optional-dependencies] 48 | dev = [ 49 | "pytest >= 7.2.0", 50 | "pytest-cov >= 4.0.0", 51 | "pytest-xdist >= 3.0.2", 52 | "black", 53 | "isort", 54 | "pre-commit", 55 | "pydantic", 56 | ] 57 | docs = [ 58 | "sphinx >= 4.0.0", 59 | "sphinx-argparse", 60 | "sphinx-autodoc-typehints", 61 | "sphinx_design", 62 | "sphinx-copybutton", 63 | "furo", 64 | "myst-parser", 65 | "sphinx-sitemap", 66 | ] 67 | 68 | [project.urls] 69 | homepage = "https://fortls.fortran-lang.org" 70 | Documentation = "https://fortls.fortran-lang.org" 71 | Changes = "https://github.com/fortran-lang/fortls/blob/master/CHANGELOG.md" 72 | Tracker = "https://github.com/fortran-lang/fortls/issues" 73 | "Source Code" = "https://github.com/fortran-lang/fortls" 74 | 75 | [project.scripts] 76 | fortls = "fortls.__init__:main" 77 | 78 | [tool.setuptools.packages.find] 79 | include = ["fortls*"] 80 | 81 | [tool.setuptools.package-data] 82 | fortls = ["parsers/internal/*.json"] 83 | 84 | [tool.setuptools_scm] 85 | write_to = "fortls/_version.py" 86 | 87 | [tool.isort] 88 | profile = "black" 89 | 90 | [tool.pytest.ini_options] 91 | minversion = "7.2.0" 92 | addopts = "-v --cov=fortls --cov-report=html --cov-report=xml --cov-context=test" 93 | testpaths = ["fortls", "test"] 94 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing 2 | 3 | 👍🎉 Thank you for taking the time to contribute! 🎉👍 4 | 5 | In this file you will find all the steps necessary to guide you through your first contribution to the project. 6 | 7 | Please note our [Code of Conduct](https://github.com/fortran-lang/fortls/blob/master/CODE_OF_CONDUCT.md) and adhere to it in all your interactions with this project. 8 | 9 | ## 📚 Getting Started 10 | 11 | A good place to start is the [Issues tab](https://github.com/fortran-lang/fortls/issues) on GitHub. Look for any issues with the `help wanted` tag. 12 | 13 | ### Downloading ⬇️ 14 | 15 | Firstly, fork the repository from . 16 | 17 | Then clone the forked repository into your local machine. 18 | 19 | ```sh 20 | git@github.com:/fortls.git 21 | ``` 22 | 23 | Where `` should be your GitHub username. 24 | 25 | ### Dependencies 26 | 27 | To build this project you will need [Python](https://www.python.org/) `>= 3.7` and [pip](https://www.python.org/) `>= 21.0`. 28 | To install all Python dependencies open a terminal go into the `fortls` cloned folder and run: 29 | 30 | ```sh 31 | pip install -e ".[dev,docs]" 32 | ``` 33 | 34 | ### Testing 🧪 35 | 36 | To verify that your cloning of the GitHub repository worked as expected open a terminal and run: 37 | 38 | ```sh 39 | pytest -v 40 | ``` 41 | 42 | This will run the entire unit test suite. You can also run this to verify that you haven't broken anything in the code. 43 | 44 | 👉 **Tip!** You can run individual tests by selecting the path to the Python file and the method 45 | 46 | ```sh 47 | pytest test/test_interface.py::test_version_update_pypi 48 | ``` 49 | 50 | ### Developing & Debugging 🐞️ 51 | 52 | ❗️ Before you start developing, open a terminal inside `fortls` and run: 53 | 54 | ```sh 55 | pre-commit install 56 | ``` 57 | 58 | This will ensure that all you commits meet the formatting standards of the project. 59 | 60 | --- 61 | 62 | You can now start writing code! Your local `fortls` version will be updated with every code change you make, so you can use your normal code editor to checkout the `fortls` features that you have implemented. 63 | It is however considerably easier to create compact unittests to check if your changes have worked. 64 | 65 | A `fortls` test normally involves writing a Python function which sends a JSONRPC request to the server and then test checks for the correct server response. 66 | Often times small bits of Fortran source code also have to be submited to be used by the test. 67 | You can find varisous test examples in the `tests` directory. 68 | 69 | 👉 **Tip!** You can attach a debugger to the main `fortls` source code during unittesting which should allow you to pause, break, step into, etc. while testing, thus making it easier to find mistakes. 70 | 71 | ### Merging 72 | 73 | To merge your changes to the main `fortls` repository push your branch on GitHub and open a [Pull Request](https://github.com/fortran-lang/fortls/pulls). Ping `@gnikit` to review your PR. 74 | -------------------------------------------------------------------------------- /assets/f.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 16 | 39 | 41 | 46 | 54 | 58 | 62 | 63 | 64 | 65 | -------------------------------------------------------------------------------- /docs/quickstart.rst: -------------------------------------------------------------------------------- 1 | Get Started 2 | ########### 3 | 4 | .. article-info:: 5 | :avatar: ../assets/f.svg 6 | :avatar-link: https://github.com/gnikit 7 | :author: `gnikit `__ 8 | :date: |today| 9 | :read-time: 1 min read 10 | :class-avatar: sd-animate-grow50-rot20 11 | 12 | 13 | ``fortls`` is a tool known as a language server that interfaces with your code editor 14 | (VS Code, Vim, etc.) to provide features like code completion, code navigation, hover messages, and many more. 15 | 16 | Download 17 | ******** 18 | 19 | The project is available for download through the **PyPi** and **Anaconda** package managers 20 | 21 | .. tab-set:: 22 | 23 | .. tab-item:: PyPi 24 | 25 | .. code-block:: sh 26 | 27 | pip install fortls 28 | 29 | 30 | For more information see `pypi/fortls`_ 31 | 32 | .. _pypi/fortls: https://pypi.python.org/pypi/fortls 33 | 34 | .. tab-item:: Anaconda 35 | 36 | .. code-block:: sh 37 | 38 | conda install -c conda-forge fortls 39 | 40 | For more installation instructions, see `conda-forge/fortls`_. 41 | 42 | .. _conda-forge/fortls: https://github.com/conda-forge/fortls-feedstock#about-fortls 43 | 44 | .. tab-item:: Brew 45 | 46 | .. code-block:: sh 47 | 48 | brew install fortls 49 | 50 | For more installation instructions, see `brew/fortls`_. 51 | 52 | .. _brew/fortls: https://formulae.brew.sh/formula/fortls 53 | 54 | .. tab-item:: Source 55 | 56 | Alternatively, one can install the development version from **GitHub** via 57 | 58 | .. code-block:: sh 59 | 60 | pip install --user --upgrade git+git://github.com/fortran-lang/fortls 61 | 62 | 63 | .. warning:: 64 | It is **NOT** possible having ``fortls`` and ``fortran-language-server`` 65 | simultaneously installed, since they use the same executable name. If you are having trouble 66 | getting ``fortls`` to work try uninstalling ``fortran-language-server`` and reinstalling ``fortls``. 67 | 68 | 69 | Usage 70 | ***** 71 | 72 | To make full use of ``fortls`` in your workflow you need to 73 | 74 | - integrate it into your code editor, see: :doc:`editor_integration` 75 | - (Optional) configure any additional settings to ``fortls``, see: :doc:`options` 76 | 77 | Integration 78 | =========== 79 | 80 | Depending on the code editor used, different steps will have to be followed to integrate ``fortls``. 81 | Luckily, we support numerous code editors and have detailed instructions in the 82 | :doc:`editor_integration` section. 83 | 84 | .. card:: Example: VS Code 85 | 86 | Setting up ``fortls`` with `VS Code`_ is as simple as installing 87 | the `Modern Fortran`_ extension. 88 | 89 | .. _VS Code: https://code.visualstudio.com 90 | .. _Modern Fortran: https://marketplace.visualstudio.com/items?itemName=fortran-lang.linter-gfortran 91 | 92 | 93 | Configuration 94 | ============= 95 | 96 | The Language Server by default is configured with reasonable settings however, 97 | depending on the project additional settings might need to be configured, such 98 | as source file paths, or additional preprocessor definitions. 99 | 100 | Instructions on how to do this and much more can be found in the :doc:`options` section. 101 | -------------------------------------------------------------------------------- /fortls/parsers/internal/keywords.json: -------------------------------------------------------------------------------- 1 | { 2 | "var_def": { 3 | "ALLOCATABLE": { 4 | "doc": "Specifies that an object is allocatable." 5 | }, 6 | "ASYNCHRONOUS": { 7 | "doc": "Specifies that a variable can be used for asynchronous input and output." 8 | }, 9 | "BIND": { 10 | "doc": "Specifies that an object is interoperable with C and has external linkage." 11 | }, 12 | "CODIMENSION": { 13 | "doc": "Specifies that an entity is a coarray, and specifies its corank and cobounds, if any." 14 | }, 15 | "CONTIGUOUS": { 16 | "doc": "Specifies that the target of a pointer or an assumed-sized array is contiguous." 17 | }, 18 | "DIMENSION(:)": { 19 | "doc": "Specifies that an object is an array, and defines the shape of the array." 20 | }, 21 | "EXTERNAL": { 22 | "doc": "Allows an external procedure, a dummy procedure, a procedure pointer, or a block data subprogram to be used as an actual argument." 23 | }, 24 | "INTRINSIC": { 25 | "doc": "Allows the specific name of an intrinsic procedure to be used as an actual argument." 26 | }, 27 | "POINTER": { 28 | "doc": "Specifies that an object or a procedure is a pointer (a dynamic variable)." 29 | }, 30 | "PROTECTED": { 31 | "doc": "Specifies limitations on the use of module entities." 32 | }, 33 | "TARGET": { 34 | "doc": "Specifies that an object can become the target of a pointer (it can be pointed to)." 35 | }, 36 | "VOLATILE": { 37 | "doc": "Specifies that the value of an object is entirely unpredictable, based on information local to the current program unit. It prevents objects from being optimized during compilation." 38 | } 39 | }, 40 | "arg": { 41 | "INTENT(IN)": { 42 | "doc": "Specifies that the dummy argument will be used only to provide data to the procedure." 43 | }, 44 | "INTENT(OUT)": { 45 | "doc": "Specifies that the dummy argument will be used to pass data from the procedure back to the calling program." 46 | }, 47 | "INTENT(INOUT)": { 48 | "doc": "Specifies that the dummy argument can both provide data to the procedure and return data to the calling program." 49 | }, 50 | "OPTIONAL": { 51 | "doc": "Permits dummy arguments to be omitted in a procedure reference." 52 | }, 53 | "SAVE": { 54 | "doc": "Causes the values and definition of objects to be retained after execution of a RETURN or END statement in a subprogram." 55 | }, 56 | "VALUE": { 57 | "doc": "Specifies a type of argument association for a dummy argument." 58 | } 59 | }, 60 | "type_mem": { 61 | "DEFERRED": { 62 | "doc": "Indicates that the procedure is deferred. Deferred bindings must only be specified for derived-type definitions with the ABSTRACT attribute." 63 | }, 64 | "NON_OVERRIDABLE": { 65 | "doc": "Determines whether a binding can be overridden in an extended type. You must not specify NON_OVERRIDABLE for a binding with the DEFERRED attribute." 66 | }, 67 | "NOPASS": { 68 | "doc": "Indicate that the procedure has no passed-object dummy argument." 69 | }, 70 | "PASS": { 71 | "doc": "Indicates that the procedure has no passed-object dummy argument.", 72 | "args": "arg_name" 73 | } 74 | }, 75 | "vis": { 76 | "PRIVATE": {}, 77 | "PUBLIC": {} 78 | }, 79 | "param": { 80 | "PARAMETER": {} 81 | } 82 | } 83 | -------------------------------------------------------------------------------- /fortls/parsers/internal/associate.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | import re 4 | from dataclasses import dataclass 5 | from typing import TYPE_CHECKING 6 | 7 | from fortls.constants import ASSOC_TYPE_ID 8 | from fortls.helper_functions import get_var_stack 9 | 10 | from .block import Block 11 | from .utilities import climb_type_tree, find_in_scope 12 | from .variable import Variable 13 | 14 | if TYPE_CHECKING: 15 | from .ast import FortranAST 16 | 17 | 18 | @dataclass 19 | class AssociateMap: 20 | var: Variable 21 | bind_name: str 22 | link_name: str 23 | 24 | 25 | class Associate(Block): 26 | def __init__(self, file_ast: FortranAST, line_number: int, name: str): 27 | super().__init__(file_ast, line_number, name) 28 | self.links: list[AssociateMap] = [] # holds the info to associate variables 29 | 30 | def get_type(self, no_link=False): 31 | return ASSOC_TYPE_ID 32 | 33 | def get_desc(self): 34 | return "ASSOCIATE" 35 | 36 | def create_binding_variable( 37 | self, file_ast: FortranAST, line_number: int, bind_name: str, link_name: str 38 | ) -> Variable: 39 | """Create a new variable to be linked upon resolution to the real variable 40 | that contains the information of the mapping from the parent scope to the 41 | ASSOCIATE block scope. 42 | 43 | Parameters 44 | ---------- 45 | file_ast : fortran_ast 46 | AST file 47 | line_number : int 48 | Line number 49 | bind_name : str 50 | Name of the ASSOCIATE block variable 51 | link_name : str 52 | Name of the parent scope variable 53 | 54 | Returns 55 | ------- 56 | fortran_var 57 | Variable object holding the ASSOCIATE block variable, pending resolution 58 | """ 59 | new_var = Variable(file_ast, line_number, bind_name, "UNKNOWN", []) 60 | self.links.append(AssociateMap(new_var, bind_name, link_name)) 61 | return new_var 62 | 63 | def resolve_link(self, obj_tree): 64 | # Loop through the list of the associated variables map and resolve the links 65 | # find the AST node that that corresponds to the variable with link_name 66 | for assoc in self.links: 67 | # TODO: extract the dimensions component from the link_name 68 | # re.sub(r'\(.*\)', '', link_name) removes the dimensions component 69 | # keywords = re.match(r'(.*)\((.*)\)', link_name).groups() 70 | # now pass the keywords through the dimension_parser and set the keywords 71 | # in the associate object. Hover should now pick the local keywords 72 | # over the linked_object keywords 73 | assoc.link_name = re.sub(r"\(.*\)", "", assoc.link_name) 74 | var_stack = get_var_stack(assoc.link_name) 75 | is_member = len(var_stack) > 1 76 | if is_member: 77 | type_scope = climb_type_tree(var_stack, self, obj_tree) 78 | if type_scope is None: 79 | continue 80 | var_obj = find_in_scope(type_scope, var_stack[-1], obj_tree) 81 | else: 82 | var_obj = find_in_scope(self, assoc.link_name, obj_tree) 83 | if var_obj is not None: 84 | assoc.var.link_obj = var_obj 85 | 86 | def require_link(self): 87 | return True 88 | -------------------------------------------------------------------------------- /test/test_parser.py: -------------------------------------------------------------------------------- 1 | import pytest 2 | from setup_tests import test_dir 3 | 4 | from fortls.parsers.internal.parser import FortranFile 5 | 6 | 7 | def test_line_continuations(): 8 | file_path = test_dir / "parse" / "line_continuations.f90" 9 | file = FortranFile(str(file_path)) 10 | err_str, _ = file.load_from_disk() 11 | assert err_str is None 12 | try: 13 | file.parse() 14 | assert True 15 | except Exception as e: 16 | print(e) 17 | assert False 18 | 19 | 20 | def test_submodule(): 21 | file_path = test_dir / "parse" / "submodule.f90" 22 | file = FortranFile(str(file_path)) 23 | err_str, _ = file.load_from_disk() 24 | assert err_str is None 25 | try: 26 | ast = file.parse() 27 | assert True 28 | assert ast.scope_list[0].name == "val" 29 | assert ast.scope_list[0].ancestor_name == "p1" 30 | assert ast.scope_list[1].name == "" 31 | assert ast.scope_list[1].ancestor_name == "p2" 32 | except Exception as e: 33 | print(e) 34 | assert False 35 | 36 | 37 | def test_private_visibility_interfaces(): 38 | file_path = test_dir / "vis" / "private.f90" 39 | file = FortranFile(str(file_path)) 40 | err_str, _ = file.load_from_disk() 41 | file.parse() 42 | assert err_str is None 43 | 44 | 45 | def test_end_scopes_semicolon(): 46 | file_path = test_dir / "parse" / "trailing_semicolon.f90" 47 | file = FortranFile(str(file_path)) 48 | err_str, _ = file.load_from_disk() 49 | ast = file.parse() 50 | assert err_str is None 51 | assert not ast.end_errors 52 | 53 | 54 | def test_weird_parser_bug(): 55 | file_path = test_dir / "parse" / "mixed" / "preproc_and_normal_syntax.F90" 56 | file = FortranFile(str(file_path)) 57 | err_str, _ = file.load_from_disk() 58 | ast = file.parse() 59 | assert err_str is None 60 | assert not ast.end_errors 61 | 62 | 63 | @pytest.mark.parametrize( 64 | "ln_no, pp_defs, reference", 65 | [ 66 | (6, {}, 6), 67 | (7, {}, 6), 68 | (8, {}, 6), 69 | (11, {"TEST": True}, 60), # not entirely correct ref vals 70 | (23, {"MULT": True}, 90), # not entirely correct ref vals 71 | (32, {"TEST": True, "MULT": True}, 130), # not entirely correct ref vals 72 | (39, {"TEST": True, "MULT": True}, 2400), # not entirely correct ref vals 73 | ], 74 | ) 75 | def test_get_code_line_multilines(ln_no: int, pp_defs: dict, reference: int): 76 | """Tests how the get_code_line performs with multi-line and preprocessor 77 | 78 | Not all the results are correct, since get_code_line is not aware of the 79 | preprocessor skips. Instead what it does is it evaluates all the line 80 | continuations and appends them in post. 81 | """ 82 | 83 | def calc_result(res: tuple): 84 | pre, cur, post = res 85 | res = "".join(pre + [cur] + post).replace(" ", "") 86 | assert "result" in res, "Fortran variable `result` not found in results" 87 | loc = {} 88 | exec(res, None, loc) 89 | return loc["result"] 90 | 91 | file_path = test_dir / "parse" / "mixed" / "multilines.F90" 92 | file = FortranFile(str(file_path)) 93 | file.load_from_disk() 94 | file.preprocess(pp_defs=pp_defs) 95 | pp = bool(pp_defs) 96 | res = file.get_code_line(line_no=ln_no, pp_content=pp) 97 | result = calc_result(res) 98 | assert result == reference 99 | -------------------------------------------------------------------------------- /fortls/parsers/internal/base.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | from fortls.constants import BASE_TYPE_ID 4 | from fortls.helper_functions import fortran_md 5 | 6 | 7 | # Fortran object classes 8 | class FortranObj: 9 | def __init__(self): 10 | self.vis: int = 0 11 | self.def_vis: int = 0 12 | self.doc_str: str = None 13 | self.parent = None 14 | self.eline: int = -1 15 | self.implicit_vars = None 16 | 17 | def set_default_vis(self, new_vis: int): 18 | self.def_vis = new_vis 19 | 20 | def set_visibility(self, new_vis: int): 21 | self.vis = new_vis 22 | 23 | def set_parent(self, parent_obj): 24 | self.parent = parent_obj 25 | 26 | def add_doc(self, doc_str: str): 27 | self.doc_str = doc_str 28 | 29 | def update_fqsn(self, enc_scope=None): 30 | return None 31 | 32 | def end(self, line_number: int): 33 | self.eline = line_number 34 | 35 | def resolve_inherit(self, obj_tree, inherit_version): 36 | return None 37 | 38 | def require_inherit(self): 39 | return False 40 | 41 | def resolve_link(self, obj_tree): 42 | return None 43 | 44 | def require_link(self): 45 | return False 46 | 47 | def get_type(self, no_link=False): 48 | return BASE_TYPE_ID 49 | 50 | def get_type_obj(self, obj_tree): 51 | return None 52 | 53 | def get_desc(self): 54 | return "unknown" 55 | 56 | def get_snippet(self, name_replace=None, drop_arg=-1): 57 | return None, None 58 | 59 | def get_documentation(self): 60 | return self.doc_str 61 | 62 | def get_hover(self, long=False, drop_arg=-1) -> tuple[str | None, str | None]: 63 | return None, None 64 | 65 | def get_hover_md(self, long=False, drop_arg=-1) -> str: 66 | msg, docs = self.get_hover(long, drop_arg) 67 | return fortran_md(msg, docs) 68 | 69 | def get_signature(self, drop_arg=-1): 70 | return None, None, None 71 | 72 | def get_interface(self, name_replace=None, drop_arg=-1, change_strings=None): 73 | return None 74 | 75 | def get_children(self, public_only=False): 76 | return [] 77 | 78 | def get_ancestors(self): 79 | return [] 80 | 81 | def get_diagnostics(self): 82 | return [] 83 | 84 | def get_implicit(self): 85 | if self.parent is None: 86 | return self.implicit_vars 87 | parent_implicit = self.parent.get_implicit() 88 | if (self.implicit_vars is not None) or (parent_implicit is None): 89 | return self.implicit_vars 90 | return parent_implicit 91 | 92 | def get_actions(self, sline, eline): 93 | return None 94 | 95 | def is_optional(self): 96 | return False 97 | 98 | def is_mod_scope(self): 99 | return False 100 | 101 | def is_callable(self): 102 | return False 103 | 104 | def is_external_int(self): 105 | return False 106 | 107 | def is_abstract(self): 108 | return False 109 | 110 | def req_named_end(self): 111 | return False 112 | 113 | def check_valid_parent(self): 114 | return True 115 | 116 | def check_definition(self, obj_tree, known_types: dict = None, interface=False): 117 | if known_types is None: 118 | known_types = {} 119 | return None, known_types 120 | -------------------------------------------------------------------------------- /test/test_preproc.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | from setup_tests import run_request, test_dir, write_rpc_request 4 | 5 | 6 | def test_hover(): 7 | def hover_req(file_path: str, ln: int, col: int) -> str: 8 | return write_rpc_request( 9 | 1, 10 | "textDocument/hover", 11 | { 12 | "textDocument": {"uri": str(file_path)}, 13 | "position": {"line": ln, "character": col}, 14 | }, 15 | ) 16 | 17 | def check_return(result_array, checks): 18 | assert len(result_array) == len(checks) 19 | for i, check in enumerate(checks): 20 | assert result_array[i]["contents"]["value"] == check 21 | 22 | root_dir = test_dir / "pp" 23 | string = write_rpc_request(1, "initialize", {"rootPath": str(root_dir)}) 24 | file_path = root_dir / "preproc.F90" 25 | string += hover_req(file_path, 5, 8) # user defined type 26 | string += hover_req(file_path, 7, 30) # variable 27 | string += hover_req(file_path, 7, 40) # multi-lin variable 28 | string += hover_req(file_path, 8, 7) # function with if conditional 29 | string += hover_req(file_path, 9, 7) # multiline function with if conditional 30 | string += hover_req(file_path, 10, 15) # defined without () 31 | file_path = root_dir / "preproc_keywords.F90" 32 | string += hover_req(file_path, 6, 2) # ignores PP across Fortran line continuations 33 | file_path = root_dir / "preproc_else.F90" 34 | string += hover_req(file_path, 8, 12) 35 | string += hover_req(file_path, 18, 12) 36 | file_path = root_dir / "preproc_elif.F90" 37 | string += hover_req(file_path, 22, 15) 38 | string += hover_req(file_path, 24, 10) 39 | file_path = root_dir / "preproc_elif_elif_skip.F90" 40 | string += hover_req(file_path, 30, 23) 41 | file_path = root_dir / "preproc_if_elif_else.F90" 42 | string += hover_req(file_path, 30, 23) 43 | file_path = root_dir / "preproc_if_elif_skip.F90" 44 | string += hover_req(file_path, 30, 23) 45 | file_path = root_dir / "preproc_if_nested.F90" 46 | string += hover_req(file_path, 33, 23) 47 | config = str(root_dir / ".pp_conf.json") 48 | errcode, results = run_request(string, ["--config", config]) 49 | assert errcode == 0 50 | 51 | # Reference solution 52 | ref_results = ( 53 | "```fortran90\n#define PCType character*(80)\n```", 54 | "```fortran90\n#define PETSC_ERR_INT_OVERFLOW 84\n```", 55 | "```fortran90\n#define varVar 55\n```", 56 | ( 57 | "```fortran90\n#define ewrite(priority, format)" 58 | " if (priority <= 3) write((priority), format)\n```" 59 | ), 60 | ( 61 | "```fortran90\n#define ewrite2(priority, format)" 62 | " if (priority <= 3) write((priority), format)\n```" 63 | ), 64 | "```fortran90\n#define SUCCESS .true.\n```", 65 | "```fortran90\nREAL, CONTIGUOUS, POINTER, DIMENSION(:) :: var1\n```", 66 | "```fortran90\nINTEGER :: var0\n```", 67 | "```fortran90\nREAL :: var1\n```", 68 | "```fortran90\nINTEGER :: var2\n```", 69 | "```fortran90\nINTEGER, INTENT(INOUT) :: var\n```", 70 | "```fortran90\nINTEGER, PARAMETER :: res = 0+1+0+0\n```", 71 | "```fortran90\nINTEGER, PARAMETER :: res = 0+0+0+1\n```", 72 | "```fortran90\nINTEGER, PARAMETER :: res = 1+0+0+0\n```", 73 | "```fortran90\nINTEGER, PARAMETER :: res = 0+0+1+0\n```", 74 | ) 75 | assert len(ref_results) == len(results) - 1 76 | check_return(results[1:], ref_results) 77 | -------------------------------------------------------------------------------- /test/test_server_implementation.py: -------------------------------------------------------------------------------- 1 | # from types import NoneType 2 | from setup_tests import path_to_uri, run_request, test_dir, write_rpc_request 3 | 4 | from fortls.json_templates import uri_json 5 | 6 | 7 | def imp_request(file, line, char): 8 | return write_rpc_request( 9 | 1, 10 | "textDocument/implementation", 11 | { 12 | "textDocument": {"uri": path_to_uri(str(file))}, 13 | "position": {"line": line, "character": char}, 14 | }, 15 | ) 16 | 17 | 18 | def check_imp_request(response: dict, references: dict): 19 | for uri, changes in response.items(): 20 | refs = references[uri] 21 | # Loop over all the changes in the current URI, instances of object 22 | for c, r in zip(changes, refs): 23 | assert c["range"] == r["range"] 24 | 25 | 26 | def create(file, line, schar, echar): 27 | return uri_json(path_to_uri(str(file)), line, schar, line, echar) 28 | 29 | 30 | def test_implementation_type_bound(): 31 | """Go to implementation of type-bound procedures""" 32 | string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) 33 | file_path = test_dir / "test.f90" 34 | string += imp_request(file_path, 3, 17) 35 | errcode, results = run_request(string, ["-n", "1"]) 36 | assert errcode == 0 37 | assert results[1] == create(test_dir / "subdir" / "test_free.f90", 49, 11, 28) 38 | 39 | 40 | def test_implementation_intrinsics(): 41 | """Go to implementation of implicit methods is handled gracefully""" 42 | string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "rename")}) 43 | file_path = test_dir / "rename" / "test_rename_intrinsic.f90" 44 | string += imp_request(file_path, 11, 18) 45 | errcode, results = run_request(string, ["-n", "1"]) 46 | assert errcode == 0 47 | assert results[1] is None 48 | 49 | 50 | def test_implementation_integer(): 51 | """Go to implementation when no implementation is present is handled gracefully""" 52 | string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "rename")}) 53 | file_path = test_dir / "rename" / "test_rename_intrinsic.f90" 54 | string += imp_request(file_path, 20, 31) 55 | errcode, results = run_request(string, ["-n", "1"]) 56 | assert errcode == 0 57 | assert results[1] is None 58 | 59 | 60 | def test_implementation_empty(): 61 | """Go to implementation for empty lines is handled gracefully""" 62 | string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "rename")}) 63 | file_path = test_dir / "rename" / "test_rename_intrinsic.f90" 64 | string += imp_request(file_path, 13, 0) 65 | errcode, results = run_request(string, ["-n", "1"]) 66 | assert errcode == 0 67 | assert results[1] is None 68 | 69 | 70 | def test_implementation_no_file(): 71 | """Go to implementation for empty lines is handled gracefully""" 72 | string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "rename")}) 73 | file_path = test_dir / "rename" / "fake.f90" 74 | string += imp_request(file_path, 13, 0) 75 | errcode, results = run_request(string, ["-n", "1"]) 76 | assert errcode == 0 77 | assert results[1] is None 78 | 79 | 80 | def test_implementation_submodule(): 81 | """Go to implementation for submodule""" 82 | root = test_dir / "imp" 83 | string = write_rpc_request(1, "initialize", {"rootPath": str(root)}) 84 | file_path = root / "submodule.f90" 85 | string += imp_request(file_path, 5, 30) 86 | string += imp_request(file_path, 8, 30) 87 | string += imp_request(file_path, 9, 30) 88 | errcode, results = run_request(string, ["-n", "1"]) 89 | assert errcode == 0 90 | assert results[1] == create(str(root / "submodule.f90"), 19, 20, 34) 91 | assert results[2] == create(str(root / "submodule.f90"), 19, 20, 34) 92 | assert results[3] is None 93 | -------------------------------------------------------------------------------- /docs/features.rst: -------------------------------------------------------------------------------- 1 | Features 2 | =============== 3 | 4 | - Project-wide and Document symbol detection and Renaming 5 | - Hover support, Signature help and Auto-completion 6 | - GoTo/Peek implementation and Find/Peek references 7 | - Preprocessor support 8 | - Documentation parsing `Doxygen `__ and `FORD `__ styles 9 | - Diagnostics 10 | - Code actions 11 | - Intrinsics modules 12 | 13 | 14 | Completion 15 | ---------- 16 | 17 | .. image:: ../assets/lsp/completion-ani.gif 18 | 19 | .. image:: ../assets/lsp/completion.png 20 | 21 | 22 | Hover 23 | ------- 24 | 25 | .. image:: ../assets/lsp/hover.png 26 | 27 | .. image:: ../assets/lsp/hover2.png 28 | 29 | 30 | Symbols 31 | ------------ 32 | 33 | Project-wide and single Document symbol search 34 | 35 | .. image:: ../assets/lsp/symbols-workspace.png 36 | 37 | .. image:: ../assets/lsp/symbols-doc.png 38 | 39 | 40 | 41 | Signature Help 42 | ---------------- 43 | 44 | .. image:: ../assets/lsp/sig-help.gif 45 | 46 | 47 | Find References 48 | ------------------ 49 | 50 | .. figure:: ../assets/lsp/definition-goto.gif 51 | :align: left 52 | 53 | *Go To Definition of a function* 54 | 55 | 56 | .. figure:: ../assets/lsp/definition-peek.png 57 | :align: left 58 | 59 | *Peek into the Definition of a function* 60 | 61 | 62 | .. figure:: ../assets/lsp/references-peek.png 63 | :align: left 64 | 65 | *Peek into all the References of a function* 66 | 67 | 68 | Renaming 69 | ------------ 70 | 71 | .. figure:: ../assets/lsp/rename.gif 72 | :align: left 73 | 74 | *Rename a variable* 75 | 76 | 77 | Diagnostics 78 | ------------- 79 | 80 | - Multiple definitions with the same variable name 81 | - Variable definition masks definition from parent scope 82 | - Missing subroutine/function arguments 83 | - Unknown user-defined type used in ``TYPE``/ ``CLASS`` definition (only if visible in project) 84 | - Unclosed blocks/scopes 85 | - Invalid scope nesting 86 | - Unknown modules in ``USE`` statement 87 | - Unimplemented deferred type-bound procedures 88 | - Use of non-imported variables/objects in interface blocks 89 | - Statement placement errors (``CONTAINS``, ``IMPLICIT``, ``IMPORT``) 90 | 91 | 92 | 93 | Code Actions 94 | --------------- 95 | 96 | - Generate type-bound procedures and implementation templates for deferred procedures 97 | 98 | 99 | Intrinsics Modules 100 | ------------------ 101 | 102 | 103 | - ``ISO_FORTRAN_ENV``, ``ISO_C_BINDING`` GCC 11.2.0 104 | - ``IEEE_EXCEPTIONS``, ``IEEE_ARITHMETIC``, ``IEEE_FEATURES`` GCC 11.2.0 105 | - OpenMP ``OMP_LIB``, ``OMP_LIB_KINDS`` v5.0 106 | - OpenACC ``OPENACC``, ``OPENACC_KINDS`` v3.1 107 | 108 | 109 | All LSP Requests 110 | -------------------- 111 | 112 | .. list-table:: tmp 113 | :header-rows: 1 114 | 115 | * - Request 116 | - Description 117 | * - ``workspace/symbol`` 118 | - Get workspace-wide symbols 119 | * - ``textDocument/documentSymbol`` 120 | - Get document symbols e.g. functions, subroutines, etc. 121 | * - ``textDocument/completion`` 122 | - Suggested tab-completion when typing 123 | * - ``textDocument/signatureHelp`` 124 | - Get signature information at a given cursor position 125 | * - ``textDocument/definition`` 126 | - GoTo definition/Peek definition 127 | * - ``textDocument/references`` 128 | - Find all/Peek references 129 | * - ``textDocument/documentHighlight`` 130 | - Same as ``textDocument/references`` 131 | * - ``textDocument/hover`` 132 | - Show messages and signatures upon hover 133 | * - ``textDocument/implementation`` 134 | - GoTo implementation/Peek implementation 135 | * - ``textDocument/rename`` 136 | - Rename a symbol across the workspace 137 | * - ``textDocument/didOpen`` 138 | - Document synchronisation upon opening 139 | * - ``textDocument/didSave`` 140 | - Document synchronisation upon saving 141 | * - ``textDocument/didClose`` 142 | - Document synchronisation upon closing 143 | * - ``textDocument/didChange`` 144 | - Document synchronisation upon changes to the document 145 | * - ``textDocument/codeAction`` 146 | - **Experimental** Generate code 147 | -------------------------------------------------------------------------------- /fortls/ftypes.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | from dataclasses import dataclass, field 4 | from typing import NamedTuple 5 | 6 | #: A single line range tuple 7 | Range = NamedTuple("Range", [("start", int), ("end", int)]) 8 | 9 | 10 | @dataclass 11 | class VarInfo: 12 | """Holds information about a Fortran VARIABLE""" 13 | 14 | var_type: str #: Type of variable e.g. ``INTEGER``, ``REAL``, etc. 15 | #: keywords associated with this variable e.g. SAVE, DIMENSION, etc. 16 | keywords: list[str] #: Keywords associated with variable 17 | var_names: list[str] #: Variable names 18 | #: Kind of variable e.g. ``INTEGER*4`` etc. 19 | var_kind: str | None = field(default=None) 20 | 21 | 22 | @dataclass 23 | class SelectInfo: 24 | """Holds information about a SELECT construct""" 25 | 26 | type: int #: Type of SELECT e.g. normal, select type, select kind, select rank 27 | binding: str #: Variable/Object being selected upon 28 | desc: str #: Description of select e.g. "TYPE", "CLASS", None 29 | 30 | 31 | @dataclass 32 | class ClassInfo: 33 | """Holds information about a Fortran CLASS""" 34 | 35 | name: str #: Class name 36 | parent: str #: Parent object of class e.g. ``TYPE, EXTENDS(scaled_vector) :: a`` 37 | keywords: list[str] #: Keywords associated with the class 38 | 39 | 40 | @dataclass 41 | class UseInfo: 42 | """Holds information about a Fortran USE statement""" 43 | 44 | mod_name: str #: Module name 45 | #: List of procedures, variables, interfaces, etc. imported via only 46 | only_list: set[str] 47 | #: A dictionary holding the new names after a rename operation 48 | rename_map: dict[str, str] 49 | 50 | 51 | @dataclass 52 | class GenProcDefInfo: 53 | """Holds information about a GENERIC PROCEDURE DEFINITION""" 54 | 55 | bound_name: str #: Procedure name 56 | pro_links: list[str] #: Procedure links 57 | vis_flag: int #: Visibility flag, public or private 58 | 59 | 60 | @dataclass 61 | class SmodInfo: 62 | """Holds information about Fortran SUBMODULES""" 63 | 64 | name: str #: Submodule name 65 | parent: str #: Submodule i.e. module, parent 66 | 67 | 68 | @dataclass 69 | class InterInfo: 70 | """Holds information about a Fortran INTERFACE""" 71 | 72 | name: str #: Interface name 73 | abstract: bool #: Whether or not the interface is abstract 74 | 75 | 76 | @dataclass 77 | class VisInfo: 78 | """Holds information about the VISIBILITY of a module's contents""" 79 | 80 | type: int #: Visibility type 0: PUBLIC 1: PRIVATE TODO: convert to boolean 81 | obj_names: list[str] #: Module variables, procedures, etc. with that visibility 82 | 83 | 84 | @dataclass 85 | class IncludeInfo: 86 | """Holds information about a Fortran INCLUDE statement""" 87 | 88 | line_number: int #: Line number of include 89 | path: str #: File path to include 90 | file: None # fortran_file #: fortran_file object 91 | scope_objs: list[str] #: A list of available scopes 92 | 93 | 94 | @dataclass 95 | class SubInfo: 96 | """Holds information about a Fortran SUBROUTINE""" 97 | 98 | name: str #: Procedure name 99 | args: str #: Argument list 100 | #: Keywords associated with procedure 101 | keywords: list[str] = field(default_factory=list) 102 | #: Whether or not this is a ``MODULE PROCEDURE`` 103 | mod_flag: bool = field(default=False) 104 | 105 | 106 | @dataclass 107 | class ResultSig: 108 | """Holds information about the RESULT section of a Fortran FUNCTION""" 109 | 110 | name: str | None = field(default=None) #: Variable name of result 111 | type: str | None = field(default=None) #: Variable type of result 112 | kind: str | None = field(default=None) #: Variable kind of result 113 | #: Keywords associated with the result variable, can append without init 114 | keywords: list[str] = field(default_factory=list) 115 | 116 | 117 | @dataclass 118 | class FunSig(SubInfo): 119 | """Holds information about a Fortran FUNCTION""" 120 | 121 | #: Function's result with default ``result.name = name`` 122 | result: ResultSig = field(default_factory=ResultSig) 123 | 124 | def __post_init__(self): 125 | if not self.result.name: 126 | self.result.name = self.name 127 | -------------------------------------------------------------------------------- /test/test_server_signature_help.py: -------------------------------------------------------------------------------- 1 | from pathlib import Path 2 | 3 | from setup_tests import run_request, test_dir, write_rpc_request 4 | 5 | 6 | def sigh_request(uri: Path, line: int, char: int): 7 | return write_rpc_request( 8 | 1, 9 | "textDocument/signatureHelp", 10 | { 11 | "textDocument": {"uri": str(uri)}, 12 | "position": {"line": line, "character": char}, 13 | }, 14 | ) 15 | 16 | 17 | def validate_sigh(results, refs): 18 | assert results.get("activeParameter", -1) == refs[0] 19 | signatures = results.get("signatures") 20 | assert signatures[0].get("label") == refs[2] 21 | assert len(signatures[0].get("parameters")) == refs[1] 22 | 23 | 24 | def test_subroutine_signature_help(): 25 | """Test that the signature help is correctly resolved for all arguments and 26 | that the autocompletion is correct for the subroutine signature. 27 | """ 28 | string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) 29 | file_path = test_dir / "test_prog.f08" 30 | string += sigh_request(file_path, 25, 18) 31 | string += sigh_request(file_path, 25, 20) 32 | string += sigh_request(file_path, 25, 22) 33 | string += sigh_request(file_path, 25, 27) 34 | string += sigh_request(file_path, 25, 29) 35 | errcode, results = run_request(string) 36 | assert errcode == 0 37 | 38 | sub_sig = "test_sig_Sub(arg1, arg2, opt1=opt1, opt2=opt2, opt3=opt3)" 39 | ref = ( 40 | [0, 5, sub_sig], 41 | [1, 5, sub_sig], 42 | [2, 5, sub_sig], 43 | [3, 5, sub_sig], 44 | [4, 5, sub_sig], 45 | ) 46 | assert len(ref) == len(results) - 1 47 | for i, r in enumerate(ref): 48 | validate_sigh(results[i + 1], r) 49 | 50 | 51 | def test_intrinsics(): 52 | string = write_rpc_request( 53 | 1, "initialize", {"rootPath": str(test_dir / "signature")} 54 | ) 55 | file_path = test_dir / "signature" / "nested_sigs.f90" 56 | string += sigh_request(file_path, 8, 77) 57 | errcode, results = run_request( 58 | string, ["--hover_signature", "--use_signature_help", "-n", "1"] 59 | ) 60 | assert errcode == 0 61 | 62 | ref = [[0, 2, "REAL(A, KIND=kind)"]] 63 | assert len(ref) == len(results) - 1 64 | for i, r in enumerate(ref): 65 | validate_sigh(results[i + 1], r) 66 | 67 | 68 | def test_subroutine_markdown(): 69 | """Test that the signature help is correctly resolved for all arguments and 70 | that the autocompletion is correct for the subroutine signature, when there 71 | is documentation present. 72 | """ 73 | string = write_rpc_request( 74 | 1, "initialize", {"rootPath": str(test_dir / "signature")} 75 | ) 76 | file_path = test_dir / "signature" / "help.f90" 77 | string += sigh_request(file_path, 23, 18) 78 | errcode, results = run_request( 79 | string, ["--hover_signature", "--use_signature_help", "-n1"] 80 | ) 81 | assert errcode == 0 82 | # Compare against the full signature help response 83 | ref = { 84 | "signatures": [ 85 | { 86 | "label": "sub2call(arg1, arg2=arg2)", 87 | "parameters": [ 88 | { 89 | "label": "arg1", 90 | "documentation": { 91 | "kind": "markdown", 92 | "value": ( 93 | "```fortran90\nINTEGER, INTENT(IN) ::" 94 | " arg1\n```\n-----\nDoc for arg1" 95 | ), 96 | }, 97 | }, 98 | { 99 | "label": "arg2=arg2", 100 | "documentation": { 101 | "kind": "markdown", 102 | "value": ( 103 | "```fortran90\nINTEGER, INTENT(IN), OPTIONAL ::" 104 | " arg2\n```\n-----\nDoc for arg2" 105 | ), 106 | }, 107 | }, 108 | ], 109 | "documentation": {"kind": "markdown", "value": "Top level Doc"}, 110 | } 111 | ], 112 | "activeParameter": 0, 113 | } 114 | assert results[1] == ref 115 | -------------------------------------------------------------------------------- /assets/icon.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 16 | 39 | 41 | 46 | 48 | 53 | 61 | 66 | 67 | 68 | 69 | -------------------------------------------------------------------------------- /fortls/parsers/internal/submodule.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | from typing import TYPE_CHECKING 4 | from typing import Type as T 5 | 6 | from fortls.constants import ( 7 | BASE_TYPE_ID, 8 | FUNCTION_TYPE_ID, 9 | INTERFACE_TYPE_ID, 10 | SUBMODULE_TYPE_ID, 11 | SUBROUTINE_TYPE_ID, 12 | ) 13 | 14 | from .function import Function 15 | from .module import Module 16 | from .subroutine import Subroutine 17 | 18 | if TYPE_CHECKING: 19 | from .ast import FortranAST 20 | from .interface import Interface 21 | from .scope import Scope 22 | 23 | 24 | class Submodule(Module): 25 | def __init__( 26 | self, 27 | file_ast: FortranAST, 28 | line_number: int, 29 | name: str, 30 | ancestor_name: str = "", 31 | ): 32 | super().__init__(file_ast, line_number, name) 33 | self.ancestor_name = ancestor_name 34 | self.ancestor_obj = None 35 | 36 | def get_type(self, no_link=False): 37 | return SUBMODULE_TYPE_ID 38 | 39 | def get_desc(self): 40 | return "SUBMODULE" 41 | 42 | def get_ancestors(self): 43 | if self.ancestor_obj is not None: 44 | great_ancestors = self.ancestor_obj.get_ancestors() 45 | if great_ancestors is not None: 46 | return [self.ancestor_obj] + great_ancestors 47 | return [self.ancestor_obj] 48 | return [] 49 | 50 | def resolve_inherit(self, obj_tree, inherit_version): 51 | if not self.ancestor_name: 52 | return 53 | if self.ancestor_name in obj_tree: 54 | self.ancestor_obj = obj_tree[self.ancestor_name][0] 55 | 56 | def require_inherit(self): 57 | return True 58 | 59 | def resolve_link(self, obj_tree): 60 | def get_ancestor_interfaces( 61 | ancestor_children: list[Scope], 62 | ) -> list[T[Interface]]: 63 | interfaces = [] 64 | for child in ancestor_children: 65 | if child.get_type() != INTERFACE_TYPE_ID: 66 | continue 67 | for interface in child.children: 68 | interface_type = interface.get_type() 69 | if ( 70 | interface_type 71 | in (SUBROUTINE_TYPE_ID, FUNCTION_TYPE_ID, BASE_TYPE_ID) 72 | ) and interface.is_mod_scope(): 73 | interfaces.append(interface) 74 | return interfaces 75 | 76 | def create_child_from_prototype(child: Scope, interface: Interface): 77 | if interface.get_type() == SUBROUTINE_TYPE_ID: 78 | return Subroutine(child.file_ast, child.sline, child.name) 79 | elif interface.get_type() == FUNCTION_TYPE_ID: 80 | return Function(child.file_ast, child.sline, child.name) 81 | else: 82 | raise ValueError(f"Unsupported interface type: {interface.get_type()}") 83 | 84 | def replace_child_in_scope_list(child: Scope, child_old: Scope): 85 | for i, file_scope in enumerate(child.file_ast.scope_list): 86 | if file_scope is child_old: 87 | child.file_ast.scope_list[i] = child 88 | return child 89 | 90 | # Link subroutine/function implementations to prototypes 91 | if self.ancestor_obj is None: 92 | return 93 | 94 | ancestor_interfaces = get_ancestor_interfaces(self.ancestor_obj.children) 95 | # Match interface definitions to implementations 96 | for interface in ancestor_interfaces: 97 | for i, child in enumerate(self.children): 98 | if child.name.lower() != interface.name.lower(): 99 | continue 100 | 101 | if child.get_type() == BASE_TYPE_ID: 102 | child_old = child 103 | child = create_child_from_prototype(child_old, interface) 104 | child.copy_from(child_old) 105 | self.children[i] = child 106 | child = replace_child_in_scope_list(child, child_old) 107 | 108 | if child.get_type() == interface.get_type(): 109 | interface.link_obj = child 110 | interface.resolve_link(obj_tree) 111 | child.copy_interface(interface) 112 | break 113 | 114 | def require_link(self): 115 | return True 116 | -------------------------------------------------------------------------------- /docs/conf.py: -------------------------------------------------------------------------------- 1 | # Configuration file for the Sphinx documentation builder. 2 | # 3 | # This file only contains a selection of the most common options. For a full 4 | # list see the documentation: 5 | # https://www.sphinx-doc.org/en/master/usage/configuration.html 6 | 7 | # -- Path setup -------------------------------------------------------------- 8 | 9 | # If extensions (or modules to document with autodoc) are in another directory, 10 | # add these directories to sys.path here. If the directory is relative to the 11 | # documentation root, use os.path.abspath to make it absolute, like shown here. 12 | # 13 | import os 14 | import sys 15 | 16 | sys.path.insert(0, os.path.abspath("..")) 17 | 18 | from fortls import __version__ # noqa: E402 19 | 20 | # Generate the agglomerated changes (from the CHANGELOG) between fortls 21 | # and the fortran-language-server project 22 | with open("../CHANGELOG.md") as f: 23 | lns = f.readlines() 24 | 25 | lns = lns[0 : lns.index("## 1.12.0\n")] 26 | changes = { 27 | "Added": [], 28 | "Changed": [], 29 | "Deprecated": [], 30 | "Removed": [], 31 | "Fixed": [], 32 | "Security": [], 33 | } 34 | 35 | field = "" 36 | for i in lns: 37 | if i.startswith("## "): 38 | continue 39 | if i.startswith("### "): 40 | field = i[4:-1] 41 | continue 42 | if i.startswith("- ") or i.startswith(" "): 43 | changes[field].append(i) 44 | 45 | new_file = ["# Unique fortls features (not in fortran-language-server)\n"] 46 | for key, val in changes.items(): 47 | if val: 48 | new_file.append(f"\n## {key}\n\n") 49 | new_file.extend(val) 50 | 51 | with open("fortls_changes.md", "w") as f: 52 | f.writelines(new_file) 53 | 54 | 55 | # -- Project information ----------------------------------------------------- 56 | 57 | project = "fortls" 58 | copyright = "2021-2022, Giannis Nikiteas" 59 | author = "Giannis Nikiteas" 60 | 61 | # The full version, including alpha/beta/rc tags 62 | release = __version__ 63 | 64 | 65 | # -- General configuration --------------------------------------------------- 66 | 67 | # Add any Sphinx extension module names here, as strings. They can be 68 | # extensions coming with Sphinx (named 'sphinx.ext.*') or your custom 69 | # ones. 70 | extensions = [ 71 | "sphinxarg.ext", 72 | "sphinx.ext.autodoc", 73 | "sphinx.ext.autosectionlabel", 74 | "sphinx.ext.autosummary", 75 | "sphinx.ext.napoleon", 76 | "sphinx.ext.intersphinx", 77 | "sphinx.ext.inheritance_diagram", 78 | "sphinx_autodoc_typehints", 79 | "sphinx.ext.autosectionlabel", 80 | "sphinx_design", 81 | "sphinx_copybutton", 82 | "myst_parser", 83 | "sphinx_sitemap", 84 | ] 85 | # For sphinx_design in Markdown 86 | myst_enable_extensions = ["colon_fence"] 87 | 88 | # Add any paths that contain templates here, relative to this directory. 89 | templates_path = ["_templates"] 90 | source_suffix = [".rst", ".md"] 91 | 92 | 93 | # List of patterns, relative to source directory, that match files and 94 | # directories to ignore when looking for source files. 95 | # This pattern also affects html_static_path and html_extra_path. 96 | exclude_patterns = ["_build", "Thumbs.db", ".DS_Store"] 97 | 98 | 99 | # -- Options for HTML output ------------------------------------------------- 100 | 101 | # The theme to use for HTML and HTML Help pages. See the documentation for 102 | # a list of builtin themes. 103 | # 104 | html_theme = "alabaster" 105 | html_theme = "sphinx_rtd_theme" 106 | html_theme = "furo" 107 | html_title = "fortls" 108 | html_logo = "../assets/logo.svg" 109 | html_favicon = "../assets/icon.svg" 110 | html_baseurl = "https://fortls.fortran-lang.org/" 111 | 112 | # Add any paths that contain custom static files (such as style sheets) here, 113 | # relative to this directory. They are copied after the builtin static files, 114 | # so a file named "default.css" will overwrite the builtin "default.css". 115 | html_static_path = ["_static"] 116 | 117 | # Add any extra paths that contain custom files (such as robots.txt or 118 | # .htaccess) here, relative to this directory. These files are copied 119 | # directly to the root of the documentation. 120 | html_extra_path = ["html_extra"] 121 | # Default is {version}{lang}{link} 122 | sitemap_url_scheme = "{link}" 123 | 124 | display_toc = True 125 | # autodoc_default_flags = ["members"] 126 | autosummary_generate = True 127 | 128 | 129 | intersphinx_mapping = { 130 | "python": ("https://docs.python.org/3.10", None), 131 | } 132 | 133 | inheritance_graph_attrs = { 134 | "size": '"6.0, 8.0"', 135 | "fontsize": 32, 136 | "bgcolor": "transparent", 137 | } 138 | inheritance_node_attrs = { 139 | "color": "black", 140 | "fillcolor": "white", 141 | "style": '"filled,solid"', 142 | } 143 | inheritance_edge_attrs = { 144 | "penwidth": 1.2, 145 | "arrowsize": 0.8, 146 | } 147 | -------------------------------------------------------------------------------- /fortls/parsers/internal/statements.json: -------------------------------------------------------------------------------- 1 | { 2 | "var_def": { 3 | "CHARACTER": { "args": "LEN=len" }, 4 | "CLASS": { "args": "name" }, 5 | "COMPLEX": { "args": "KIND=kind" }, 6 | "DOUBLE COMPLEX": {}, 7 | "DOUBLE PRECISION": {}, 8 | "INTEGER": { "args": "KIND=kind" }, 9 | "LOGICAL": { "args": "KIND=kind" }, 10 | "REAL": { "args": "KIND=kind" }, 11 | "TYPE": { "args": "KIND=kind" } 12 | }, 13 | "int_stmnts": { 14 | "ALLOCATE": { 15 | "doc": "Dynamically creates storage for allocatable variables and pointer targets." 16 | }, 17 | "BACKSPACE": { 18 | "doc": "Positions a sequential file at the beginning of the preceding record, making it available for subsequent I/O processing." 19 | }, 20 | "CALL": { 21 | "doc": "Transfers control to a subroutine subprogram." 22 | }, 23 | "CLOSE": { 24 | "doc": "Disconnects a file from a unit." 25 | }, 26 | "CONTINUE": { 27 | "doc": "Primarily used to terminate a labelled DO construct when the construct would otherwise end improperly with either a GO TO, arithmetic IF, or other prohibited control statement." 28 | }, 29 | "CYCLE": { 30 | "doc": "Interrupts the current execution cycle of the innermost (or named) DO construct." 31 | }, 32 | "DEALLOCATE": { 33 | "doc": "Frees the storage allocated for allocatable variables and nonprocedure pointer targets (and causes the pointers to become disassociated)." 34 | }, 35 | "ENDFILE": { 36 | "doc": "For sequential files, writes an end-of-file record to the file and positions the file after this record (the terminal point)." 37 | }, 38 | "ERROR STOP": { 39 | "doc": "Initiates error termination of an image before the execution of an END statement of the main program." 40 | }, 41 | "EVENT POST": { 42 | "doc": "Allows an image to notify another image that it can proceed to work on tasks that use common resources." 43 | }, 44 | "EVENT WAIT": { 45 | "doc": "Allows an image to wait on events posted by other images." 46 | }, 47 | "FAIL IMAGE": { 48 | "doc": "Forces the failure of the current image of the program unit." 49 | }, 50 | "FLUSH": { 51 | "doc": "Causes data written to a file to become available to other processes or causes data written to a file outside of Fortran to be accessible to a READ statement." 52 | }, 53 | "FORM TEAM": { 54 | "args": "team_number,team_variable", 55 | "doc": "Defines team variables; creates one or more teams of images from the images on the current team." 56 | }, 57 | "FORMAT": { 58 | "doc": "Specifies the form of data being transferred and the data conversion (editing) required to achieve that form." 59 | }, 60 | "INQUIRE": { 61 | "doc": "Returns information on the status of specified properties of a file or logical unit." 62 | }, 63 | "LOCK": { 64 | "doc": "Causes a lock variable to become locked by an image." 65 | }, 66 | "NAMELIST": { 67 | "doc": "Associates a name with a list of variables. This group name can be referenced in some input/output operations." 68 | }, 69 | "NULLIFY": { 70 | "doc": "Disassociates a pointer from a target." 71 | }, 72 | "OPEN": { 73 | "doc": "Connects an external file to a unit, creates a new file and connects it to a unit, creates a preconnected file, or changes certain properties of a connection." 74 | }, 75 | "PRINT": { 76 | "doc": "Displays output on the screen." 77 | }, 78 | "READ": { 79 | "doc": "Transfers input data from external sequential, direct-access, or internal records." 80 | }, 81 | "RETURN": { 82 | "doc": "Return control to the calling program unit." 83 | }, 84 | "REWIND": { 85 | "doc": "Positions a sequential or direct access file at the beginning of the file (the initial point)." 86 | }, 87 | "STOP": { 88 | "doc": "Initiates normal termination of an image before the execution of an END statement of the main program." 89 | }, 90 | "SYNC ALL": { 91 | "args": "STAT=stat,ERRMSG=errmsg", 92 | "doc": "Performs a synchronization of all images in the current team." 93 | }, 94 | "SYNC IMAGES": { 95 | "args": "image_set,STAT=stat,ERRMSG=errmsg", 96 | "doc": "Performs a synchronization of the image with each of the other images in the image set." 97 | }, 98 | "SYNC MEMORY": { 99 | "args": "STAT=stat,ERRMSG=errmsg", 100 | "doc": "Ends one image segment and begins another. Each segment can then be ordered in some way with respect to segments on other images." 101 | }, 102 | "SYNC TEAM": { 103 | "args": "team_value,STAT=stat,ERRMSG=errmsg", 104 | "doc": "Performs a synchronization of all images on the specified team." 105 | }, 106 | "UNLOCK": { 107 | "doc": "Causes a lock variable to become unlocked by an image." 108 | }, 109 | "WAIT": { 110 | "doc": "Performs a wait operation for a specified pending asynchronous data transfer operation." 111 | }, 112 | "WRITE": { 113 | "doc": "Transfers output data to external sequential, direct-access, or internal records." 114 | } 115 | } 116 | } 117 | -------------------------------------------------------------------------------- /docs/index.rst: -------------------------------------------------------------------------------- 1 | :sd_hide_title: 2 | 3 | ============== 4 | fortls 5 | ============== 6 | 7 | 8 | .. div:: landing-title 9 | :style: padding: 0.1rem 0.5rem 0.6rem 0; background-image: linear-gradient(315deg, #2753e3 0%, #734f96 74%); clip-path: polygon(0px 0px, 100% 0%, 100% 100%, 0% calc(100% - 1.5rem)); -webkit-clip-path: polygon(0px 0px, 100% 0%, 100% 100%, 0% calc(100% - 1.5rem)); 10 | 11 | .. grid:: 12 | :reverse: 13 | :gutter: 2 3 3 3 14 | :margin: 4 4 1 2 15 | 16 | .. grid-item:: 17 | :columns: 12 6 6 6 18 | 19 | .. image:: ../assets/logo2-animated.svg 20 | :alt: fortls 21 | :width: 100% 22 | 23 | .. grid-item:: 24 | :columns: 12 6 6 6 25 | :child-align: justify 26 | :class: sd-text-white sd-fs-3 27 | 28 | A Language Server for Fortran providing code completion, diagnostics, hovering and more. 29 | 30 | .. button-ref:: quickstart 31 | :ref-type: doc 32 | :outline: 33 | :color: white 34 | :class: sd-px-4 sd-fs-5 35 | 36 | Get Started 37 | 38 | 39 | .. .. grid:: 2 40 | .. :gutter: 0 41 | .. :class-container: sd-text-center sd-pt-4 42 | .. :class-row: sd-align-minor-center 43 | 44 | .. .. grid-item:: 45 | .. .. button-link:: https://github.com/sponsors/gnikit 46 | .. :ref-type: ref 47 | .. :outline: 48 | .. :color: danger 49 | .. :class: sd-px-2 sd-fs-4 50 | 51 | .. Become a **Sponsor** 52 | .. :octicon:`mark-github;2em;sd-text-black` 53 | .. :octicon:`heart-fill;2em;sd-text-danger` 54 | 55 | .. .. grid-item:: 56 | .. .. button-link:: https://www.paypal.com/paypalme/inikit 57 | .. :ref-type: ref 58 | .. :color: primary 59 | .. :class: sd-px-2 sd-fs-5 60 | 61 | .. Make a **Donation** 62 | .. :fa:`fa-paypal` 63 | 64 | 65 | .. div:: sd-text-center 66 | 67 | *A tool to supercharge Fortran development!* 68 | 69 | .. tab-set:: 70 | :class: sd-align-major-center 71 | 72 | 73 | .. tab-item:: Completion 74 | :class-label: sd-rounded-2 sd-border-1 sd-my-2 sd-mx-2 sd-px-2 sd-py-1 75 | 76 | .. image:: ../assets/lsp/completion-ani.gif 77 | 78 | .. tab-item:: Hover 79 | :class-label: sd-rounded-2 sd-border-1 sd-my-2 sd-mx-2 sd-px-2 sd-py-1 80 | 81 | .. image:: ../assets/lsp/hover2.png 82 | 83 | .. tab-item:: Rename 84 | :class-label: sd-rounded-2 sd-border-1 sd-my-2 sd-mx-2 sd-px-2 sd-py-1 85 | 86 | .. image:: ../assets/lsp/rename2.gif 87 | 88 | .. tab-item:: Symbols 89 | :class-label: sd-rounded-2 sd-border-1 sd-my-2 sd-mx-2 sd-px-2 sd-py-1 90 | 91 | .. image:: ../assets/lsp/symbols-crop.png 92 | 93 | .. tab-item:: References 94 | :class-label: sd-rounded-2 sd-border-1 sd-my-2 sd-mx-2 sd-px-2 sd-py-1 95 | 96 | .. image:: ../assets/lsp/definition-peek.png 97 | 98 | .. tab-item:: Diagnostics 99 | :class-label: sd-rounded-2 sd-border-1 sd-my-2 sd-mx-2 sd-px-2 sd-py-1 100 | 101 | .. image:: ../assets/lsp/diagnostics1.png 102 | 103 | 104 | .. TODO: here go the sponsors 105 | 106 | .. toctree:: 107 | :hidden: 108 | 109 | quickstart.rst 110 | 111 | .. toctree:: 112 | :maxdepth: 2 113 | :caption: Components 114 | :hidden: 115 | 116 | features.rst 117 | editor_integration.rst 118 | options.rst 119 | fortls_changes.md 120 | 121 | .. toctree:: 122 | :maxdepth: 2 123 | :caption: Get Involved 124 | :hidden: 125 | 126 | contributing.rst 127 | 128 | .. toctree:: 129 | :maxdepth: 2 130 | :caption: Contact Us 131 | :hidden: 132 | 133 | contact.rst 134 | 135 | .. toctree:: 136 | :hidden: 137 | :caption: Development 138 | 139 | modules.rst 140 | 141 | .. grid:: 1 2 3 3 142 | :margin: 4 4 0 0 143 | :gutter: 1 144 | 145 | 146 | .. grid-item-card:: :octicon:`desktop-download;5em;sd-text-primary` 147 | :link-type: any 148 | :link: Download 149 | :class-body: sd-text-center 150 | 151 | Download 152 | 153 | 154 | .. grid-item-card:: :material-sharp:`import_contacts;5em;sd-text-primary` 155 | :class-body: sd-text-center 156 | :link: features 157 | :link-type: doc 158 | 159 | Features 160 | 161 | .. grid-item-card:: :material-outlined:`settings;5em;sd-text-primary` 162 | :link-type: doc 163 | :link: options 164 | :class-body: sd-text-center 165 | 166 | Configuration Options 167 | 168 | .. grid-item-card:: :octicon:`browser;5em;sd-text-primary` 169 | :link-type: doc 170 | :link: editor_integration 171 | :class-body: sd-text-center 172 | 173 | Editor Integration 174 | 175 | .. grid-item-card:: :material-round:`mail;5em;sd-text-primary` 176 | :link-type: doc 177 | :link: contact 178 | :class-body: sd-text-center 179 | 180 | Contact Us 181 | 182 | .. grid-item-card:: :octicon:`git-pull-request;5em;sd-text-primary` 183 | :link-type: doc 184 | :link: contributing 185 | :class-body: sd-text-center 186 | 187 | Contribute 188 | 189 | 190 | .. 191 | Include native markdown into native rst 192 | .. include:: README.md 193 | :parser: myst_parser.sphinx_ 194 | -------------------------------------------------------------------------------- /fortls/parsers/internal/method.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | from typing import TYPE_CHECKING 4 | 5 | from fortls.constants import CLASS_TYPE_ID, KEYWORD_ID_DICT, METH_TYPE_ID 6 | from fortls.helper_functions import get_paren_substring 7 | 8 | from .utilities import find_in_scope 9 | from .variable import Variable 10 | 11 | if TYPE_CHECKING: 12 | from .ast import FortranAST 13 | 14 | 15 | class Method(Variable): # i.e. TypeBound procedure 16 | def __init__( 17 | self, 18 | file_ast: FortranAST, 19 | line_number: int, 20 | name: str, 21 | var_desc: str, 22 | keywords: list, 23 | keyword_info: dict, 24 | proc_ptr: str = "", # procedure pointer e.g. `foo` in `procedure(foo)` 25 | link_obj=None, 26 | ): 27 | super().__init__( 28 | file_ast, 29 | line_number, 30 | name, 31 | var_desc, 32 | keywords, 33 | keyword_info, 34 | kind=proc_ptr, 35 | link_obj=link_obj, 36 | ) 37 | self.drop_arg: int = -1 38 | self.pass_name: str = keyword_info.get("pass") 39 | if link_obj is None: 40 | self.link_name = get_paren_substring(self.get_desc(True).lower()) 41 | 42 | def set_parent(self, parent_obj): 43 | self.parent = parent_obj 44 | if self.parent.get_type() == CLASS_TYPE_ID: 45 | if self.keywords.count(KEYWORD_ID_DICT["nopass"]) == 0: 46 | self.drop_arg = 0 47 | if ( 48 | (self.parent.contains_start is not None) 49 | and (self.sline > self.parent.contains_start) 50 | and (self.link_name is None) 51 | ): 52 | self.link_name = self.name.lower() 53 | 54 | def get_snippet(self, name_replace=None, drop_arg=-1): 55 | if self.link_obj is not None: 56 | name = self.name if name_replace is None else name_replace 57 | return self.link_obj.get_snippet(name, self.drop_arg) 58 | return None, None 59 | 60 | def get_type(self, no_link=False): 61 | if (not no_link) and (self.link_obj is not None): 62 | return self.link_obj.get_type() 63 | # Generic 64 | return METH_TYPE_ID 65 | 66 | def get_documentation(self): 67 | if (self.link_obj is not None) and (self.doc_str is None): 68 | return self.link_obj.get_documentation() 69 | return self.doc_str 70 | 71 | def get_hover(self, long=False, drop_arg=-1) -> tuple[str, str]: 72 | docs = self.get_documentation() 73 | # Long hover message 74 | if self.link_obj is None: 75 | sub_sig, _ = self.get_snippet() 76 | hover_str = f"{self.get_desc()} {sub_sig}" 77 | else: 78 | link_msg, link_docs = self.link_obj.get_hover( 79 | long=True, drop_arg=self.drop_arg 80 | ) 81 | # Replace the name of the linked object with the name of this object 82 | hover_str = link_msg.replace(self.link_obj.name, self.name, 1) 83 | if isinstance(link_docs, str): 84 | # Get just the docstring of the link, if any, no args 85 | link_doc_top = self.link_obj.get_documentation() 86 | # Replace the linked objects topmost documentation with the 87 | # documentation of the procedure pointer if one is present 88 | if link_doc_top is not None: 89 | docs = link_docs.replace(link_doc_top, docs, 1) 90 | # If no top docstring is present at the linked object but there 91 | # are docstrings for the arguments, add them to the end of the 92 | # documentation for this object 93 | elif link_docs: 94 | if docs is None: 95 | docs = "" 96 | docs += " \n" + link_docs 97 | return hover_str, docs 98 | 99 | def get_signature(self, drop_arg=-1): 100 | if self.link_obj is not None: 101 | call_sig, _ = self.get_snippet() 102 | _, _, arg_sigs = self.link_obj.get_signature(self.drop_arg) 103 | return call_sig, self.get_documentation(), arg_sigs 104 | return None, None, None 105 | 106 | def get_interface(self, name_replace=None, drop_arg=-1, change_strings=None): 107 | if self.link_obj is not None: 108 | return self.link_obj.get_interface( 109 | name_replace, self.drop_arg, change_strings 110 | ) 111 | return None 112 | 113 | def resolve_link(self, obj_tree): 114 | if self.link_name is None: 115 | return 116 | if self.parent is not None: 117 | if self.parent.get_type() == CLASS_TYPE_ID: 118 | link_obj = find_in_scope(self.parent.parent, self.link_name, obj_tree) 119 | else: 120 | link_obj = find_in_scope(self.parent, self.link_name, obj_tree) 121 | if link_obj is not None: 122 | self.link_obj = link_obj 123 | if self.pass_name is not None: 124 | self.pass_name = self.pass_name.lower() 125 | for i, arg in enumerate(link_obj.args_snip.split(",")): 126 | if arg.lower() == self.pass_name: 127 | self.drop_arg = i 128 | break 129 | 130 | def is_callable(self): 131 | return True 132 | 133 | def check_definition(self, obj_tree, known_types=None, interface=False): 134 | if known_types is None: 135 | known_types = {} 136 | return None, known_types 137 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | We as members, contributors, and leaders pledge to make participation in our 6 | community a harassment-free experience for everyone, regardless of age, body 7 | size, visible or invisible disability, ethnicity, sex characteristics, gender 8 | identity and expression, level of experience, education, socio-economic status, 9 | nationality, personal appearance, race, religion, or sexual identity 10 | and orientation. 11 | 12 | We pledge to act and interact in ways that contribute to an open, welcoming, 13 | diverse, inclusive, and healthy community. 14 | 15 | ## Our Standards 16 | 17 | Examples of behavior that contributes to a positive environment for our 18 | community include: 19 | 20 | * Demonstrating empathy and kindness toward other people 21 | * Being respectful of differing opinions, viewpoints, and experiences 22 | * Giving and gracefully accepting constructive feedback 23 | * Accepting responsibility and apologizing to those affected by our mistakes, 24 | and learning from the experience 25 | * Focusing on what is best not just for us as individuals, but for the 26 | overall community 27 | 28 | Examples of unacceptable behavior include: 29 | 30 | * The use of sexualized language or imagery, and sexual attention or 31 | advances of any kind 32 | * Trolling, insulting or derogatory comments, and personal or political attacks 33 | * Public or private harassment 34 | * Publishing others' private information, such as a physical or email 35 | address, without their explicit permission 36 | * Other conduct which could reasonably be considered inappropriate in a 37 | professional setting 38 | 39 | ## Enforcement Responsibilities 40 | 41 | Community leaders are responsible for clarifying and enforcing our standards of 42 | acceptable behavior and will take appropriate and fair corrective action in 43 | response to any behavior that they deem inappropriate, threatening, offensive, 44 | or harmful. 45 | 46 | Community leaders have the right and responsibility to remove, edit, or reject 47 | comments, commits, code, wiki edits, issues, and other contributions that are 48 | not aligned to this Code of Conduct, and will communicate reasons for moderation 49 | decisions when appropriate. 50 | 51 | ## Scope 52 | 53 | This Code of Conduct applies within all community spaces, and also applies when 54 | an individual is officially representing the community in public spaces. 55 | Examples of representing our community include using an official e-mail address, 56 | posting via an official social media account, or acting as an appointed 57 | representative at an online or offline event. 58 | 59 | ## Enforcement 60 | 61 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 62 | reported to the community leaders responsible for enforcement at 63 | giannis.nikiteas@gmail.com. 64 | All complaints will be reviewed and investigated promptly and fairly. 65 | 66 | All community leaders are obligated to respect the privacy and security of the 67 | reporter of any incident. 68 | 69 | ## Enforcement Guidelines 70 | 71 | Community leaders will follow these Community Impact Guidelines in determining 72 | the consequences for any action they deem in violation of this Code of Conduct: 73 | 74 | ### 1. Correction 75 | 76 | **Community Impact**: Use of inappropriate language or other behavior deemed 77 | unprofessional or unwelcome in the community. 78 | 79 | **Consequence**: A private, written warning from community leaders, providing 80 | clarity around the nature of the violation and an explanation of why the 81 | behavior was inappropriate. A public apology may be requested. 82 | 83 | ### 2. Warning 84 | 85 | **Community Impact**: A violation through a single incident or series 86 | of actions. 87 | 88 | **Consequence**: A warning with consequences for continued behavior. No 89 | interaction with the people involved, including unsolicited interaction with 90 | those enforcing the Code of Conduct, for a specified period of time. This 91 | includes avoiding interactions in community spaces as well as external channels 92 | like social media. Violating these terms may lead to a temporary or 93 | permanent ban. 94 | 95 | ### 3. Temporary Ban 96 | 97 | **Community Impact**: A serious violation of community standards, including 98 | sustained inappropriate behavior. 99 | 100 | **Consequence**: A temporary ban from any sort of interaction or public 101 | communication with the community for a specified period of time. No public or 102 | private interaction with the people involved, including unsolicited interaction 103 | with those enforcing the Code of Conduct, is allowed during this period. 104 | Violating these terms may lead to a permanent ban. 105 | 106 | ### 4. Permanent Ban 107 | 108 | **Community Impact**: Demonstrating a pattern of violation of community 109 | standards, including sustained inappropriate behavior, harassment of an 110 | individual, or aggression toward or disparagement of classes of individuals. 111 | 112 | **Consequence**: A permanent ban from any sort of public interaction within 113 | the community. 114 | 115 | ## Attribution 116 | 117 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], 118 | version 2.0, available at 119 | https://www.contributor-covenant.org/version/2/0/code_of_conduct.html. 120 | 121 | Community Impact Guidelines were inspired by [Mozilla's code of conduct 122 | enforcement ladder](https://github.com/mozilla/diversity). 123 | 124 | [homepage]: https://www.contributor-covenant.org 125 | 126 | For answers to common questions about this code of conduct, see the FAQ at 127 | https://www.contributor-covenant.org/faq. Translations are available at 128 | https://www.contributor-covenant.org/translations. 129 | -------------------------------------------------------------------------------- /docs/fortls.parsers.internal.rst: -------------------------------------------------------------------------------- 1 | fortls.parsers.internal package 2 | =============================== 3 | 4 | Submodules 5 | ---------- 6 | 7 | fortls.parsers.internal.associate module 8 | ---------------------------------------- 9 | 10 | .. automodule:: fortls.parsers.internal.associate 11 | :members: 12 | :undoc-members: 13 | :show-inheritance: 14 | 15 | fortls.parsers.internal.ast module 16 | ---------------------------------- 17 | 18 | .. automodule:: fortls.parsers.internal.ast 19 | :members: 20 | :undoc-members: 21 | :show-inheritance: 22 | 23 | fortls.parsers.internal.base module 24 | ----------------------------------- 25 | 26 | .. automodule:: fortls.parsers.internal.base 27 | :members: 28 | :undoc-members: 29 | :show-inheritance: 30 | 31 | fortls.parsers.internal.block module 32 | ------------------------------------ 33 | 34 | .. automodule:: fortls.parsers.internal.block 35 | :members: 36 | :undoc-members: 37 | :show-inheritance: 38 | 39 | fortls.parsers.internal.diagnostics module 40 | ------------------------------------------ 41 | 42 | .. automodule:: fortls.parsers.internal.diagnostics 43 | :members: 44 | :undoc-members: 45 | :show-inheritance: 46 | 47 | fortls.parsers.internal.do module 48 | --------------------------------- 49 | 50 | .. automodule:: fortls.parsers.internal.do 51 | :members: 52 | :undoc-members: 53 | :show-inheritance: 54 | 55 | fortls.parsers.internal.enum module 56 | ----------------------------------- 57 | 58 | .. automodule:: fortls.parsers.internal.enum 59 | :members: 60 | :undoc-members: 61 | :show-inheritance: 62 | 63 | fortls.parsers.internal.function module 64 | --------------------------------------- 65 | 66 | .. automodule:: fortls.parsers.internal.function 67 | :members: 68 | :undoc-members: 69 | :show-inheritance: 70 | 71 | fortls.parsers.internal.if\_block module 72 | ---------------------------------------- 73 | 74 | .. automodule:: fortls.parsers.internal.if_block 75 | :members: 76 | :undoc-members: 77 | :show-inheritance: 78 | 79 | fortls.parsers.internal.imports module 80 | -------------------------------------- 81 | 82 | .. automodule:: fortls.parsers.internal.imports 83 | :members: 84 | :undoc-members: 85 | :show-inheritance: 86 | 87 | fortls.parsers.internal.include module 88 | -------------------------------------- 89 | 90 | .. automodule:: fortls.parsers.internal.include 91 | :members: 92 | :undoc-members: 93 | :show-inheritance: 94 | 95 | fortls.parsers.internal.interface module 96 | ---------------------------------------- 97 | 98 | .. automodule:: fortls.parsers.internal.interface 99 | :members: 100 | :undoc-members: 101 | :show-inheritance: 102 | 103 | fortls.parsers.internal.intrinsics module 104 | ----------------------------------------- 105 | 106 | .. automodule:: fortls.parsers.internal.intrinsics 107 | :members: 108 | :undoc-members: 109 | :show-inheritance: 110 | 111 | fortls.parsers.internal.method module 112 | ------------------------------------- 113 | 114 | .. automodule:: fortls.parsers.internal.method 115 | :members: 116 | :undoc-members: 117 | :show-inheritance: 118 | 119 | fortls.parsers.internal.module module 120 | ------------------------------------- 121 | 122 | .. automodule:: fortls.parsers.internal.module 123 | :members: 124 | :undoc-members: 125 | :show-inheritance: 126 | 127 | fortls.parsers.internal.parser module 128 | ------------------------------------- 129 | 130 | .. automodule:: fortls.parsers.internal.parser 131 | :members: 132 | :undoc-members: 133 | :show-inheritance: 134 | 135 | fortls.parsers.internal.program module 136 | -------------------------------------- 137 | 138 | .. automodule:: fortls.parsers.internal.program 139 | :members: 140 | :undoc-members: 141 | :show-inheritance: 142 | 143 | fortls.parsers.internal.scope module 144 | ------------------------------------ 145 | 146 | .. automodule:: fortls.parsers.internal.scope 147 | :members: 148 | :undoc-members: 149 | :show-inheritance: 150 | 151 | fortls.parsers.internal.select module 152 | ------------------------------------- 153 | 154 | .. automodule:: fortls.parsers.internal.select 155 | :members: 156 | :undoc-members: 157 | :show-inheritance: 158 | 159 | fortls.parsers.internal.submodule module 160 | ---------------------------------------- 161 | 162 | .. automodule:: fortls.parsers.internal.submodule 163 | :members: 164 | :undoc-members: 165 | :show-inheritance: 166 | 167 | fortls.parsers.internal.subroutine module 168 | ----------------------------------------- 169 | 170 | .. automodule:: fortls.parsers.internal.subroutine 171 | :members: 172 | :undoc-members: 173 | :show-inheritance: 174 | 175 | fortls.parsers.internal.type module 176 | ----------------------------------- 177 | 178 | .. automodule:: fortls.parsers.internal.type 179 | :members: 180 | :undoc-members: 181 | :show-inheritance: 182 | 183 | fortls.parsers.internal.use module 184 | ---------------------------------- 185 | 186 | .. automodule:: fortls.parsers.internal.use 187 | :members: 188 | :undoc-members: 189 | :show-inheritance: 190 | 191 | fortls.parsers.internal.utilities module 192 | ---------------------------------------- 193 | 194 | .. automodule:: fortls.parsers.internal.utilities 195 | :members: 196 | :undoc-members: 197 | :show-inheritance: 198 | 199 | fortls.parsers.internal.variable module 200 | --------------------------------------- 201 | 202 | .. automodule:: fortls.parsers.internal.variable 203 | :members: 204 | :undoc-members: 205 | :show-inheritance: 206 | 207 | fortls.parsers.internal.where module 208 | ------------------------------------ 209 | 210 | .. automodule:: fortls.parsers.internal.where 211 | :members: 212 | :undoc-members: 213 | :show-inheritance: 214 | 215 | Module contents 216 | --------------- 217 | 218 | .. automodule:: fortls.parsers.internal 219 | :members: 220 | :undoc-members: 221 | :show-inheritance: 222 | -------------------------------------------------------------------------------- /fortls/parsers/internal/function.py: -------------------------------------------------------------------------------- 1 | from __future__ import annotations 2 | 3 | from typing import TYPE_CHECKING 4 | 5 | from fortls.constants import FUNCTION_TYPE_ID 6 | from fortls.helper_functions import get_keywords 7 | 8 | from .subroutine import Subroutine 9 | 10 | if TYPE_CHECKING: 11 | from .ast import FortranAST 12 | from .variable import Variable 13 | 14 | 15 | class Function(Subroutine): 16 | def __init__( 17 | self, 18 | file_ast: FortranAST, 19 | line_number: int, 20 | name: str, 21 | args: str = "", 22 | mod_flag: bool = False, 23 | keywords: list = None, 24 | keyword_info: dict = None, 25 | result_type: str = None, 26 | result_name: str = None, 27 | ): 28 | super().__init__(file_ast, line_number, name, args, mod_flag, keywords) 29 | self.args: str = args.replace(" ", "").lower() 30 | self.args_snip: str = self.args 31 | self.arg_objs: list = [] 32 | self.in_children: list = [] 33 | self.missing_args: list = [] 34 | self.mod_scope: bool = mod_flag 35 | self.result_name: str = result_name 36 | self.result_type: str = result_type 37 | self.result_obj: Variable = None 38 | self.keyword_info: dict = keyword_info 39 | # Set the implicit result() name to be the function name 40 | if self.result_name is None: 41 | self.result_name = self.name 42 | # Used in Associated blocks 43 | if self.keyword_info is None: 44 | self.keyword_info = {} 45 | 46 | def copy_interface(self, copy_source: Function): 47 | # Call the parent class method 48 | child_names = super().copy_interface(copy_source) 49 | # Return specific options 50 | self.result_name = copy_source.result_name 51 | self.result_type = copy_source.result_type 52 | self.result_obj = copy_source.result_obj 53 | if ( 54 | copy_source.result_obj is not None 55 | and copy_source.result_obj.name.lower() not in child_names 56 | ): 57 | self.in_children.append(copy_source.result_obj) 58 | 59 | def resolve_link(self, obj_tree): 60 | self.resolve_arg_link(obj_tree) 61 | result_var_lower = self.result_name.lower() 62 | for child in self.children: 63 | if child.name.lower() == result_var_lower: 64 | self.result_obj = child 65 | # Update result value and type 66 | self.result_name = child.name 67 | self.result_type = child.get_desc() 68 | 69 | def get_type(self, no_link=False): 70 | return FUNCTION_TYPE_ID 71 | 72 | def get_desc(self): 73 | token = "FUNCTION" 74 | return f"{self.result_type} {token}" if self.result_type else token 75 | 76 | def is_callable(self): 77 | return False 78 | 79 | def get_hover(self, long: bool = False, drop_arg: int = -1) -> tuple[str, str]: 80 | """Construct the hover message for a FUNCTION. 81 | Two forms are produced here the `long` i.e. the normal for hover requests 82 | 83 | [MODIFIERS] FUNCTION NAME([ARGS]) RESULT(RESULT_VAR) 84 | TYPE, [ARG_MODIFIERS] :: [ARGS] 85 | TYPE, [RESULT_MODIFIERS] :: RESULT_VAR 86 | 87 | note: intrinsic functions will display slightly different, 88 | `RESULT_VAR` and its `TYPE` might not always be present 89 | 90 | short form, used when functions are arguments in functions and subroutines: 91 | 92 | FUNCTION NAME([ARGS]) :: ARG_LIST_NAME 93 | 94 | Parameters 95 | ---------- 96 | long : bool, optional 97 | toggle between long and short hover results, by default False 98 | drop_arg : int, optional 99 | Ignore argument at position `drop_arg` in the argument list, by default -1 100 | 101 | Returns 102 | ------- 103 | tuple[str, bool] 104 | String representative of the hover message and the `long` flag used 105 | """ 106 | fun_sig, _ = self.get_snippet(drop_arg=drop_arg) 107 | # short hover messages do not include the result() 108 | fun_sig += f" RESULT({self.result_name})" if long else "" 109 | keyword_list = get_keywords(self.keywords) 110 | keyword_list.append("FUNCTION") 111 | 112 | hover_array = [f"{' '.join(keyword_list)} {fun_sig}"] 113 | hover_array, docs = self.get_docs_full(hover_array, long, drop_arg) 114 | # Only append the return value if using long form 115 | if self.result_obj and long: 116 | # Parse the documentation from the result variable 117 | arg_doc, doc_str = self.result_obj.get_hover() 118 | if doc_str is not None: 119 | docs.append(f"\n**Return:** \n`{self.result_obj.name}`{doc_str}") 120 | hover_array.append(arg_doc) 121 | # intrinsic functions, where the return type is missing but can be inferred 122 | elif self.result_type and long: 123 | # prepend type to function signature 124 | hover_array[0] = f"{self.result_type} {hover_array[0]}" 125 | return "\n ".join(hover_array), " \n".join(docs) 126 | 127 | # TODO: fix this 128 | def get_interface(self, name_replace=None, drop_arg=-1, change_strings=None): 129 | fun_sig, _ = self.get_snippet(name_replace=name_replace) 130 | fun_sig += f" RESULT({self.result_name})" 131 | # XXX: 132 | keyword_list = [] 133 | if self.result_type: 134 | keyword_list.append(self.result_type) 135 | keyword_list += get_keywords(self.keywords) 136 | keyword_list.append("FUNCTION ") 137 | 138 | interface_array = self.get_interface_array( 139 | keyword_list, fun_sig, drop_arg, change_strings 140 | ) 141 | if self.result_obj is not None: 142 | arg_doc, docs = self.result_obj.get_hover() 143 | interface_array.append(f"{arg_doc} :: {self.result_obj.name}") 144 | name = name_replace if name_replace is not None else self.name 145 | interface_array.append(f"END FUNCTION {name}") 146 | return "\n".join(interface_array) 147 | --------------------------------------------------------------------------------