From 037854795e5635ed0d28d6a109a849ecfb8eaec6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ignacio=20Fdez=2E=20Galv=C3=A1n?= Date: Tue, 9 Feb 2021 15:50:31 +0100 Subject: [PATCH 1/5] Fixes and new options --- fprettify/__init__.py | 127 ++++++++++++++++++++++++++++++++---------- 1 file changed, 98 insertions(+), 29 deletions(-) diff --git a/fprettify/__init__.py b/fprettify/__init__.py index d6450a3..8a09f3c 100644 --- a/fprettify/__init__.py +++ b/fprettify/__init__.py @@ -105,7 +105,7 @@ IF_RE = re.compile( SOL_STR + r"(\w+\s*:)?\s*IF\s*\(.*\)\s*THEN" + EOL_STR, RE_FLAGS) ELSE_RE = re.compile( - SOL_STR + r"ELSE(\s*IF\s*\(.*\)\s*THEN)?" + EOL_STR, RE_FLAGS) + SOL_STR + r"ELSE(\s*IF\s*\(.*\)\s*THEN)?(\s+\w+)?" + EOL_STR, RE_FLAGS) ENDIF_RE = re.compile(SOL_STR + r"END\s*IF(\s+\w+)?" + EOL_STR, RE_FLAGS) DO_RE = re.compile(SOL_STR + r"(\w+\s*:)?\s*DO(" + EOL_STR + r"|\s+\w)", RE_FLAGS) @@ -196,6 +196,9 @@ PRIVATE_RE = re.compile(SOL_STR + r"PRIVATE\s*::", RE_FLAGS) PUBLIC_RE = re.compile(SOL_STR + r"PUBLIC\s*::", RE_FLAGS) +ATTR_RE = re.compile(SOL_STR + r"(ALLOCATABLE|DIMENSION|EXTERNAL|INTENT|INTRINSIC|OPTIONAL|PARAMETER|POINTER|PRIVATE|PUBLIC|SAVE|TARGET)(\s+|\(|::)", RE_FLAGS) +PROC_RE = re.compile(SOL_STR + r"(MODULE\s+)?(PROCEDURE)(\s+|\(|::)", RE_FLAGS) + END_RE = re.compile(SOL_STR + r"(END)\s*(IF|DO|SELECT|ASSOCIATE|BLOCK|SUBROUTINE|FUNCTION|MODULE|SUBMODULE|TYPE|PROGRAM|INTERFACE|ENUM|WHERE|FORALL)", RE_FLAGS) # intrinsic statements with parenthesis notation that are not functions @@ -301,7 +304,7 @@ def search(self, line): forall_parser = where_parser -def build_scope_parser(fypp=True, mod=True): +def build_scope_parser(fypp=True, mod=True, select=False): parser = {} parser['new'] = \ [parser_re(IF_RE), parser_re(DO_RE), parser_re(SELCASE_RE), parser_re(SUBR_RE), @@ -309,6 +312,12 @@ def build_scope_parser(fypp=True, mod=True): parser_re(INTERFACE_RE), parser_re(TYPE_RE), parser_re(ENUM_RE), parser_re(ASSOCIATE_RE), None, parser_re(BLK_RE), where_parser(WHERE_RE), forall_parser(FORALL_RE)] + parser['double'] = \ + [False, False, select, False, + False, + False, False, False, False, + False, False, False, False] + parser['continue'] = \ [parser_re(ELSE_RE), None, parser_re(CASE_RE), parser_re(CONTAINS_RE), parser_re(CONTAINS_RE), @@ -323,11 +332,13 @@ def build_scope_parser(fypp=True, mod=True): if mod: parser['new'].extend([parser_re(MOD_RE), parser_re(SMOD_RE), parser_re(PROG_RE)]) + parser['double'].extend([False, False, False]) parser['continue'].extend([parser_re(CONTAINS_RE), parser_re(CONTAINS_RE), parser_re(CONTAINS_RE)]) parser['end'].extend([parser_re(ENDMOD_RE), parser_re(ENDSMOD_RE), parser_re(ENDPROG_RE)]) if fypp: parser['new'].extend(PREPRO_NEW_SCOPE) + parser['double'].extend(False) parser['continue'].extend(PREPRO_CONTINUE_SCOPE) parser['end'].extend(PREPRO_END_SCOPE) @@ -465,9 +476,8 @@ def build_scope_parser(fypp=True, mod=True): F90_INT_RE = r"[-+]?[0-9]+" F90_FLOAT_RE = r"[-+]?([0-9]+\.[0-9]*|\.[0-9]+)" -F90_NUMBER_RE = "(" + F90_INT_RE + "|" + F90_FLOAT_RE + ")" -F90_FLOAT_EXP_RE = F90_NUMBER_RE + r"[eEdD]" + F90_NUMBER_RE -F90_NUMBER_ALL_RE = "(" + F90_NUMBER_RE + "|" + F90_FLOAT_EXP_RE + ")" +F90_NUMBER_RE = "(" + F90_FLOAT_RE + "|" + F90_INT_RE + ")" +F90_NUMBER_ALL_RE = F90_NUMBER_RE + r"([ed]" + F90_INT_RE + r")?" F90_NUMBER_ALL_REC = re.compile(F90_NUMBER_ALL_RE, RE_FLAGS) ## F90_CONSTANTS_TYPES_RE = re.compile(r"\b" + F90_NUMBER_ALL_RE + "_(" + "|".join([a + r"\b" for a in ( @@ -545,7 +555,7 @@ def process_lines_of_fline(self, f_line, lines, rel_ind, rel_ind_con, """ if (self._initial and - (PROG_RE.match(f_line) or MOD_RE.match(f_line))): + (PROG_RE.match(f_line) or MOD_RE.match(f_line)) or SUBR_RE.match(f_line) or FCT_RE.match(f_line)): self._indent_storage[-1] = 0 self._line_indents = [0] * len(lines) @@ -571,6 +581,7 @@ def process_lines_of_fline(self, f_line, lines, rel_ind, rel_ind_con, what_new = new_n is_new = True valid_new = True + is_double = self._parser['double'][new_n] scopes.append(what_new) log_message("{}: {}".format(what_new, f_line), "debug", filename, line_nr) @@ -582,6 +593,7 @@ def process_lines_of_fline(self, f_line, lines, rel_ind, rel_ind_con, if conre and conre.search(f_line_filtered): what_con = con_n is_con = True + is_double = self._parser['double'][con_n] log_message("{}: {}".format( what_con, f_line), "debug", filename, line_nr) if len(scopes) > 0: @@ -646,6 +658,9 @@ def process_lines_of_fline(self, f_line, lines, rel_ind, rel_ind_con, indents.append(rel_ind + indents[-1]) + if is_double: + indents[-1] += rel_ind + elif (not is_new) and (is_con or is_end): valid = valid_con if is_con else valid_end @@ -658,6 +673,9 @@ def process_lines_of_fline(self, f_line, lines, rel_ind, rel_ind_con, line_indents = [ind + indents[-2 + self._initial] for ind in line_indents] + if is_con and is_double: + line_indents = [ind + rel_ind for ind in line_indents] + if is_end and valid: if len(indents) > 1: indents.pop() @@ -1006,7 +1024,8 @@ def replace_keywords_single_fline(f_line, case_dict): elif F90_CONSTANTS_TYPES_RE.match(part): part = swapcase(part, case_dict['constants']) elif F90_NUMBER_ALL_REC.match(part): - part = swapcase(part, case_dict['constants']) + end = F90_NUMBER_ALL_REC.match(part).end() + part = swapcase(part[:end], case_dict['constants']) + part[end:] line_parts[pos] = part @@ -1043,19 +1062,24 @@ def format_single_fline(f_line, whitespace, whitespace_dict, linebreak_pos, 'print': 6, # 6: print / read statements 'type': 7, # 7: select type components 'intrinsics': 8, # 8: intrinsics - 'decl': 9 # 9: declarations + 'decl': 9, # 9: declarations + 'end': 10, # 10: end statements [ = 8 ] + 'only': 11, # 11: use only: [ = 0 ] + 'if': 12, # 12: if, while, and similar [ = 8 ] + 'do': 13, # 13: do index assignments [ = 1 ] + 'list': 14 # 14: commas in declarations and use [ = 0 ] } if whitespace == 0: - spacey = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0] + spacey = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] elif whitespace == 1: - spacey = [1, 1, 1, 1, 0, 0, 1, 0, 1, 1] + spacey = [1, 1, 1, 1, 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1] elif whitespace == 2: - spacey = [1, 1, 1, 1, 1, 0, 1, 0, 1, 1] + spacey = [1, 1, 1, 1, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1] elif whitespace == 3: - spacey = [1, 1, 1, 1, 1, 1, 1, 0, 1, 1] + spacey = [1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1] elif whitespace == 4: - spacey = [1, 1, 1, 1, 1, 1, 1, 1, 1, 1] + spacey = [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1] else: raise NotImplementedError("unknown value for whitespace") @@ -1150,7 +1174,11 @@ def add_whitespace_charwise(line, spacey, scope_parser, format_decl, filename, l r"|[\w\*/=\+\-:])\s*$"), line[:pos], RE_FLAGS) and not EMPTY_RE.search(line[:pos])) or - re.search(SOL_STR + r"(\w+\s*:)?(ELSE)?\s*IF\s*$", + re.search(r"(?' # pointer assignment else: assign_op = '=' # assignment + if (spacey[13] != spacey[1]) and DO_RE.match(line_ftd[:pos]): + sp = spacey[13] + else: + sp = spacey[1] line_ftd = (lhs.rstrip(' ') + - ' ' * spacey[1] + assign_op + - ' ' * spacey[1] + rhs.lstrip(' ')) + ' ' * sp + assign_op + + ' ' * sp + rhs.lstrip(' ')) # offset w.r.t. unformatted line is_end = False @@ -1258,7 +1297,7 @@ def add_whitespace_charwise(line, spacey, scope_parser, format_decl, filename, l if endre and endre.search(line_ftd): is_end = True if is_end: - line_ftd = END_RE.sub(r'\1' + ' '*spacey[8] + r'\2', line_ftd) + line_ftd = END_RE.sub(r'\1' + ' '*spacey[10] + r'\2', line_ftd) if level != 0: log_message('unpaired bracket delimiters', "info", filename, line_nr) @@ -1315,7 +1354,7 @@ def add_whitespace_context(line, spacey): # format ':' for labels and use only statements if USE_RE.search(line): line = re.sub(r'(only)\s*:\s*', r'\g<1>:' + ' ' * - spacey[0], line, flags=RE_FLAGS) + spacey[11], line, flags=RE_FLAGS) return line @@ -1419,7 +1458,7 @@ def reformat_inplace(filename, stdout=False, diffonly=False, **kwargs): # pragm def reformat_ffile(infile, outfile, impose_indent=True, indent_size=3, strict_indent=False, impose_whitespace=True, case_dict={}, impose_replacements=False, cstyle=False, whitespace=2, whitespace_dict={}, llength=132, - strip_comments=False, format_decl=False, orig_filename=None, indent_fypp=True, indent_mod=True): + strip_comments=False, format_decl=False, orig_filename=None, indent_fypp=True, indent_mod=True, indent_main=True, indent_select=False): """main method to be invoked for formatting a Fortran file.""" # note: whitespace formatting and indentation may require different parsing rules @@ -1435,14 +1474,14 @@ def reformat_ffile(infile, outfile, impose_indent=True, indent_size=3, strict_in oldfile = infile newfile = infile - if impose_whitespace: + if impose_whitespace or impose_replacements: _impose_indent = False newfile = io.StringIO() reformat_ffile_combined(oldfile, newfile, _impose_indent, indent_size, strict_indent, impose_whitespace, case_dict, impose_replacements, cstyle, whitespace, whitespace_dict, llength, - strip_comments, format_decl, orig_filename, indent_fypp, indent_mod) + strip_comments, format_decl, orig_filename, indent_fypp, indent_mod, indent_main, indent_select) oldfile = newfile # 2) indentation @@ -1455,8 +1494,11 @@ def reformat_ffile(infile, outfile, impose_indent=True, indent_size=3, strict_in reformat_ffile_combined(oldfile, newfile, impose_indent, indent_size, strict_indent, _impose_whitespace, case_dict, _impose_replacements, cstyle, whitespace, whitespace_dict, llength, - strip_comments, format_decl, orig_filename, indent_fypp, indent_mod) + strip_comments, format_decl, orig_filename, indent_fypp, indent_mod, indent_main, indent_select) + # none + if not (impose_whitespace or impose_replacements or impose_indent): + newfile.getvalue = newfile.read outfile.write(newfile.getvalue()) @@ -1464,7 +1506,7 @@ def reformat_ffile(infile, outfile, impose_indent=True, indent_size=3, strict_in def reformat_ffile_combined(infile, outfile, impose_indent=True, indent_size=3, strict_indent=False, impose_whitespace=True, case_dict={}, impose_replacements=False, cstyle=False, whitespace=2, whitespace_dict={}, llength=132, - strip_comments=False, format_decl=False, orig_filename=None, indent_fypp=True, indent_mod=True): + strip_comments=False, format_decl=False, orig_filename=None, indent_fypp=True, indent_mod=True, indent_main=True, indent_select=False): if not orig_filename: orig_filename = infile.name @@ -1480,7 +1522,7 @@ def reformat_ffile_combined(infile, outfile, impose_indent=True, indent_size=3, if not has_fypp: indent_fypp = False - scope_parser = build_scope_parser(fypp=indent_fypp, mod=indent_mod) + scope_parser = build_scope_parser(fypp=indent_fypp, mod=indent_mod, select=indent_select) # initialization @@ -1503,6 +1545,7 @@ def reformat_ffile_combined(infile, outfile, impose_indent=True, indent_size=3, stream = InputStream(infile, not indent_fypp, orig_filename=orig_filename) skip_blank = False in_format_off_block = False + skip_first = not indent_main while 1: f_line, comments, lines = stream.next_fortran_line() @@ -1578,6 +1621,11 @@ def reformat_ffile_combined(infile, outfile, impose_indent=True, indent_size=3, indenter.process_lines_of_fline( f_line, lines, rel_indent, indent_size, stream.line_nr, indent_fypp, manual_lines_indent) + if not indent_main and len(indenter._indent_storage) == 1: + skip_first = True + if skip_first and indenter._indent_storage[-1] > 0: + indenter._indent_storage[-1] = 0 + skip_first = False indent = indenter.get_lines_indent() lines, indent = prepend_ampersands(lines, indent, pre_ampersand) @@ -1986,6 +2034,16 @@ def get_arg_parser(args): help="boolean, en-/disable whitespace for select type components") parser.add_argument("--whitespace-intrinsics", type=str2bool, nargs="?", default="None", const=True, help="boolean, en-/disable whitespace for intrinsics like if/write/close") + parser.add_argument("--whitespace-end", type=str2bool, nargs="?", default="None", const=True, + help="boolean, en-/disable whitespace for end statements") + parser.add_argument("--whitespace-only", type=str2bool, nargs="?", default="None", const=True, + help="boolean, en-/disable whitespace for only") + parser.add_argument("--whitespace-if", type=str2bool, nargs="?", default="None", const=True, + help="boolean, en-/disable whitespace for if-like statements (if, do while, select case...)") + parser.add_argument("--whitespace-do", type=str2bool, nargs="?", default="None", const=True, + help="boolean, en-/disable whitespace for do index assignments") + parser.add_argument("--whitespace-list", type=str2bool, nargs="?", default="None", const=True, + help="boolean, en-/disable whitespace for commas in lists (declarations and use)") parser.add_argument("--strict-indent", action='store_true', default=False, help="strictly impose indentation even for nested loops") parser.add_argument("--enable-decl", action="store_true", default=False, help="enable whitespace formatting of declarations ('::' operator).") parser.add_argument("--disable-indent", action='store_true', default=False, help="don't impose indentation") @@ -2003,6 +2061,10 @@ def get_arg_parser(args): help="Disables the indentation of fypp preprocessor blocks.") parser.add_argument('--disable-indent-mod', action='store_true', default=False, help="Disables the indentation after module / program.") + parser.add_argument('--disable-indent-first', action='store_true', default=False, + help="Disables the indentation of the first-level block (typically a program, module, subroutine or function).") + parser.add_argument('--indent-select', action='store_true', default=False, + help="Enable extra indentation of select blocks.") parser.add_argument("-d","--diff", action='store_true', default=False, help="Write file differences to stdout instead of formatting inplace") @@ -2044,6 +2106,11 @@ def build_ws_dict(args): ws_dict['print'] = args.whitespace_print ws_dict['type'] = args.whitespace_type ws_dict['intrinsics'] = args.whitespace_intrinsics + ws_dict['end'] = args.whitespace_end if args.whitespace_end is not None else args.whitespace_intrinsics + ws_dict['only'] = args.whitespace_only if args.whitespace_only is not None else args.whitespace_comma + ws_dict['if'] = args.whitespace_if if args.whitespace_if is not None else args.whitespace_intrinsics + ws_dict['do'] = args.whitespace_do if args.whitespace_do is not None else args.whitespace_assignment + ws_dict['list'] = args.whitespace_list if args.whitespace_list is not None else args.whitespace_comma return ws_dict # support legacy input: @@ -2136,7 +2203,9 @@ def build_ws_dict(args): strip_comments=file_args.strip_comments, format_decl=file_args.enable_decl, indent_fypp=not file_args.disable_fypp, - indent_mod=not file_args.disable_indent_mod) + indent_mod=not file_args.disable_indent_mod, + indent_main=not file_args.disable_indent_first, + indent_select=file_args.indent_select) except FprettifyException as e: log_exception(e, "Fatal error occured") sys.exit(1) From e77b5a191f590c4fcf109b57aa1ee51293df5490 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ignacio=20Fdez=2E=20Galv=C3=A1n?= Date: Wed, 10 Feb 2021 18:45:31 +0100 Subject: [PATCH 2/5] Add --reset-indent option and tests --- fprettify/__init__.py | 25 +++-- fprettify/tests/__init__.py | 180 +++++++++++++++++++++++++++++++++++- 2 files changed, 194 insertions(+), 11 deletions(-) diff --git a/fprettify/__init__.py b/fprettify/__init__.py index 8a09f3c..a3008b1 100644 --- a/fprettify/__init__.py +++ b/fprettify/__init__.py @@ -338,7 +338,7 @@ def build_scope_parser(fypp=True, mod=True, select=False): if fypp: parser['new'].extend(PREPRO_NEW_SCOPE) - parser['double'].extend(False) + parser['double'].extend([False]*len(PREPRO_NEW_SCOPE)) parser['continue'].extend(PREPRO_CONTINUE_SCOPE) parser['end'].extend(PREPRO_END_SCOPE) @@ -510,7 +510,7 @@ class F90Indenter(object): and updates the indentation. """ - def __init__(self, scope_parser, first_indent, rel_indent, filename): + def __init__(self, scope_parser, first_indent, rel_indent, reset_indent, filename): # scopes / subunits: self._scope_storage = [] # indents for all fortran lines: @@ -518,6 +518,8 @@ def __init__(self, scope_parser, first_indent, rel_indent, filename): # indents of actual lines of current fortran line self._line_indents = [] + self._reset_indent = reset_indent + self._parser = scope_parser self._filename = filename @@ -555,7 +557,8 @@ def process_lines_of_fline(self, f_line, lines, rel_ind, rel_ind_con, """ if (self._initial and - (PROG_RE.match(f_line) or MOD_RE.match(f_line)) or SUBR_RE.match(f_line) or FCT_RE.match(f_line)): + (PROG_RE.match(f_line) or MOD_RE.match(f_line)) or + (self._reset_indent and (SMOD_RE.match(f_line) or SUBR_RE.match(f_line) or FCT_RE.match(f_line)))): self._indent_storage[-1] = 0 self._line_indents = [0] * len(lines) @@ -1455,7 +1458,7 @@ def reformat_inplace(filename, stdout=False, diffonly=False, **kwargs): # pragm outfile = io.open(filename, 'w', encoding='utf-8') outfile.write(newfile.getvalue()) -def reformat_ffile(infile, outfile, impose_indent=True, indent_size=3, strict_indent=False, impose_whitespace=True, +def reformat_ffile(infile, outfile, impose_indent=True, indent_size=3, reset_indent=False, strict_indent=False, impose_whitespace=True, case_dict={}, impose_replacements=False, cstyle=False, whitespace=2, whitespace_dict={}, llength=132, strip_comments=False, format_decl=False, orig_filename=None, indent_fypp=True, indent_mod=True, indent_main=True, indent_select=False): @@ -1478,7 +1481,7 @@ def reformat_ffile(infile, outfile, impose_indent=True, indent_size=3, strict_in _impose_indent = False newfile = io.StringIO() - reformat_ffile_combined(oldfile, newfile, _impose_indent, indent_size, strict_indent, impose_whitespace, + reformat_ffile_combined(oldfile, newfile, _impose_indent, indent_size, reset_indent, strict_indent, impose_whitespace, case_dict, impose_replacements, cstyle, whitespace, whitespace_dict, llength, strip_comments, format_decl, orig_filename, indent_fypp, indent_mod, indent_main, indent_select) @@ -1491,19 +1494,20 @@ def reformat_ffile(infile, outfile, impose_indent=True, indent_size=3, strict_in _impose_replacements = False newfile = io.StringIO() - reformat_ffile_combined(oldfile, newfile, impose_indent, indent_size, strict_indent, _impose_whitespace, + reformat_ffile_combined(oldfile, newfile, impose_indent, indent_size, reset_indent, strict_indent, _impose_whitespace, case_dict, _impose_replacements, cstyle, whitespace, whitespace_dict, llength, strip_comments, format_decl, orig_filename, indent_fypp, indent_mod, indent_main, indent_select) # none if not (impose_whitespace or impose_replacements or impose_indent): - newfile.getvalue = newfile.read + if not hasattr(newfile, 'getvalue'): + newfile.getvalue = newfile.read outfile.write(newfile.getvalue()) -def reformat_ffile_combined(infile, outfile, impose_indent=True, indent_size=3, strict_indent=False, impose_whitespace=True, +def reformat_ffile_combined(infile, outfile, impose_indent=True, indent_size=3, reset_indent=False, strict_indent=False, impose_whitespace=True, case_dict={}, impose_replacements=False, cstyle=False, whitespace=2, whitespace_dict={}, llength=132, strip_comments=False, format_decl=False, orig_filename=None, indent_fypp=True, indent_mod=True, indent_main=True, indent_select=False): @@ -1534,7 +1538,7 @@ def reformat_ffile_combined(infile, outfile, impose_indent=True, indent_size=3, indent_special = 0 if impose_indent: - indenter = F90Indenter(scope_parser, first_indent, indent_size, orig_filename) + indenter = F90Indenter(scope_parser, first_indent, indent_size, reset_indent, orig_filename) else: indent_special = 3 @@ -2044,6 +2048,8 @@ def get_arg_parser(args): help="boolean, en-/disable whitespace for do index assignments") parser.add_argument("--whitespace-list", type=str2bool, nargs="?", default="None", const=True, help="boolean, en-/disable whitespace for commas in lists (declarations and use)") + parser.add_argument("--reset-indent", action='store_true', default=False, + help="Reset indent to 0 at the begining of a file if match program/module/sub/func") parser.add_argument("--strict-indent", action='store_true', default=False, help="strictly impose indentation even for nested loops") parser.add_argument("--enable-decl", action="store_true", default=False, help="enable whitespace formatting of declarations ('::' operator).") parser.add_argument("--disable-indent", action='store_true', default=False, help="don't impose indentation") @@ -2192,6 +2198,7 @@ def build_ws_dict(args): diffonly=diffonly, impose_indent=not file_args.disable_indent, indent_size=file_args.indent, + reset_indent=args.reset_indent, strict_indent=file_args.strict_indent, impose_whitespace=not file_args.disable_whitespace, impose_replacements=file_args.enable_replacements, diff --git a/fprettify/tests/__init__.py b/fprettify/tests/__init__.py index 5980930..d5bdbfe 100644 --- a/fprettify/tests/__init__.py +++ b/fprettify/tests/__init__.py @@ -423,7 +423,7 @@ def test_swap_case(self): "REAL(kind=real64), PARAMETER :: r64c = .0e3_real64", "REAL, PARAMETER :: r32 = 2.e3", "REAL, PARAMETER :: r32 = 2.0d3", - "REAL, PARAMETER :: r32 = .2e3", + "REAL, PARAMETER :: r32 = .2e3*3.0_dp1", "USE ISO_FORTRAN_ENV, ONLY: int64", "INTEGER, INTENT(IN) :: r, i, j, k", "IF (l.EQ.2) l=MAX (l64, 2_int64)", @@ -444,7 +444,7 @@ def test_swap_case(self): "real(kind=REAL64), parameter :: r64c = .0E3_REAL64", "real, parameter :: r32 = 2.E3", "real, parameter :: r32 = 2.0D3", - "real, parameter :: r32 = .2E3", + "real, parameter :: r32 = .2E3*3.0_dp1", "use iso_fortran_env, only: INT64", "integer, intent(IN) :: r, i, j, k", "if (l .eq. 2) l = max(l64, 2_INT64)", @@ -883,6 +883,182 @@ def test_label(self): self.assert_fprettify_result([], instring, outstring) + def test_named_if(self): + """test correct formatting of named if construct""" + instring = ("foo: if(a==b) then\n" + "e=a+c\n" + "elseif (c==d) then foo\n" + "f=a+c\n" + "else foo\n" + "g=a+c\n" + "end if foo") + outstring =("foo: if (a == b) then\n" + " e = a + c\n" + "elseif (c == d) then foo\n" + " f = a + c\n" + "else foo\n" + " g = a + c\n" + "end if foo") + + self.assert_fprettify_result([], instring, outstring) + + def test_reset_indet(self): + """test resetting first indent on subroutine""" + instring = (" subroutine foo(a,b)\n" + " implicit integer\n" + " b=a\n" + " end subroutine foo") + outstring =("subroutine foo(a, b)\n" + " implicit integer\n" + " b = a\n" + "end subroutine foo") + + self.assert_fprettify_result(['--reset-indent'], instring, outstring) + + def test_whitespace_end(self): + """test whitespace for end statements""" + instring = ("do i=1,n\n" + " if (a Date: Tue, 16 Feb 2021 09:51:09 +0100 Subject: [PATCH 3/5] Add "import" to attributes and fix reset-indent --- fprettify/__init__.py | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/fprettify/__init__.py b/fprettify/__init__.py index a3008b1..48d084d 100644 --- a/fprettify/__init__.py +++ b/fprettify/__init__.py @@ -196,7 +196,7 @@ PRIVATE_RE = re.compile(SOL_STR + r"PRIVATE\s*::", RE_FLAGS) PUBLIC_RE = re.compile(SOL_STR + r"PUBLIC\s*::", RE_FLAGS) -ATTR_RE = re.compile(SOL_STR + r"(ALLOCATABLE|DIMENSION|EXTERNAL|INTENT|INTRINSIC|OPTIONAL|PARAMETER|POINTER|PRIVATE|PUBLIC|SAVE|TARGET)(\s+|\(|::)", RE_FLAGS) +ATTR_RE = re.compile(SOL_STR + r"(ALLOCATABLE|DIMENSION|EXTERNAL|IMPORT|INTENT|INTRINSIC|OPTIONAL|PARAMETER|POINTER|PRIVATE|PUBLIC|SAVE|TARGET)(\s+|\(|::)", RE_FLAGS) PROC_RE = re.compile(SOL_STR + r"(MODULE\s+)?(PROCEDURE)(\s+|\(|::)", RE_FLAGS) END_RE = re.compile(SOL_STR + r"(END)\s*(IF|DO|SELECT|ASSOCIATE|BLOCK|SUBROUTINE|FUNCTION|MODULE|SUBMODULE|TYPE|PROGRAM|INTERFACE|ENUM|WHERE|FORALL)", RE_FLAGS) @@ -557,8 +557,8 @@ def process_lines_of_fline(self, f_line, lines, rel_ind, rel_ind_con, """ if (self._initial and - (PROG_RE.match(f_line) or MOD_RE.match(f_line)) or - (self._reset_indent and (SMOD_RE.match(f_line) or SUBR_RE.match(f_line) or FCT_RE.match(f_line)))): + ((PROG_RE.match(f_line) or MOD_RE.match(f_line)) or + (self._reset_indent and (SMOD_RE.match(f_line) or SUBR_RE.match(f_line) or FCT_RE.match(f_line))))): self._indent_storage[-1] = 0 self._line_indents = [0] * len(lines) From 2f766f33ed795ee69d0ac404e699e5475ff52f3f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ignacio=20Fdez=2E=20Galv=C3=A1n?= Date: Wed, 3 Mar 2021 19:12:11 +0100 Subject: [PATCH 4/5] Avoid greedy regex (slooooow with long numbers) --- fprettify/__init__.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fprettify/__init__.py b/fprettify/__init__.py index 48d084d..0a8db81 100644 --- a/fprettify/__init__.py +++ b/fprettify/__init__.py @@ -482,7 +482,7 @@ def build_scope_parser(fypp=True, mod=True, select=False): ## F90_CONSTANTS_TYPES_RE = re.compile(r"\b" + F90_NUMBER_ALL_RE + "_(" + "|".join([a + r"\b" for a in ( F90_CONSTANTS_TYPES_RE = re.compile( - r"(" + F90_NUMBER_ALL_RE + ")*_(" + "|".join(( + r"(" + F90_NUMBER_ALL_RE + ")_(" + "|".join(( ## F2003 iso_fortran_env constants. ## F2003 iso_c_binding constants. "c_int", "c_short", "c_long", "c_long_long", "c_signed_char", From 2547e92901b46512e391e77e77dd8d8497c47278 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ignacio=20Fdez=2E=20Galv=C3=A1n?= Date: Tue, 18 May 2021 10:41:01 +0200 Subject: [PATCH 5/5] Recognize "external" as declaration --- fprettify/__init__.py | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/fprettify/__init__.py b/fprettify/__init__.py index 0a8db81..a7d3745 100644 --- a/fprettify/__init__.py +++ b/fprettify/__init__.py @@ -195,6 +195,7 @@ PRIVATE_RE = re.compile(SOL_STR + r"PRIVATE\s*::", RE_FLAGS) PUBLIC_RE = re.compile(SOL_STR + r"PUBLIC\s*::", RE_FLAGS) +EXTERNAL_RE = re.compile(SOL_STR + r"EXTERNAL\s*::", RE_FLAGS) ATTR_RE = re.compile(SOL_STR + r"(ALLOCATABLE|DIMENSION|EXTERNAL|IMPORT|INTENT|INTRINSIC|OPTIONAL|PARAMETER|POINTER|PRIVATE|PUBLIC|SAVE|TARGET)(\s+|\(|::)", RE_FLAGS) PROC_RE = re.compile(SOL_STR + r"(MODULE\s+)?(PROCEDURE)(\s+|\(|::)", RE_FLAGS) @@ -745,7 +746,7 @@ def process_lines_of_fline(self, f_line, lines, rel_ind, line_nr): self.__init_line(line_nr) - is_decl = VAR_DECL_RE.search(f_line) or PUBLIC_RE.search(f_line) or PRIVATE_RE.match(f_line) + is_decl = VAR_DECL_RE.search(f_line) or PUBLIC_RE.search(f_line) or PRIVATE_RE.match(f_line) or EXTERNAL_RE.match(f_line) is_use = USE_RE.search(f_line) for pos, line in enumerate(lines): self.__align_line_continuations(