Fortran: add "linkName" extra

Close #3668. The test input is taken from https://gist.github.com/RaoulHC/a241fb714f191b5fc3a7c790d7b23523. Signed-off-by: Masatake YAMATO <yamato@redhat.com>
universal-ctags · Mar 20, 2023 · 1ec3f03 · 1ec3f03
1 parent 8606b4b
commit 1ec3f03
Show file tree

Hide file tree

Showing 8 changed files with 231 additions and 0 deletions.
diff --git a/Units/parser-fortran.r/fortran-linkname.d/args.ctags b/Units/parser-fortran.r/fortran-linkname.d/args.ctags
@@ -0,0 +1,2 @@
+--sort=no
+--extras-Fortran={linkName}
diff --git a/Units/parser-fortran.r/fortran-linkname.d/expected.tags b/Units/parser-fortran.r/fortran-linkname.d/expected.tags
@@ -0,0 +1,33 @@
+my_mod	input.f	/^      module my_mod$/;"	m
+__anon9b9a88660103	input.f	/^        enumerator :: my_constr = 1, my_second_constr = 4$/;"	E	module:my_mod
+my_constr	input.f	/^        enumerator :: my_constr /;"	N	enum:__anon9b9a88660103
+my_second_constr	input.f	/^        enumerator :: my_constr = 1, my_second_constr /;"	N	enum:__anon9b9a88660103
+my_type	input.f	/^      type my_type$/;"	t	module:my_mod
+a	input.f	/^        integer a$/;"	k	type:my_type
+b	input.f	/^        integer b$/;"	k	type:my_type
+c	input.f	/^        integer c$/;"	k	type:my_type
+my_proc	input.f	/^        procedure :: my_proc /;"	M	type:my_type
+my_sequence_type	input.f	/^      type my_sequence_type$/;"	t	module:my_mod
+a	input.f	/^        integer a$/;"	k	type:my_sequence_type
+b	input.f	/^        integer b$/;"	k	type:my_sequence_type
+my_mod_type	input.f	/^      type(my_sequence_type) :: my_mod_type$/;"	v	module:my_mod
+my_mod_common	input.f	23;"	c	module:my_mod
+my_mod_common_	input.f	23;"	c	module:my_mod
+my_func	input.f	/^      function my_func(/;"	f	module:my_mod
+my_func_	input.f	/^      function my_func(x)$/;"	f	module:my_mod
+my_block	input.f	/^      block data my_block$/;"	b
+my_block_	input.f	/^      block data my_block$/;"	b
+my_var	input.f	/^        integer my_var$/;"	v	blockData:my_block
+my_common	input.f	40;"	c	blockData:my_block
+my_common_	input.f	40;"	c	blockData:my_block
+my_subr	input.f	/^      subroutine my_subr$/;"	s
+my_subr_	input.f	/^      subroutine my_subr$/;"	s
+my_entry	input.f	/^        entry my_entry$/;"	e	subroutine:my_subr
+my_entry_	input.f	/^        entry my_entry$/;"	e	subroutine:my_subr
+my_main	input.f	/^      program my_main$/;"	p
+my_interface	input.f	/^        interface my_interface$/;"	i	program:my_main
+my_var	input.f	/^        integer my_var$/;"	v	program:my_main
+my_namelist	input.f	/^        namelist \/my_namelist\//;"	n	program:my_main
+my_conc_type	input.f	/^        type(my_type) :: my_conc_type$/;"	v	program:my_main
+my_common	input.f	64;"	c	program:my_main
+my_common_	input.f	64;"	c	program:my_main
diff --git a/Units/parser-fortran.r/fortran-linkname.d/input.f b/Units/parser-fortran.r/fortran-linkname.d/input.f
@@ -0,0 +1,67 @@
+      module my_mod
+
+      enum, bind(c)
+        enumerator :: my_constr = 1, my_second_constr = 4
+      end enum
+
+      type my_type
+        integer a
+        integer b
+        integer c
+      contains
+        procedure :: my_proc => my_func
+      end type my_type
+
+      type my_sequence_type
+        sequence
+        integer a
+        integer b
+      end type
+
+      type(my_sequence_type) :: my_mod_type
+
+      common /my_mod_common/ my_mod_type
+
+      contains
+
+      function my_func(x)
+        class(my_type), intent(in) :: x
+        my_func = x%a
+        return
+        my_func = 2
+        return
+      end function my_func
+
+
+      end module
+
+      block data my_block
+        integer my_var
+        common /my_common/ my_var
+        data my_var/123/
+      end
+
+      subroutine my_subr
+        use my_mod
+        integer :: my_enum = my_constr
+        print *, my_enum
+        return
+        entry my_entry
+        print *, "an entry!"
+      end subroutine my_subr
+
+
+      program my_main
+        use my_mod
+        interface my_interface
+          subroutine my_subr()
+          end subroutine my_subr
+        end interface
+
+        integer my_var
+        namelist /my_namelist/ my_var
+        type(my_type) :: my_conc_type
+        common /my_common/ my_var
+        call my_subr()
+        print *, my_conc_type%my_proc()
+      end program my_main
diff --git a/docs/man-pages.rst b/docs/man-pages.rst
@@ -18,6 +18,7 @@ Man pages
 
 	ctags-lang-asm(7) <man/ctags-lang-asm.7.rst>
 	ctags-lang-elm(7) <man/ctags-lang-elm.7.rst>
+	ctags-lang-fortran(7) <man/ctags-lang-fortran.7.rst>
 	ctags-lang-gdscript(7) <man/ctags-lang-gdscript.7.rst>
 	ctags-lang-iPythonCell(7) <man/ctags-lang-iPythonCell.7.rst>
 	ctags-lang-inko(7) <man/ctags-lang-inko.7.rst>

diff --git a/docs/man/ctags-lang-fortran.7.rst b/docs/man/ctags-lang-fortran.7.rst
@@ -0,0 +1,33 @@
+.. _ctags-lang-fortran(7):
+
+==============================================================
+ctags-lang-fortran
+==============================================================
+
+Random notes about tagging Fortran source code with Universal Ctags
+
+:Version: 6.0.0
+:Manual group: Universal Ctags
+:Manual section: 7
+
+SYNOPSIS
+--------
+|	**ctags** ... --languages=+Fortran ...
+|	**ctags** ... --language-force=Fortran ...
+|	**ctags** ... --map-Fortran=+.f ...
+
+DESCRIPTION
+-----------
+This man page gathers random notes about tagging FORTRAN source code.
+
+VERSIONS
+--------
+
+Change since "0.0"
+~~~~~~~~~~~~~~~~~~
+
+* New extra ``linkName``.
+
+SEE ALSO
+--------
+:ref:`ctags(1) <ctags(1)>`
diff --git a/man/GNUmakefile.am b/man/GNUmakefile.am
@@ -29,6 +29,7 @@ GEN_IN_MAN_FILES = \
 	\
 	ctags-lang-asm.7 \
 	ctags-lang-elm.7 \
+	ctags-lang-fortran.7 \
 	ctags-lang-gdscript.7 \
 	ctags-lang-iPythonCell.7 \
 	ctags-lang-inko.7 \

diff --git a/man/ctags-lang-fortran.7.rst.in b/man/ctags-lang-fortran.7.rst.in
@@ -0,0 +1,33 @@
+.. _ctags-lang-fortran(7):
+
+==============================================================
+ctags-lang-fortran
+==============================================================
+---------------------------------------------------------------------
+Random notes about tagging Fortran source code with Universal Ctags
+---------------------------------------------------------------------
+:Version: @VERSION@
+:Manual group: Universal Ctags
+:Manual section: 7
+
+SYNOPSIS
+--------
+|	**@CTAGS_NAME_EXECUTABLE@** ... --languages=+Fortran ...
+|	**@CTAGS_NAME_EXECUTABLE@** ... --language-force=Fortran ...
+|	**@CTAGS_NAME_EXECUTABLE@** ... --map-Fortran=+.f ...
+
+DESCRIPTION
+-----------
+This man page gathers random notes about tagging FORTRAN source code.
+
+VERSIONS
+--------
+
+Change since "0.0"
+~~~~~~~~~~~~~~~~~~
+
+* New extra ``linkName``.
+
+SEE ALSO
+--------
+ctags(1)
diff --git a/parsers/fortran.c b/parsers/fortran.c
@@ -368,6 +368,18 @@ static const keywordTable FortranKeywordTable [] = {
 	{ "while",          KEYWORD_while        }
 };
 
+typedef enum {
+	X_LINK_NAME,
+} fortranXtag;
+
+static xtagDefinition FortranXtagTable [] = {
+	{
+		.enabled = false,
+		.name    = "linkName",
+		.description = "Linking name used in foreign languages",
+	},
+};
+
 static struct {
 	unsigned int count;
 	unsigned int max;
@@ -554,6 +566,46 @@ static const char *implementationString (const impType imp)
 	return names [(int) imp];
 }
 
+static bool hasLinkName(tagEntryInfo *e)
+{
+	switch (e->kindIndex)
+	{
+	case TAG_FUNCTION:
+	case TAG_SUBROUTINE:
+	case TAG_BLOCK_DATA:
+	case TAG_COMMON_BLOCK:
+	case TAG_ENTRY_POINT:
+		return true;
+	default:
+		return false;
+	}
+}
+
+/* ref.
+ * * https://gcc.gnu.org/onlinedocs/gfortran/Code-Gen-Options.html
+ *   - -fno-underscoring
+ *   - -fsecond-underscore
+ * * https://docs.oracle.com/cd/E19957-01/805-4940/z400091044a7/index.html
+ */
+static void makeFortranLinkNameTag(tagEntryInfo *e)
+{
+	vString *ln = vStringNewInit (e->name);
+	vStringLower(ln);
+
+#if 0
+	if (strchr(vStringValue (ln), '_'))
+		vStringPut(ln, '_');
+#endif
+
+	vStringPut(ln, '_');
+
+	tagEntryInfo ln_e = *e;
+	ln_e.name = vStringValue (ln);
+	markTagExtraBit (&ln_e, X_LINK_NAME);
+	makeTagEntry (&ln_e);
+	vStringDelete (ln);
+}
+
 static void makeFortranTag (tokenInfo *const token, tagType tag)
 {
 	token->tag = tag;
@@ -600,6 +652,9 @@ static void makeFortranTag (tokenInfo *const token, tagType tag)
 			 token->tag == TAG_PROTOTYPE))
 			e.extensionFields.signature = vStringValue (token->signature);
 		makeTagEntry (&e);
+		if (isXtagEnabled (FortranXtagTable[X_LINK_NAME].xtype)
+			&& hasLinkName(&e))
+			makeFortranLinkNameTag(&e);
 	}
 }
 
@@ -2724,5 +2779,11 @@ extern parserDefinition* FortranParser (void)
 	def->initialize = initialize;
 	def->keywordTable = FortranKeywordTable;
 	def->keywordCount = ARRAY_SIZE (FortranKeywordTable);
+	def->xtagTable  = FortranXtagTable;
+	def->xtagCount  = ARRAY_SIZE(FortranXtagTable);
+
+	def->versionCurrent = 1;
+	def->versionAge = 1;
+
 	return def;
 }