diff --git a/fortls/intrinsics.py b/fortls/intrinsics.py index c7e0e693..3f128dbd 100644 --- a/fortls/intrinsics.py +++ b/fortls/intrinsics.py @@ -12,6 +12,7 @@ Module, Subroutine, Type, + Use, Variable, ) @@ -119,7 +120,7 @@ def create_object(json_obj: dict, enc_obj=None): if json_obj["type"] == 0: # module, match "type": in JSON files mod_tmp = Module(intrinsic_ast, 0, name) if "use" in json_obj: - mod_tmp.add_use(json_obj["use"], 0) + mod_tmp.add_use(Use(json_obj["use"], line_number=0)) return mod_tmp elif json_obj["type"] == 1: # subroutine, match "type": in JSON files return Subroutine(intrinsic_ast, 0, name, args=args) diff --git a/fortls/langserver.py b/fortls/langserver.py index d01fec0f..6d2ce185 100644 --- a/fortls/langserver.py +++ b/fortls/langserver.py @@ -51,6 +51,9 @@ from fortls.jsonrpc import JSONRPC2Connection, path_from_uri, path_to_uri from fortls.objects import ( FortranAST, + Import, + Scope, + Use, Variable, climb_type_tree, find_in_scope, @@ -386,11 +389,14 @@ def get_candidates( ): # def child_candidates( - scope, only_list: list = None, filter_public=True, req_abstract=False - ): + scope: Scope, + only_list: list = None, + filter_public=True, + req_abstract=False, + ) -> list[str]: if only_list is None: only_list = [] - tmp_list = [] + tmp_list: list[str] = [] # Filter children nonly = len(only_list) for child in scope.get_children(filter_public): @@ -410,8 +416,8 @@ def child_candidates( tmp_list.append(child) return tmp_list - var_list = [] - use_dict = {} + var_list: list[str] = [] + use_dict: dict[str, Use | Import] = {} for scope in scope_list: var_list += child_candidates( scope, filter_public=public_only, req_abstract=abstract_only @@ -421,48 +427,58 @@ def child_candidates( use_dict = get_use_tree(scope, use_dict, self.obj_tree) # Look in found use modules rename_list = [None for _ in var_list] + import_var_list = [] for use_mod, use_info in use_dict.items(): - scope = self.obj_tree[use_mod][0] - only_list = use_info.only_list - if len(use_info.rename_map) > 0: - only_list = [ - use_info.rename_map.get(only_name, only_name) - for only_name in only_list - ] - tmp_list = child_candidates( - scope, only_list, req_abstract=abstract_only - ) - # Setup renaming - if len(use_info.rename_map) > 0: - rename_reversed = { - value: key for (key, value) in use_info.rename_map.items() - } - for tmp_obj in tmp_list: - var_list.append(tmp_obj) - rename_list.append( - rename_reversed.get(tmp_obj.name.lower(), None) - ) - else: - var_list += tmp_list - rename_list += [None for _ in tmp_list] + if type(use_info) is Use: + scope = self.obj_tree[use_mod][0] + only_list = use_info.rename() + tmp_list = child_candidates( + scope, only_list, req_abstract=abstract_only + ) + # Setup renaming + if use_info.rename_map: + rename_reversed = { + value: key for (key, value) in use_info.rename_map.items() + } + for tmp_obj in tmp_list: + var_list.append(tmp_obj) + rename_list.append( + rename_reversed.get(tmp_obj.name.lower(), None) + ) + else: + var_list += tmp_list + rename_list += [None for _ in tmp_list] + elif type(use_info) is Import: + scope = use_info.scope + # Add import candidates + import_var_list += child_candidates( + scope, + only_list=use_info.only_list, + req_abstract=abstract_only, + ) + # We do not have renames so ignore + # Add globals if inc_globals: tmp_list = [obj[0] for (_, obj) in self.obj_tree.items()] var_list += tmp_list + self.intrinsic_funs rename_list += [None for _ in tmp_list + self.intrinsic_funs] + if import_var_list: + var_list = import_var_list + rename_list = [None for _ in import_var_list] # Filter by prefix if necessary if var_prefix == "": return var_list, rename_list else: - tmp_list = [] - tmp_rename = [] - for (i, var) in enumerate(var_list): - var_name = rename_list[i] + tmp_list: list[str] = [] + tmp_rename: list[str] = [] + for (var, rename) in zip(var_list, rename_list): + var_name: str | None = rename if var_name is None: var_name = var.name if var_name.lower().startswith(var_prefix): tmp_list.append(var) - tmp_rename.append(rename_list[i]) + tmp_rename.append(rename) return tmp_list, tmp_rename def build_comp( @@ -651,7 +667,7 @@ def build_comp( candidate_list, rename_list = get_candidates( scope_list, var_prefix, include_globals, public_only, abstract_only, no_use ) - for (i, candidate) in enumerate(candidate_list): + for (candidate, rename) in zip(candidate_list, rename_list): # Skip module names (only valid in USE) candidate_type = candidate.get_type() if type_mask[candidate_type]: @@ -659,7 +675,7 @@ def build_comp( if req_callable and (not candidate.is_callable()): continue # - name_replace = rename_list[i] + name_replace = rename if candidate_type == INTERFACE_TYPE_ID and not line_context == "mod_mems": tmp_list = [] if name_replace is None: diff --git a/fortls/objects.py b/fortls/objects.py index 28bf02f8..bc76a758 100644 --- a/fortls/objects.py +++ b/fortls/objects.py @@ -3,7 +3,7 @@ import copy import os import re -from dataclasses import dataclass, replace +from dataclasses import dataclass from typing import Pattern from fortls.constants import ( @@ -26,7 +26,7 @@ WHERE_TYPE_ID, FRegex, ) -from fortls.ftypes import IncludeInfo, UseInfo +from fortls.ftypes import IncludeInfo from fortls.helper_functions import ( fortran_md, get_keywords, @@ -39,13 +39,13 @@ def get_use_tree( scope: Scope, - use_dict: dict[str, UseInfo], + use_dict: dict[str, Use | Import], obj_tree: dict, - only_list: list[str] = None, - rename_map: dict[str, str] = None, - curr_path: list[str] = None, + only_list: set[str] = set(), + rename_map: dict[str, str] = {}, + curr_path: list[str] = [], ): - def intersect_only(use_stmnt): + def intersect_only(use_stmnt: Use | Import): tmp_list = [] tmp_map = rename_map.copy() for val1 in only_list: @@ -59,56 +59,77 @@ def intersect_only(use_stmnt): tmp_map.pop(val1, None) return tmp_list, tmp_map - if only_list is None: - only_list = [] - if rename_map is None: - rename_map = {} - if curr_path is None: - curr_path = [] - # Detect and break circular references if scope.FQSN in curr_path: return use_dict new_path = curr_path + [scope.FQSN] # Add recursively for use_stmnt in scope.use: - if use_stmnt.mod_name not in obj_tree: + # if use_stmnt.mod_name not in obj_tree: + if type(use_stmnt) is Use and use_stmnt.mod_name not in obj_tree: + continue + # Escape any IMPORT, NONE statements + if type(use_stmnt) is Import and use_stmnt.import_type is ImportTypes.NONE: continue # Intersect parent and current ONLY list and renaming if len(only_list) == 0: - merged_use_list = use_stmnt.only_list[:] + merged_use_list = use_stmnt.only_list.copy() merged_rename = use_stmnt.rename_map.copy() elif len(use_stmnt.only_list) == 0: - merged_use_list = only_list[:] + merged_use_list = only_list.copy() merged_rename = rename_map.copy() else: merged_use_list, merged_rename = intersect_only(use_stmnt) if len(merged_use_list) == 0: continue # Update ONLY list and renaming for current module + # If you have + # USE MOD, ONLY: A + # USE MOD, ONLY: B + # or + # IMPORT VAR + # IMPORT VAR2 use_dict_mod = use_dict.get(use_stmnt.mod_name) if use_dict_mod is not None: old_len = len(use_dict_mod.only_list) - if (old_len > 0) and (len(merged_use_list) > 0): + if old_len > 0 and merged_use_list: only_len = old_len for only_name in merged_use_list: use_dict_mod.only_list.add(only_name) - if len(use_dict_mod.only_list) != only_len: - only_len = len(use_dict_mod.only_list) - new_rename = merged_rename.get(only_name, None) - if new_rename is not None: - use_dict[use_stmnt.mod_name] = replace( - use_dict_mod, rename_map=merged_rename - ) + if len(use_dict_mod.only_list) == only_len: + continue + only_len = len(use_dict_mod.only_list) + new_rename = merged_rename.get(only_name) + if new_rename is None: + continue + use_dict_mod.rename_map = merged_rename + use_dict[use_stmnt.mod_name] = use_dict_mod else: - use_dict[use_stmnt.mod_name] = UseInfo(use_stmnt.mod_name, set(), {}) + use_dict[use_stmnt.mod_name] = Use(use_stmnt.mod_name) # Skip if we have already visited module with the same only list if old_len == len(use_dict_mod.only_list): continue else: - use_dict[use_stmnt.mod_name] = UseInfo( - use_stmnt.mod_name, set(merged_use_list), merged_rename - ) + if type(use_stmnt) is Use: + use_dict[use_stmnt.mod_name] = Use( + mod_name=use_stmnt.mod_name, + only_list=set(merged_use_list), + rename_map=merged_rename, + ) + elif type(use_stmnt) is Import: + use_dict[use_stmnt.mod_name] = Import( + name=use_stmnt.mod_name, + import_type=use_stmnt.import_type, + only_list=set(merged_use_list), + rename_map=merged_rename, + ) + try: + use_dict[use_stmnt.mod_name].scope = scope.parent.parent + except AttributeError: + pass + # Do not descent the IMPORT tree, because it does not exist + if type(use_stmnt) is Import: + continue # Descend USE tree use_dict = get_use_tree( obj_tree[use_stmnt.mod_name][0], @@ -160,6 +181,22 @@ def check_scope( return child return None + def check_import_scope(scope: Scope, var_name_lower: str): + for use_stmnt in scope.use: + if not type(use_stmnt) is Import: + continue + if use_stmnt.import_type == ImportTypes.ONLY: + # Check if name is in only list + if var_name_lower in use_stmnt.only_list: + return ImportTypes.ONLY + # Get Get the parent scope + elif use_stmnt.import_type == ImportTypes.ALL: + return ImportTypes.ALL + # Skip looking for parent scope + elif use_stmnt.import_type == ImportTypes.NONE: + return ImportTypes.NONE + return None + # var_name_lower = var_name.lower() # Check local scope @@ -182,6 +219,9 @@ def check_scope( use_dict = get_use_tree(scope, {}, obj_tree) # Look in found use modules for use_mod, use_info in use_dict.items(): + # If use_mod is Import then it will not exist in the obj_tree + if type(use_info) is Import: + continue use_scope = obj_tree[use_mod][0] # Module name is request if use_mod.lower() == var_name_lower: @@ -195,17 +235,13 @@ def check_scope( if tmp_var is not None: return tmp_var # Only search local and imported names for interfaces + import_type = ImportTypes.DEFAULT if interface: - in_import = False - for use_stmnt in scope.use: - if use_stmnt.mod_name.startswith("#import"): - if var_name_lower in use_stmnt.only_list: - in_import = True - break - if not in_import: + import_type = check_import_scope(scope, var_name_lower) + if import_type is None: return None # Check parent scopes - if scope.parent is not None: + if scope.parent is not None and import_type != ImportTypes.NONE: tmp_var = find_in_scope(scope.parent, var_name, obj_tree) if tmp_var is not None: return tmp_var @@ -278,22 +314,73 @@ def climb_type_tree(var_stack, curr_scope: Scope, obj_tree: dict): # Helper classes -class USE_line: +class Use: + """AST node for USE statement""" + def __init__( self, mod_name: str, - line_number: int, - only_list: list = None, - rename_map: dict = None, + only_list: set[str] = set(), + rename_map: dict[str, str] = {}, + line_number: int | None = 0, ): self.mod_name: str = mod_name.lower() - self.line_number: int = line_number - if only_list is not None: - self.only_list: list = [only.lower() for only in only_list] - if rename_map is not None: - self.rename_map: dict = { - key.lower(): value.lower() for key, value in rename_map.items() - } + self._line_no: int = line_number + self.only_list: set[str] = only_list + self.rename_map: dict[str, str] = rename_map + if only_list: + self.only_list: set[str] = {only.lower() for only in only_list} + if rename_map: + self.rename_map = {k.lower(): v.lower() for k, v in rename_map.items()} + + @property + def line_number(self): + return self._line_no + + @line_number.setter + def line_number(self, line_number: int): + self._line_no = line_number + + def rename(self, only_list: list[str] = []): + """Rename ONLY:, statements""" + if not only_list: + only_list = self.only_list + renamed_only_list = [] + for only_name in only_list: + renamed_only_list.append(self.rename_map.get(only_name, only_name)) + return renamed_only_list + + +class ImportTypes: + DEFAULT = -1 + NONE = 0 + ALL = 1 + ONLY = 2 + + +class Import(Use): + """AST node for IMPORT statement""" + + def __init__( + self, + name: str, + import_type: ImportTypes = ImportTypes.DEFAULT, + only_list: set[str] = set(), + rename_map: dict[str, str] = {}, + line_number: int = 0, + ): + super().__init__(name, only_list, rename_map, line_number) + self.import_type = import_type + self._scope: Scope | Module | None = None + + @property + def scope(self): + """Parent scope of IMPORT statement i.e. parent of the interface""" + return self._scope + + @scope.setter + def scope(self, scope: Scope): + self._scope = scope @dataclass @@ -486,7 +573,7 @@ def __init__(self, file_ast, line_number: int, name: str, keywords: list = None) self.name: str = name self.children: list = [] self.members: list = [] - self.use: list[USE_line] = [] + self.use: list[Use | Import] = [] self.keywords: list = keywords self.inherit = None self.parent = None @@ -502,14 +589,8 @@ def copy_from(self, copy_source: Scope): for k, v in copy_source.__dict__.items(): setattr(self, k, v) - def add_use( - self, use_mod, line_number, only_list: list = None, rename_map: dict = None - ): - if only_list is None: - only_list = [] - if rename_map is None: - rename_map = {} - self.use.append(USE_line(use_mod, line_number, only_list, rename_map)) + def add_use(self, use_mod: Use | Import): + self.use.append(use_mod) def set_inherit(self, inherit_type): self.inherit = inherit_type @@ -664,7 +745,7 @@ def check_use(self, obj_tree): last_use_line = -1 for use_stmnt in self.use: last_use_line = max(last_use_line, use_stmnt.line_number) - if use_stmnt.mod_name.startswith("#import"): + if type(use_stmnt) == Import: if (self.parent is None) or ( self.parent.get_type() != INTERFACE_TYPE_ID ): @@ -1606,7 +1687,7 @@ def __init__( self.keyword_info: dict = keyword_info self.kind: str | None = kind self.children: list = [] - self.use: list[USE_line] = [] + self.use: list[Use | Import] = [] self.link_obj = None self.type_obj = None self.is_const: bool = False @@ -2044,16 +2125,10 @@ def add_private(self, name: str): def add_public(self, name: str): self.public_list.append(self.enc_scope_name + "::" + name) - def add_use( - self, - mod_word: str, - line_number: int, - only_list: list = [], - rename_map: dict = {}, - ): + def add_use(self, use_mod: Use | Import): if self.current_scope is None: self.create_none_scope() - self.current_scope.add_use(mod_word, line_number, only_list, rename_map) + self.current_scope.add_use(use_mod) def add_include(self, path: str, line_number: int): self.include_statements.append(IncludeInfo(line_number, path, None, [])) @@ -2095,11 +2170,30 @@ def end_ppif(self, line_number): self.pp_if[-1][1] = line_number - 1 def get_scopes(self, line_number: int = None): + """Get a list of all the scopes present in the line number provided. + + Parameters + ---------- + line_number : int, optional + Document line number, if None return all document scopes, by default None + + Returns + ------- + Variable,Type,Function,Subroutine,Module,Program,Interface,BlockData + A list of scopes + """ if line_number is None: return self.scope_list scope_list = [] for scope in self.scope_list: if (line_number >= scope.sline) and (line_number <= scope.eline): + if type(scope.parent) == Interface: + for use_stmnt in scope.use: + if not type(use_stmnt) == Import: + continue + # Exclude the parent and all other scopes + if use_stmnt.import_type == ImportTypes.NONE: + return [scope] scope_list.append(scope) for ancestor in scope.get_ancestors(): scope_list.append(ancestor) diff --git a/fortls/parse_fortran.py b/fortls/parse_fortran.py index fb4154cd..413c4966 100644 --- a/fortls/parse_fortran.py +++ b/fortls/parse_fortran.py @@ -35,7 +35,6 @@ SelectInfo, SmodInfo, SubInfo, - UseInfo, VarInfo, VisInfo, ) @@ -58,6 +57,8 @@ FortranAST, Function, If, + Import, + ImportTypes, Interface, Method, Module, @@ -67,6 +68,7 @@ Submodule, Subroutine, Type, + Use, Variable, Where, ) @@ -632,7 +634,7 @@ def read_int_def(line: str) -> tuple[Literal["int"], InterInfo] | None: return "int", InterInfo(int_match.group(2), is_abstract) -def read_use_stmt(line: str) -> tuple[Literal["use"], UseInfo] | None: +def read_use_stmt(line: str) -> tuple[Literal["use"], Use] | None: """Attempt to read USE statement""" use_match = FRegex.USE.match(line) if use_match is None: @@ -649,18 +651,30 @@ def read_use_stmt(line: str) -> tuple[Literal["use"], UseInfo] | None: only_list.add(only_name) if len(only_split) == 2: rename_map[only_name] = only_split[1].strip() - return "use", UseInfo(use_mod, only_list, rename_map) + return "use", Use(use_mod, only_list, rename_map) -def read_imp_stmt(line: str) -> tuple[Literal["import"], list[str]] | None: +def read_imp_stmt(line: str) -> tuple[Literal["import"], Import] | None: """Attempt to read IMPORT statement""" import_match = FRegex.IMPORT.match(line) if import_match is None: return None + import_type = import_match.groupdict() + is_empty = all(value is None for value in import_type.values()) + # import + # import, all + if is_empty or (import_type["spec"] and import_type["spec"].lower() == "all"): + return "import", Import("#import", ImportTypes.ALL) + # import, none + elif import_type["spec"] and import_type["spec"].lower() == "none": + return "import", Import("#import", ImportTypes.NONE) + # import, only: a, b, c + # import :: a, b, c + # import a, b, c trailing_line = line[import_match.end(0) - 1 :].lower() - import_list = [import_obj.strip() for import_obj in trailing_line.split(",")] - return "import", import_list + import_list = {import_obj.strip() for import_obj in trailing_line.split(",")} + return "import", Import("#import", ImportTypes.ONLY, import_list) def read_inc_stmt(line: str) -> tuple[Literal["inc"], str] | None: @@ -1273,6 +1287,7 @@ def parse( ifs=0, block=0, select=0, + imports=0, interface=0, ) multi_lines = deque() @@ -1623,16 +1638,15 @@ def parse( log.debug("%s !!! INTERFACE-IMPL - Ln:%d", line, line_no) elif obj_type == "use": - file_ast.add_use( - obj_info.mod_name, - line_no, - obj_info.only_list, - obj_info.rename_map, - ) + obj_info.line_number = line_no + file_ast.add_use(obj_info) log.debug("%s !!! USE - Ln:%d", line, line_no) elif obj_type == "import": - file_ast.add_use("#IMPORT", line_no, obj_info) + obj_info.line_number = line_no + obj_info.mod_name += str(counters["import"]) + file_ast.add_use(obj_info) + counters["imports"] += 1 log.debug("%s !!! IMPORT - Ln:%d", line, line_no) elif obj_type == "inc": diff --git a/fortls/regex_patterns.py b/fortls/regex_patterns.py index 2847edbb..2a3bd6c4 100644 --- a/fortls/regex_patterns.py +++ b/fortls/regex_patterns.py @@ -11,7 +11,17 @@ class FortranRegularExpressions: r"[ ]*USE([, ]+(?:INTRINSIC|NON_INTRINSIC))?[ :]+(\w*)([, ]+ONLY[ :]+)?", I, ) - IMPORT: Pattern = compile(r"[ ]*IMPORT[ :]+([a-z_])", I) + IMPORT: Pattern = compile( + r"[ ]*IMPORT" + r"(?:" + r"[ ]*,[ ]*(?PALL|NONE)" # import, [all | none] + r"|" # or + r"[ ]*,[ ]*(?PONLY)[ ]*:[ ]*(?P[\w_])" # import, only: name-list + r"|" # or + r"[ ]+(?:::[ ]*)?(?P[\w_])" # import [[::] name-list] + r")?", # standalone import + I, + ) INCLUDE: Pattern = compile(r"[ ]*INCLUDE[ :]*[\'\"]([^\'\"]*)", I) CONTAINS: Pattern = compile(r"[ ]*(CONTAINS)[ ]*$", I) IMPLICIT: Pattern = compile(r"[ ]*IMPLICIT[ ]+([a-z]*)", I) diff --git a/test/test_server_completion.py b/test/test_server_completion.py index a7148a09..6ef55fee 100644 --- a/test/test_server_completion.py +++ b/test/test_server_completion.py @@ -229,14 +229,10 @@ def test_comp_import_host_association(): string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir)}) file_path = test_dir / "test_import.f90" string += comp_request(file_path, 15, 20) - errcode, results = run_request(string, ["--use_signature_help"]) + errcode, results = run_request(string, ["--use_signature_help", "-n1"]) assert errcode == 0 - exp_results = ( - # TODO: this should be 1, mytype2 should not appear in autocomplete - # see #5 and #8 on GitHub - [2, "mytype", "TYPE"], - ) + exp_results = ([1, "mytype", "TYPE"],) assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) @@ -394,3 +390,47 @@ def test_comp_use_only_interface(): assert len(exp_results) == len(results) - 1 for i, ref in enumerate(exp_results): validate_comp(results[i + 1], ref) + + +def test_import(): + """Test that import works.""" + string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "imp")}) + file_path = test_dir / "imp" / "import.f90" + string += comp_request(file_path, 13, 16) # import type1 + string += comp_request(file_path, 17, 16) # import, only: type2 + string += comp_request(file_path, 21, 16) # import, none + string += comp_request(file_path, 25, 16) # import, all + string += comp_request(file_path, 29, 16) # import + string += comp_request(file_path, 34, 16) # import type1; import type2 + string += comp_request(file_path, 38, 16) # import :: type1, type2 + errcode, results = run_request(string, ["--use_signature_help", "-n1"]) + assert errcode == 0 + exp_results = ( + [1, "type1", "TYPE"], + [1, "type2", "TYPE"], + [0], + [2, "type1", "TYPE"], + [2, "type1", "TYPE"], + [2, "type1", "TYPE"], + [2, "type1", "TYPE"], + ) + assert len(exp_results) == len(results) - 1 + for i, ref in enumerate(exp_results): + validate_comp(results[i + 1], ref) + + +def test_use_multiple(): + """Test that USE multiple times works.""" + string = write_rpc_request(1, "initialize", {"rootPath": str(test_dir / "use")}) + file_path = test_dir / "use" / "use.f90" + string += comp_request(file_path, 14, 11) + string += comp_request(file_path, 15, 12) + errcode, results = run_request(string, ["--use_signature_help", "-n1"]) + assert errcode == 0 + exp_results = ( + [5, "val1", "INTEGER"], + [1, "val4", "INTEGER"], + ) + assert len(exp_results) == len(results) - 1 + for i, ref in enumerate(exp_results): + validate_comp(results[i + 1], ref) diff --git a/test/test_source/imp/import.f90 b/test/test_source/imp/import.f90 new file mode 100644 index 00000000..cfc1b7f0 --- /dev/null +++ b/test/test_source/imp/import.f90 @@ -0,0 +1,48 @@ +module import_mod + implicit none + type :: type1 + real(kind=8) :: value + contains + procedure :: abs_int => abs_int1 + end type type1 + type :: type2 + type(type1) :: t + end type type2 + interface + subroutine abs_int1(this) + import type1 + class(type1), intent(inout) :: this ! only type1 + end subroutine abs_int1 + subroutine abs_int2(this) + import, only: type2 + class(type2), intent(inout) :: this ! only type2 + end subroutine abs_int2 + subroutine abs_int3(this) + import, none + class(type1), intent(inout) :: this ! no comp results + end subroutine abs_int3 + subroutine abs_int4(this) + import, all + class(type1), intent(inout) :: this ! type1 and type2 + end subroutine abs_int4 + subroutine abs_int5(this) + import + class(type1), intent(inout) :: this ! type1 and type2 + end subroutine abs_int5 + subroutine abs_int6(this) + import type1 + import type2 + class(type1), intent(inout) :: this ! type1 and type2 + end subroutine abs_int6 + subroutine abs_int7(this) + import :: type1, type2 + class(type1), intent(inout) :: this ! type1 and type2 + end subroutine abs_int7 + end interface +end module import_mod + +program main + use import_mod + type(type1) :: obj + call obj%abs_int() +end program main diff --git a/test/test_source/use/use.f90 b/test/test_source/use/use.f90 new file mode 100644 index 00000000..b9e69489 --- /dev/null +++ b/test/test_source/use/use.f90 @@ -0,0 +1,17 @@ +module use_mod +integer :: val1, val2, val3 +contains +end module use_mod +module use_mod_all +integer :: val4, val5 +contains +end module use_mod_all + +program use_main +use use_mod, only: val1, val2 +use use_mod, only: val3_renamed => val3 +use use_mod_all, only: val4 +use use_mod_all, only: val4, val5 +print*, val3_renamed +print*, val4 +end program use_main