From 500a7bcb085da3198746a95484bd37551f5b52a5 Mon Sep 17 00:00:00 2001 From: gnikit Date: Wed, 25 May 2022 00:13:04 +0100 Subject: [PATCH 1/9] Initial work on parsing kind seperately for vars --- fortls/ftypes.py | 1 + fortls/helper_functions.py | 13 ++++ fortls/parse_fortran.py | 136 +++++++++++++++++++++++++------------ 3 files changed, 105 insertions(+), 45 deletions(-) diff --git a/fortls/ftypes.py b/fortls/ftypes.py index d4e4220d..474dbaef 100644 --- a/fortls/ftypes.py +++ b/fortls/ftypes.py @@ -15,6 +15,7 @@ class VarInfo: #: keywords associated with this variable e.g. SAVE, DIMENSION, etc. keywords: list[str] #: Keywords associated with variable var_names: list[str] #: Variable names + var_kind: str = field(default=None) #: Kind of variable e.g. ``INTEGER*4`` etc. @dataclass diff --git a/fortls/helper_functions.py b/fortls/helper_functions.py index d2485afe..4dccc0d7 100644 --- a/fortls/helper_functions.py +++ b/fortls/helper_functions.py @@ -372,6 +372,19 @@ def get_keywords(keywords: list, keyword_info: dict = {}): return keyword_strings +def parenthetic_contents(string: str): + """Generate parenthesized contents in string as pairs + (contents, start-position, level). + """ + stack = [] + for i, c in enumerate(string): + if c == "(": + stack.append(i) + elif c == ")" and stack: + start = stack.pop() + yield (string[start + 1 : i], start, len(stack)) + + def get_paren_substring(string: str) -> str | None: """Get the contents enclosed by the first pair of parenthesis diff --git a/fortls/parse_fortran.py b/fortls/parse_fortran.py index 545edbb2..ccb64725 100644 --- a/fortls/parse_fortran.py +++ b/fortls/parse_fortran.py @@ -169,47 +169,58 @@ def parse_var_keywords(test_str: str) -> tuple[list[str], str]: def read_var_def(line: str, var_type: str = None, fun_only: bool = False): """Attempt to read variable definition line""" + + def parse_kind(line: str): + match = FRegex.KIND_SPEC.match(line) + if not match: + return None, line + kind_str = match.group(1).replace(" ", "") + line = line[match.end(0) :] + if kind_str.find("(") >= 0: + match_char = find_paren_match(line) + if match_char < 0: # this triggers while typing with autocomplete + raise ValueError("Incomplete kind specification") + kind_str += line[: match_char + 1].strip() + line = line[match_char + 1 :] + return kind_str, line + if var_type is None: type_match = FRegex.VAR.match(line) if type_match is None: return None - else: - var_type = type_match.group(0).strip() - trailing_line = line[type_match.end(0) :] + var_type = type_match.group(0).strip() + trailing_line = line[type_match.end(0) :] else: trailing_line = line[len(var_type) :] var_type = var_type.upper() trailing_line = trailing_line.split("!")[0] if len(trailing_line) == 0: return None - # - kind_match = FRegex.KIND_SPEC.match(trailing_line) - if kind_match: - kind_str = kind_match.group(1).replace(" ", "") - var_type += kind_str - trailing_line = trailing_line[kind_match.end(0) :] - if kind_str.find("(") >= 0: - match_char = find_paren_match(trailing_line) - if match_char < 0: - return None # Incomplete type spec - else: - kind_word = trailing_line[: match_char + 1].strip() - var_type += kind_word - trailing_line = trailing_line[match_char + 1 :] - else: - # Class and Type statements need a kind spec - if var_type in ("TYPE", "CLASS"): - return None - # Make sure next character is space or comma or colon - if not trailing_line[0] in (" ", ",", ":"): - return None + + # Parse the global kind, if any, for the current line definition + # The global kind in some cases, like characters can be overriden by a locally + # defined kind + try: + kind_str, trailing_line = parse_kind(trailing_line) + var_type += kind_str # XXX: see below + except ValueError: + return None + except TypeError: # XXX: remove with explicit kind specification in VarInfo + pass + + # Class and Type statements need a kind spec + if not kind_str and var_type in ("TYPE", "CLASS"): + return None + # Make sure next character is space or comma or colon + if not kind_str and not trailing_line[0] in (" ", ",", ":"): + return None # keywords, trailing_line = parse_var_keywords(trailing_line) # Check if this is a function definition fun_def = read_fun_def(trailing_line, ResultSig(type=var_type, keywords=keywords)) - if (fun_def is not None) or fun_only: + if fun_def or fun_only: return fun_def - # + # Split the type and variable name line_split = trailing_line.split("::") if len(line_split) == 1: if len(keywords) > 0: @@ -222,8 +233,8 @@ def read_var_def(line: str, var_type: str = None, fun_only: bool = False): var_words = separate_def_list(trailing_line.strip()) if var_words is None: var_words = [] - # - return "var", VarInfo(var_type, keywords, var_words) + + return "var", VarInfo(var_type, keywords, var_words, kind_str) def get_procedure_modifiers( @@ -1356,9 +1367,13 @@ def parse( procedure_def = True link_name = get_paren_substring(desc_string) for var_name in obj_info.var_names: + desc = desc_string link_name: str = None if var_name.find("=>") > -1: name_split = var_name.split("=>") + # TODO: rename name_raw to name + # TODO: rename name_stripped to name + # TODO: rename desc_string to desc name_raw = name_split[0] link_name = name_split[1].split("(")[0].strip() if link_name.lower() == "null": @@ -1367,28 +1382,27 @@ def parse( name_raw = var_name.split("=")[0] # Add dimension if specified # TODO: turn into function and add support for co-arrays i.e. [*] - key_tmp = obj_info.keywords[:] - iparen = name_raw.find("(") - if iparen == 0: + # Copy global keywords to the individual variable + var_keywords: list[str] = obj_info.keywords[:] + # The name starts with ( + if name_raw.find("(") == 0: continue - elif iparen > 0: - if name_raw[iparen - 1] == "*": - iparen -= 1 - if desc_string.find("(") < 0: - desc_string += f"*({get_paren_substring(name_raw)})" - else: - key_tmp.append( - f"dimension({get_paren_substring(name_raw)})" - ) - name_raw = name_raw[:iparen] + name_raw, dims = self.parse_imp_dim(name_raw) + name_raw, char_len = self.parse_imp_char(name_raw) + if dims: + var_keywords.append(dims) + if char_len: + desc += char_len + name_stripped = name_raw.strip() - keywords, keyword_info = map_keywords(key_tmp) + keywords, keyword_info = map_keywords(var_keywords) + if procedure_def: new_var = Method( file_ast, line_no, name_stripped, - desc_string, + desc, keywords, keyword_info=keyword_info, link_obj=link_name, @@ -1398,9 +1412,10 @@ def parse( file_ast, line_no, name_stripped, - desc_string, + desc, keywords, keyword_info=keyword_info, + # kind=obj_info.var_kind, link_obj=link_name, ) # If the object is fortran_var and a parameter include @@ -1413,7 +1428,7 @@ def parse( new_var.set_parameter_val(var) # Check if the "variable" is external and if so cycle - if find_external(file_ast, desc_string, name_stripped, new_var): + if find_external(file_ast, desc, name_stripped, new_var): continue # if not merge_external: @@ -1643,6 +1658,37 @@ def parse( log.debug(f"{error['range']}: {error['message']}") return file_ast + def parse_imp_dim(self, name: str): + regex = re.compile(r"[ ]*\w+[ ]*(\()", re.I) + # TODO: replace space + m = regex.match(name) + if not m: + return name, None + i = find_paren_match(name[m.end(1) :]) + if i < 0: + return name, None # triggers for autocomplete + dims = name[m.start(1) : m.end(1) + i + 1] + name = name[: m.start(1)] + name[m.end(1) + i + 1 :] + return name, f"dimension{dims}" + + def parse_imp_char(self, name: str): + implicit_len = re.compile(r"(\w+)[ ]*\*[ ]*(\d+|\()", re.I) + # TODO: replace space in name + match = re.match(implicit_len, name) + if not match: + return name, None + if match.group(2) == "(": + i = find_paren_match(name[match.end(2) :]) + if i < 0: + return name, None # triggers for autocomplete + char_len = name[match.start(2) : match.end(2) + i + 1] + elif match.group(2).isdigit(): + char_len = match.group(2) + else: + raise ValueError("No matching group(2) for implicit length") + name = match.group(1) + return name, f"*{char_len}" + def parse_end_scope_word( self, line: str, ln: int, file_ast: FortranAST, match: re.Match ) -> bool: From 107a9a00ed650d9e33a5599f3287fb0854634fd4 Mon Sep 17 00:00:00 2001 From: gnikit Date: Wed, 25 May 2022 14:09:12 +0100 Subject: [PATCH 2/9] Simplifying implicit parsing for dims and len --- fortls/parse_fortran.py | 59 ++++++++++++++++++++++++++++------------- 1 file changed, 41 insertions(+), 18 deletions(-) diff --git a/fortls/parse_fortran.py b/fortls/parse_fortran.py index ccb64725..5758e071 100644 --- a/fortls/parse_fortran.py +++ b/fortls/parse_fortran.py @@ -1658,36 +1658,59 @@ def parse( log.debug(f"{error['range']}: {error['message']}") return file_ast - def parse_imp_dim(self, name: str): + def parse_imp_dim(self, line: str): + """Parse the implicit dimension of an array e.g. + var(3,4), var_name(size(val,1)*10) + + Parameters + ---------- + line : str + line containing variable name + + Returns + ------- + tuple[str, str] + truncated line, dimension string + """ regex = re.compile(r"[ ]*\w+[ ]*(\()", re.I) # TODO: replace space - m = regex.match(name) + m = regex.match(line) if not m: - return name, None - i = find_paren_match(name[m.end(1) :]) + return line, None + i = find_paren_match(line[m.end(1) :]) if i < 0: - return name, None # triggers for autocomplete - dims = name[m.start(1) : m.end(1) + i + 1] - name = name[: m.start(1)] + name[m.end(1) + i + 1 :] - return name, f"dimension{dims}" + return line, None # triggers for autocomplete + dims = line[m.start(1) : m.end(1) + i + 1] + line = line[: m.start(1)] + line[m.end(1) + i + 1 :] + return line, f"dimension{dims}" + + def parse_imp_char(self, line: str): + """Parse the implicit character length from a variable e.g. + var_name*10 or var_name*(10), var_name*(size(val, 1)) - def parse_imp_char(self, name: str): + Parameters + ---------- + line : str + line containing potential variable + + Returns + ------- + tuple[str, str] + truncated line, character length + """ implicit_len = re.compile(r"(\w+)[ ]*\*[ ]*(\d+|\()", re.I) # TODO: replace space in name - match = re.match(implicit_len, name) + match = implicit_len.match(line) if not match: - return name, None + return line, None if match.group(2) == "(": - i = find_paren_match(name[match.end(2) :]) + i = find_paren_match(line[match.end(2) :]) if i < 0: - return name, None # triggers for autocomplete - char_len = name[match.start(2) : match.end(2) + i + 1] + return line, None # triggers for autocomplete + char_len = line[match.start(2) : match.end(2) + i + 1] elif match.group(2).isdigit(): char_len = match.group(2) - else: - raise ValueError("No matching group(2) for implicit length") - name = match.group(1) - return name, f"*{char_len}" + return match.group(1), f"*{char_len}" def parse_end_scope_word( self, line: str, ln: int, file_ast: FortranAST, match: re.Match From f1ba00f1155c91d60a3271260c092a72a5ee879c Mon Sep 17 00:00:00 2001 From: gnikit Date: Wed, 25 May 2022 16:30:34 +0100 Subject: [PATCH 3/9] Add hover unittests for all possible types of kind, len, etc. --- test/test_server_hover.py | 96 ++++++++++++++++++- .../test_source/parse/test_kinds_and_dims.f90 | 42 ++++++++ 2 files changed, 137 insertions(+), 1 deletion(-) create mode 100644 test/test_source/parse/test_kinds_and_dims.f90 diff --git a/test/test_server_hover.py b/test/test_server_hover.py index 7fd3f523..f1a573c9 100644 --- a/test/test_server_hover.py +++ b/test/test_server_hover.py @@ -23,7 +23,7 @@ def test_hover_abstract_int_procedure(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "subdir" / "test_abstract.f90" string += hover_req(file_path, 7, 30) - errcode, results = run_request(string, fortls_args=["--sort_keywords"]) + errcode, results = run_request(string, fortls_args=["--sort_keywords", "-n1"]) assert errcode == 0 ref_results = [ """SUBROUTINE test(a, b) @@ -348,3 +348,97 @@ def test_hover_submodule_procedure(): REAL(dp) :: fi""", ] validate_hover(results, ref_results) + + +def test_var_type_kinds(): + string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "parse")}) + file_path = test_dir / "parse" / "test_kinds_and_dims.f90" + string += hover_req(file_path, 2, 24) + string += hover_req(file_path, 2, 27) + string += hover_req(file_path, 3, 15) + string += hover_req(file_path, 3, 19) + string += hover_req(file_path, 4, 20) + string += hover_req(file_path, 4, 25) + string += hover_req(file_path, 5, 23) + string += hover_req(file_path, 6, 25) + errcode, results = run_request(string, fortls_args=["-n", "1"]) + assert errcode == 0 + ref_results = [ + "INTEGER(kind=4)", + "INTEGER(kind=4), DIMENSION(3,4)", + "INTEGER*8", + "INTEGER*8, DIMENSION(3,4)", + "INTEGER(8)", + "INTEGER(8), DIMENSION(3,4)", + "REAL(kind=r15)", + "REAL(kind(0.d0))", + ] + validate_hover(results, ref_results) + + +def test_kind_function_result(): + string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "parse")}) + file_path = test_dir / "parse" / "test_kinds_and_dims.f90" + string += hover_req(file_path, 9, 18) + string += hover_req(file_path, 14, 25) + errcode, results = run_request(string, fortls_args=["-n", "1"]) + assert errcode == 0 + ref_results = [ + """FUNCTION foo(val) RESULT(r) + REAL(8), INTENT(IN) :: val + REAL*8 :: r""", + """FUNCTION phi(val) RESULT(r) + REAL(8), INTENT(IN) :: val + REAL(kind=8) :: r""", + ] + validate_hover(results, ref_results) + + +def test_var_type_asterisk(): + string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "parse")}) + file_path = test_dir / "parse" / "test_kinds_and_dims.f90" + string += hover_req(file_path, 2 + 19, 18) + string += hover_req(file_path, 2 + 19, 21) + string += hover_req(file_path, 2 + 19, 29) + string += hover_req(file_path, 3 + 19, 21) + string += hover_req(file_path, 4 + 19, 17) + string += hover_req(file_path, 5 + 19, 23) + errcode, results = run_request(string, fortls_args=["-n", "1"]) + assert errcode == 0 + ref_results = [ + "CHARACTER*17", + "CHARACTER*17, DIMENSION(3,4)", + "CHARACTER*17, DIMENSION(9)", + "CHARACTER*(6+3)", + "CHARACTER*10, DIMENSION(3,4)", + "CHARACTER*(LEN(B)), DIMENSION(3,4)", + ] + validate_hover(results, ref_results) + + +def test_var_name_asterisk(): + string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "parse")}) + file_path = test_dir / "parse" / "test_kinds_and_dims.f90" + string += hover_req(file_path, 26, 15) + string += hover_req(file_path, 26, 22) + string += hover_req(file_path, 26, 34) + string += hover_req(file_path, 27, 15) + string += hover_req(file_path, 28, 15) + string += hover_req(file_path, 29, 15) + string += hover_req(file_path, 31, 24) + string += hover_req(file_path, 32, 32) + # string += hover_req(file_path, 33, 32) # FIXME: this is not displayed correctly + errcode, results = run_request(string, fortls_args=["-n", "1"]) + assert errcode == 0 + ref_results = [ + "CHARACTER*17", + "CHARACTER*17, DIMENSION(3,4)", + "CHARACTER*17, DIMENSION(9)", + "CHARACTER*(6+3)", + "CHARACTER*(LEN(A))", + "CHARACTER*10, DIMENSION(*)", + "CHARACTER(LEN=200)", + "CHARACTER(KIND=4, LEN=200), DIMENSION(3,4)", + # "CHARACTER(KIND=4, LEN=100), DIMENSION(3,4)", + ] + validate_hover(results, ref_results) diff --git a/test/test_source/parse/test_kinds_and_dims.f90 b/test/test_source/parse/test_kinds_and_dims.f90 new file mode 100644 index 00000000..fe6fc2bb --- /dev/null +++ b/test/test_source/parse/test_kinds_and_dims.f90 @@ -0,0 +1,42 @@ +subroutine normal_kinds() + integer, parameter :: r15 = selected_real_kind(15) + integer(kind=4) :: a, b(3,4) + integer*8 aa, bb(3,4) + integer(8) :: aaa, bbb(3,4) + real(kind=r15) :: r + real(kind(0.d0)) :: rr +end subroutine normal_kinds + +real*8 function foo(val) result(r) + real(8), intent(in) :: val + r = val +end function foo + +real(kind=8) function phi(val) result(r) + real(8), intent(in) :: val + r = val +end function phi + +subroutine character_len_parsing(input) + ! global variable_type * length variable_name1, variable_name2,... + CHARACTER*17 A, B(3,4), V(9) + CHARACTER*(6+3) C + CHARACTER*10D(3,4) + CHARACTER*(LEN(B))DD(3,4) + ! local variable_type variable_name1 * length, variable_name2 * length,... + CHARACTER AA*17, BB(3,4)*17, VV(9)*17 + CHARACTER CC*(6+3) + CHARACTER AAA*(LEN(A)) + CHARACTER INPUT(*)*10 + ! explicit len and kind for characters + CHARACTER(LEN=200) F + CHARACTER(KIND=4, LEN=200) FF(3,4) + CHARACTER(KIND=4, LEN=200) AAAA(3,4)*100 + + ! override global length with local length + CHARACTER*10 BBB(3,4)*(LEN(B)) ! has the length of len(b) + CHARACTER*10CCC(3,4)*(LEN(B)) ! no-space + CHARACTER(KIND=4) BBBB(3,4)*(LEN(B)) ! cannot have *10(kind=4) or vice versa + + INTEGER((4)) INT_KIND_IMP ! FIXME: (()) trips up the regex +end subroutine character_len_parsing From cd40a23ee2c1167cba370498d52e3288de4c4bf5 Mon Sep 17 00:00:00 2001 From: gnikit Date: Wed, 25 May 2022 17:32:58 +0100 Subject: [PATCH 4/9] Updated ignore paths TODO: move source file to hover once done with kind, len improvements --- test/test_source/.fortls | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/test_source/.fortls b/test/test_source/.fortls index 9bf0936d..ec8e37c9 100644 --- a/test/test_source/.fortls +++ b/test/test_source/.fortls @@ -6,7 +6,8 @@ "excldir/**", "./diag/", "docs", - "rename" + "rename", + "parse" ] } From 9f6d07dfef0411edc12977a65e430aa736734747 Mon Sep 17 00:00:00 2001 From: gnikit Date: Thu, 26 May 2022 17:57:15 +0100 Subject: [PATCH 5/9] fix: Fix docstrings examples --- fortls/helper_functions.py | 40 +++++++++++++++++++------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/fortls/helper_functions.py b/fortls/helper_functions.py index 4dccc0d7..90b8a6b7 100644 --- a/fortls/helper_functions.py +++ b/fortls/helper_functions.py @@ -136,12 +136,12 @@ def separate_def_list(test_str: str) -> list[str] | None: Examples -------- - >>> separate_def_list("var1, var2, var3") - ["var1", "var2", "var3"] + >>> separate_def_list('var1, var2, var3') + ['var1', 'var2', 'var3'] - >>> separate_def_list("var, init_var(3) = [1,2,3], array(3,3)") - ["var", "init_var", "array"] + >>> separate_def_list('var, init_var(3) = [1,2,3], array(3,3)') + ['var', 'init_var(3) = [1,2,3]', 'array(3,3)'] """ stripped_str = strip_strings(test_str) paren_count = 0 @@ -208,17 +208,17 @@ def find_paren_match(string: str) -> int: Examples -------- - >>> find_paren_match("a, b)") + >>> find_paren_match('a, b)') 4 Multiple parenthesis that are closed - >>> find_paren_match("a, (b, c), d)") + >>> find_paren_match('a, (b, c), d)') 12 If the outermost parenthesis is not closed function returns -1 - >>> find_paren_match("a, (b, (c, d)") + >>> find_paren_match('a, (b, (c, d)') -1 """ paren_count = 1 @@ -401,12 +401,12 @@ def get_paren_substring(string: str) -> str | None: Examples -------- - >>> get_paren_substring("some line(a, b, (c, d))") - "a, b, (c, d)" + >>> get_paren_substring('some line(a, b, (c, d))') + 'a, b, (c, d)' If the line has incomplete parenthesis however, ``None`` is returned - >>> get_paren_substring("some line(a, b") - None + >>> get_paren_substring('some line(a, b') is None + True """ i1 = string.find("(") i2 = string.rfind(")") @@ -432,13 +432,13 @@ def get_paren_level(line: str) -> tuple[str, list[Range]]: Examples -------- - >>> get_paren_level("CALL sub1(arg1,arg2") + >>> get_paren_level('CALL sub1(arg1,arg2') ('arg1,arg2', [Range(start=10, end=19)]) If the range is interrupted by parenthesis, another Range variable is used to mark the ``start`` and ``end`` of the argument - >>> get_paren_level("CALL sub1(arg1(i),arg2") + >>> get_paren_level('CALL sub1(arg1(i),arg2') ('arg1,arg2', [Range(start=10, end=14), Range(start=17, end=22)]) """ @@ -493,16 +493,16 @@ def get_var_stack(line: str) -> list[str]: Examples -------- - >>> get_var_stack("myvar%foo%bar") - ["myvar", "foo", "bar"] + >>> get_var_stack('myvar%foo%bar') + ['myvar', 'foo', 'bar'] - >>> get_var_stack("myarray(i)%foo%bar") - ["myarray", "foo", "bar"] + >>> get_var_stack('myarray(i)%foo%bar') + ['myarray', 'foo', 'bar'] - In this case it will operate at the end of the string i.e. ``"this%foo"`` + In this case it will operate at the end of the string i.e. ``'this%foo'`` - >>> get_var_stack("CALL self%method(this%foo") - ["this", "foo"] + >>> get_var_stack('CALL self%method(this%foo') + ['this', 'foo'] """ if len(line) == 0: return [""] From 131091d02cf3d09ff59ebeecef46800ec27a034b Mon Sep 17 00:00:00 2001 From: gnikit Date: Thu, 26 May 2022 17:59:05 +0100 Subject: [PATCH 6/9] fix: Add example to parenthetic_contentes docstring --- fortls/helper_functions.py | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/fortls/helper_functions.py b/fortls/helper_functions.py index 90b8a6b7..e9cefbf3 100644 --- a/fortls/helper_functions.py +++ b/fortls/helper_functions.py @@ -375,6 +375,11 @@ def get_keywords(keywords: list, keyword_info: dict = {}): def parenthetic_contents(string: str): """Generate parenthesized contents in string as pairs (contents, start-position, level). + + Examples + -------- + >>> list(parenthetic_contents('character*(10*size(val(1), 2)) :: name')) + [('1', 22, 2), ('val(1), 2', 18, 1), ('10*size(val(1), 2)', 10, 0)] """ stack = [] for i, c in enumerate(string): From 4b5e4bb2cfb328505631f05f82222e69b7f6dddf Mon Sep 17 00:00:00 2001 From: gnikit Date: Sun, 29 May 2022 02:06:34 +0100 Subject: [PATCH 7/9] chore: Removes doctest from default pytest cmd VS Codes test discovery has a bug where tests are not detected if you are using doctest in your default pytest env --- .github/workflows/main.yml | 4 ++-- pyproject.toml | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 978a0b5a..fa01ef36 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -25,7 +25,7 @@ jobs: run: pip install .[dev] - name: Unittests - run: pytest + run: pytest --doctest-modules - name: Lint run: black --diff --check --verbose . @@ -45,7 +45,7 @@ jobs: - name: Coverage report run: | pip install .[dev] - pytest + pytest --doctest-modules shell: bash - name: Upload coverage to Codecov diff --git a/pyproject.toml b/pyproject.toml index 0ee903a7..69446d19 100644 --- a/pyproject.toml +++ b/pyproject.toml @@ -15,5 +15,5 @@ profile = "black" [tool.pytest.ini_options] minversion = "7.0" -addopts = "-v --cov=fortls --cov-report=html --cov-report=xml --cov-context=test --doctest-modules" +addopts = "-v --cov=fortls --cov-report=html --cov-report=xml --cov-context=test" testpaths = ["fortls", "test"] From 70c0ddb835af5252d134b1f0a8cc356802e61dec Mon Sep 17 00:00:00 2001 From: gnikit Date: Sun, 29 May 2022 04:00:42 +0100 Subject: [PATCH 8/9] Clean parsing routines for dimensions and lengths --- fortls/parse_fortran.py | 8 ++------ test/test_source/parse/test_incomplete_dims.f90 | 8 ++++++++ 2 files changed, 10 insertions(+), 6 deletions(-) create mode 100644 test/test_source/parse/test_incomplete_dims.f90 diff --git a/fortls/parse_fortran.py b/fortls/parse_fortran.py index 5758e071..a52c3b9d 100644 --- a/fortls/parse_fortran.py +++ b/fortls/parse_fortran.py @@ -1672,9 +1672,7 @@ def parse_imp_dim(self, line: str): tuple[str, str] truncated line, dimension string """ - regex = re.compile(r"[ ]*\w+[ ]*(\()", re.I) - # TODO: replace space - m = regex.match(line) + m = re.compile(r"[ ]*\w+[ ]*(\()", re.I).match(line) if not m: return line, None i = find_paren_match(line[m.end(1) :]) @@ -1698,9 +1696,7 @@ def parse_imp_char(self, line: str): tuple[str, str] truncated line, character length """ - implicit_len = re.compile(r"(\w+)[ ]*\*[ ]*(\d+|\()", re.I) - # TODO: replace space in name - match = implicit_len.match(line) + match = re.compile(r"(\w+)[ ]*\*[ ]*(\d+|\()", re.I).match(line) if not match: return line, None if match.group(2) == "(": diff --git a/test/test_source/parse/test_incomplete_dims.f90 b/test/test_source/parse/test_incomplete_dims.f90 new file mode 100644 index 00000000..0dd2db6b --- /dev/null +++ b/test/test_source/parse/test_incomplete_dims.f90 @@ -0,0 +1,8 @@ + +! Tests that the parser will not break, when parsing incomplete variables +! constructs. This is particularly important for autocompletion. +program test_incomplete_dims + implicit none + integer :: dim_val(1, 2 + character :: char_val*(10 +end program test_incomplete_dims From 3c098c44d73957885d08efc4d1f4128d6804e3b2 Mon Sep 17 00:00:00 2001 From: gnikit Date: Sun, 29 May 2022 04:34:07 +0100 Subject: [PATCH 9/9] Updated CHANGELOG --- CHANGELOG.md | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 156e87cb..ba17fb6d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,7 +2,7 @@ ## Unreleased -## 2.6.0 +## 2.7.0 ### Added @@ -11,6 +11,14 @@ ### Changed +- Redesigned parsing functions for short-hand declarations of array dimensions, + character length and parsing of kind + ([#130](https://github.com/gnikit/fortls/pull/130)) + +## 2.6.0 + +### Changed + - Redesigned the `fortls` website to be more aesthetically pleasing and user-friendly ([#112](https://github.com/gnikit/fortls/issues/112))