[PATCH,FORTRAN 15/29] Use stringpool for iso_c_binding module names
Bernhard Reutner-Fischer
rep.dot.nop@gmail.com
Wed Sep 5 15:02:00 GMT 2018
From: Bernhard Reutner-Fischer <aldot@gcc.gnu.org>
gcc/fortran/ChangeLog:
2017-11-20 Bernhard Reutner-Fischer <aldot@gcc.gnu.org>
* gfortran.h (struct CInteropKind_t): Make name a pointer.
* misc.c (get_c_kind): Use pointer comparison on name to
determine index.
* symbol.c (generate_isocbinding_symbol): Use stringpool pointer
for argument to get_c_kind ().
* trans-types.c (gfc_init_c_interop_kinds): Use stringpool node
for name.
* module.c (import_iso_c_binding_module): Likewise.
---
gcc/fortran/gfortran.h | 2 +-
gcc/fortran/misc.c | 2 +-
gcc/fortran/module.c | 16 +++++++++-------
gcc/fortran/symbol.c | 3 ++-
gcc/fortran/trans-types.c | 20 ++++++++++----------
5 files changed, 23 insertions(+), 20 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 039719644ea..0e164c35300 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -719,7 +719,7 @@ enum intmod_id
typedef struct
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name;
int value; /* Used for both integer and character values. */
bt f90_type;
}
diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c
index fb18c5ceb6f..29aae591ed3 100644
--- a/gcc/fortran/misc.c
+++ b/gcc/fortran/misc.c
@@ -278,7 +278,7 @@ get_c_kind(const char *c_kind_name, CInteropKind_t kinds_table[])
int index = 0;
for (index = 0; index < ISOCBINDING_LAST; index++)
- if (strcmp (kinds_table[index].name, c_kind_name) == 0)
+ if (kinds_table[index].name == c_kind_name)
return index;
return ISOCBINDING_INVALID;
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index b94411ac68b..22d9abb247f 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -6357,27 +6357,27 @@ import_iso_c_binding_module (void)
#define NAMED_FUNCTION(a,b,c,d) \
case a: \
not_in_std = (gfc_option.allow_std & d) == 0; \
- name = b; \
+ name = gfc_get_string ("%s", b); \
break;
#define NAMED_SUBROUTINE(a,b,c,d) \
case a: \
not_in_std = (gfc_option.allow_std & d) == 0; \
- name = b; \
+ name = gfc_get_string ("%s", b); \
break;
#define NAMED_INTCST(a,b,c,d) \
case a: \
not_in_std = (gfc_option.allow_std & d) == 0; \
- name = b; \
+ name = gfc_get_string ("%s", b); \
break;
#define NAMED_REALCST(a,b,c,d) \
case a: \
not_in_std = (gfc_option.allow_std & d) == 0; \
- name = b; \
+ name = gfc_get_string ("%s", b); \
break;
#define NAMED_CMPXCST(a,b,c,d) \
case a: \
not_in_std = (gfc_option.allow_std & d) == 0; \
- name = b; \
+ name = gfc_get_string ("%s", b); \
break;
#include "iso-c-binding.def"
default:
@@ -6481,13 +6481,15 @@ import_iso_c_binding_module (void)
return_type = c_funptr->n.sym; \
else \
return_type = NULL; \
- create_intrinsic_function (b, a, iso_c_module_name, \
+ create_intrinsic_function (gfc_get_string ("%s", b), \
+ a, iso_c_module_name, \
INTMOD_ISO_C_BINDING, false, \
return_type); \
break;
#define NAMED_SUBROUTINE(a,b,c,d) \
case a: \
- create_intrinsic_function (b, a, iso_c_module_name, \
+ create_intrinsic_function (gfc_get_string ("%s", b), \
+ a, iso_c_module_name, \
INTMOD_ISO_C_BINDING, true, NULL); \
break;
#include "iso-c-binding.def"
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index cc9d4e3f9d8..ce134d2b441 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -4985,7 +4985,8 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
tmp_comp->ts.f90_type = BT_INTEGER;
/* The kinds for c_ptr and c_funptr are the same. */
- index = get_c_kind ("c_ptr", c_interop_kinds_table);
+ index = get_c_kind (gfc_get_string ("%s", "c_ptr"),
+ c_interop_kinds_table);
tmp_comp->ts.kind = c_interop_kinds_table[index].value;
tmp_comp->attr.access = ACCESS_PRIVATE;
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 46f6d8c03a6..deb9993b0e3 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -360,45 +360,45 @@ gfc_init_c_interop_kinds (void)
for (i = 0; i < ISOCBINDING_NUMBER; i++)
{
/* Initialize the name and value fields. */
- c_interop_kinds_table[i].name[0] = '\0';
+ c_interop_kinds_table[i].name = NULL;
c_interop_kinds_table[i].value = -100;
c_interop_kinds_table[i].f90_type = BT_UNKNOWN;
}
#define NAMED_INTCST(a,b,c,d) \
- strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
+ c_interop_kinds_table[a].name = gfc_get_string ("%s", b); \
c_interop_kinds_table[a].f90_type = BT_INTEGER; \
c_interop_kinds_table[a].value = c;
#define NAMED_REALCST(a,b,c,d) \
- strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
+ c_interop_kinds_table[a].name = gfc_get_string ("%s", b); \
c_interop_kinds_table[a].f90_type = BT_REAL; \
c_interop_kinds_table[a].value = c;
#define NAMED_CMPXCST(a,b,c,d) \
- strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
+ c_interop_kinds_table[a].name = gfc_get_string ("%s", b); \
c_interop_kinds_table[a].f90_type = BT_COMPLEX; \
c_interop_kinds_table[a].value = c;
#define NAMED_LOGCST(a,b,c) \
- strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
+ c_interop_kinds_table[a].name = gfc_get_string ("%s", b); \
c_interop_kinds_table[a].f90_type = BT_LOGICAL; \
c_interop_kinds_table[a].value = c;
#define NAMED_CHARKNDCST(a,b,c) \
- strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
+ c_interop_kinds_table[a].name = gfc_get_string ("%s", b); \
c_interop_kinds_table[a].f90_type = BT_CHARACTER; \
c_interop_kinds_table[a].value = c;
#define NAMED_CHARCST(a,b,c) \
- strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
+ c_interop_kinds_table[a].name = gfc_get_string ("%s", b); \
c_interop_kinds_table[a].f90_type = BT_CHARACTER; \
c_interop_kinds_table[a].value = c;
#define DERIVED_TYPE(a,b,c) \
- strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
+ c_interop_kinds_table[a].name = gfc_get_string ("%s", b); \
c_interop_kinds_table[a].f90_type = BT_DERIVED; \
c_interop_kinds_table[a].value = c;
#define NAMED_FUNCTION(a,b,c,d) \
- strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
+ c_interop_kinds_table[a].name = gfc_get_string ("%s", b); \
c_interop_kinds_table[a].f90_type = BT_PROCEDURE; \
c_interop_kinds_table[a].value = c;
#define NAMED_SUBROUTINE(a,b,c,d) \
- strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
+ c_interop_kinds_table[a].name = gfc_get_string ("%s", b); \
c_interop_kinds_table[a].f90_type = BT_PROCEDURE; \
c_interop_kinds_table[a].value = c;
#include "iso-c-binding.def"
--
2.19.0.rc1
More information about the Gcc-patches
mailing list