Pascal: Add parsing of function/proc signatures

Units/parser-pascal.r/simple-pascal.d/args.ctags

@@ -0,0 +1,2 @@
+--fields=+tS
+--sort=no

Units/parser-pascal.r/simple-pascal.d/expected.tags

@@ -0,0 +1,3 @@
+helloproc	input.pas	/^PROCEDURE helloproc(param1: STRING; param2: BYTE);$/;"	p	signature:(param1: STRING; param2: BYTE)
+max	input.pas	/^FUNCTION max(num1, num2: INTEGER): INTEGER;$/;"	f	typeref:typename:INTEGER	signature:(num1, num2: INTEGER)
+noargs	input.pas	/^FUNCTION noargs: STRING;$/;"	f	typeref:typename:STRING	signature:()

Units/parser-pascal.r/simple-pascal.d/input.pas

@@ -0,0 +1,39 @@
+PROGRAM hello;
+
+TYPE
+	simpletype = RECORD
+					one: INTEGER;
+				 END;
+
+
+PROCEDURE helloproc(param1: STRING; param2: BYTE);
+BEGIN
+	writeln('Hello World!');
+END;
+
+
+FUNCTION max(num1, num2: INTEGER): INTEGER;
+VAR
+   result: INTEGER;
+BEGIN
+   if (num1 > num2) then
+      result := num1
+
+   else
+      result := num2;
+   max := result;
+END;
+
+
+FUNCTION noargs: STRING;
+BEGIN
+   noargs := 'functon without arguments';
+END;
+
+
+VAR result : INTEGER;
+BEGIN
+	helloproc('ignored', 1);
+	result := max(73, 42);
+	writeln('Result: ', result);
+END.

parsers/pascal.c

@@ -38,10 +38,16 @@ static kindDefinition PascalKinds [] = {
 */
 
 static void createPascalTag (
-		tagEntryInfo* const tag, const vString* const name, const int kind)
+		tagEntryInfo* const tag, const vString* const name, const int kind,
+		const char *arglist, const char *vartype)
 {
 	if (PascalKinds [kind].enabled  &&  name != NULL  &&  vStringLength (name) > 0)
+	{
 		initTagEntry (tag, vStringValue (name), kind);
+		tag->extensionFields.signature = arglist;
+		tag->extensionFields.typeRef[0] = "typename";
+		tag->extensionFields.typeRef[1] = vartype;
+	}
 	else
 		/* TODO: Passing NULL as name makes an assertion behind initTagEntry failure */
 		initTagEntry (tag, NULL, KIND_GHOST_INDEX);
@@ -74,6 +80,68 @@ static bool tail (const char *cp)
 	return result;
 }
 
+static void parseArglist(const char *buf, char **arglist, char **vartype)
+{
+	char *c, *start, *end;
+	int level;
+
+	if (NULL == buf || NULL == arglist)
+		return;
+
+	c = strdup(buf);
+	/* parse argument list which can be missing like in "function ginit:integer;" */
+	if (NULL != (start = strchr(c, '(')))
+	{
+		for (level = 1, end = start + 1; level > 0; ++end)
+		{
+			if ('\0' == *end)
+				break;
+			else if ('(' == *end)
+				++ level;
+			else if (')' == *end)
+				-- level;
+		}
+	}
+	else /* if no argument list was found, continue looking for a return value */
+	{
+		start = "()";
+		end = c;
+	}
+
+	/* parse return type if requested by passing a non-NULL vartype argument */
+	if (NULL != vartype)
+	{
+		char *var, *var_start;
+
+		*vartype = NULL;
+
+		if (NULL != (var = strchr(end, ':')))
+		{
+			var++; /* skip ':' */
+			while (isspace((int) *var))
+				++var;
+
+			if (starttoken(*var))
+			{
+				var_start = var;
+				var++;
+				while (intoken(*var))
+					var++;
+				if (endtoken(*var))
+				{
+					*var = '\0';
+					*vartype = strdup(var_start);
+				}
+			}
+		}
+	}
+
+	*end = '\0';
+	*arglist = strdup(start);
+
+	eFree(c);
+}
+
 /* Algorithm adapted from from GNU etags.
  * Locates tags for procedures & functions.  Doesn't do any type- or
  * var-definitions.  It does look for the keyword "extern" or "forward"
@@ -84,6 +152,8 @@ static void findPascalTags (void)
 {
 	vString *name = vStringNew ();
 	tagEntryInfo tag;
+	char *arglist = NULL;
+	char *vartype = NULL;
 	pascalKind kind = K_FUNCTION;
 		/* each of these flags is true iff: */
 	bool incomment = false;  /* point is inside a comment */
@@ -205,7 +275,14 @@ static void findPascalTags (void)
 			for (cp = dbp  ;  *cp != '\0' && !endtoken (*cp)  ;  cp++)
 				continue;
 			vStringNCopyS (name, (const char*) dbp,  cp - dbp);
-			createPascalTag (&tag, name, kind);
+
+			if (arglist != NULL)
+				eFree(arglist);
+			if (kind == K_FUNCTION && vartype != NULL)
+				eFree(vartype);
+			parseArglist((const char*) cp, &arglist, (kind == K_FUNCTION) ? &vartype : NULL);
+
+			createPascalTag (&tag, name, kind, arglist, (kind == K_FUNCTION) ? vartype : NULL);
 			dbp = cp;  /* set dbp to e-o-token */
 			get_tagname = false;
 			found_tag = true;
@@ -246,6 +323,10 @@ static void findPascalTags (void)
 			}
 		}  /* while not eof */
 	}
+	if (arglist != NULL)
+		eFree(arglist);
+	if (vartype != NULL)
+		eFree(vartype);
 	vStringDelete (name);
 }