#!/usr/bin/perl
# Fortran95 coding style tester for the Pencil Code style.
# Currently, only basic checks are performed, e.g. indentation.
# Feel free to add more tests carefully.
#
# More general information about good Fortran95 coding style:
# https://code.google.com/p/pencil-code/wiki/CodingStyle
#
# Command-line arguments:
# -a: automatic correction, where possible
# -b: backups original, if changes are applied
# -o: old style
# -n: new style
# -c: comment empty lines
# -i: indent after 'contains'
# -l: loose checking
# -f: fatal errors only
# -q: quiet
# -s: summary only
# -v: verbose ouput
# -d: debug ouput
#
# 17.11.2014, Bourdin.KIS: coded.
# $Id$

use strict;

# settings
my $indentation_str = '  ';
my $continuation_str = '    ';
my $tab_to_spaces_str = '        ';
my $comment_str = '! ';
my $max_line_length = 132;
my $preferred_line_length = 80;
my $routine_separator_length = $preferred_line_length - length ($comment_str);
my @trigger_indent = ('program', 'module', 'interface', 'type', 'subroutine', 'function', 'where', 'do', 'repeat', 'if', 'select');
my @trigger_unindent = ('program', 'module', 'interface', 'type', 'subroutine', 'function', 'where', 'do', 'if', 'select');
my @data_types = ('integer', 'real', 'logical', 'character', 'double precision');
my %require_separator = ('.and.' => '', '.or.' => '', '.not.' => '', '.true.' => '', '.false.' => '', '.eqv.' => '', '.neqv.' => '', '.in.' => '');
my $name = 'a-zA-Z0-9_';
my %require_spaces = ('=' => '<>/=', '>' => '=', '<' => '=', '>=' => '', '<=' => '', '==' => '=', '/=' => '=', 'inquire' => $name.'%', 'open' => $name.'%', 'close' => $name.'%', 'read' => $name.'%', 'write' => $name.'%', '::' => ':');
my @require_declaration_left_space = ('pointer', 'save', 'parameter', 'dimension', 'allocatable');
my %require_declaration_right_separator = ('dimension' => '(', 'intent' => '(', 'character' => '(', 'integer' => '(', 'real' => '(', 'complex' => '(');
my %replace = ('.gt.' => ' > ', '.lt.' => ' < ', '.ge.' => ' >= ', '.le.' => ' <= ', '.eq.' => ' == ', '.ne.' => ' /= ', '.AND.' => '.and.', '.OR.' => '.or.', '.NOT.' => '.not.', '.TRUE.' => '.true.', '.FALSE.' => '.false.', '.EQV.' => '.eqv.', '.NEQV.' => '.neqv.', '.IN.' => '.in.');

# default command line arguments settings
my $comment_empty_lines = 1;
my $indent_after_contains = 1;
my $header_before_routine = 0;
my $old_style = 1;
my $loose_check = 0;
my $fatals_only = 0;
my $auto_correct = 0;
my $quiet = 0;
my $recursive = 0;
my $summary_only = 0;
my $backup = 0;
my $verbose = 0;
my $faulty = 0;

# parse command line arguments
while ($ARGV[0] =~ /^-/) {
	my $argument = shift ();
	if ($argument =~ s/^(-.)(.+)$/${1}/s) { unshift (@ARGV, '-'.$2); }
	if (lc ($argument) eq '-l') { $loose_check = 1; }
	elsif (lc ($argument) eq '-f') { $fatals_only = 1; }
	elsif (lc ($argument) eq '-c') { $comment_empty_lines = 1; }
	elsif (lc ($argument) eq '-i') { $indent_after_contains = 1; }
	elsif (lc ($argument) eq '-v') { if ($verbose < 1) { $verbose = 1; } }
	elsif (lc ($argument) eq '-d') { $verbose = 2; }
	elsif (lc ($argument) eq '-q') { $quiet = 1; }
	elsif (lc ($argument) eq '-r') { $recursive = 1; }
	elsif (lc ($argument) eq '-s') { $summary_only = 1; }
	elsif (lc ($argument) eq '-a') { $auto_correct = 1; }
	elsif (lc ($argument) eq '-b') { $backup = 1; }
	elsif (lc ($argument) eq '-n') {
		warn ("WARNING: NEW STYLE activated!\n");
		$comment_empty_lines = 0;
		$indent_after_contains = 0;
		$header_before_routine = 1;
		$old_style = 0;
	}
	elsif (lc ($argument) eq '-o') {
		$comment_empty_lines = 1;
		$indent_after_contains = 1;
		$header_before_routine = 0;
		$old_style = 1;
	}
	else {
		warn ('ERROR: Option "'.$argument.'" unkown ...'."\n");
		$faulty = 1;
	}
}
my $num_files = @ARGV;
if ($faulty || !$num_files) {
	usage ('');
	exit (1);
}

# initialize globals
if ($indent_after_contains) {
	push (@trigger_indent, 'contains');
}
my %state = ();
my @lines = [''];
my @line_numbers = [0];
my $pos = 0;
my $num_warnings = 0;
my $num_fixed = 0;
my $num_accumulative = 0;
my $num_fatals = 0;
my $indentation = length ($indentation_str);
my $num_trigger_indent = @trigger_indent;

my $num_file = 0;
my $exit_code = 0;

# process command-line arguments
while (my $argument = shift ()) {
	# replacement of filename abbreviations
	my $PENCIL_HOME = $ENV{'PENCIL_HOME'};
	$argument =~ s/^\s*src\s*$/${PENCIL_HOME}\/src\//is;
	$argument =~ s/^\s*all\s*$/\./is;
	scan_directory ($argument);
}
exit ($exit_code);


sub usage {
	my ($message) = @_;
	if ($message) { warn ($message."\n"); }
	my $script_name = $0;
	$script_name =~ s/^.*\///s;
	warn ('Usage: '.$script_name.' [-options] filename'."\n");
	warn ('Options:'."\n");
	warn ('    -a: automatic correction, where possible'."\n");
	warn ('    -b: backups original, if changes are applied'."\n");
	warn ('    -o: old style'."\n");
	warn ('    -n: new style'."\n");
	warn ('    -c: comment empty lines'."\n");
	warn ('    -i: indent after \'contains\''."\n");
	warn ('    -l: loose checking'."\n");
	warn ('    -f: fatal errors only'."\n");
	warn ('    -q: quiet'."\n");
	warn ('    -r: recursive checking through subdirectories'."\n");
	warn ('    -s: summary only'."\n");
	warn ('    -v: verbose ouput'."\n");
	warn ('    -d: debug ouput'."\n");
	warn ('Possible filenames:'."\n");
	warn ('    run.f90   : check only "run.f90" in the current directory'."\n");
	warn ('    .         : check all Fortran files in the current directory'."\n");
	warn ('    all       : check all Fortran files in the current directory (same as ".")'."\n");
	warn ('    *.f90 *.h : check Fortran and header files in the current directory'."\n");
	warn ('    src       : check Fortran files in "$PENCIL_HOME/src/" and subdirectories'."\n");
}

