[m-rev.] diff: fix infinite loop in mtags

[Zoltan Somogyi]

tools/mtags:
	Fix an infinite loop that occurs in some certain rare circumstances.

	Convert to four-space indentation.

Zoltan.

cvs diff: Diffing .
Index: mtags
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/scripts/mtags,v
retrieving revision 1.34
diff -u -b -r1.34 mtags
--- mtags	24 Nov 2003 11:05:18 -0000	1.34
+++ mtags	30 Sep 2005 18:08:22 -0000
@@ -1,4 +1,6 @@
 
+# vim: ts=4 sw=4 et
+#
 # Leave the first line of this file blank!
 # This is a Perl script; the following two lines allow us to avoid
 # embedding the path of the perl interpreter in the script.
@@ -225,7 +227,7 @@
 #---------------------------------------------------------------------------#
 
 sub output_name() {
-	# figure out the part of the body that is the name
+    # Figure out the part of the body that is the name.
 
 	$name =~ s/^[ \t]*//;
 
@@ -242,19 +244,18 @@
 	$match_line =~ s|\\|\\\\|g;   # replace `\' with `\\'
 	$match_line =~ s|/|\\/|g;     # replace `/' with `\/'
 
-	# $src_name holds the name as it was in the original source
+    # $src_name holds the name as it was in the original source.
 	$src_name = $name;
 	$name =~ s|\.|__|g;     # replace `.' module qualifiers with `__'
 
-	# output a tag for the fully-qualified name
+    # Output a tag for the fully-qualified name.
 	if (substr($name, 0, length($module)) ne $module) {
 		$name = "${module}__$name";
 	}
 	output_single_name();
 
-	# strip off the leading module qualifiers one by one,
-	# and output a tag for each partially qualified
-	# or unqualified name
+    # Strip off the leading module qualifiers one by one, and output a tag
+    # for each partially qualified or unqualified name.
 	while ($name =~ /__/) {
 		$name =~ s/[^_]*(_[^_]+)*__//;
 		output_single_name();
@@ -288,12 +289,10 @@
 	    }
 	} else {
 	    if ($emacs) {
-		printf OUT "%s\177%s\001%d,%d\n",
-		    $_, $name, $., $.;
+            printf OUT "%s\177%s\001%d,%d\n", $_, $name, $., $.;
 	    } else {
 	    	# Output basic tag line for vi/vim/elvis.
-	    	printf OUT "%s\t%s\t/^%s\$/",
-		    $name, $file, $match_line;
+            printf OUT "%s\t%s\t/^%s\$/", $name, $file, $match_line;
 
 		# Output commands to alter the search buffer.
 		if ($search_definitions) {
@@ -357,13 +356,13 @@
     }
     
     $module = $file;
-    $module =~ s/.*\///;	# delete the directory name, if any
-    $module =~ s/\.m$//;	# delete the trailing `.m'
-    $module =~ s/\./__/;	# replace `.' module qualifiers with `__'
+    $module =~ s/.*\///;    # Delete the directory name, if any.
+    $module =~ s/\.m$//;    # Delete the trailing `.m'.
+    $module =~ s/\./__/;    # Replace `.' module qualifiers with `__'.
 
     while ($_ = <SRCFILE>)
     {
-	# skip lines which are not declarations
+        # Skip lines which are not declarations.
 	next unless ($_ =~ /^:- /);
 
 	chop;
@@ -387,8 +386,7 @@
 	# typeclass or instance declarations.
 	# Also skip instance declarations if we're producing a normal vi
 	# tags file since vi doesn't allow duplicate tags and the
-	# typeclass tags are probably more important than the instance
-	# tags.
+        # typeclass tags are probably more important than the instance tags.
 	next unless (
 	    $decl eq "pred" ||
 	    $decl eq "func" ||
@@ -399,15 +397,15 @@
 	    ($decl eq "instance" && $keep_dups)
 	);
 
-	# skip declarations which are not definitions
+        # Skip declarations which are not definitions.
 	next unless (
-	    # pred, func, and typeclass declarations are always definitions
+            # Pred, func, and typeclass declarations are always definitions.
 	    $decl eq "pred" ||
 	    $decl eq "func" ||
 	    $decl eq "typeclass" ||
 
-	    # if it doesn't end in a `.' (i.e if it doesn't fit on one line),
-	    # then it's probably a definition
+            # If it doesn't end in a `.' (i.e if it doesn't fit on one line),
+            # then it's probably a definition.
 	    ($body !~ /\.[ \t]*$/ && $body !~ /\.[ \t]*%.*$/) ||
 
 	    # if it contains `--->', `=', or `::', it's probably a
@@ -425,33 +423,33 @@
 	if ($kind eq "instance") { $kind = "tci"; }
 	output_name();
 	
-	# for everything except type, typeclass and instance declarations,
-	# we're done
+        # For everything except type, typeclass and instance declarations,
+        # we're done.
 	next unless ($decl eq "type" || $decl eq "typeclass" || 
 			$decl eq "instance");
 
 	if ($decl eq "type") {
-	    # make sure we're at the line with the `--->'
+            # Make sure we're at the line with the `--->'.
 	    if ($body !~ /--->/) {
 		    next if $_ =~ /\.[ \t]*$/ || $_ =~ /\.[ \t]*%.*$/;
 		    $_ = <SRCFILE>;
 		    chop;
 		    $body = $_;
 	    }
+
 	    next unless ($body =~ /--->/);
 
-	    # replace everything up to the `--->' with `;'
+            # Replace everything up to the `--->' with `;'.
 	    $body =~ s/.*--->/;/;
 
 	    for(;;) {
-		# if the body starts with `;', we assume it must be the
-		# start of a constructor definition
+                # If the body starts with `;', we assume it must be the start
+                # of a constructor definition.
 		if ($body =~ /^[ \t]*;/) {
-
 		    # delete the leading `;'
 		    $body =~ s/[^;]*;[ \t]*//;
 
-		    # skip blank lines and comments
+                    # Skip blank lines and comments.
 		    while ($body =~ /^[ \t]*$/ || $body =~ /^[ \t]*%.*$/) {
 			$_ = <SRCFILE> || last;
 			chop;
@@ -467,26 +465,33 @@
 		    $name = $body;
 		    $name =~ s/[ \t;.%].*//;
 		    $kind = "cons";
+
 		    output_name();
 
 		    # Look for field names on the same line as the
-		    # constructor name
-		    while ($body =~ /([a-z][_a-zA-Z0-9]*)[ \t]*::/) {
+                    # constructor name. Don't allow the line to start with
+                    # a colon, because then the assignment
+                    #
+                    # $body =~ s/^[^:]*:://;
+                    #
+                    # below may leave $body unchanged, leading to an infinite
+                    # loop.
+                    while ($body =~ /^[^:].*([a-z][_a-zA-Z0-9]*)[ \t]*::/) {
 		    	$name = $1;
 			$kind = "fld";
 			output_name();
 			$body =~ s/^[^:]*:://;
 		    }
 
-		    # if there are more constructor definitions on the
-		    # same line, process the next one
+                    # If there are more constructor definitions on the
+                    # same line, process the next one.
 		    if ($body =~ /;/) {
 			    $body =~ s/[^;]*;/;/;
 			    next;
 		    }
 		} else {
-		    # Look for field names that are not on the
-		    # same line as the constructor name
+                    # Look for field names that are not on the same line
+                    # as the constructor name.
 		    while ($body =~ /([a-z][_a-zA-Z0-9]*)[ \t]*::/) {
 			$name = $1;
 			$kind = "fld";
@@ -501,9 +506,7 @@
 		$body = $_;
 	    }
 	} elsif ($decl eq "typeclass") {
-
 	    for(;;) {
-
 		# Assume each method declaration starts on a new line.
 		if ($body =~ /^.*\b(pred|func)[ \t]*/) {
 		    $body =~ s/^.*\b(pred|func)[ \t]*//;
@@ -528,7 +531,6 @@
 	    }
 	} else { # instance declaration
 	    for(;;) {
-
 		# Assume each method declaration starts on a new line.
 		if ($body =~ /^.*\b(pred\(|func\()/) {
 		    $body =~ s/.*\b(pred\(|func\()//;
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------