sub scan_directory {
	my ($dir_entry) = @_;

	# scan recursively through subdirectories
	if (-d $dir_entry) {
		$dir_entry =~ s/[\/\s]*$//s;

		# count the files in this directory
		my @dirlist = ( glob ($dir_entry."/*.f90"), glob ($dir_entry."/*.f"), glob ($dir_entry."/*.h") );
		$num_files += $#dirlist;

		# iterate over subdirectories
		my @dirlist = glob ($dir_entry."/*");
		foreach my $subdir_entry (@dirlist) {
			if ($subdir_entry =~ /^\.{1,2}\/?$/s) { next; }
			if (-d $subdir_entry && $recursive) {
				scan_directory ($subdir_entry);
			}
		}

		# process the files in this directory
		my @dirlist = ( glob ($dir_entry."/*.f90"), glob ($dir_entry."/*.f"), glob ($dir_entry."/*.h") );
		foreach my $subdir_entry (@dirlist) {
			scan_file ($subdir_entry);
		}
	}
	else {
		# process entry as file
		if (!-e $dir_entry) { die ('No such file or directory: "'.$dir_entry.'"'."\n"); }
		if (!-f $dir_entry) { die ('Not a file: "'.$dir_entry.'"'."\n"); }
		$num_files++;
		scan_file ($dir_entry);
	}
}

sub scan_file {
	my ($filename) = @_;

	# print file header
	if (!$quiet || $summary_only) {
		print ('========================================================================'."\n");
		print ('File "'.$filename.'":'."\n");
	}

	# sanity check
	if (!-e $filename) { die ('No such file: "'.$filename.'"'."\n"); }
	if (!-f $filename) { die ('Not a file: "'.$filename.'"'."\n"); }

	# parse and auto-correct a file
	parse_file ($filename);
	if (!$summary_only && ((!$fatals_only && $num_accumulative) || $num_fatals)) {
		warn ('File "'.$filename.'":'."\n");
	}
	if (!$quiet || $summary_only || (!$fatals_only && $num_accumulative) || $num_fatals) {
		print STDERR ('=> ');
	}
	if ($auto_correct && !$num_fatals) {
		write_file ($filename);
	}

	# print statistics
	print_num_warnings ();
}

sub parse_file {
	my ($filename) = @_;

	# reset global state
	$state{'indent'} = 0;
	$state{'indent_str'} = '';
	$state{'nesting'} = '';
	$state{'last_nesting'} = '';
	$state{'continuation'} = 0;
	$state{'multiline_if'} = 0;
	$state{'multiline_where'} = 0;
	$state{'multiline_elseif'} = 0;
	$state{'multiline_declaration'} = 0;
	$state{'else_branch'} = '';
	$state{'eol_comment'} = 0;
	$state{'complete_line'} = '';
	$state{'comment_block_length'} = 0;
	$state{'routine_declaration'} = 1;
	$state{'routine_header'} = 0;
	$state{'routine_footer'} = 0;
	$state{'header_file'} = 0;

	# header file
	if ($filename =~ /\.h$/is) {
		$state{'header_file'} = 1;
		add_nesting ('');
	}

	# read file
	$num_file++;
	my $num_lines = 0;
	my $orig_line_number = 0;
	@lines = [''];
	open (FILE, '< '.$filename);
	while (defined (my $line = <FILE>)) {
		$num_lines++;
		$orig_line_number++;
		$line =~ s/\n$//s;
		# split multi-line commands
		my $clean_line = cut_comment ($line);
		while ($clean_line =~ s/^(.*?) *\; */\{auto-indent}/s) {
			$line =~ s/^(.*?) *\; */\{auto-indent}/s;
			$lines[$num_lines] = $1.'{remove-MLC}';
			$line_numbers[$num_lines] = $orig_line_number;
			$num_lines++;
		}
		$lines[$num_lines] = $line;
		$line_numbers[$num_lines] = $orig_line_number;
	}
	close (FILE);

	# parse and check file line by line
	for ($pos = 1; $pos <= $num_lines; $pos++) {

		# reset per-line state
		$state{'fixed_multiple_commands'} = 0;
		$state{'num_warnings'} = 0;
		$state{'num_fixed'} = 0;
		$state{'num_accumulative'} = 0;
		$state{'num_fatals'} = 0;

		# white-spaces
		if ($lines[$pos] =~ /\r$/s) {
			warning ("convert to 'unix EOL'-format");
			$lines[$pos] =~ s/\r$//s;
		}
		if ($lines[$pos] =~ /\r/s) {
			warning ("unallowed 'carriage-return' character");
			$lines[$pos] =~ s/\r//gs;
		}
		if ($lines[$pos] =~ /\f/s) {
			warning ("unallowed 'form-feed' character");
			$lines[$pos] =~ s/\f//gs;
		}
		if ($lines[$pos] =~ /\t/s) {
			warning ("unallowed 'tabulator' character");
			$lines[$pos] =~ s/\t/${tab_to_spaces_str}/gs;
		}
		if ($lines[$pos] =~ /\s+$/s) {
			warning ("remove 'spaces' at end of line");
			$lines[$pos] =~ s/\s*$//s;
		}
		if ($lines[$pos] =~ / +,/s) {
			warning ("remove 'spaces' before a comma");
			$lines[$pos] =~ s/ +,/,/s;
		}

		# comments
		if ($comment_empty_lines && ($lines[$pos] =~ /^ *$/)) {
			# empty line
			warning ("empty lines should have a '!' in front");
			$lines[$pos] = '!';
		}
		my $no_strings = cut_strings ($lines[$pos]);
		if ($no_strings =~ /^( +)\!/s) {
			my $spaces = $1;
			my $num_spaces = length ($spaces);
			if ($num_spaces != $state{'indent'}) {
				if (($state{'eol_comment'} > 0) && ($num_spaces > $state{'indent'})) {
					# multi-line comment block with extra indentation
					picky_fixme_warning ("no extra indentation for multi-line comment blocks");
				}
				else {
					warning ("comments start either at the beginning of a line or at the correct indentation level");
					if (($num_spaces > $state{'indent'}*4/3) && ($num_spaces >= 4)) {
						$spaces = $state{'indent_str'};
					}
					else {
						$spaces = '';
					}
					$lines[$pos] =~ s/^ +\!/${spaces}\!/s;
				}
			}
			elsif ($lines[$pos] =~ s/^ +\!$/\!/s) {
				picky_warning ("empty comment lines start at the beginning of a line");
			}
		}
		if ($lines[$pos] =~ /^ *\!\!+ */s) {
			# double commenting
			picky_warning ("comments start with only one 'exclamation mark'");
			$lines[$pos] =~ s/^( *\!)\!+ */${1} /s;
		}
		if (!$old_style && $state{'routine_footer'}) {
			# routine separator line
			if ($lines[$pos] =~ /^ *\! *\*[ \*]{11,}$/s) {
				if ($lines[$pos] !~ /^\! \*{${routine_separator_length}}$/s) {
					picky_warning ("non-standard separator line after the end of a routine");
					$lines[$pos] = $comment_str.('*' x $routine_separator_length);
				}
			}
			else {
				if ($lines[$pos-1] =~ /^ *contains$/is) {
					warning ("separator line required after 'contains'");
				}
				else {
					warning ("separator line required after the end of a routine");
				}
				if ($lines[$pos] =~ s/^[ \!]*$/{remove-me}/s) {
					warning ("no empty line allowed after 'contains'");
					next;
				}
				$lines[$pos-1] .= "\n".$comment_str.('*' x $routine_separator_length);
			}
		}
		$state{'routine_footer'} = 0;
		if ($lines[$pos] =~ /^ *\!/s) {
			# this line contains only a comment
			$state{'comment_block_length'}++;
			if ($state{'routine_header'}) { $state{'routine_header'}++; }
			next;
		}
		my $before = $state{'comment_block_length'};
		if (!$state{'eol_comment'} && !$state{'routine_header'} && ($before >= 1) && ($before <= 3)) {
			if ($lines[$pos-$before] =~ s/^ *(\!?)$/${1}/s) {
				# empty comment line
				if (!$comment_empty_lines) {
					$pos -= $before;
					warning ("empty lines shall stay empty");
					$lines[$pos] = '';
					$pos += $before;
				}
				# single line comment
				my $pre = $state{'indent'};
				if (!$old_style && (($before == 2) || (($before == 3) && ($lines[$pos-1] =~ /^ *\!?$/s)))) {
					if ($lines[$pos-$before+1] !~ /^ {${pre}}\! *([^ ].*)$/s) {
						if ($lines[$pos-$before+1] =~ /^ *\! *([^ ].*)$/s) {
							my $comment = $1;
							$pos -= $before-1;
							warning ("single-line comments shall be indented");
							$lines[$pos] = $state{'indent_str'}.$comment_str.$comment;
							$pos += $before-1;
						}
					}
					if ($before == 3) {
						$pos--;
						warning ("single-line comments are not followed by an empty line");
						$lines[$pos] = '{remove-me}';
						$pos++;
					}
				}
			}
		}
		if (!$state{'eol_comment'} && ($state{'routine_header'} == 2) && ($lines[$pos] =~ /^[ \!]*$/s)) {
			# routine start
			warning ("no empty lines after the beginning of a routine");
			$lines[$pos] = '{remove-me}';
			$state{'routine_header'} = 0;
		}
		if ($header_before_routine && !$state{'eol_comment'} && ($state{'routine_header'} >= 2)) {
			# routine header
			$pos--;
			warning ("routine headers reside ahead of the routine they describe");
			my $routine = $lines[$pos-$state{'routine_header'}+1];
			my $warning_given = 0;
			my $just_started = 1;
			for (my $move = $state{'routine_header'}-1; $move >= 1; $move--) {
				$lines[$pos-$move] = $lines[$pos-$move+1];
				if ($just_started && ($lines[$pos-$move] =~ /^[ \!]*$/s)) {
					if (!$warning_given) {
						warning ("no empty lines after a routine separator line");
						$warning_given = 1;
					}
					$lines[$pos-$move] = '{remove-me}';
				}
				else {
					$just_started = 0;
				}
			}
			if ($lines[$pos-1] !~ /^[ \!]+$/s) {
				warning ("one empty line is required after the routine header");
				$lines[$pos-1] .= "\n";
				if ($comment_empty_lines) { $lines[$pos-1] .= '!'; }
			}
			else {
				if (!$comment_empty_lines) { $lines[$pos-1] =~ s/^[ \!]+$//s; }
			}
			$lines[$pos] = $routine;
			$pos++;
		}
		$state{'routine_header'} = 0;
		if ($lines[$pos] =~ /^ *(?:subroutine|function) /is) {
			$state{'routine_declaration'} = 1;
			$state{'routine_header'} = 1;
			# empty lines after routine header
			if ($lines[$pos-1] =~ s/^ *(\!?)$/${1}/s) {
				my $found = $1;
				if (!$comment_empty_lines && $found) {
					warning ("a routine header does not end with an empty comment line");
					$lines[$pos-1] = '';
				}
				my $back = 2;
				my $warning_given = 0;
				while ($lines[$pos-$back] =~ s/^[ \!]*$/\{remove-me}/s) {
					if (!$warning_given) {
						warning ("exactly one empty line is required between the header and its routine");
						$warning_given = 1;
					}
					$back++;
				}
			}
		}
		my $min_block_length = 2;
		if ($old_style) { $min_block_length = 3; }
		if (($state{'comment_block_length'} > $min_block_length) || (($state{'comment_block_length'} == $min_block_length) && (!$old_style || ($lines[$pos] =~ /^[ \!]*$/s)))) {
			# multi-line comment
			my $before = $state{'comment_block_length'};
			if ($lines[$pos-$before] =~ /^(\!?)$/s) {
				# start of multi-line comment
				my $found = $1;
				if (!$comment_empty_lines && $found) {
					$pos -= $before;
					warning ("multi-line comment blocks do not start with an empty comment line");
					$lines[$pos] = '';
					if ($lines[$pos-1] =~ /^[ \!]*$/s) { $lines[$pos] = '{remove-me}'; }
					$pos += $before;
				}
				my $back = 1;
				my $warning_given = 0;
				while ($lines[$pos-$before+$back] =~ s/^[ \!]*$/\{remove-me}/s) {
					if (!$warning_given) {
						$pos -= $before-$back;
						if ($comment_empty_lines) {
							warning ("multi-line comment blocks start with at maximum one empty comment line");
						}
						else {
							warning ("multi-line comment blocks start with at maximum one empty line");
						}
						$pos += $before-$back;
						$warning_given = 1;
					}
					$back++;
				}
			}
			if ($lines[$pos-1] =~ /^(\!?)$/s) {
				# end of multi-line comment
				my $found = $1;
				if (!$comment_empty_lines && $found) {
					$pos--;
					warning ("a multi-line comment does not end with an empty comment line");
					$lines[$pos] = '';
					if ($lines[$pos+1] =~ /^[ \!]*$/s) { $lines[$pos] = '{remove-me}'; }
					$pos++;
				}
				my $back = 2;
				my $warning_given = 0;
				while ($lines[$pos-$back] =~ s/^[ \!]*$/\{remove-me}/s) {
					if (!$warning_given) {
						$pos -= $back;
						if ($comment_empty_lines) {
							warning ("a multi-line comment ends with at maximum one empty comment line");
						}
						else {
							warning ("a multi-line comment ends with at maximum one empty line");
						}
						$pos += $back;
						$warning_given = 1;
					}
					$back++;
				}
			}
		}
		$state{'comment_block_length'} = 0;
		if ($no_strings =~ /\S *\!/s) {
			# comment at end of line
			picky_fixme_warning ("avoid end-of-line comments");
			$state{'eol_comment'}++;
			if ($no_strings =~ s/(\S)( *)(\!{2,})( *)(.*)$/${1} ! ${5}/s) {
				my $pre = $2;
				my $num_exclam = length ($3);
				my $post = $4;
				$lines[$pos] =~ s/(\S)${pre}\!{${num_exclam}}${post}(.*)$/${1} ! ${2}/s;
				picky_warning ("end-of-line comments start with only one exclamation mark");
			}
		}
		else {
			$state{'eol_comment'} = 0;
		}

		# replace
		while (my ($search, $replace) = each (%replace)) {
			my $pattern = regex_escape ($search);
			if (lc ($search) eq lc ($replace)) {
				if ($lines[$pos] =~ /${pattern}/s) {
					warning ("replace '".$search."' by '".$replace."'");
					$lines[$pos] =~ s/${pattern}/${replace}/gs;
				}
			}
			else {
				if ($lines[$pos] =~ /${pattern}/is) {
					warning ("replace '".$search."' by '".$replace."'");
					$lines[$pos] =~ s/${pattern}/${replace}/gis;
				}
			}
		}

		# require spaces
		while (my ($item, $exclude) = each (%require_spaces)) {
			if (!$exclude) { $exclude = $item; }
			$exclude = regex_escape ($exclude);
			my $clear_line = cut_initialization ($lines[$pos]);
			if ($item eq '=') {
				$clear_line = cut_brackets ($clear_line);
			}
			my $warning_given = 0;
			while ($clear_line =~ s/^(.*?[^ ${exclude}])(${item}[^${exclude}])/${1} ${2}/is) {
				my $pre = length ($1);
				if (!$warning_given) {
					picky_warning ("'".$item."' should be surrounded by spaces for readability");
					$warning_given = 1;
				}
				$lines[$pos] =~ s/^(.{${pre}})(${item}[^${exclude}])/${1} ${2}/is;
			}
			while ($clear_line =~ s/^(.*?[^${exclude}]${item})([^ ${exclude}])/${1} ${2}/is) {
				my $pre = length ($1);
				if (!$warning_given) {
					picky_warning ("'".$item."' should be surrounded by spaces for readability");
					$warning_given = 1;
				}
				$lines[$pos] =~ s/^(.{${pre}})([^ ${exclude}])/${1} ${2}/is;
			}
		}

		# use declaration
		if ($lines[$pos] =~ /^ *use +[${name}]+( *, *)only([ :].*)$/is) {
			my $pre = $1;
			my $post = $2;
			if ($pre =~ s/^ +//s) {
				picky_warning ("a comma is not preceeded by spaces within a 'use'-statement");
				$lines[$pos] =~ s/^( *use +[${name}]+) +(, *only[ :])/${1}${2}/is;
			}
			if ($pre =~ /^,$/s) {
				picky_warning ("'only' requires a space left to it within a 'use'-statement");
				$lines[$pos] =~ s/^( *use +[^:]*,)only([ :])/${1} only${2}/is;
			}
			if (!$old_style && ($pre =~ /^,  +/s)) {
				picky_warning ("'only' requires only one space left to it within a 'use'-statement");
				$lines[$pos] =~ s/^( *use +[^:]*,) +only([ :])/${1} only${2}/is;
			}
			if ($post =~ s/^ +//s) {
				picky_warning ("'only' is not followed by spaces within a 'use'-statement");
				$lines[$pos] =~ s/^( *use +[^:]*,) *only *:/${1} only:/is;
			}
			if ($post =~ /^:(?:[^ ]|  +)/s) {
				picky_warning ("'only' is followed by a colon and exactly one space within a 'use'-statement");
				$lines[$pos] =~ s/^( *use +[^:]*,) *only: */${1} only: /is;
			}
		}

		# variable declaration
		my $code_line = cut_comment ($lines[$pos]);
		if (($code_line =~ /::/s) || $state{'multiline_declaration'}) {
			$state{'multiline_declaration'} = 0;
			if ($code_line =~ /\&$/s) { $state{'multiline_declaration'} = 1; }
			# require spaces around ::
			my $warning_given = 0;
			my $test_line = $code_line;
			$test_line =~ s/ *:: ?/ :: /s;
			if ($test_line ne $code_line) {
				$code_line = $test_line;
				$lines[$pos] =~ s/ *:: ?/ :: /s;
				if (!$warning_given) {
					picky_warning ("'::' is surrounded by at least one space in a variable declaration for readability");
					$warning_given = 1;
				}
			}
			$test_line = '';
			# comma-separated list of variables
			$code_line = cut_brackets ($code_line);
			while ($code_line =~ /^(.*?[^ ]) *,(?:[^ ]|[ ,]{2,})[^ ]/s) {
				my $pre = length ($1);
				if (!$warning_given) {
					picky_warning ("',' is followed by one space in a variable declaration for readability");
					$warning_given = 1;
				}
				$code_line =~ s/^(.{${pre}}) *,[ ,]*(?=[^ ])/${1}, /s;
				$lines[$pos] =~ s/^(.{${pre}}) *,[ ,]*(?=[^ ])/${1}, /s;
			}
			# require right separator without space in variable declaration
			my $init_line = cut_initialization ($code_line);
			while (my ($item, $separator) = each (%require_declaration_right_separator)) {
				if (!$separator) { $separator = '('; }
				my $follow = regex_escape ($separator);
				my $warning_given = 0;
				while ($init_line =~ s/^(.*?[ ,]${item}) +([${follow}])/${1}${2}/is) {
					my $pre = length ($1);
					my $found = $2;
					if (!$warning_given) {
						picky_warning ("there is no space between '".$item."' and '".$found."'");
						$warning_given = 1;
					}
					$code_line =~ s/^(.{${pre}}) +([${follow}])/${1}${2}/is;
					$lines[$pos] =~ s/^(.{${pre}}) +([${follow}])/${1}${2}/is;
				}
			}
			# require left spaces in variable declaration
			foreach my $item (@require_declaration_left_space) {
				my $warning_given = 0;
				while ($init_line =~ s/^(.*?[^ ${name}])(${item}[ ,:])/${1} ${2}/is) {
					my $pre = length ($1);
					if (!$warning_given) {
						picky_warning ("'".$item."' should have a space left to it for readability");
						$warning_given = 1;
					}
					$code_line =~ s/^(.{${pre}})(${item}[ ,:])/${1} ${2}/is;
					$lines[$pos] =~ s/^(.{${pre}})(${item}[ ,:])/${1} ${2}/is;
				}
			}
			# old-style variable declaration
			my $type_list = join ('|', @data_types);
			$type_list =~ s/ / \+/gs;
			if ($lines[$pos] =~ / (${type_list}) *\* *(\d+)/is) {
				my $found_type = lc ($1);
				my $found_number = $2;
				if ($found_type eq 'character') {
					warning ("old-style variable declaration '".$found_type.'*'.$found_number."' => use 'character(len=".$found_number.")'");
					$lines[$pos] =~ s/ character *\* *\d+/ character\(len=${found_number}\)/is;
				}
				else {
					accumulative_fatal ("old-style variable declaration '".$found_type.'*'.$found_number."' => replace with e.g.'".$found_type."(kind=...)'");
				}
			}
			# convert declaration-keywords to small letters
			if ($lines[$pos] =~ / character *\( *(LEN) *=/is) {
				my $found = $1;
				if ($found =~ /[A-Z]/s) {
					picky_warning ("'character(".$found."=...)' should be written in small letters");
					$found = lc ($found);
					$lines[$pos] =~ s/( character *\() *${found} *=/${1}${found}=/gis;
				}
			}
			if ($lines[$pos] =~ / intent *\( *(IN|OUT|INOUT) *\)/is) {
				my $found = $1;
				if ($found =~ /[A-Z]/s) {
					picky_warning ("'intent(".$found.")' should be written in small letters");
					$found = lc ($found);
					$lines[$pos] =~ s/( intent *\() *${found} *\)/${1}${found})/gis;
				}
			}
			# put '(len=...)' after 'character(...)'
			if ($lines[$pos] =~ / character *\( *(\d+|\*)\** *\)/is) {
				my $found = $1;
				picky_warning ("write 'character(len=".$found.")' instead of 'character(".$found.")'");
				$lines[$pos] =~ s/( character) *\( *(\d+|\*)\** *\)/${1}(len=${2})/gis;
			}
		}

		# require separator
		while (my ($item, $separator) = each (%require_separator)) {
			if (!$separator) { $separator = ' ()=,'; }
			$separator = regex_escape ($separator);
			my $pattern = regex_escape ($item);
			my $warning_given = 0;
			while ($lines[$pos] =~ /[^${separator}]${pattern}/is) {
				if (!$warning_given) {
					warning ("separator is required before and after '".$item."'");
					$warning_given = 1;
				}
				$lines[$pos] =~ s/([^ \(\)=,])${pattern}/${1} ${item}/is;
			}
			while ($lines[$pos] =~ /${pattern}[^ \(\)=,]/is) {
				if (!$warning_given) {
					warning ("separator is required before and after '".$item."'");
					$warning_given = 1;
				}
				$lines[$pos] =~ s/${pattern}([^ \(\)=,])/${item} ${1}/is;
			}
		}

		# jumping around
		if ($lines[$pos] =~ /, *end *=/is) {
			accumulative_fatal ("'end=' is deprecated => use 'iostat=' instead, a conditional 'exit' may help in loops");
		}
		if ($lines[$pos] =~ /, *err *=/is) {
			accumulative_fatal ("'err=' is deprecated => use 'iostat=' instead, a conditional 'exit' may help in loops");
		}

		# format strings
		if ($lines[$pos] =~ /, *fmt *= *(\d+)/is) {
			accumulative_fatal ("'fmt=".$1."' is deprecated => better move the format string directly there");
		}

		# absolutely forbidden
		if ($lines[$pos] =~ /(?:^| )goto /is) {
			accumulative_fatal ("'goto' is absolutely forbidden => use proper control structures, like 'if-else' or 'do-while-repeat'");
		}
		if ($lines[$pos] =~ /(?:^| )entry /is) {
			accumulative_fatal ("'entry' is absolutely forbidden => use 'interface' instead");
		}

		# indentation
		if (check_closed_nesting ($lines[$pos])) { return; }
		if ($state{'indent'} < 0) {
			fatal ("surplus 'end' => indentation became negative");
			return;
		}
		my $start_spaces = $state{'indent_str'};
		if ($state{'continuation'} > 0) {
			if ($state{'routine_declaration'}) { $start_spaces =~ s/${indentation_str}$//s; }
			$start_spaces .= $continuation_str;
		}
		if ($lines[$pos] && ($lines[$pos] !~ /^${start_spaces}\S/s)) {
			if (($state{'continuation'} == 0) && ($lines[$pos] =~ /^( *(\d+) +)\S/s)) {
				# numeric label
				my $indent_level = length ($1);
				my $label = $2;
				fixme_warning ("numeric labels are deprecated => use proper control structures, like 'if-else' or 'do-while-repeat'");
				if ($indent_level != $state{'indent'}) {
					warning ("wrong indentation level");
					my $add_spaces = ' ' x (length ($start_spaces) - length ($label));
					$lines[$pos] =~ s/^ *(\d+) +/${1}${add_spaces}/s;
				}
			}
			elsif (($state{'continuation'} <= 1) || (($state{'continuation'} >= 2) && ($lines[$pos] !~ /^${start_spaces}${continuation_str}\S/s))) {
				# regular line
				if ($verbose) { warn ("NESTING:".$state{'nesting'}." INDENT:".$state{'indent'}."\n"); }
				if ($lines[$pos] !~ /^ *<(?:auto-indent|remove-me)>/s) {
					warning ("wrong indentation level");
				}
				$lines[$pos] =~ s/^ *(?:\{auto-indent} *)?/${start_spaces}/s;
			}
		}
		if (check_new_nesting ($lines[$pos])) { return; }

		# routine ending
		if ($lines[$pos] =~ /^ *end(?:subroutine|function)(?: |$)/is) {
			$pos--;
			if (!$old_style && ($lines[$pos] =~ /^[ \!]*$/s)) {
				picky_warning ("there is no empty line before the end of a routine");
				$lines[$pos] = '{remove-me}';
			}
			$pos++;
			$state{'routine_footer'} = 1;
		}
		if ($lines[$pos] =~ /^ *contains$/is) { $state{'routine_footer'} = 1; }

		# multiple commands per line
		if (!$state{'fixed_multiple_commands'} && ($lines[$pos] =~ /<remove-MCL>$/s)) {
			picky_warning ("possible multi-command line => better put one command per line");
			$lines[$pos] =~ s/ *<remove-MCL>$//s;
		}

		# continuation line sign
		if ($lines[$pos] =~ /[^ ]\&$/s) {
			picky_warning ("'&' requires a space in front of it");
			$lines[$pos] =~ s/([^ ])\&$/${1} \&/s;
		}

		# construct complete line
		$state{'complete_line'} .= $lines[$pos];
		$state{'complete_line'} =~ s/ *\&$//s;
		$state{'complete_line'} =~ s/(\S) {2,}/${1} /gs;

		# continued line
		if ($lines[$pos] =~ /\&$/s) {
			$state{'continuation'}++;
			if ($state{'routine_declaration'}) { $state{'routine_declaration'}++; }
		}
		else {
			if ($state{'continuation'}) {
				# end of continuation
				if (($lines[$pos] =~ /[^&]$/s) && (length ($state{'complete_line'}) <= $preferred_line_length)) {
					# unneeded breaking
					warning ("unneeded continuation-line break");
					for (my $remove = 1; $remove <= $state{'continuation'}; $remove++) {
						$lines[$pos-$remove] = '{remove-me}';
					}
					$lines[$pos] = $state{'complete_line'};
				}
			}
			$state{'continuation'} = 0;
			$state{'complete_line'} = '';
			$state{'routine_declaration'} = 0;
		}

		# line length
		if (length ($lines[$pos]) >= $max_line_length) {
			accumulative_fatal ("line longer than ".$max_line_length." characters (including newline character)");
		}
	}

	# test for open indentation
	if ($state{'header_file'} && ($state{'nesting'} =~ s/^\|//s)) { remove_nesting (); }
	if ($state{'nesting'} ne '') {
		$pos = $num_lines;
		my $last_nesting = '';
		if ($state{'nesting'} =~ /([^\|]+)\|+$/s) { $last_nesting = $1; }
		accumulative_fatal ("indentation is still open at EOF => missing 'end".$last_nesting."'-statement");
	}

	# file-global checks
	$_ = join ("\n", @lines);
	s/(?:\n *\{remove-me})+//gs;

	# empty else-blocks
	while (/(^.*?\n) *else(|where)(\n\![^\n]*)*\n *end *(|if|where)(?: |\n)/is) {
		my $pre = $1;
		my $type = $2;
		my $empty = $3;
		my $closing = $4;
		$pre =~ s/[^\n]+//gs;
		$pos = length ($pre);
		if ($type && (lc ($closing) ne lc ($type))) {
			$empty =~ s/[^\n]+//gs;
			$pos += length ($empty) + 1;
			fatal ("misplaced 'end".$closing."' after empty 'else".$type."'-block => better use the pure 'end'-statement");
			return;
		}
		warning ("remove empty 'else".$type."'-block");
		s/\n *else${type}(?:\n\![^\n]*)*(\n *end *${closing}(?: |\n))/${1}/is;
	}

	# split into lines again
	@lines = split (/\n/s, $_);
}

sub regex_escape {
	my ($pattern) = (@_);
	$pattern =~ s/([\.\?\*\+\^\$\|\\\(\)\[\{])/\\${1}/gs;
	return ($pattern);
}

sub cut_initialization {
	my ($line) = cut_comment (@_);
	if ($state{'multiline_declaration'}) { $line = ''; }
	$line =~ s/ *::.*$//s;
	return ($line);
}

sub cut_brackets {
	my ($line) = cut_comment (@_);
	if ($line =~ /\(((?:[^_\(\)]|\(_*\))(?:[^\(\)]*(?:\(_*\)[^\(\)]*)*)*)\)/s) {
		my $content = $1;
		if ($content =~ /^_*$/s) { return ($line); }
		my $replace = '_' x length ($content);
		$line =~ s/\(((?:[^_\(\)]|\(_*\))(?:[^\(\)]*(?:\(_*\)[^\(\)]*)*)*)\)/\(${replace}\)/s;
		$line = cut_brackets ($line);
	}
	return ($line);
}

sub cut_comment {
	my ($line) = cut_strings (@_);
	$line =~ s/ *\!.*$//s;
	return ($line);
}

sub cut_strings {
	my ($line) = @_;
	my $old_line = '';
	while ($line =~ /^(.*?)(['"])(.*)$/s) {
		my $pre = $1;
		my $type = $2;
		my $post = $3;
		if ($pre =~ /\!/s) { return ($line); }
		my $fill = '';
		while ($post =~ /^(.*?)${type}(.*)$/s) {
			my $string = $1;
			my $rest = $2;
			if (!$fill) { $fill = '_' x length ($string); }
			$string =~ s/\\\\//gs;
			if ($string !~ s/\\$//s) {
				my $type_str = '';
				if ($type eq '\'') { $type_str = 'apostroph'; }
				if ($type eq '"') { $type_str = 'quote'; }
				$line = $pre.'<type-'.$type_str.'>'.$fill.'<type-'.$type_str.'>'.$rest;
				last;
			}
			$post = $string.$rest;
		}
		if ($old_line eq $line) { last; }
		$old_line = $line;
	}
	$line =~ s/<type-quote>/"/gis;
	$line =~ s/<type-apostroph>/'/gis;
	return ($line);
}

sub picky_fixme_warning {
	my ($message) = @_;
	if ($loose_check) { return; }
	fixme_warning ("picky: ".$message);
}

sub picky_warning {
	my ($message) = @_;
	if ($loose_check) { return; }
	warning ("picky: ".$message);
}

sub fixme_warning {
	my ($message) = @_;
	print_warning ($message);
	if ($num_fatals) { perish (); }
}

sub warning {
	my ($message) = @_;
	if ($auto_correct) {
		$message = "fixed: ".$message;
		$message =~ s/^ *([^ :]+): +([^ :]+): +(.*)$/${1}: ${3} (${2})/is;
	}
	$num_fixed++;
	$state{'num_fixed'}++;
	print_warning ($message);
	if ($num_fatals) { perish (); }
}

sub print_warning {
	my ($message) = @_;
	if ($fatals_only && ($message !~ /^FATAL: /s)) { return; }
	$num_warnings++;
	$state{'num_warnings'}++;
	if (!$quiet && !$summary_only) { warn ("[".$line_numbers[$pos]."] ".$message."\n"); }
}

sub write_file {
	my ($filename) = @_;
	if (!$num_fixed) {
		# no automatic changes applied
		if (($num_warnings > 0) || ($num_fatals > 0)) {
			warn ("NO automatic changes applied.\n");
		}
		return;
	}
	if ($backup) {
		# create backup of unchanged file
		my $suffix = '.bak';
		my $backup_file = $filename.$suffix;
		my $counter = 0;
		while (-e $backup_file) {
			$counter++;
			$backup_file = $filename.$suffix.'.'.$counter
		}
		system ('mv "'.$filename.'" "'.$backup_file.'"');
	}
	# write auto-corrected file
	shift (@lines);
	$_ = join ("\n", @lines)."\n";
	open (FILE, '> '.$filename);
	print FILE $_;
	close (FILE);
}

sub print_num_warnings {
	if ((!$quiet && !$fatals_only) || $summary_only) {
		my $num_unfixed = ($num_warnings - $num_fixed);
		if ($auto_correct) {
			if ($num_fixed) {
				if ($num_fatals) {
					warn ($num_fixed." STYLE BREAKS can be fixed automatically, once ".$num_fatals." FATAL ERRORS are resolved manually.\n");
				}
				elsif (!$num_unfixed) {
					warn ("ALL style breaks were FIXED.\n");
				}
				else {
					warn ($num_fixed." style breaks were FIXED.\n");
				}
			}
			if ($num_unfixed) {
				warn ($num_unfixed." STYLE BREAKS need to be fixed manually.\n");
			}
		}
		else {
			if ($num_warnings) {
				warn ($num_warnings." STYLE BREAKS should be fixed.\n");
			}
			if ($num_fixed) {
				if (!$num_unfixed) {
					warn ("ALL of them can be fixed automatically.\n");
				}
				else {
					warn ($num_fixed." of them can be fixed automatically.\n");
				}
			}
			if ($num_unfixed) {
				warn ($num_unfixed." STYLE BREAKS need to be fixed manually.\n");
			}
		}
	}
	if ($num_accumulative || $num_fatals) {
		warn (($num_accumulative + $num_fatals)." FATAL ERRORS still remain for manual fixing!\n");
	}
	elsif (!$quiet && !$num_warnings && !$num_fixed) { warn ("everything OK, congratulations!\n"); }
	$num_warnings = 0;
	$num_fixed = 0;
	$num_accumulative = 0;
	$num_fatals = 0;
}

sub accumulative_fatal {
	my ($message) = @_;
	$num_accumulative++;
	$state{'num_accumulative'}++;
	print_warning ("FATAL: ".$message);
}

sub fatal {
	my ($message) = @_;
	$num_fatals++;
	$state{'num_fatals'}++;
	fixme_warning ("FATAL: ".$message);
	perish ();
}

sub perish {
	$exit_code = 1;
}

sub add_nesting {
	my ($nesting) = @_;
	if ($verbose >= 2) { warn ("[".$line_numbers[$pos]."] ADD: ".$nesting."\n"); }
	$state{'nesting'} .= $nesting.'|';
	$state{'last_nesting'} = $nesting;
	$state{'indent'} += $indentation;
	$state{'indent_str'} .= $indentation_str;
}

sub remove_nesting {
	if ($verbose >= 2) { warn ("[".$line_numbers[$pos]."] REMOVE: ".$state{'last_nesting'}."\n"); }
	$state{'indent'} -= $indentation;
	if ($state{'indent_str'} !~ s/${indentation_str}$//s) {
		fatal ("internal error while reducing the indentation string");
		return (1);
	}
	$state{'last_nesting'} = '';
	if ($state{'nesting'} =~ /([^\|]+)\|$/s) { $state{'last_nesting'} = $1; }
	return (0);
}

sub check_new_nesting {
	my ($line) = cut_comment (@_);
	if ($line =~ /\)then(?: |$)/is) {
		warning ("space is required before 'then'");
		$line =~ s/\)then( |$)/\) then${1}/is;
		$lines[$pos] =~ s/\)then( |$)/\) then${1}/is;
	}
	if ($state{'multiline_if'}) {
		$state{'multiline_if'} = 0;
		if ($line =~ / then$/is) { add_nesting ('if'); }
		if ($line =~ /\&$/s) { $state{'multiline_if'} = 1; }
		return (0);
	}
	if ($state{'multiline_where'}) {
		if ($line !~ /\&$/s) {
			$state{'multiline_where'} = 0;
			my $clean_line = cut_brackets ($state{'complete_line'}.$line);
			if ($clean_line !~ /\(_+\) *\S/s) { add_nesting ('where'); }
		}
		return (0);
	}
	if ($state{'multiline_elseif'}) {
		$state{'multiline_elseif'} = 0;
		if ($line =~ / then$/is) { add_nesting ('if'); }
		if ($line =~ /\&$/s) { $state{'multiline_elseif'} = 1; }
		return (0);
	}
	if ($state{'else_branch'}) {
		add_nesting ($state{'else_branch'});
		$state{'else_branch'} = '';
		return (0);
	}
	for (my $index = 0; $index < $num_trigger_indent; $index++) {
		my $trigger = $trigger_indent[$index];
		my $label = '';
		if ($trigger eq 'contains') {
			if ($line =~ /^ *contains$/is) {
				add_nesting ('');
				last;
			}
		}
		if ($line =~ /^ *([${name}]+) *: *${trigger}(?:[^${name}'"]|$)/is) {
			$label = $1;
			warning ("using labels for '".$trigger."'-statements is not recommended");
			$line =~ s/^( *)${label} *: *(?=${trigger})/${1}/is;
			$lines[$pos] =~ s/^( *)${label} *: *(?=${trigger})/${1}/is;
		}
		if ($line =~ /^ *${trigger}[^ ${name}'"]/is) {
			warning ("space after '".$trigger."'-statement required");
			$line =~ s/^( *${trigger})/${1} /is;
			$lines[$pos] =~ s/^( *${trigger})/${1} /is;
		}
		if ($trigger eq 'function') {
			my $type_list = join ('|', @data_types);
			$type_list =~ s/ / \+/gs;
			my $character_brackets = '(?: *\\([^\\(\\)]+\\))?';
			$type_list =~ s/character(\||$)/character${character_brackets}${1}/s;
			if ($line =~ s/^( *)($type_list) +function /${1}function /is) {
				picky_fixme_warning ("data type '".$2."' belongs inside the 'function' block");
			}
		}
		if (($trigger eq 'subroutine') || ($trigger eq 'function')) {
			$line =~ s/^( *)recursive +/${1}/is;
		}
		if ($line =~ /^ *${trigger} /is) {
			if ($line =~ / *\{remove-MLC}$/s) {
				warning ("put each indentation-sensitive command in a separate line");
				$line =~ s/ *\{remove-MLC}$//s;
				$lines[$pos] =~ s/ *\{remove-MLC}$//s;
				$state{'fixed_multiple_commands'} = 1;
			}
			if (($trigger eq 'module') && ($line =~ /^ *module +procedure /is)) { last; }
			if (($trigger eq 'type') && ($line =~ /::/is)) { last; }
			if (($trigger eq 'if') && ($line =~ /\&$/s)) {
				$state{'multiline_if'} = 1;
				last;
			}
			if (($trigger eq 'if') && ($line !~ / then *$/is)) { last; }
			if (($trigger eq 'where') && ($line =~ /\&$/s)) {
				$state{'multiline_where'} = 1;
				last;
			}
			if ($trigger eq 'where') {
				my $clean_line = cut_brackets ($line);
				if ($clean_line =~ /\(_+\) *\S/s) { last; }
			}
			if ($label) { $trigger .= ' '.$label; }
			add_nesting ($trigger);
			last;
		}
	}
	return (0);
}

sub check_closed_nesting {
	my ($line) = cut_comment (@_);
	$line =~ s/^\{auto-indent}//s;
	my $trigger_list = join ('|', @trigger_unindent);
	my $trigger = '';
	if ($line =~ s/ *\{remove-MLC}$//s) {
		warning ("put each indentation-sensitive command in a separate line");
		$lines[$pos] =~ s/ *\{remove-MLC}$//s;
		$state{'fixed_multiple_commands'} = 1;
	}
	if ($line =~ /^ *end *(${trigger_list})( +[${name}]+)?$/is) {
		$trigger = $1;
		my $label = $2;
		if ($trigger =~ /(?:subroutine|function|module|type)/is) { $label = ''; }
		if ($line =~ s/^( *end) +${trigger}/${1}${trigger}/is) {
			warning ("either use 'end".$trigger."' or a pure 'end'-statement");
			$lines[$pos] =~ s/^( *(?:\{auto-indent} *)?end) +${trigger}/${1}${trigger}/is;
		}
		if ($label) {
			warning ("using labels for 'end".$trigger."'-statements is not recommended");
			$label =~ s/^ */ /s;
			$line =~ s/^( *end${trigger}) *${label}/${1}/is;
			$lines[$pos] =~ s/^( *(?:\{auto-indent} *)?end${trigger}) *${label}/${1}/is;
		}
		if ($state{'nesting'} !~ s/(^|\|)${trigger}${label}(\|+)$/${1}${2}/is) {
			if ($verbose) { warn ("NESTING:".$state{'nesting'}." TRIGGER:".$trigger."\n"); }
			fatal ("misplaced 'end".$trigger.$label."' => expecting 'end".$state{'last_nesting'}."'");
			return (1);
		}
	}
	elsif ($line =~ /^ *end( +\S+)?$/is) {
		my $label = $1;
		if ($label) {
			accumulative_fatal ("nothing should follow after a pure 'end'-statements");
		}
		if ($state{'nesting'} !~ s/(^|\|)[^ \|]+(\|+)$/${1}${2}/s) { 
			fatal ("internal error while removing nesting");
			return (1);
		}
	}
	elsif ($line =~ /^ *else(.*?)$/is) {
		my $else = cut_comment ($1);
		my $type = $state{'last_nesting'};
		if ($else =~ /^ +${type}/s) {
			warning ("better use 'else".$type."' instead of 'else ".$type."'");
			$else =~ s/^ +//is;
			$line =~ s/^( *else) +(${type})/${1}${2}/is;
			$lines[$pos] =~ s/^( *(?:\{auto-indent} *)?else) +(${type})/${1}${2}/is;
		}
		if ($type =~ /^if ([${name}]+)$/is) {
			my $label = $1;
			if ($line =~ /^ *(?:else|else(if) .*? then) +${label} *$/is) {
				my $else_type = $1;
				warning ("using labels for 'else".$else_type."'-statements is not recommended");
				$else =~ s/ +${label} *$//is;
				$line =~ s/ +${label}(.*)$/${1}/is;
				$lines[$pos] =~ s/ +${label}(.*)$/${1}/is;
			}
		}
		if ($else =~ /^${type}[^ ${name}%]/is) {
			warning ("space after 'else".$type."'-statement required");
			$else =~ s/^${type}/${type} /is;
			$line =~ s/^( *else${type})/${1} /is;
			$lines[$pos] =~ s/^( *(?:\{auto-indent} *)?else${type})/${1} /is;
		}
		if (($type eq 'if') && ($else =~ /^${type}(?: |$)/is) && ($else !~ / then$/is)) {
			if ($else =~ /\&$/s) {
				# multi-line elseif-block
				$state{'multiline_elseif'} = 1;
				$state{'nesting'} =~ s/(^|\|)${type}\|$/${1}/s;
				return (remove_nesting ());
			}
			fatal ("must place 'then' after 'elseif'");
			return (1);
		}
		elsif (($else =~ /^${type} /is) || (($type eq 'if') && ($else =~ /^$/is)) || (($type eq 'where') && ($else =~ /^${type}$/is))) {
			if ($state{'nesting'} !~ s/(^|\|)${type}\|$/${1}\|/s) {
				if ($verbose) { warn ("NESTING:".$state{'nesting'}." TYPE:".$type."\n"); }
				fatal ("misplaced 'else".$trigger."'");
				return (1);
			}
			$state{'else_branch'} = $type;
		}
		else {
			# unrecognized "else...", might be something like "elset = 1"
			return (0);
		}
	}
	elsif ($line =~ /^ *case([^${name}%].*?)$/is && ($state{'last_nesting'} eq 'select')) {
		my $case = $1;
		my $type = $state{'last_nesting'};
		if ($case !~ /^ /s) {
			warning ("space after 'case'-statement required");
			$case = ' '.$case;
			$line =~ s/^( *case)/${1} /is;
			$lines[$pos] =~ s/^( *(?:\{auto-indent} *)?case)/${1} /is;
		}
		if ($state{'nesting'} !~ s/(^|\|)${type}\|$/${1}\|/s) {
			if ($verbose) { warn ("NESTING:".$state{'nesting'}." TYPE:".$type."\n"); }
			fatal ("misplaced 'case'");
			return (1);
		}
		$state{'else_branch'} = $type;
	}
	else {
		# no end, nor else
		return (0);
	}
	if (($trigger eq 'module') && ($state{'nesting'} =~ s/(^|\|)\|$/${1}/s)) {
		my $result = remove_nesting ();
		if ($result) { return (1); }
	}
	if ($state{'nesting'} =~ s/(^|\|)\|$/${1}/s) { return (remove_nesting ()); }
	return (0);
}