* [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
@ 2010-11-06 20:11 Janus Weil
2010-11-06 21:03 ` Thomas Koenig
2010-11-07 16:52 ` Tobias Burnus
0 siblings, 2 replies; 23+ messages in thread
From: Janus Weil @ 2010-11-06 20:11 UTC (permalink / raw)
To: gfortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 1298 bytes --]
Hi all,
with the test cases in this PR Tobias demonstrated that our naming
scheme for class containers and vtables is insufficient. It currently
is based only on the type name. As shown in the PR, naming ambiguities
can be created, e.g. by setting up two derived types with identical
names in different modules, and use-renaming them in the main program.
The patch avoids these naming ambiguities by including the module name
in the naming scheme for class containers and vtabs. Example:
module mo
type :: dt
! ...
end type
class(dt), pointer :: cp
end module
Without the patch, the class container name is "class$dt", with the
patch it will be "class$mo$dt". This makes sure that we get one unique
class container and vtab for each derived type, even with renamed
derived types.
The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk?
Cheers,
Janus
2010-11-06 Janus Weil <janus@gcc.gnu.org>
PR fortran/46313
* class.c (get_unique_type_string): New function.
(gfc_build_class_symbol): Use 'get_unique_type_string' to construct
uniques names for the class containers.
(gfc_find_derived_vtab): Use 'get_unique_type_string' to construct
uniques names for the vtab symbols.
2010-11-06 Janus Weil <janus@gcc.gnu.org>
PR fortran/46313
* gfortran.dg/class_28.f03: New.
[-- Attachment #2: pr46313.diff --]
[-- Type: application/octet-stream, Size: 4820 bytes --]
Index: gcc/fortran/class.c
===================================================================
--- gcc/fortran/class.c (revision 166404)
+++ gcc/fortran/class.c (working copy)
@@ -36,11 +36,11 @@ along with GCC; see the file COPYING3. If not see
For each derived type we set up a "vtable" entry, i.e. a structure with the
following fields:
- * $hash: A hash value serving as a unique identifier for this type.
- * $size: The size in bytes of the derived type.
- * $extends: A pointer to the vtable entry of the parent derived type.
+ * $hash: A hash value serving as a unique identifier for this type.
+ * $size: The size in bytes of the derived type.
+ * $extends: A pointer to the vtable entry of the parent derived type.
* $def_init: A pointer to a default initialized variable of this type.
- * $copy: A procedure pointer to a copying procedure.
+ * $copy: A procedure pointer to a copying procedure.
After these follow procedure pointer components for the specific
type-bound procedures. */
@@ -107,6 +107,20 @@ gfc_class_null_initializer (gfc_typespec *ts)
}
+/* Create a unique string identifier for a derived type, composed of its name
+ and module name. This is used to construct unique names for the class
+ containers and vtab symbols. */
+
+static void
+get_unique_type_string (char *string, gfc_symbol *derived)
+{
+ if (derived->module)
+ sprintf (string, "%s$%s", derived->module, derived->name);
+ else
+ sprintf (string, "%s$%s", derived->ns->proc_name->name, derived->name);
+}
+
+
/* Build a polymorphic CLASS entity, using the symbol that comes from
build_sym. A CLASS entity is represented by an encapsulating type,
which contains the declared type as '$data' component, plus a pointer
@@ -116,22 +130,23 @@ gfc_try
gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
gfc_array_spec **as, bool delayed_vtab)
{
- char name[GFC_MAX_SYMBOL_LEN + 5];
+ char name[GFC_MAX_SYMBOL_LEN], tname[GFC_MAX_SYMBOL_LEN];
gfc_symbol *fclass;
gfc_symbol *vtab;
gfc_component *c;
/* Determine the name of the encapsulating type. */
+ get_unique_type_string (tname, ts->u.derived);
if ((*as) && (*as)->rank && attr->allocatable)
- sprintf (name, "class$%s_%d_a", ts->u.derived->name, (*as)->rank);
+ sprintf (name, "class$%s_%d_a", tname, (*as)->rank);
else if ((*as) && (*as)->rank)
- sprintf (name, "class$%s_%d", ts->u.derived->name, (*as)->rank);
+ sprintf (name, "class$%s_%d", tname, (*as)->rank);
else if (attr->pointer)
- sprintf (name, "class$%s_p", ts->u.derived->name);
+ sprintf (name, "class$%s_p", tname);
else if (attr->allocatable)
- sprintf (name, "class$%s_a", ts->u.derived->name);
+ sprintf (name, "class$%s_a", tname);
else
- sprintf (name, "class$%s", ts->u.derived->name);
+ sprintf (name, "class$%s", tname);
gfc_find_symbol (name, ts->u.derived->ns, 0, &fclass);
if (fclass == NULL)
@@ -316,7 +331,6 @@ gfc_find_derived_vtab (gfc_symbol *derived)
gfc_namespace *ns;
gfc_symbol *vtab = NULL, *vtype = NULL, *found_sym = NULL, *def_init = NULL;
gfc_symbol *copy = NULL, *src = NULL, *dst = NULL;
- char name[2 * GFC_MAX_SYMBOL_LEN + 8];
/* Find the top-level namespace (MODULE or PROGRAM). */
for (ns = gfc_current_ns; ns; ns = ns->parent)
@@ -329,7 +343,10 @@ gfc_find_derived_vtab (gfc_symbol *derived)
if (ns)
{
- sprintf (name, "vtab$%s", derived->name);
+ char name[GFC_MAX_SYMBOL_LEN], tname[GFC_MAX_SYMBOL_LEN];
+
+ get_unique_type_string (tname, derived);
+ sprintf (name, "vtab$%s", tname);
/* Look for the vtab symbol in various namespaces. */
gfc_find_symbol (name, gfc_current_ns, 0, &vtab);
@@ -350,7 +367,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
vtab->attr.vtab = 1;
vtab->attr.access = ACCESS_PUBLIC;
gfc_set_sym_referenced (vtab);
- sprintf (name, "vtype$%s", derived->name);
+ sprintf (name, "vtype$%s", tname);
gfc_find_symbol (name, ns, 0, &vtype);
if (vtype == NULL)
@@ -431,7 +448,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
else
{
/* Construct default initialization variable. */
- sprintf (name, "def_init$%s", derived->name);
+ sprintf (name, "def_init$%s", tname);
gfc_get_symbol (name, ns, &def_init);
def_init->attr.target = 1;
def_init->attr.save = SAVE_EXPLICIT;
@@ -462,7 +479,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
ns->contained = sub_ns;
sub_ns->resolved = 1;
/* Set up procedure symbol. */
- sprintf (name, "copy$%s", derived->name);
+ sprintf (name, "copy$%s", tname);
gfc_get_symbol (name, sub_ns, ©);
sub_ns->proc_name = copy;
copy->attr.flavor = FL_PROCEDURE;
[-- Attachment #3: class_28.f03 --]
[-- Type: application/octet-stream, Size: 528 bytes --]
! { dg-do compile }
!
! PR 46313: [OOP] OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
module m1
type mytype
real :: a(10) = 2
end type
end module m1
module m2
type mytype
real :: b(10) = 8
end type
end module m2
program p
use m1, t1 => mytype
use m2, t2 => mytype
implicit none
class(t1), allocatable :: x
class(t2), allocatable :: y
allocate (t1 :: x)
allocate (t2 :: y)
print *, x%a
print *, y%b
end
! { dg-final { cleanup-modules "m1 m2" } }
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2010-11-06 20:11 [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue Janus Weil
@ 2010-11-06 21:03 ` Thomas Koenig
2010-11-06 21:23 ` Janus Weil
2010-11-07 16:52 ` Tobias Burnus
1 sibling, 1 reply; 23+ messages in thread
From: Thomas Koenig @ 2010-11-06 21:03 UTC (permalink / raw)
To: Janus Weil; +Cc: gfortran, gcc-patches
Am Samstag, den 06.11.2010, 21:11 +0100 schrieb Janus Weil:
> The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk?
If we are going to change the naming of the OOP stuff anyway, what about
the possible name collisions with -fdollar-ok ?
Should we put in an underscore, an at sign etc. or should we decide that
anybody who creates a name collision like that with a non-standard
extension deserves to lose?
Test case:
ig25@linux-fd1f:~/Krempel/Class> cat class.f90
program main
type :: dt
! ...
end type dt
class(dt), pointer :: cp
contains
subroutine vtab$dt
end subroutine vtab$dt
end program main
ig25@linux-fd1f:~/Krempel/Class> gfortran -fdollar-ok class.f90
class.f90:7.20:
subroutine vtab$dt
1
Error: VARIABLE attribute of 'vtab$dt' conflicts with PROCEDURE
attribute at (1)
class.f90:8.5:
end subroutine vtab$dt
1
Error: Expecting END PROGRAM statement at (1)
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2010-11-06 21:03 ` Thomas Koenig
@ 2010-11-06 21:23 ` Janus Weil
0 siblings, 0 replies; 23+ messages in thread
From: Janus Weil @ 2010-11-06 21:23 UTC (permalink / raw)
To: Thomas Koenig; +Cc: gfortran, gcc-patches
Hi Thomas,
>> The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk?
>
> If we are going to change the naming of the OOP stuff anyway, what about
> the possible name collisions with -fdollar-ok ?
uh, good point. To be honest I wasn't even aware of this flag ...
> Should we put in an underscore, an at sign etc. or should we decide that
> anybody who creates a name collision like that with a non-standard
> extension deserves to lose?
Well, I can image that someone using a flag called '-fdollar-ok' would
expect that it's ok to use dollar signs without running into trouble.
So, yes, since we're about to change the naming anyway, I think we
should get rid of the dollars. Throwing in @s instead is fine with me,
or is there a downside to this choice, too?
I think the underscore is not an option, since it can also be used in
standard variable names, right?
Cheers,
Janus
> Test case:
>
> ig25@linux-fd1f:~/Krempel/Class> cat class.f90
> program main
> type :: dt
> ! ...
> end type dt
> class(dt), pointer :: cp
> contains
> subroutine vtab$dt
> end subroutine vtab$dt
> end program main
> ig25@linux-fd1f:~/Krempel/Class> gfortran -fdollar-ok class.f90
> class.f90:7.20:
>
> subroutine vtab$dt
> 1
> Error: VARIABLE attribute of 'vtab$dt' conflicts with PROCEDURE
> attribute at (1)
> class.f90:8.5:
>
> end subroutine vtab$dt
> 1
> Error: Expecting END PROGRAM statement at (1)
>
>
>
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2010-11-06 20:11 [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue Janus Weil
2010-11-06 21:03 ` Thomas Koenig
@ 2010-11-07 16:52 ` Tobias Burnus
2010-11-07 18:44 ` Janus Weil
1 sibling, 1 reply; 23+ messages in thread
From: Tobias Burnus @ 2010-11-07 16:52 UTC (permalink / raw)
To: Janus Weil; +Cc: gfortran, gcc-patches
Janus Weil wrote:
> The patch avoids these naming ambiguities by including the module name
> in the naming scheme for class containers and vtabs.
> The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk?
OK.
I think we can worry about submodules and similar problem later - when
real-world programs pop up which use them. At least there is then only a
single place to change.
Regarding $ vs. period vs. _: Seemingly, all platforms on which gfortran
is used support the $ as there was not bug report so far. Thus, I think
we can continue using it. Regarding user code: I somehow think it is
unlikely that users have that strange variable names; if they do: It's
their fault as $ is an not allowed in ISO Fortran.
Janus Weil wrote:
> Btw, what is the reason for the macro adding *two* underscores in
> front, instead of just one?
C allows leading underscores -- and according to the ISO C standard,
identifiers which start with two underscores are for the internal use of
the compiler.
Steve Kargl wrote:
> A leading underscore moves the issue from -fdollar-ok to
> -fleading_underscore.
Well, there is a difference. Many compilers support a $ sign - some also
as first character (gfortran does not!). Most compilers do not support
leading underscores; gfortran's -fleading_underscore only exists to
generate (before BIND(C) was implemented) __gfortran_... procedures.
-fleading_underscore is also not officially supported (e.g. it is not in
the man page) - and there are some compile-time restrictions.
I also do not think we need to explicitly take care of leading
underscores (which can also be reached via BIND(C)) or $. If a user
wants to shoot into his foot, the compiler does not need to prevent it.
-- It just shouldn't encourage it. And if possible, standard conforming
code should not break. If users plays around with __vtab$... I think its
their fault.
Tobias
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2010-11-07 16:52 ` Tobias Burnus
@ 2010-11-07 18:44 ` Janus Weil
2010-11-08 13:27 ` Tobias Burnus
0 siblings, 1 reply; 23+ messages in thread
From: Janus Weil @ 2010-11-07 18:44 UTC (permalink / raw)
To: Tobias Burnus; +Cc: gfortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 1323 bytes --]
>> The patch avoids these naming ambiguities by including the module name
>> in the naming scheme for class containers and vtabs.
>> The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk?
>
> OK.
>
> I think we can worry about submodules and similar problem later - when
> real-world programs pop up which use them. At least there is then only a
> single place to change.
>
> Regarding $ vs. period vs. _: Seemingly, all platforms on which gfortran is
> used support the $ as there was not bug report so far. Thus, I think we can
> continue using it. Regarding user code: I somehow think it is unlikely that
> users have that strange variable names; if they do: It's their fault as $ is
> an not allowed in ISO Fortran.
>
> Janus Weil wrote:
>> Btw, what is the reason for the macro adding *two* underscores in
>> front, instead of just one?
>
> C allows leading underscores -- and according to the ISO C standard,
> identifiers which start with two underscores are for the internal use of the
> compiler.
Ok, so it seems to me that using two leading underscores is really the
best option, since it's safe against collisions with Fortran and C
user code, and also safe to use with -fdollar-ok.
The attached patch adds double underscores for the vtabs, vtypes,
class containers and temporaries.
Cheers,
Janus
[-- Attachment #2: pr46313_leading_double_underscore.diff --]
[-- Type: application/octet-stream, Size: 29414 bytes --]
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c (revision 166419)
+++ gcc/fortran/trans-array.c (working copy)
@@ -6317,7 +6317,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree
comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
decl, cdecl, NULL_TREE);
- /* Add reference to '$data' component. */
+ /* Add reference to '_data' component. */
tmp = CLASS_DATA (c)->backend_decl;
comp = fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (tmp), comp, tmp, NULL_TREE);
@@ -6357,7 +6357,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree
/* Allocatable scalar CLASS components. */
comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
decl, cdecl, NULL_TREE);
- /* Add reference to '$data' component. */
+ /* Add reference to '_data' component. */
tmp = CLASS_DATA (c)->backend_decl;
comp = fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (tmp), comp, tmp, NULL_TREE);
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (revision 166419)
+++ gcc/fortran/trans-expr.c (working copy)
@@ -2584,7 +2584,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_exp
var = gfc_create_var (tmp, "class");
/* Set the vptr. */
- cmp = gfc_find_component (declared, "$vptr", true, true);
+ cmp = gfc_find_component (declared, "_vptr", true, true);
ctree = fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (cmp->backend_decl),
var, cmp->backend_decl, NULL_TREE);
@@ -2598,7 +2598,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_exp
fold_convert (TREE_TYPE (ctree), tmp));
/* Now set the data field. */
- cmp = gfc_find_component (declared, "$data", true, true);
+ cmp = gfc_find_component (declared, "_data", true, true);
ctree = fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (cmp->backend_decl),
var, cmp->backend_decl, NULL_TREE);
@@ -4504,13 +4504,13 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr,
if (!c->expr || cm->attr.allocatable)
continue;
- if (strcmp (cm->name, "$size") == 0)
+ if (strcmp (cm->name, "_size") == 0)
{
val = TYPE_SIZE_UNIT (gfc_get_derived_type (cm->ts.u.derived));
CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl, val);
}
else if (cm->initializer && cm->initializer->expr_type != EXPR_NULL
- && strcmp (cm->name, "$extends") == 0)
+ && strcmp (cm->name, "_extends") == 0)
{
tree vtab;
gfc_symbol *vtabs;
@@ -5875,15 +5875,15 @@ gfc_trans_class_init_assign (gfc_code *code)
gfc_start_block (&block);
lhs = gfc_copy_expr (code->expr1);
- gfc_add_component_ref (lhs, "$data");
+ gfc_add_data_component (lhs);
rhs = gfc_copy_expr (code->expr1);
- gfc_add_component_ref (rhs, "$vptr");
- gfc_add_component_ref (rhs, "$def_init");
+ gfc_add_vptr_component (rhs);
+ gfc_add_def_init_component (rhs);
sz = gfc_copy_expr (code->expr1);
- gfc_add_component_ref (sz, "$vptr");
- gfc_add_component_ref (sz, "$size");
+ gfc_add_vptr_component (sz);
+ gfc_add_size_component (sz);
gfc_init_se (&dst, NULL);
gfc_init_se (&src, NULL);
@@ -5914,9 +5914,9 @@ gfc_trans_class_assign (gfc_expr *expr1, gfc_expr
if (expr2->ts.type != BT_CLASS)
{
- /* Insert an additional assignment which sets the '$vptr' field. */
+ /* Insert an additional assignment which sets the '_vptr' field. */
lhs = gfc_copy_expr (expr1);
- gfc_add_component_ref (lhs, "$vptr");
+ gfc_add_vptr_component (lhs);
if (expr2->ts.type == BT_DERIVED)
{
gfc_symbol *vtab;
@@ -5945,7 +5945,7 @@ gfc_trans_class_assign (gfc_expr *expr1, gfc_expr
if (expr2->ts.type == BT_CLASS)
op = EXEC_ASSIGN;
else
- gfc_add_component_ref (expr1, "$data");
+ gfc_add_data_component (expr1);
if (op == EXEC_ASSIGN)
tmp = gfc_trans_assignment (expr1, expr2, false, true);
Index: gcc/fortran/class.c
===================================================================
--- gcc/fortran/class.c (revision 166419)
+++ gcc/fortran/class.c (working copy)
@@ -29,18 +29,18 @@ along with GCC; see the file COPYING3. If not see
Each CLASS variable is encapsulated by a class container, which is a
structure with two fields:
- * $data: A pointer to the actual data of the variable. This field has the
+ * _data: A pointer to the actual data of the variable. This field has the
declared type of the class variable and its attributes
(pointer/allocatable/dimension/...).
- * $vptr: A pointer to the vtable entry (see below) of the dynamic type.
+ * _vptr: A pointer to the vtable entry (see below) of the dynamic type.
For each derived type we set up a "vtable" entry, i.e. a structure with the
following fields:
- * $hash: A hash value serving as a unique identifier for this type.
- * $size: The size in bytes of the derived type.
- * $extends: A pointer to the vtable entry of the parent derived type.
- * $def_init: A pointer to a default initialized variable of this type.
- * $copy: A procedure pointer to a copying procedure.
+ * _hash: A hash value serving as a unique identifier for this type.
+ * _size: The size in bytes of the derived type.
+ * _extends: A pointer to the vtable entry of the parent derived type.
+ * _def_init: A pointer to a default initialized variable of this type.
+ * _copy: A procedure pointer to a copying procedure.
After these follow procedure pointer components for the specific
type-bound procedures. */
@@ -52,7 +52,7 @@ along with GCC; see the file COPYING3. If not see
/* Insert a reference to the component of the given name.
- Only to be used with CLASS containers. */
+ Only to be used with CLASS containers and vtables. */
void
gfc_add_component_ref (gfc_expr *e, const char *name)
@@ -68,7 +68,7 @@ gfc_add_component_ref (gfc_expr *e, const char *na
break;
tail = &((*tail)->next);
}
- if (*tail != NULL && strcmp (name, "$data") == 0)
+ if (*tail != NULL && strcmp (name, "_data") == 0)
next = *tail;
(*tail) = gfc_get_ref();
(*tail)->next = next;
@@ -82,7 +82,7 @@ gfc_add_component_ref (gfc_expr *e, const char *na
/* Build a NULL initializer for CLASS pointers,
- initializing the $data and $vptr components to zero. */
+ initializing the _data and _vptr components to zero. */
gfc_expr *
gfc_class_null_initializer (gfc_typespec *ts)
@@ -107,31 +107,46 @@ gfc_class_null_initializer (gfc_typespec *ts)
}
+/* Create a unique string identifier for a derived type, composed of its name
+ and module name. This is used to construct unique names for the class
+ containers and vtab symbols. */
+
+static void
+get_unique_type_string (char *string, gfc_symbol *derived)
+{
+ if (derived->module)
+ sprintf (string, "%s_%s", derived->module, derived->name);
+ else
+ sprintf (string, "%s_%s", derived->ns->proc_name->name, derived->name);
+}
+
+
/* Build a polymorphic CLASS entity, using the symbol that comes from
build_sym. A CLASS entity is represented by an encapsulating type,
- which contains the declared type as '$data' component, plus a pointer
- component '$vptr' which determines the dynamic type. */
+ which contains the declared type as '_data' component, plus a pointer
+ component '_vptr' which determines the dynamic type. */
gfc_try
gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
gfc_array_spec **as, bool delayed_vtab)
{
- char name[GFC_MAX_SYMBOL_LEN + 5];
+ char name[GFC_MAX_SYMBOL_LEN], tname[GFC_MAX_SYMBOL_LEN];
gfc_symbol *fclass;
gfc_symbol *vtab;
gfc_component *c;
/* Determine the name of the encapsulating type. */
+ get_unique_type_string (tname, ts->u.derived);
if ((*as) && (*as)->rank && attr->allocatable)
- sprintf (name, "class$%s_%d_a", ts->u.derived->name, (*as)->rank);
+ sprintf (name, "__class_%s_%d_a", tname, (*as)->rank);
else if ((*as) && (*as)->rank)
- sprintf (name, "class$%s_%d", ts->u.derived->name, (*as)->rank);
+ sprintf (name, "__class_%s_%d", tname, (*as)->rank);
else if (attr->pointer)
- sprintf (name, "class$%s_p", ts->u.derived->name);
+ sprintf (name, "__class_%s_p", tname);
else if (attr->allocatable)
- sprintf (name, "class$%s_a", ts->u.derived->name);
+ sprintf (name, "__class_%s_a", tname);
else
- sprintf (name, "class$%s", ts->u.derived->name);
+ sprintf (name, "__class_%s", tname);
gfc_find_symbol (name, ts->u.derived->ns, 0, &fclass);
if (fclass == NULL)
@@ -151,8 +166,8 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_a
NULL, &gfc_current_locus) == FAILURE)
return FAILURE;
- /* Add component '$data'. */
- if (gfc_add_component (fclass, "$data", &c) == FAILURE)
+ /* Add component '_data'. */
+ if (gfc_add_component (fclass, "_data", &c) == FAILURE)
return FAILURE;
c->ts = *ts;
c->ts.type = BT_DERIVED;
@@ -167,8 +182,8 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_a
c->as = (*as);
c->initializer = NULL;
- /* Add component '$vptr'. */
- if (gfc_add_component (fclass, "$vptr", &c) == FAILURE)
+ /* Add component '_vptr'. */
+ if (gfc_add_component (fclass, "_vptr", &c) == FAILURE)
return FAILURE;
c->ts.type = BT_DERIVED;
if (delayed_vtab)
@@ -316,7 +331,6 @@ gfc_find_derived_vtab (gfc_symbol *derived)
gfc_namespace *ns;
gfc_symbol *vtab = NULL, *vtype = NULL, *found_sym = NULL, *def_init = NULL;
gfc_symbol *copy = NULL, *src = NULL, *dst = NULL;
- char name[2 * GFC_MAX_SYMBOL_LEN + 8];
/* Find the top-level namespace (MODULE or PROGRAM). */
for (ns = gfc_current_ns; ns; ns = ns->parent)
@@ -329,7 +343,10 @@ gfc_find_derived_vtab (gfc_symbol *derived)
if (ns)
{
- sprintf (name, "vtab$%s", derived->name);
+ char name[GFC_MAX_SYMBOL_LEN], tname[GFC_MAX_SYMBOL_LEN];
+
+ get_unique_type_string (tname, derived);
+ sprintf (name, "__vtab_%s", tname);
/* Look for the vtab symbol in various namespaces. */
gfc_find_symbol (name, gfc_current_ns, 0, &vtab);
@@ -350,7 +367,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
vtab->attr.vtab = 1;
vtab->attr.access = ACCESS_PUBLIC;
gfc_set_sym_referenced (vtab);
- sprintf (name, "vtype$%s", derived->name);
+ sprintf (name, "__vtype_%s", tname);
gfc_find_symbol (name, ns, 0, &vtype);
if (vtype == NULL)
@@ -366,8 +383,8 @@ gfc_find_derived_vtab (gfc_symbol *derived)
vtype->attr.vtype = 1;
gfc_set_sym_referenced (vtype);
- /* Add component '$hash'. */
- if (gfc_add_component (vtype, "$hash", &c) == FAILURE)
+ /* Add component '_hash'. */
+ if (gfc_add_component (vtype, "_hash", &c) == FAILURE)
goto cleanup;
c->ts.type = BT_INTEGER;
c->ts.kind = 4;
@@ -375,8 +392,8 @@ gfc_find_derived_vtab (gfc_symbol *derived)
c->initializer = gfc_get_int_expr (gfc_default_integer_kind,
NULL, derived->hash_value);
- /* Add component '$size'. */
- if (gfc_add_component (vtype, "$size", &c) == FAILURE)
+ /* Add component '_size'. */
+ if (gfc_add_component (vtype, "_size", &c) == FAILURE)
goto cleanup;
c->ts.type = BT_INTEGER;
c->ts.kind = 4;
@@ -388,8 +405,8 @@ gfc_find_derived_vtab (gfc_symbol *derived)
c->initializer = gfc_get_int_expr (gfc_default_integer_kind,
NULL, 0);
- /* Add component $extends. */
- if (gfc_add_component (vtype, "$extends", &c) == FAILURE)
+ /* Add component _extends. */
+ if (gfc_add_component (vtype, "_extends", &c) == FAILURE)
goto cleanup;
c->attr.pointer = 1;
c->attr.access = ACCESS_PRIVATE;
@@ -419,8 +436,8 @@ gfc_find_derived_vtab (gfc_symbol *derived)
goto have_vtype;
}
- /* Add component $def_init. */
- if (gfc_add_component (vtype, "$def_init", &c) == FAILURE)
+ /* Add component _def_init. */
+ if (gfc_add_component (vtype, "_def_init", &c) == FAILURE)
goto cleanup;
c->attr.pointer = 1;
c->attr.access = ACCESS_PRIVATE;
@@ -431,7 +448,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
else
{
/* Construct default initialization variable. */
- sprintf (name, "def_init$%s", derived->name);
+ sprintf (name, "__def_init_%s", tname);
gfc_get_symbol (name, ns, &def_init);
def_init->attr.target = 1;
def_init->attr.save = SAVE_EXPLICIT;
@@ -445,8 +462,8 @@ gfc_find_derived_vtab (gfc_symbol *derived)
c->initializer = gfc_lval_expr_from_sym (def_init);
}
- /* Add component $copy. */
- if (gfc_add_component (vtype, "$copy", &c) == FAILURE)
+ /* Add component _copy. */
+ if (gfc_add_component (vtype, "_copy", &c) == FAILURE)
goto cleanup;
c->attr.proc_pointer = 1;
c->attr.access = ACCESS_PRIVATE;
@@ -462,7 +479,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
ns->contained = sub_ns;
sub_ns->resolved = 1;
/* Set up procedure symbol. */
- sprintf (name, "copy$%s", derived->name);
+ sprintf (name, "__copy_%s", tname);
gfc_get_symbol (name, sub_ns, ©);
sub_ns->proc_name = copy;
copy->attr.flavor = FL_PROCEDURE;
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (revision 166419)
+++ gcc/fortran/decl.c (working copy)
@@ -6014,10 +6014,10 @@ attr_decl1 (void)
/* Update symbol table. DIMENSION attribute is set in
gfc_set_array_spec(). For CLASS variables, this must be applied
- to the first component, or '$data' field. */
+ to the first component, or '_data' field. */
if (sym->ts.type == BT_CLASS && sym->ts.u.derived->attr.is_class)
{
- if (gfc_copy_attr (&CLASS_DATA (sym)->attr, ¤t_attr,&var_locus)
+ if (gfc_copy_attr (&CLASS_DATA (sym)->attr, ¤t_attr, &var_locus)
== FAILURE)
{
m = MATCH_ERROR;
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 166419)
+++ gcc/fortran/gfortran.h (working copy)
@@ -2877,6 +2877,11 @@ gfc_try gfc_check_same_strlen (const gfc_expr*, co
/* class.c */
void gfc_add_component_ref (gfc_expr *, const char *);
+#define gfc_add_data_component(e) gfc_add_component_ref(e,"_data")
+#define gfc_add_vptr_component(e) gfc_add_component_ref(e,"_vptr")
+#define gfc_add_hash_component(e) gfc_add_component_ref(e,"_hash")
+#define gfc_add_size_component(e) gfc_add_component_ref(e,"_size")
+#define gfc_add_def_init_component(e) gfc_add_component_ref(e,"_def_init")
gfc_expr *gfc_class_null_initializer (gfc_typespec *);
gfc_try gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
gfc_array_spec **, bool);
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (revision 166419)
+++ gcc/fortran/trans-stmt.c (working copy)
@@ -4388,7 +4388,7 @@ gfc_trans_allocate (gfc_code * code)
expr = gfc_copy_expr (al->expr);
if (expr->ts.type == BT_CLASS)
- gfc_add_component_ref (expr, "$data");
+ gfc_add_data_component (expr);
gfc_init_se (&se, NULL);
gfc_start_block (&se.pre);
@@ -4409,8 +4409,8 @@ gfc_trans_allocate (gfc_code * code)
gfc_expr *sz;
gfc_se se_sz;
sz = gfc_copy_expr (code->expr3);
- gfc_add_component_ref (sz, "$vptr");
- gfc_add_component_ref (sz, "$size");
+ gfc_add_vptr_component (sz);
+ gfc_add_size_component (sz);
gfc_init_se (&se_sz, NULL);
gfc_conv_expr (&se_sz, sz);
gfc_free_expr (sz);
@@ -4497,18 +4497,18 @@ gfc_trans_allocate (gfc_code * code)
actual = gfc_get_actual_arglist ();
actual->expr = gfc_copy_expr (rhs);
if (rhs->ts.type == BT_CLASS)
- gfc_add_component_ref (actual->expr, "$data");
+ gfc_add_data_component (actual->expr);
actual->next = gfc_get_actual_arglist ();
actual->next->expr = gfc_copy_expr (al->expr);
- gfc_add_component_ref (actual->next->expr, "$data");
+ gfc_add_data_component (actual->next->expr);
if (rhs->ts.type == BT_CLASS)
{
ppc = gfc_copy_expr (rhs);
- gfc_add_component_ref (ppc, "$vptr");
+ gfc_add_vptr_component (ppc);
}
else
ppc = gfc_lval_expr_from_sym (gfc_find_derived_vtab (rhs->ts.u.derived));
- gfc_add_component_ref (ppc, "$copy");
+ gfc_add_component_ref (ppc, "_copy");
gfc_conv_procedure_call (&call, ppc->symtree->n.sym, actual,
ppc, NULL);
gfc_add_expr_to_block (&call.pre, call.expr);
@@ -4527,8 +4527,8 @@ gfc_trans_allocate (gfc_code * code)
/* Default-initialization via MOLD (polymorphic). */
gfc_expr *rhs = gfc_copy_expr (code->expr3);
gfc_se dst,src;
- gfc_add_component_ref (rhs, "$vptr");
- gfc_add_component_ref (rhs, "$def_init");
+ gfc_add_vptr_component (rhs);
+ gfc_add_def_init_component (rhs);
gfc_init_se (&dst, NULL);
gfc_init_se (&src, NULL);
gfc_conv_expr (&dst, expr);
@@ -4549,13 +4549,13 @@ gfc_trans_allocate (gfc_code * code)
/* Initialize VPTR for CLASS objects. */
lhs = gfc_expr_to_initialize (expr);
- gfc_add_component_ref (lhs, "$vptr");
+ gfc_add_vptr_component (lhs);
rhs = NULL;
if (code->expr3 && code->expr3->ts.type == BT_CLASS)
{
/* Polymorphic SOURCE: VPTR must be determined at run time. */
rhs = gfc_copy_expr (code->expr3);
- gfc_add_component_ref (rhs, "$vptr");
+ gfc_add_vptr_component (rhs);
tmp = gfc_trans_pointer_assignment (lhs, rhs);
gfc_add_expr_to_block (&block, tmp);
gfc_free_expr (rhs);
Index: gcc/fortran/module.c
===================================================================
--- gcc/fortran/module.c (revision 166419)
+++ gcc/fortran/module.c (working copy)
@@ -4372,8 +4372,8 @@ read_module (void)
p = name;
/* Exception: Always import vtabs & vtypes. */
- if (p == NULL && (strncmp (name, "vtab$", 5) == 0
- || strncmp (name, "vtype$", 6) == 0))
+ if (p == NULL && (strncmp (name, "__vtab_", 5) == 0
+ || strncmp (name, "__vtype_", 6) == 0))
p = name;
/* Skip symtree nodes not in an ONLY clause, unless there
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 166419)
+++ gcc/fortran/resolve.c (working copy)
@@ -988,9 +988,9 @@ resolve_structure_cons (gfc_expr *expr, int init)
!gfc_compare_types (&cons->expr->ts, &comp->ts))
{
t = FAILURE;
- if (strcmp (comp->name, "$extends") == 0)
+ if (strcmp (comp->name, "_extends") == 0)
{
- /* Can afford to be brutal with the $extends initializer.
+ /* Can afford to be brutal with the _extends initializer.
The derived type can get lost because it is PRIVATE
but it is not usage constrained by the standard. */
cons->expr->ts = comp->ts;
@@ -5726,7 +5726,7 @@ resolve_typebound_function (gfc_expr* e)
is present. */
ts = expr->ts;
declared = ts.u.derived;
- c = gfc_find_component (declared, "$vptr", true, true);
+ c = gfc_find_component (declared, "_vptr", true, true);
if (c->ts.u.derived == NULL)
c->ts.u.derived = gfc_find_derived_vtab (declared);
@@ -5737,7 +5737,7 @@ resolve_typebound_function (gfc_expr* e)
name = name ? name : e->value.function.esym->name;
e->symtree = expr->symtree;
e->ref = gfc_copy_ref (expr->ref);
- gfc_add_component_ref (e, "$vptr");
+ gfc_add_vptr_component (e);
gfc_add_component_ref (e, name);
e->value.function.esym = NULL;
return SUCCESS;
@@ -5760,7 +5760,7 @@ resolve_typebound_function (gfc_expr* e)
return resolve_compcall (e, NULL);
}
- c = gfc_find_component (declared, "$data", true, true);
+ c = gfc_find_component (declared, "_data", true, true);
declared = c->ts.u.derived;
/* Treat the call as if it is a typebound procedure, in order to roll
@@ -5776,8 +5776,8 @@ resolve_typebound_function (gfc_expr* e)
if (new_ref)
e->ref = new_ref;
- /* '$vptr' points to the vtab, which contains the procedure pointers. */
- gfc_add_component_ref (e, "$vptr");
+ /* '_vptr' points to the vtab, which contains the procedure pointers. */
+ gfc_add_vptr_component (e);
gfc_add_component_ref (e, name);
/* Recover the typespec for the expression. This is really only
@@ -5816,7 +5816,7 @@ resolve_typebound_subroutine (gfc_code *code)
is present. */
ts = expr->symtree->n.sym->ts;
declared = ts.u.derived;
- c = gfc_find_component (declared, "$vptr", true, true);
+ c = gfc_find_component (declared, "_vptr", true, true);
if (c->ts.u.derived == NULL)
c->ts.u.derived = gfc_find_derived_vtab (declared);
@@ -5827,7 +5827,7 @@ resolve_typebound_subroutine (gfc_code *code)
name = name ? name : code->expr1->value.function.esym->name;
code->expr1->symtree = expr->symtree;
expr->symtree->n.sym->ts.u.derived = declared;
- gfc_add_component_ref (code->expr1, "$vptr");
+ gfc_add_vptr_component (code->expr1);
gfc_add_component_ref (code->expr1, name);
code->expr1->value.function.esym = NULL;
return SUCCESS;
@@ -5861,8 +5861,8 @@ resolve_typebound_subroutine (gfc_code *code)
if (new_ref)
code->expr1->ref = new_ref;
- /* '$vptr' points to the vtab, which contains the procedure pointers. */
- gfc_add_component_ref (code->expr1, "$vptr");
+ /* '_vptr' points to the vtab, which contains the procedure pointers. */
+ gfc_add_vptr_component (code->expr1);
gfc_add_component_ref (code->expr1, name);
/* Recover the typespec for the expression. This is really only
@@ -6404,7 +6404,7 @@ resolve_deallocate_expr (gfc_expr *e)
if (e->ts.type == BT_CLASS)
{
/* Only deallocate the DATA component. */
- gfc_add_component_ref (e, "$data");
+ gfc_add_data_component (e);
}
return SUCCESS;
@@ -7735,8 +7735,8 @@ resolve_select_type (gfc_code *code, gfc_namespace
ns->code->next = new_st;
code = new_st;
code->op = EXEC_SELECT;
- gfc_add_component_ref (code->expr1, "$vptr");
- gfc_add_component_ref (code->expr1, "$hash");
+ gfc_add_vptr_component (code->expr1);
+ gfc_add_hash_component (code->expr1);
/* Loop over TYPE IS / CLASS IS cases. */
for (body = code->block; body; body = body->block)
@@ -7756,14 +7756,14 @@ resolve_select_type (gfc_code *code, gfc_namespace
'global' one). */
if (c->ts.type == BT_CLASS)
- sprintf (name, "tmp$class$%s", c->ts.u.derived->name);
+ sprintf (name, "__tmp_class_%s", c->ts.u.derived->name);
else
- sprintf (name, "tmp$type$%s", c->ts.u.derived->name);
+ sprintf (name, "__tmp_type_%s", c->ts.u.derived->name);
st = gfc_find_symtree (ns->sym_root, name);
gcc_assert (st->n.sym->assoc);
st->n.sym->assoc->target = gfc_get_variable_expr (code->expr1->symtree);
if (c->ts.type == BT_DERIVED)
- gfc_add_component_ref (st->n.sym->assoc->target, "$data");
+ gfc_add_data_component (st->n.sym->assoc->target);
new_st = gfc_get_code ();
new_st->op = EXEC_BLOCK;
@@ -7880,7 +7880,7 @@ resolve_select_type (gfc_code *code, gfc_namespace
/* Set up arguments. */
new_st->expr1->value.function.actual = gfc_get_actual_arglist ();
new_st->expr1->value.function.actual->expr = gfc_get_variable_expr (code->expr1->symtree);
- gfc_add_component_ref (new_st->expr1->value.function.actual->expr, "$vptr");
+ gfc_add_vptr_component (new_st->expr1->value.function.actual->expr);
vtab = gfc_find_derived_vtab (body->ext.case_list->ts.u.derived);
st = gfc_find_symtree (vtab->ns->sym_root, vtab->name);
new_st->expr1->value.function.actual->next = gfc_get_actual_arglist ();
@@ -11193,8 +11193,8 @@ resolve_fl_derived (gfc_symbol *sym)
if (sym->attr.is_class && sym->ts.u.derived == NULL)
{
/* Fix up incomplete CLASS symbols. */
- gfc_component *data = gfc_find_component (sym, "$data", true, true);
- gfc_component *vptr = gfc_find_component (sym, "$vptr", true, true);
+ gfc_component *data = gfc_find_component (sym, "_data", true, true);
+ gfc_component *vptr = gfc_find_component (sym, "_vptr", true, true);
if (vptr->ts.u.derived == NULL)
{
gfc_symbol *vtab = gfc_find_derived_vtab (data->ts.u.derived);
Index: gcc/fortran/iresolve.c
===================================================================
--- gcc/fortran/iresolve.c (revision 166419)
+++ gcc/fortran/iresolve.c (working copy)
@@ -938,7 +938,7 @@ gfc_resolve_extends_type_of (gfc_expr *f, gfc_expr
/* Replace the first argument with the corresponding vtab. */
if (a->ts.type == BT_CLASS)
- gfc_add_component_ref (a, "$vptr");
+ gfc_add_vptr_component (a);
else if (a->ts.type == BT_DERIVED)
{
vtab = gfc_find_derived_vtab (a->ts.u.derived);
@@ -954,7 +954,7 @@ gfc_resolve_extends_type_of (gfc_expr *f, gfc_expr
/* Replace the second argument with the corresponding vtab. */
if (mo->ts.type == BT_CLASS)
- gfc_add_component_ref (mo, "$vptr");
+ gfc_add_vptr_component (mo);
else if (mo->ts.type == BT_DERIVED)
{
vtab = gfc_find_derived_vtab (mo->ts.u.derived);
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c (revision 166419)
+++ gcc/fortran/match.c (working copy)
@@ -4516,9 +4516,9 @@ select_type_set_tmp (gfc_typespec *ts)
return;
if (ts->type == BT_CLASS)
- sprintf (name, "tmp$class$%s", ts->u.derived->name);
+ sprintf (name, "__tmp_class_%s", ts->u.derived->name);
else
- sprintf (name, "tmp$type$%s", ts->u.derived->name);
+ sprintf (name, "__tmp_type_%s", ts->u.derived->name);
gfc_get_sym_tree (name, gfc_current_ns, &tmp, false);
gfc_add_type (tmp->n.sym, ts, NULL);
gfc_set_sym_referenced (tmp->n.sym);
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c (revision 166419)
+++ gcc/fortran/trans-decl.c (working copy)
@@ -3393,7 +3393,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gf
e = gfc_lval_expr_from_sym (sym);
if (sym->ts.type == BT_CLASS)
- gfc_add_component_ref (e, "$data");
+ gfc_add_data_component (e);
gfc_init_se (&se, NULL);
se.want_pointer = 1;
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c (revision 166419)
+++ gcc/fortran/trans-intrinsic.c (working copy)
@@ -4547,7 +4547,7 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *e
if (ss == gfc_ss_terminator)
{
if (arg->ts.type == BT_CLASS)
- gfc_add_component_ref (arg, "$data");
+ gfc_add_data_component (arg);
gfc_conv_expr_reference (&argse, arg);
@@ -4618,8 +4618,8 @@ gfc_conv_intrinsic_storage_size (gfc_se *se, gfc_e
{
if (arg->ts.type == BT_CLASS)
{
- gfc_add_component_ref (arg, "$vptr");
- gfc_add_component_ref (arg, "$size");
+ gfc_add_vptr_component (arg);
+ gfc_add_size_component (arg);
gfc_conv_expr (&argse, arg);
tmp = fold_convert (result_type, argse.expr);
goto done;
@@ -5070,7 +5070,7 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr)
/* Allocatable scalar. */
arg1se.want_pointer = 1;
if (arg1->expr->ts.type == BT_CLASS)
- gfc_add_component_ref (arg1->expr, "$data");
+ gfc_add_data_component (arg1->expr);
gfc_conv_expr (&arg1se, arg1->expr);
tmp = arg1se.expr;
}
@@ -5111,7 +5111,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
gfc_init_se (&arg2se, NULL);
arg1 = expr->value.function.actual;
if (arg1->expr->ts.type == BT_CLASS)
- gfc_add_component_ref (arg1->expr, "$data");
+ gfc_add_data_component (arg1->expr);
arg2 = arg1->next;
ss1 = gfc_walk_expr (arg1->expr);
@@ -5141,7 +5141,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
{
/* An optional target. */
if (arg2->expr->ts.type == BT_CLASS)
- gfc_add_component_ref (arg2->expr, "$data");
+ gfc_add_data_component (arg2->expr);
ss2 = gfc_walk_expr (arg2->expr);
nonzero_charlen = NULL_TREE;
@@ -5228,8 +5228,8 @@ gfc_conv_same_type_as (gfc_se *se, gfc_expr *expr)
if (a->ts.type == BT_CLASS)
{
- gfc_add_component_ref (a, "$vptr");
- gfc_add_component_ref (a, "$hash");
+ gfc_add_vptr_component (a);
+ gfc_add_hash_component (a);
}
else if (a->ts.type == BT_DERIVED)
a = gfc_get_int_expr (gfc_default_integer_kind, NULL,
@@ -5237,8 +5237,8 @@ gfc_conv_same_type_as (gfc_se *se, gfc_expr *expr)
if (b->ts.type == BT_CLASS)
{
- gfc_add_component_ref (b, "$vptr");
- gfc_add_component_ref (b, "$hash");
+ gfc_add_vptr_component (b);
+ gfc_add_hash_component (b);
}
else if (b->ts.type == BT_DERIVED)
b = gfc_get_int_expr (gfc_default_integer_kind, NULL,
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2010-11-07 18:44 ` Janus Weil
@ 2010-11-08 13:27 ` Tobias Burnus
2010-11-09 10:41 ` Janus Weil
0 siblings, 1 reply; 23+ messages in thread
From: Tobias Burnus @ 2010-11-08 13:27 UTC (permalink / raw)
To: Janus Weil; +Cc: gfortran, gcc-patches
On 11/07/2010 07:44 PM, Janus Weil wrote:
> Ok, so it seems to me that using two leading underscores is really the
> best option, since it's safe against collisions with Fortran and C
> user code, and also safe to use with -fdollar-ok.
>
> The attached patch adds double underscores for the vtabs, vtypes,
> class containers and temporaries.
OK. Thanks for the patch!
Tobias
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2010-11-08 13:27 ` Tobias Burnus
@ 2010-11-09 10:41 ` Janus Weil
2018-09-17 8:59 ` Bernhard Reutner-Fischer
0 siblings, 1 reply; 23+ messages in thread
From: Janus Weil @ 2010-11-09 10:41 UTC (permalink / raw)
To: Tobias Burnus; +Cc: gfortran, gcc-patches
>> Ok, so it seems to me that using two leading underscores is really the
>> best option, since it's safe against collisions with Fortran and C
>> user code, and also safe to use with -fdollar-ok.
>>
>> The attached patch adds double underscores for the vtabs, vtypes,
>> class containers and temporaries.
>
> OK. Thanks for the patch!
Committed as r166480.
Thanks for all the helpful comments, everyone!
Cheers,
Janus
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2010-11-09 10:41 ` Janus Weil
@ 2018-09-17 8:59 ` Bernhard Reutner-Fischer
2018-09-17 19:22 ` Janus Weil
0 siblings, 1 reply; 23+ messages in thread
From: Bernhard Reutner-Fischer @ 2018-09-17 8:59 UTC (permalink / raw)
To: Janus Weil; +Cc: Tobias Burnus, gfortran, GCC Patches
On Tue, 9 Nov 2010 at 11:41, Janus Weil <janus@gcc.gnu.org> wrote:
>
> >> Ok, so it seems to me that using two leading underscores is really the
> >> best option, since it's safe against collisions with Fortran and C
> >> user code, and also safe to use with -fdollar-ok.
> >>
> >> The attached patch adds double underscores for the vtabs, vtypes,
> >> class containers and temporaries.
> >
> > OK. Thanks for the patch!
>
> Committed as r166480.
>
> Thanks for all the helpful comments, everyone!
Index: gcc/fortran/module.c
===================================================================
--- gcc/fortran/module.c (revision 166419)
+++ gcc/fortran/module.c (working copy)
@@ -4372,8 +4372,8 @@ read_module (void)
p = name;
/* Exception: Always import vtabs & vtypes. */
- if (p == NULL && (strncmp (name, "vtab$", 5) == 0
- || strncmp (name, "vtype$", 6) == 0))
+ if (p == NULL && (strncmp (name, "__vtab_", 5) == 0
+ || strncmp (name, "__vtype_", 6) == 0))
p = name;
/* Skip symtree nodes not in an ONLY clause, unless there
---8<---
Sorry for the late follow-up but current trunk still has the code
quoted above where we forgot to add 2 to the length parameter of both
strncmp calls.
I think it would be nice to teach the C and C++ frontends to warn
about this even though it might trigger in quite some code in the
wild.
Looking at gcc/fortran alone there are
gcc/fortran/interface.c: if (strncmp (mode, "unformatted", 9) == 0) // 11 !
gcc/fortran/module.c: && (strncmp (name, "__vtab_", 5) == 0 // 7 !
gcc/fortran/module.c: || strncmp (name, "__vtype_", 6) == 0)) // 8!
gcc/fortran/module.c: || (strncmp (name, "__vtab_", 5) != 0 // 7!
gcc/fortran/module.c: && strncmp (name, "__vtype_", 6)
!= 0)) // 8!
so warning by default with -Wall or at least per default in -Wextra
would make sense IMO.
cheers,
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2018-09-17 8:59 ` Bernhard Reutner-Fischer
@ 2018-09-17 19:22 ` Janus Weil
2018-09-17 20:25 ` Janus Weil
0 siblings, 1 reply; 23+ messages in thread
From: Janus Weil @ 2018-09-17 19:22 UTC (permalink / raw)
To: Bernhard Reutner-Fischer; +Cc: Tobias Burnus, gfortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 2884 bytes --]
Am Mo., 17. Sep. 2018 um 10:59 Uhr schrieb Bernhard Reutner-Fischer
<rep.dot.nop@gmail.com>:
>
> On Tue, 9 Nov 2010 at 11:41, Janus Weil <janus@gcc.gnu.org> wrote:
> >
> > >> Ok, so it seems to me that using two leading underscores is really the
> > >> best option, since it's safe against collisions with Fortran and C
> > >> user code, and also safe to use with -fdollar-ok.
> > >>
> > >> The attached patch adds double underscores for the vtabs, vtypes,
> > >> class containers and temporaries.
> > >
> > > OK. Thanks for the patch!
> >
> > Committed as r166480.
> >
> > Thanks for all the helpful comments, everyone!
>
> Index: gcc/fortran/module.c
> ===================================================================
> --- gcc/fortran/module.c (revision 166419)
> +++ gcc/fortran/module.c (working copy)
> @@ -4372,8 +4372,8 @@ read_module (void)
> p = name;
>
> /* Exception: Always import vtabs & vtypes. */
> - if (p == NULL && (strncmp (name, "vtab$", 5) == 0
> - || strncmp (name, "vtype$", 6) == 0))
> + if (p == NULL && (strncmp (name, "__vtab_", 5) == 0
> + || strncmp (name, "__vtype_", 6) == 0))
> p = name;
>
> /* Skip symtree nodes not in an ONLY clause, unless there
>
> ---8<---
>
> Sorry for the late follow-up
'Late' is a pretty bold understatement for 8 years ;D
But in any case, 'late' is certainly better than 'never' ...
> but current trunk still has the code
> quoted above where we forgot to add 2 to the length parameter of both
> strncmp calls.
True! Thanks for noticing. I'll take care of fixing it.
> I think it would be nice to teach the C and C++ frontends to warn
> about this even though it might trigger in quite some code in the
> wild.
I don't really think this is a good idea. There are actually valid use
cases of strncmp, where the 'num' argument does not correspond to the
length of any of the two strings (in particular if they're not const).
Instead, for the sake of gfortran, how about a macro like this?
#define gfc_str_startswith(str, pref) \
(strncmp ((str), (pref), strlen (pref)) == 0)
(In fact I just noticed that something like this already exists in
trans-intrinsic.c, so I would just move it into gfortran.h and rename
it.)
> Looking at gcc/fortran alone there are
> gcc/fortran/interface.c: if (strncmp (mode, "unformatted", 9) == 0) // 11 !
I think this one could actually be a 'strcmp'?
> gcc/fortran/module.c: && (strncmp (name, "__vtab_", 5) == 0 // 7 !
> gcc/fortran/module.c: || strncmp (name, "__vtype_", 6) == 0)) // 8!
> gcc/fortran/module.c: || (strncmp (name, "__vtab_", 5) != 0 // 7!
> gcc/fortran/module.c: && strncmp (name, "__vtype_", 6)
> != 0)) // 8!
Here the new macro could be applied (and in a few other cases as
well), see attached patch.
I'm regtesting the patch now. Ok for trunk if it passes?
Cheers,
Janus
[-- Attachment #2: strncmp_macro.diff --]
[-- Type: text/x-patch, Size: 10631 bytes --]
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 3d19ad479e5..91a1f34d7f1 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -2529,7 +2529,7 @@ variable_decl (int elem)
}
/* %FILL components may not have initializers. */
- if (strncmp (name, "%FILL", 5) == 0 && gfc_match_eos () != MATCH_YES)
+ if (gfc_str_startswith (name, "%FILL") && gfc_match_eos () != MATCH_YES)
{
gfc_error ("%qs entity cannot have an initializer at %C", "%FILL");
m = MATCH_ERROR;
@@ -7811,7 +7811,7 @@ gfc_match_end (gfc_statement *st)
{
case COMP_ASSOCIATE:
case COMP_BLOCK:
- if (!strncmp (block_name, "block@", strlen("block@")))
+ if (gfc_str_startswith (block_name, "block@"))
block_name = NULL;
break;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 04b0024a992..8f37a51d71c 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3305,6 +3305,9 @@ bool gfc_is_compile_time_shape (gfc_array_spec *);
bool gfc_ref_dimen_size (gfc_array_ref *, int dimen, mpz_t *, mpz_t *);
+#define gfc_str_startswith(str, pref) \
+ (strncmp ((str), (pref), strlen (pref)) == 0)
+
/* interface.c -- FIXME: some of these should be in symbol.c */
void gfc_free_interface (gfc_interface *);
bool gfc_compare_derived_types (gfc_symbol *, gfc_symbol *);
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index f85c76bad0f..ff6b2bb7ece 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -122,9 +122,9 @@ fold_unary_intrinsic (gfc_intrinsic_op op)
static gfc_intrinsic_op
dtio_op (char* mode)
{
- if (strncmp (mode, "formatted", 9) == 0)
+ if (strcmp (mode, "formatted") == 0)
return INTRINSIC_FORMATTED;
- if (strncmp (mode, "unformatted", 9) == 0)
+ if (strcmp (mode, "unformatted") == 0)
return INTRINSIC_UNFORMATTED;
return INTRINSIC_NONE;
}
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 2eb8f7c9113..f2d6bbaec5c 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -698,7 +698,7 @@ is_trig_resolved (gfc_expr *f)
/* We know we've already resolved the function if we see the lib call
starting with '__'. */
return (f->value.function.name != NULL
- && strncmp ("__", f->value.function.name, 2) == 0);
+ && gfc_str_startswith (f->value.function.name, "__"));
}
/* Return a shallow copy of the function expression f. The original expression
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 993ea9f16b9..7b8e863ca0a 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -4791,7 +4791,7 @@ load_omp_udrs (void)
mio_pool_string (&name);
gfc_clear_ts (&ts);
mio_typespec (&ts);
- if (strncmp (name, "operator ", sizeof ("operator ") - 1) == 0)
+ if (gfc_str_startswith (name, "operator "))
{
const char *p = name + sizeof ("operator ") - 1;
if (strcmp (p, "+") == 0)
@@ -5233,8 +5233,8 @@ read_module (void)
/* Exception: Always import vtabs & vtypes. */
if (p == NULL && name[0] == '_'
- && (strncmp (name, "__vtab_", 5) == 0
- || strncmp (name, "__vtype_", 6) == 0))
+ && (gfc_str_startswith (name, "__vtab_")
+ || gfc_str_startswith (name, "__vtype_")))
p = name;
/* Skip symtree nodes not in an ONLY clause, unless there
@@ -5319,8 +5319,8 @@ read_module (void)
sym->attr.use_rename = 1;
if (name[0] != '_'
- || (strncmp (name, "__vtab_", 5) != 0
- && strncmp (name, "__vtype_", 6) != 0))
+ || (!gfc_str_startswith (name, "__vtab_")
+ && !gfc_str_startswith (name, "__vtype_")))
sym->attr.use_only = only_flag;
/* Store the symtree pointing to this symbol. */
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index e8db54d4d37..73f5389361d 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -565,7 +565,7 @@ gfc_handle_runtime_check_option (const char *arg)
result = 1;
break;
}
- else if (optname[n] && pos > 3 && strncmp ("no-", arg, 3) == 0
+ else if (optname[n] && pos > 3 && gfc_str_startswith (arg, "no-")
&& strncmp (optname[n], arg+3, pos-3) == 0)
{
gfc_option.rtcheck &= ~optmask[n];
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 094f2101bbc..6f45afa86ea 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1713,21 +1713,21 @@ match_arg_list_function (gfc_actual_arglist *result)
switch (name[0])
{
case 'l':
- if (strncmp (name, "loc", 3) == 0)
+ if (gfc_str_startswith (name, "loc"))
{
result->name = "%LOC";
break;
}
/* FALLTHRU */
case 'r':
- if (strncmp (name, "ref", 3) == 0)
+ if (gfc_str_startswith (name, "ref"))
{
result->name = "%REF";
break;
}
/* FALLTHRU */
case 'v':
- if (strncmp (name, "val", 3) == 0)
+ if (gfc_str_startswith (name, "val"))
{
result->name = "%VAL";
break;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e6180b889ec..a2beb7fc90a 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2061,7 +2061,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
nothing to do for %REF. */
if (arg->name && arg->name[0] == '%')
{
- if (strncmp ("%VAL", arg->name, 4) == 0)
+ if (strcmp ("%VAL", arg->name) == 0)
{
if (e->ts.type == BT_CHARACTER || e->ts.type == BT_DERIVED)
{
@@ -2093,7 +2093,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
}
/* Statement functions have already been excluded above. */
- else if (strncmp ("%LOC", arg->name, 4) == 0
+ else if (strcmp ("%LOC", arg->name) == 0
&& e->ts.type == BT_PROCEDURE)
{
if (e->symtree->n.sym->attr.proc == PROC_INTERNAL)
@@ -3265,7 +3265,7 @@ resolve_function (gfc_expr *expr)
if (arg->next->expr->expr_type != EXPR_CONSTANT)
break;
- if (arg->next->name && strncmp (arg->next->name, "kind", 4) == 0)
+ if (arg->next->name && strcmp (arg->next->name, "kind") == 0)
break;
if ((int)mpz_get_si (arg->next->expr->value.integer)
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 06066eb93dd..159c3dbbc6b 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1828,7 +1828,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
GFC_DECL_ASSOCIATE_VAR_P (decl) = 1;
if (sym->attr.vtab
- || (sym->name[0] == '_' && strncmp ("__def_init", sym->name, 10) == 0))
+ || (sym->name[0] == '_' && gfc_str_startswith (sym->name, "__def_init")))
TREE_READONLY (decl) = 1;
return decl;
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 35052a8a8ea..54a2877f8c5 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -4705,14 +4705,14 @@ conv_arglist_function (gfc_se *se, gfc_expr *expr, const char *name)
indirectly for %LOC, else by reference. Thus %REF
is a "do-nothing" and %LOC is the same as an F95
pointer. */
- if (strncmp (name, "%VAL", 4) == 0)
+ if (strcmp (name, "%VAL") == 0)
gfc_conv_expr (se, expr);
- else if (strncmp (name, "%LOC", 4) == 0)
+ else if (strcmp (name, "%LOC") == 0)
{
gfc_conv_expr_reference (se, expr);
se->expr = gfc_build_addr_expr (NULL, se->expr);
}
- else if (strncmp (name, "%REF", 4) == 0)
+ else if (strcmp (name, "%REF") == 0)
gfc_conv_expr_reference (se, expr);
else
gfc_error ("Unknown argument list function at %L", &expr->where);
@@ -5869,7 +5869,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
/* When calling __copy for character expressions to unlimited
polymorphic entities, the dst argument needs a string length. */
if (sym->name[0] == '_' && e && e->ts.type == BT_CHARACTER
- && strncmp (sym->name, "__vtab_CHARACTER", 16) == 0
+ && gfc_str_startswith (sym->name, "__vtab_CHARACTER")
&& arg->next && arg->next->expr
&& (arg->next->expr->ts.type == BT_DERIVED
|| arg->next->expr->ts.type == BT_CLASS)
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index b2cea93742a..d93f87b9e29 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -8937,37 +8937,33 @@ gfc_conv_ieee_arithmetic_function (gfc_se * se, gfc_expr * expr)
{
const char *name = expr->value.function.name;
-#define STARTS_WITH(A,B) (strncmp((A), (B), strlen(B)) == 0)
-
- if (STARTS_WITH (name, "_gfortran_ieee_is_nan"))
+ if (gfc_str_startswith (name, "_gfortran_ieee_is_nan"))
conv_intrinsic_ieee_builtin (se, expr, BUILT_IN_ISNAN, 1);
- else if (STARTS_WITH (name, "_gfortran_ieee_is_finite"))
+ else if (gfc_str_startswith (name, "_gfortran_ieee_is_finite"))
conv_intrinsic_ieee_builtin (se, expr, BUILT_IN_ISFINITE, 1);
- else if (STARTS_WITH (name, "_gfortran_ieee_unordered"))
+ else if (gfc_str_startswith (name, "_gfortran_ieee_unordered"))
conv_intrinsic_ieee_builtin (se, expr, BUILT_IN_ISUNORDERED, 2);
- else if (STARTS_WITH (name, "_gfortran_ieee_is_normal"))
+ else if (gfc_str_startswith (name, "_gfortran_ieee_is_normal"))
conv_intrinsic_ieee_is_normal (se, expr);
- else if (STARTS_WITH (name, "_gfortran_ieee_is_negative"))
+ else if (gfc_str_startswith (name, "_gfortran_ieee_is_negative"))
conv_intrinsic_ieee_is_negative (se, expr);
- else if (STARTS_WITH (name, "_gfortran_ieee_copy_sign"))
+ else if (gfc_str_startswith (name, "_gfortran_ieee_copy_sign"))
conv_intrinsic_ieee_copy_sign (se, expr);
- else if (STARTS_WITH (name, "_gfortran_ieee_scalb"))
+ else if (gfc_str_startswith (name, "_gfortran_ieee_scalb"))
conv_intrinsic_ieee_scalb (se, expr);
- else if (STARTS_WITH (name, "_gfortran_ieee_next_after"))
+ else if (gfc_str_startswith (name, "_gfortran_ieee_next_after"))
conv_intrinsic_ieee_next_after (se, expr);
- else if (STARTS_WITH (name, "_gfortran_ieee_rem"))
+ else if (gfc_str_startswith (name, "_gfortran_ieee_rem"))
conv_intrinsic_ieee_rem (se, expr);
- else if (STARTS_WITH (name, "_gfortran_ieee_logb"))
+ else if (gfc_str_startswith (name, "_gfortran_ieee_logb"))
conv_intrinsic_ieee_logb_rint (se, expr, BUILT_IN_LOGB);
- else if (STARTS_WITH (name, "_gfortran_ieee_rint"))
+ else if (gfc_str_startswith (name, "_gfortran_ieee_rint"))
conv_intrinsic_ieee_logb_rint (se, expr, BUILT_IN_RINT);
else
/* It is not among the functions we translate directly. We return
false, so a library function call is emitted. */
return false;
-#undef STARTS_WITH
-
return true;
}
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2018-09-17 19:22 ` Janus Weil
@ 2018-09-17 20:25 ` Janus Weil
2018-09-19 14:50 ` Bernhard Reutner-Fischer
0 siblings, 1 reply; 23+ messages in thread
From: Janus Weil @ 2018-09-17 20:25 UTC (permalink / raw)
To: Bernhard Reutner-Fischer; +Cc: Tobias Burnus, gfortran, gcc-patches
Am Mo., 17. Sep. 2018 um 21:21 Uhr schrieb Janus Weil <janus@gcc.gnu.org>:
>
> Instead, for the sake of gfortran, how about a macro like this?
>
> #define gfc_str_startswith(str, pref) \
> (strncmp ((str), (pref), strlen (pref)) == 0)
>
> (In fact I just noticed that something like this already exists in
> trans-intrinsic.c, so I would just move it into gfortran.h and rename
> it.)
>
>
> > Looking at gcc/fortran alone there are
> > gcc/fortran/interface.c: if (strncmp (mode, "unformatted", 9) == 0) // 11 !
>
> I think this one could actually be a 'strcmp'?
>
>
> > gcc/fortran/module.c: && (strncmp (name, "__vtab_", 5) == 0 // 7 !
> > gcc/fortran/module.c: || strncmp (name, "__vtype_", 6) == 0)) // 8!
> > gcc/fortran/module.c: || (strncmp (name, "__vtab_", 5) != 0 // 7!
> > gcc/fortran/module.c: && strncmp (name, "__vtype_", 6)
> > != 0)) // 8!
>
> Here the new macro could be applied (and in a few other cases as
> well), see attached patch.
>
> I'm regtesting the patch now. Ok for trunk if it passes?
The regtest was successful. I don't think the off-by-two error for the
vtab/vtype comparisons is a big problem in practice, since the number
of internal symbols with leading underscores is very limited, but of
course it should still be fixed ...
Cheers,
Janus
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2018-09-17 20:25 ` Janus Weil
@ 2018-09-19 14:50 ` Bernhard Reutner-Fischer
2018-09-20 19:36 ` Janus Weil
0 siblings, 1 reply; 23+ messages in thread
From: Bernhard Reutner-Fischer @ 2018-09-19 14:50 UTC (permalink / raw)
To: Janus Weil; +Cc: Tobias Burnus, gfortran, GCC Patches
On Mon, 17 Sep 2018 at 22:25, Janus Weil <janus@gcc.gnu.org> wrote:
> The regtest was successful. I don't think the off-by-two error for the
> vtab/vtype comparisons is a big problem in practice, since the number
> of internal symbols with leading underscores is very limited, but of
> course it should still be fixed ...
Luckily it should make no difference indeed as "__vta" and "__vtyp"
are only used for this one purpose.
I don't think the DTIO op keyword fix would hit any real user either.
Thanks for taking care of it, patch LGTM.
cheers,
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2018-09-19 14:50 ` Bernhard Reutner-Fischer
@ 2018-09-20 19:36 ` Janus Weil
0 siblings, 0 replies; 23+ messages in thread
From: Janus Weil @ 2018-09-20 19:36 UTC (permalink / raw)
To: Bernhard Reutner-Fischer; +Cc: Tobias Burnus, gfortran, gcc-patches
Am Mi., 19. Sep. 2018 um 16:50 Uhr schrieb Bernhard Reutner-Fischer
<rep.dot.nop@gmail.com>:
>
> On Mon, 17 Sep 2018 at 22:25, Janus Weil <janus@gcc.gnu.org> wrote:
>
> > The regtest was successful. I don't think the off-by-two error for the
> > vtab/vtype comparisons is a big problem in practice, since the number
> > of internal symbols with leading underscores is very limited, but of
> > course it should still be fixed ...
>
> Luckily it should make no difference indeed as "__vta" and "__vtyp"
> are only used for this one purpose.
> I don't think the DTIO op keyword fix would hit any real user either.
> Thanks for taking care of it, patch LGTM.
I have now committed this as r264448.
Cheers,
Janus
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2010-11-07 15:50 ` Janus Weil
@ 2010-11-07 16:39 ` Tobias Schlüter
0 siblings, 0 replies; 23+ messages in thread
From: Tobias Schlüter @ 2010-11-07 16:39 UTC (permalink / raw)
To: Janus Weil
Cc: Tobias Burnus, Dominique Dhumieres, fortran, gcc-patches, tkoenig
On 2010-11-07 16:49, Janus Weil wrote:
> Btw, what is the reason for the macro adding *two* underscores in
> front, instead of just one?
I got curious and did some googling. Tthe C standard has this:
7.1.3 Reserved identifiers
Each header declares or defines all identifiers listed in its
associated subclause, and optionally declares or defines identifiers
listed in its associated future library directions subclause and
identifiers which are always reserved either for any use or for use as
file scope identifiers.
* All identifiers that begin with an underscore and either an
uppercase letter or another underscore are always reserved for any use.
...
So if the compiler can't use a character the user can't put into
identifiers ('.' or '$'), it reverts to something that isn't allowed to
put into identifiers: two underscores in the beginning. I think the
lesson for us is: '.' and '$' aren't portable.
Cheers,
- Tobi
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2010-11-07 12:04 ` Janus Weil
2010-11-07 12:11 ` Tobias Schlüter
@ 2010-11-07 16:30 ` Steve Kargl
1 sibling, 0 replies; 23+ messages in thread
From: Steve Kargl @ 2010-11-07 16:30 UTC (permalink / raw)
To: Janus Weil
Cc: Tobias Burnus, Dominique Dhumieres, fortran, gcc-patches, tkoenig
On Sun, Nov 07, 2010 at 01:04:05PM +0100, Janus Weil wrote:
> >> Yes, that is expected, because the patch changes the name of the vtab
> >> to "vtab$main$dt", so one needs to change the name of the subroutine
> >> in the test case in the same way in order to see the failure:
> >
> > Dot? vtab.main.dt?
>
> Yes, we once had this variant. I think the reason why I switched to
> dollars was that it made the dumps easier to read (think
> "vtab.main.dt..extends..size" etc).
>
> The best option I can currently see is to use leading underscores (as
> in "_vtab_main_dt"). This is forbidden in Fortran (cf. F08:R303), but
> accepted by the assembler (cf.
> http://sourceware.org/binutils/docs-2.20/as/Symbol-Names.html#Symbol-Names).
>
> Attached is a patch which does this change. I also added a few macros
> in gfortran.h. Ok for trunk after successful regtest?
>
A leading underscore moves the issue from -fdollar-ok to
-fleading_underscore. IIRC, -fdollar-ok was introduced
to gfortran for compatibility with g77, which allows
legacy code to compile. None of the OOP features should
appear in legacy code, so just throw an error if -fdollar-ok
is used when an OO feature is in the code.
--
Steve
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2010-11-07 15:34 ` Tobias Schlüter
@ 2010-11-07 15:50 ` Janus Weil
2010-11-07 16:39 ` Tobias Schlüter
0 siblings, 1 reply; 23+ messages in thread
From: Janus Weil @ 2010-11-07 15:50 UTC (permalink / raw)
To: Tobias Schlüter
Cc: Tobias Burnus, Dominique Dhumieres, fortran, gcc-patches, tkoenig
>>>>>> Yes, that is expected, because the patch changes the name of the vtab
>>>>>> to "vtab$main$dt", so one needs to change the name of the subroutine
>>>>>> in the test case in the same way in order to see the failure:
>>>
>>> Sorry I'm late, but gcc has the macro ASM_FORMAT_PRIVATE_NAME which does
>>> the work of making a name collision-free. If you use it you can make the
>>> rest of the name as readable as you want.
>>
>> I think that it won't work. One needs the same assembler name for in
>> each translation unit as there is one, common, global vtable per base
>> type. My understanding is that ASM_FORMAT_PRIVATE_NAME would generate
>> several disjunct assembler names...
>
> I don't think so, it only adds a platform-dependent character to the
> variable name. The offered varieties cover exactly what was suggested in
> this thread so far:
>
> #ifndef ASM_PN_FORMAT
> # ifndef NO_DOT_IN_LABEL
> # define ASM_PN_FORMAT "%s.%lu"
> # else
> # ifndef NO_DOLLAR_IN_LABEL
> # define ASM_PN_FORMAT "%s$%lu"
> # else
> # define ASM_PN_FORMAT "__%s_%lu"
> # endif
> # endif
> #endif /* ! ASM_PN_FORMAT */
>
> #ifndef ASM_FORMAT_PRIVATE_NAME
> # define ASM_FORMAT_PRIVATE_NAME(OUTPUT, NAME, LABELNO) \
> do { const char *const name_ = (NAME); \
> char *const output_ = (OUTPUT) = \
> (char *) alloca (strlen (name_) + 32); \
> sprintf (output_, ASM_PN_FORMAT, name_, (unsigned long)(LABELNO)); \
> } while (0)
> #endif
Yes, I think it would do the job. But we actually do not need the
additional number.
Btw, what is the reason for the macro adding *two* underscores in
front, instead of just one?
Cheers,
Janus
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2010-11-07 13:19 ` Tobias Burnus
2010-11-07 14:21 ` Janus Weil
@ 2010-11-07 15:34 ` Tobias Schlüter
2010-11-07 15:50 ` Janus Weil
1 sibling, 1 reply; 23+ messages in thread
From: Tobias Schlüter @ 2010-11-07 15:34 UTC (permalink / raw)
To: Tobias Burnus
Cc: Janus Weil, Dominique Dhumieres, fortran, gcc-patches, tkoenig
On 2010-11-07 14:19, Tobias Burnus wrote:
> Tobias Schlüter wrote:
>> On 2010-11-07 13:04, Janus Weil wrote:
>>>>> Yes, that is expected, because the patch changes the name of the vtab
>>>>> to "vtab$main$dt", so one needs to change the name of the subroutine
>>>>> in the test case in the same way in order to see the failure:
>>
>> Sorry I'm late, but gcc has the macro ASM_FORMAT_PRIVATE_NAME which does
>> the work of making a name collision-free. If you use it you can make the
>> rest of the name as readable as you want.
>
> I think that it won't work. One needs the same assembler name for in
> each translation unit as there is one, common, global vtable per base
> type. My understanding is that ASM_FORMAT_PRIVATE_NAME would generate
> several disjunct assembler names...
I don't think so, it only adds a platform-dependent character to the
variable name. The offered varieties cover exactly what was suggested
in this thread so far:
#ifndef ASM_PN_FORMAT
# ifndef NO_DOT_IN_LABEL
# define ASM_PN_FORMAT "%s.%lu"
# else
# ifndef NO_DOLLAR_IN_LABEL
# define ASM_PN_FORMAT "%s$%lu"
# else
# define ASM_PN_FORMAT "__%s_%lu"
# endif
# endif
#endif /* ! ASM_PN_FORMAT */
#ifndef ASM_FORMAT_PRIVATE_NAME
# define ASM_FORMAT_PRIVATE_NAME(OUTPUT, NAME, LABELNO) \
do { const char *const name_ = (NAME); \
char *const output_ = (OUTPUT) = \
(char *) alloca (strlen (name_) + 32); \
sprintf (output_, ASM_PN_FORMAT, name_, (unsigned long)(LABELNO)); \
} while (0)
#endif
Cheers,
- Tobi
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2010-11-07 13:19 ` Tobias Burnus
@ 2010-11-07 14:21 ` Janus Weil
2010-11-07 15:34 ` Tobias Schlüter
1 sibling, 0 replies; 23+ messages in thread
From: Janus Weil @ 2010-11-07 14:21 UTC (permalink / raw)
To: Tobias Burnus
Cc: Tobias Schlüter, Dominique Dhumieres, fortran, gcc-patches, tkoenig
>>> The best option I can currently see is to use leading underscores (as
>>> in "_vtab_main_dt"). This is forbidden in Fortran (cf. F08:R303), but
>>> accepted by the assembler (cf.
>>>
>>> http://sourceware.org/binutils/docs-2.20/as/Symbol-Names.html#Symbol-Names).
>>>
>>> Attached is a patch which does this change. I also added a few macros
>>> in gfortran.h. Ok for trunk after successful regtest?
>
> +static void
> +get_unique_type_string (char *string, gfc_symbol *derived)
> +{
> + if (derived->module)
> + sprintf (string, "%s_%s", derived->module, derived->name);
> + else
> + sprintf (string, "%s_%s", derived->ns->proc_name->name, derived->name);
> +}
>
> I wonder whether that works for cases like:
>
> * module name == procedure name
> * internal procedures == procedure name / module name.
> * Nested submodules (when implemented)
>
> I assume defining the same-named (and disjunct) DT in a module and
> separately in a subroutine is weird; with internal procedures and submodules
> it will start to get crazy. But shouldn't one do something like
> _proc_<procedure_name> for procedures? A {module/procedure
> name}_internal-proc-name?
>
> Alternatively, one can defer it until a real-world bug report comes (which I
> think is very unlikely).
I also think it's unlikely. And in fact we have enough real-world PRs
to deal with right now, so I would prefer to defer this to some point
in late stage 3 when we have fixed all the worst bugs and start to get
bored ;)
The last patch I sent (leading underscore version) regtested fine btw.
Is it ok if I commit it now and leave the PR open for the corner
cases?
Cheers,
Janus
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2010-11-07 12:11 ` Tobias Schlüter
@ 2010-11-07 13:19 ` Tobias Burnus
2010-11-07 14:21 ` Janus Weil
2010-11-07 15:34 ` Tobias Schlüter
0 siblings, 2 replies; 23+ messages in thread
From: Tobias Burnus @ 2010-11-07 13:19 UTC (permalink / raw)
To: Tobias Schlüter
Cc: Janus Weil, Dominique Dhumieres, fortran, gcc-patches, tkoenig
Tobias Schlüter wrote:
> On 2010-11-07 13:04, Janus Weil wrote:
>>>> Yes, that is expected, because the patch changes the name of the vtab
>>>> to "vtab$main$dt", so one needs to change the name of the subroutine
>>>> in the test case in the same way in order to see the failure:
>
> Sorry I'm late, but gcc has the macro ASM_FORMAT_PRIVATE_NAME which does
> the work of making a name collision-free. If you use it you can make the
> rest of the name as readable as you want.
I think that it won't work. One needs the same assembler name for in
each translation unit as there is one, common, global vtable per base
type. My understanding is that ASM_FORMAT_PRIVATE_NAME would generate
several disjunct assembler names...
>> The best option I can currently see is to use leading underscores (as
>> in "_vtab_main_dt"). This is forbidden in Fortran (cf. F08:R303), but
>> accepted by the assembler (cf.
>> http://sourceware.org/binutils/docs-2.20/as/Symbol-Names.html#Symbol-Names).
>>
>> Attached is a patch which does this change. I also added a few macros
>> in gfortran.h. Ok for trunk after successful regtest?
+static void
+get_unique_type_string (char *string, gfc_symbol *derived)
+{
+ if (derived->module)
+ sprintf (string, "%s_%s", derived->module, derived->name);
+ else
+ sprintf (string, "%s_%s", derived->ns->proc_name->name, derived->name);
+}
I wonder whether that works for cases like:
* module name == procedure name
* internal procedures == procedure name / module name.
* Nested submodules (when implemented)
I assume defining the same-named (and disjunct) DT in a module and
separately in a subroutine is weird; with internal procedures and
submodules it will start to get crazy. But shouldn't one do something
like _proc_<procedure_name> for procedures? A {module/procedure
name}_internal-proc-name?
Alternatively, one can defer it until a real-world bug report comes
(which I think is very unlikely).
(And, at some point, the name becomes too long and one could think of
using a hash name as in GCC's C++ compiler.)
Tobias
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2010-11-07 12:04 ` Janus Weil
@ 2010-11-07 12:11 ` Tobias Schlüter
2010-11-07 13:19 ` Tobias Burnus
2010-11-07 16:30 ` Steve Kargl
1 sibling, 1 reply; 23+ messages in thread
From: Tobias Schlüter @ 2010-11-07 12:11 UTC (permalink / raw)
To: Janus Weil
Cc: Tobias Burnus, Dominique Dhumieres, fortran, gcc-patches, tkoenig
On 2010-11-07 13:04, Janus Weil wrote:
>>> Yes, that is expected, because the patch changes the name of the vtab
>>> to "vtab$main$dt", so one needs to change the name of the subroutine
>>> in the test case in the same way in order to see the failure:
>>
>> Dot? vtab.main.dt?
>
> Yes, we once had this variant. I think the reason why I switched to
> dollars was that it made the dumps easier to read (think
> "vtab.main.dt..extends..size" etc).
Sorry I'm late, but gcc has the macro ASM_FORMAT_PRIVATE_NAME which does
the work of making a name collision-free. If you use it you can make
the rest of the name as readable as you want.
Cheers,
- Tobi
>
> The best option I can currently see is to use leading underscores (as
> in "_vtab_main_dt"). This is forbidden in Fortran (cf. F08:R303), but
> accepted by the assembler (cf.
> http://sourceware.org/binutils/docs-2.20/as/Symbol-Names.html#Symbol-Names).
>
> Attached is a patch which does this change. I also added a few macros
> in gfortran.h. Ok for trunk after successful regtest?
>
> Cheers,
> Janus
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2010-11-07 7:55 ` Tobias Burnus
@ 2010-11-07 12:04 ` Janus Weil
2010-11-07 12:11 ` Tobias Schlüter
2010-11-07 16:30 ` Steve Kargl
0 siblings, 2 replies; 23+ messages in thread
From: Janus Weil @ 2010-11-07 12:04 UTC (permalink / raw)
To: Tobias Burnus; +Cc: Dominique Dhumieres, fortran, gcc-patches, tkoenig
[-- Attachment #1: Type: text/plain, Size: 784 bytes --]
>> Yes, that is expected, because the patch changes the name of the vtab
>> to "vtab$main$dt", so one needs to change the name of the subroutine
>> in the test case in the same way in order to see the failure:
>
> Dot? vtab.main.dt?
Yes, we once had this variant. I think the reason why I switched to
dollars was that it made the dumps easier to read (think
"vtab.main.dt..extends..size" etc).
The best option I can currently see is to use leading underscores (as
in "_vtab_main_dt"). This is forbidden in Fortran (cf. F08:R303), but
accepted by the assembler (cf.
http://sourceware.org/binutils/docs-2.20/as/Symbol-Names.html#Symbol-Names).
Attached is a patch which does this change. I also added a few macros
in gfortran.h. Ok for trunk after successful regtest?
Cheers,
Janus
[-- Attachment #2: pr46313_leading_underscore.diff --]
[-- Type: application/octet-stream, Size: 29399 bytes --]
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (revision 166408)
+++ gcc/fortran/trans-expr.c (working copy)
@@ -2584,7 +2584,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_exp
var = gfc_create_var (tmp, "class");
/* Set the vptr. */
- cmp = gfc_find_component (declared, "$vptr", true, true);
+ cmp = gfc_find_component (declared, "_vptr", true, true);
ctree = fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (cmp->backend_decl),
var, cmp->backend_decl, NULL_TREE);
@@ -2598,7 +2598,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_exp
fold_convert (TREE_TYPE (ctree), tmp));
/* Now set the data field. */
- cmp = gfc_find_component (declared, "$data", true, true);
+ cmp = gfc_find_component (declared, "_data", true, true);
ctree = fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (cmp->backend_decl),
var, cmp->backend_decl, NULL_TREE);
@@ -4504,13 +4504,13 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr,
if (!c->expr || cm->attr.allocatable)
continue;
- if (strcmp (cm->name, "$size") == 0)
+ if (strcmp (cm->name, "_size") == 0)
{
val = TYPE_SIZE_UNIT (gfc_get_derived_type (cm->ts.u.derived));
CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl, val);
}
else if (cm->initializer && cm->initializer->expr_type != EXPR_NULL
- && strcmp (cm->name, "$extends") == 0)
+ && strcmp (cm->name, "_extends") == 0)
{
tree vtab;
gfc_symbol *vtabs;
@@ -5875,15 +5875,15 @@ gfc_trans_class_init_assign (gfc_code *code)
gfc_start_block (&block);
lhs = gfc_copy_expr (code->expr1);
- gfc_add_component_ref (lhs, "$data");
+ gfc_add_data_component (lhs);
rhs = gfc_copy_expr (code->expr1);
- gfc_add_component_ref (rhs, "$vptr");
- gfc_add_component_ref (rhs, "$def_init");
+ gfc_add_vptr_component (rhs);
+ gfc_add_def_init_component (rhs);
sz = gfc_copy_expr (code->expr1);
- gfc_add_component_ref (sz, "$vptr");
- gfc_add_component_ref (sz, "$size");
+ gfc_add_vptr_component (sz);
+ gfc_add_size_component (sz);
gfc_init_se (&dst, NULL);
gfc_init_se (&src, NULL);
@@ -5914,9 +5914,9 @@ gfc_trans_class_assign (gfc_expr *expr1, gfc_expr
if (expr2->ts.type != BT_CLASS)
{
- /* Insert an additional assignment which sets the '$vptr' field. */
+ /* Insert an additional assignment which sets the '_vptr' field. */
lhs = gfc_copy_expr (expr1);
- gfc_add_component_ref (lhs, "$vptr");
+ gfc_add_vptr_component (lhs);
if (expr2->ts.type == BT_DERIVED)
{
gfc_symbol *vtab;
@@ -5945,7 +5945,7 @@ gfc_trans_class_assign (gfc_expr *expr1, gfc_expr
if (expr2->ts.type == BT_CLASS)
op = EXEC_ASSIGN;
else
- gfc_add_component_ref (expr1, "$data");
+ gfc_add_data_component (expr1);
if (op == EXEC_ASSIGN)
tmp = gfc_trans_assignment (expr1, expr2, false, true);
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c (revision 166408)
+++ gcc/fortran/trans-array.c (working copy)
@@ -6317,7 +6317,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree
comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
decl, cdecl, NULL_TREE);
- /* Add reference to '$data' component. */
+ /* Add reference to '_data' component. */
tmp = CLASS_DATA (c)->backend_decl;
comp = fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (tmp), comp, tmp, NULL_TREE);
@@ -6357,7 +6357,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree
/* Allocatable scalar CLASS components. */
comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
decl, cdecl, NULL_TREE);
- /* Add reference to '$data' component. */
+ /* Add reference to '_data' component. */
tmp = CLASS_DATA (c)->backend_decl;
comp = fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (tmp), comp, tmp, NULL_TREE);
Index: gcc/fortran/class.c
===================================================================
--- gcc/fortran/class.c (revision 166408)
+++ gcc/fortran/class.c (working copy)
@@ -29,18 +29,18 @@ along with GCC; see the file COPYING3. If not see
Each CLASS variable is encapsulated by a class container, which is a
structure with two fields:
- * $data: A pointer to the actual data of the variable. This field has the
+ * _data: A pointer to the actual data of the variable. This field has the
declared type of the class variable and its attributes
(pointer/allocatable/dimension/...).
- * $vptr: A pointer to the vtable entry (see below) of the dynamic type.
+ * _vptr: A pointer to the vtable entry (see below) of the dynamic type.
For each derived type we set up a "vtable" entry, i.e. a structure with the
following fields:
- * $hash: A hash value serving as a unique identifier for this type.
- * $size: The size in bytes of the derived type.
- * $extends: A pointer to the vtable entry of the parent derived type.
- * $def_init: A pointer to a default initialized variable of this type.
- * $copy: A procedure pointer to a copying procedure.
+ * _hash: A hash value serving as a unique identifier for this type.
+ * _size: The size in bytes of the derived type.
+ * _extends: A pointer to the vtable entry of the parent derived type.
+ * _def_init: A pointer to a default initialized variable of this type.
+ * _copy: A procedure pointer to a copying procedure.
After these follow procedure pointer components for the specific
type-bound procedures. */
@@ -52,7 +52,7 @@ along with GCC; see the file COPYING3. If not see
/* Insert a reference to the component of the given name.
- Only to be used with CLASS containers. */
+ Only to be used with CLASS containers and vtables. */
void
gfc_add_component_ref (gfc_expr *e, const char *name)
@@ -68,7 +68,7 @@ gfc_add_component_ref (gfc_expr *e, const char *na
break;
tail = &((*tail)->next);
}
- if (*tail != NULL && strcmp (name, "$data") == 0)
+ if (*tail != NULL && strcmp (name, "_data") == 0)
next = *tail;
(*tail) = gfc_get_ref();
(*tail)->next = next;
@@ -82,7 +82,7 @@ gfc_add_component_ref (gfc_expr *e, const char *na
/* Build a NULL initializer for CLASS pointers,
- initializing the $data and $vptr components to zero. */
+ initializing the _data and _vptr components to zero. */
gfc_expr *
gfc_class_null_initializer (gfc_typespec *ts)
@@ -107,31 +107,46 @@ gfc_class_null_initializer (gfc_typespec *ts)
}
+/* Create a unique string identifier for a derived type, composed of its name
+ and module name. This is used to construct unique names for the class
+ containers and vtab symbols. */
+
+static void
+get_unique_type_string (char *string, gfc_symbol *derived)
+{
+ if (derived->module)
+ sprintf (string, "%s_%s", derived->module, derived->name);
+ else
+ sprintf (string, "%s_%s", derived->ns->proc_name->name, derived->name);
+}
+
+
/* Build a polymorphic CLASS entity, using the symbol that comes from
build_sym. A CLASS entity is represented by an encapsulating type,
- which contains the declared type as '$data' component, plus a pointer
- component '$vptr' which determines the dynamic type. */
+ which contains the declared type as '_data' component, plus a pointer
+ component '_vptr' which determines the dynamic type. */
gfc_try
gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
gfc_array_spec **as, bool delayed_vtab)
{
- char name[GFC_MAX_SYMBOL_LEN + 5];
+ char name[GFC_MAX_SYMBOL_LEN], tname[GFC_MAX_SYMBOL_LEN];
gfc_symbol *fclass;
gfc_symbol *vtab;
gfc_component *c;
/* Determine the name of the encapsulating type. */
+ get_unique_type_string (tname, ts->u.derived);
if ((*as) && (*as)->rank && attr->allocatable)
- sprintf (name, "class$%s_%d_a", ts->u.derived->name, (*as)->rank);
+ sprintf (name, "_class_%s_%d_a", tname, (*as)->rank);
else if ((*as) && (*as)->rank)
- sprintf (name, "class$%s_%d", ts->u.derived->name, (*as)->rank);
+ sprintf (name, "_class_%s_%d", tname, (*as)->rank);
else if (attr->pointer)
- sprintf (name, "class$%s_p", ts->u.derived->name);
+ sprintf (name, "_class_%s_p", tname);
else if (attr->allocatable)
- sprintf (name, "class$%s_a", ts->u.derived->name);
+ sprintf (name, "_class_%s_a", tname);
else
- sprintf (name, "class$%s", ts->u.derived->name);
+ sprintf (name, "_class_%s", tname);
gfc_find_symbol (name, ts->u.derived->ns, 0, &fclass);
if (fclass == NULL)
@@ -151,8 +166,8 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_a
NULL, &gfc_current_locus) == FAILURE)
return FAILURE;
- /* Add component '$data'. */
- if (gfc_add_component (fclass, "$data", &c) == FAILURE)
+ /* Add component '_data'. */
+ if (gfc_add_component (fclass, "_data", &c) == FAILURE)
return FAILURE;
c->ts = *ts;
c->ts.type = BT_DERIVED;
@@ -167,8 +182,8 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_a
c->as = (*as);
c->initializer = NULL;
- /* Add component '$vptr'. */
- if (gfc_add_component (fclass, "$vptr", &c) == FAILURE)
+ /* Add component '_vptr'. */
+ if (gfc_add_component (fclass, "_vptr", &c) == FAILURE)
return FAILURE;
c->ts.type = BT_DERIVED;
if (delayed_vtab)
@@ -316,7 +331,6 @@ gfc_find_derived_vtab (gfc_symbol *derived)
gfc_namespace *ns;
gfc_symbol *vtab = NULL, *vtype = NULL, *found_sym = NULL, *def_init = NULL;
gfc_symbol *copy = NULL, *src = NULL, *dst = NULL;
- char name[2 * GFC_MAX_SYMBOL_LEN + 8];
/* Find the top-level namespace (MODULE or PROGRAM). */
for (ns = gfc_current_ns; ns; ns = ns->parent)
@@ -329,7 +343,10 @@ gfc_find_derived_vtab (gfc_symbol *derived)
if (ns)
{
- sprintf (name, "vtab$%s", derived->name);
+ char name[GFC_MAX_SYMBOL_LEN], tname[GFC_MAX_SYMBOL_LEN];
+
+ get_unique_type_string (tname, derived);
+ sprintf (name, "_vtab_%s", tname);
/* Look for the vtab symbol in various namespaces. */
gfc_find_symbol (name, gfc_current_ns, 0, &vtab);
@@ -350,7 +367,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
vtab->attr.vtab = 1;
vtab->attr.access = ACCESS_PUBLIC;
gfc_set_sym_referenced (vtab);
- sprintf (name, "vtype$%s", derived->name);
+ sprintf (name, "_vtype_%s", tname);
gfc_find_symbol (name, ns, 0, &vtype);
if (vtype == NULL)
@@ -366,8 +383,8 @@ gfc_find_derived_vtab (gfc_symbol *derived)
vtype->attr.vtype = 1;
gfc_set_sym_referenced (vtype);
- /* Add component '$hash'. */
- if (gfc_add_component (vtype, "$hash", &c) == FAILURE)
+ /* Add component '_hash'. */
+ if (gfc_add_component (vtype, "_hash", &c) == FAILURE)
goto cleanup;
c->ts.type = BT_INTEGER;
c->ts.kind = 4;
@@ -375,8 +392,8 @@ gfc_find_derived_vtab (gfc_symbol *derived)
c->initializer = gfc_get_int_expr (gfc_default_integer_kind,
NULL, derived->hash_value);
- /* Add component '$size'. */
- if (gfc_add_component (vtype, "$size", &c) == FAILURE)
+ /* Add component '_size'. */
+ if (gfc_add_component (vtype, "_size", &c) == FAILURE)
goto cleanup;
c->ts.type = BT_INTEGER;
c->ts.kind = 4;
@@ -388,8 +405,8 @@ gfc_find_derived_vtab (gfc_symbol *derived)
c->initializer = gfc_get_int_expr (gfc_default_integer_kind,
NULL, 0);
- /* Add component $extends. */
- if (gfc_add_component (vtype, "$extends", &c) == FAILURE)
+ /* Add component _extends. */
+ if (gfc_add_component (vtype, "_extends", &c) == FAILURE)
goto cleanup;
c->attr.pointer = 1;
c->attr.access = ACCESS_PRIVATE;
@@ -419,8 +436,8 @@ gfc_find_derived_vtab (gfc_symbol *derived)
goto have_vtype;
}
- /* Add component $def_init. */
- if (gfc_add_component (vtype, "$def_init", &c) == FAILURE)
+ /* Add component _def_init. */
+ if (gfc_add_component (vtype, "_def_init", &c) == FAILURE)
goto cleanup;
c->attr.pointer = 1;
c->attr.access = ACCESS_PRIVATE;
@@ -431,7 +448,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
else
{
/* Construct default initialization variable. */
- sprintf (name, "def_init$%s", derived->name);
+ sprintf (name, "_def_init_%s", tname);
gfc_get_symbol (name, ns, &def_init);
def_init->attr.target = 1;
def_init->attr.save = SAVE_EXPLICIT;
@@ -445,8 +462,8 @@ gfc_find_derived_vtab (gfc_symbol *derived)
c->initializer = gfc_lval_expr_from_sym (def_init);
}
- /* Add component $copy. */
- if (gfc_add_component (vtype, "$copy", &c) == FAILURE)
+ /* Add component _copy. */
+ if (gfc_add_component (vtype, "_copy", &c) == FAILURE)
goto cleanup;
c->attr.proc_pointer = 1;
c->attr.access = ACCESS_PRIVATE;
@@ -462,7 +479,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
ns->contained = sub_ns;
sub_ns->resolved = 1;
/* Set up procedure symbol. */
- sprintf (name, "copy$%s", derived->name);
+ sprintf (name, "_copy_%s", tname);
gfc_get_symbol (name, sub_ns, ©);
sub_ns->proc_name = copy;
copy->attr.flavor = FL_PROCEDURE;
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (revision 166408)
+++ gcc/fortran/decl.c (working copy)
@@ -6014,10 +6014,10 @@ attr_decl1 (void)
/* Update symbol table. DIMENSION attribute is set in
gfc_set_array_spec(). For CLASS variables, this must be applied
- to the first component, or '$data' field. */
+ to the first component, or '_data' field. */
if (sym->ts.type == BT_CLASS && sym->ts.u.derived->attr.is_class)
{
- if (gfc_copy_attr (&CLASS_DATA (sym)->attr, ¤t_attr,&var_locus)
+ if (gfc_copy_attr (&CLASS_DATA (sym)->attr, ¤t_attr, &var_locus)
== FAILURE)
{
m = MATCH_ERROR;
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 166408)
+++ gcc/fortran/gfortran.h (working copy)
@@ -2877,6 +2877,11 @@ gfc_try gfc_check_same_strlen (const gfc_expr*, co
/* class.c */
void gfc_add_component_ref (gfc_expr *, const char *);
+#define gfc_add_data_component(e) gfc_add_component_ref(e,"_data")
+#define gfc_add_vptr_component(e) gfc_add_component_ref(e,"_vptr")
+#define gfc_add_hash_component(e) gfc_add_component_ref(e,"_hash")
+#define gfc_add_size_component(e) gfc_add_component_ref(e,"_size")
+#define gfc_add_def_init_component(e) gfc_add_component_ref(e,"_def_init")
gfc_expr *gfc_class_null_initializer (gfc_typespec *);
gfc_try gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
gfc_array_spec **, bool);
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (revision 166408)
+++ gcc/fortran/trans-stmt.c (working copy)
@@ -4388,7 +4388,7 @@ gfc_trans_allocate (gfc_code * code)
expr = gfc_copy_expr (al->expr);
if (expr->ts.type == BT_CLASS)
- gfc_add_component_ref (expr, "$data");
+ gfc_add_data_component (expr);
gfc_init_se (&se, NULL);
gfc_start_block (&se.pre);
@@ -4409,8 +4409,8 @@ gfc_trans_allocate (gfc_code * code)
gfc_expr *sz;
gfc_se se_sz;
sz = gfc_copy_expr (code->expr3);
- gfc_add_component_ref (sz, "$vptr");
- gfc_add_component_ref (sz, "$size");
+ gfc_add_vptr_component (sz);
+ gfc_add_size_component (sz);
gfc_init_se (&se_sz, NULL);
gfc_conv_expr (&se_sz, sz);
gfc_free_expr (sz);
@@ -4497,18 +4497,18 @@ gfc_trans_allocate (gfc_code * code)
actual = gfc_get_actual_arglist ();
actual->expr = gfc_copy_expr (rhs);
if (rhs->ts.type == BT_CLASS)
- gfc_add_component_ref (actual->expr, "$data");
+ gfc_add_data_component (actual->expr);
actual->next = gfc_get_actual_arglist ();
actual->next->expr = gfc_copy_expr (al->expr);
- gfc_add_component_ref (actual->next->expr, "$data");
+ gfc_add_data_component (actual->next->expr);
if (rhs->ts.type == BT_CLASS)
{
ppc = gfc_copy_expr (rhs);
- gfc_add_component_ref (ppc, "$vptr");
+ gfc_add_vptr_component (ppc);
}
else
ppc = gfc_lval_expr_from_sym (gfc_find_derived_vtab (rhs->ts.u.derived));
- gfc_add_component_ref (ppc, "$copy");
+ gfc_add_component_ref (ppc, "_copy");
gfc_conv_procedure_call (&call, ppc->symtree->n.sym, actual,
ppc, NULL);
gfc_add_expr_to_block (&call.pre, call.expr);
@@ -4527,8 +4527,8 @@ gfc_trans_allocate (gfc_code * code)
/* Default-initialization via MOLD (polymorphic). */
gfc_expr *rhs = gfc_copy_expr (code->expr3);
gfc_se dst,src;
- gfc_add_component_ref (rhs, "$vptr");
- gfc_add_component_ref (rhs, "$def_init");
+ gfc_add_vptr_component (rhs);
+ gfc_add_def_init_component (rhs);
gfc_init_se (&dst, NULL);
gfc_init_se (&src, NULL);
gfc_conv_expr (&dst, expr);
@@ -4549,13 +4549,13 @@ gfc_trans_allocate (gfc_code * code)
/* Initialize VPTR for CLASS objects. */
lhs = gfc_expr_to_initialize (expr);
- gfc_add_component_ref (lhs, "$vptr");
+ gfc_add_vptr_component (lhs);
rhs = NULL;
if (code->expr3 && code->expr3->ts.type == BT_CLASS)
{
/* Polymorphic SOURCE: VPTR must be determined at run time. */
rhs = gfc_copy_expr (code->expr3);
- gfc_add_component_ref (rhs, "$vptr");
+ gfc_add_vptr_component (rhs);
tmp = gfc_trans_pointer_assignment (lhs, rhs);
gfc_add_expr_to_block (&block, tmp);
gfc_free_expr (rhs);
Index: gcc/fortran/module.c
===================================================================
--- gcc/fortran/module.c (revision 166408)
+++ gcc/fortran/module.c (working copy)
@@ -4372,8 +4372,8 @@ read_module (void)
p = name;
/* Exception: Always import vtabs & vtypes. */
- if (p == NULL && (strncmp (name, "vtab$", 5) == 0
- || strncmp (name, "vtype$", 6) == 0))
+ if (p == NULL && (strncmp (name, "_vtab_", 5) == 0
+ || strncmp (name, "_vtype_", 6) == 0))
p = name;
/* Skip symtree nodes not in an ONLY clause, unless there
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 166408)
+++ gcc/fortran/resolve.c (working copy)
@@ -988,9 +988,9 @@ resolve_structure_cons (gfc_expr *expr, int init)
!gfc_compare_types (&cons->expr->ts, &comp->ts))
{
t = FAILURE;
- if (strcmp (comp->name, "$extends") == 0)
+ if (strcmp (comp->name, "_extends") == 0)
{
- /* Can afford to be brutal with the $extends initializer.
+ /* Can afford to be brutal with the _extends initializer.
The derived type can get lost because it is PRIVATE
but it is not usage constrained by the standard. */
cons->expr->ts = comp->ts;
@@ -5726,7 +5726,7 @@ resolve_typebound_function (gfc_expr* e)
is present. */
ts = expr->ts;
declared = ts.u.derived;
- c = gfc_find_component (declared, "$vptr", true, true);
+ c = gfc_find_component (declared, "_vptr", true, true);
if (c->ts.u.derived == NULL)
c->ts.u.derived = gfc_find_derived_vtab (declared);
@@ -5737,7 +5737,7 @@ resolve_typebound_function (gfc_expr* e)
name = name ? name : e->value.function.esym->name;
e->symtree = expr->symtree;
e->ref = gfc_copy_ref (expr->ref);
- gfc_add_component_ref (e, "$vptr");
+ gfc_add_vptr_component (e);
gfc_add_component_ref (e, name);
e->value.function.esym = NULL;
return SUCCESS;
@@ -5760,7 +5760,7 @@ resolve_typebound_function (gfc_expr* e)
return resolve_compcall (e, NULL);
}
- c = gfc_find_component (declared, "$data", true, true);
+ c = gfc_find_component (declared, "_data", true, true);
declared = c->ts.u.derived;
/* Treat the call as if it is a typebound procedure, in order to roll
@@ -5776,8 +5776,8 @@ resolve_typebound_function (gfc_expr* e)
if (new_ref)
e->ref = new_ref;
- /* '$vptr' points to the vtab, which contains the procedure pointers. */
- gfc_add_component_ref (e, "$vptr");
+ /* '_vptr' points to the vtab, which contains the procedure pointers. */
+ gfc_add_vptr_component (e);
gfc_add_component_ref (e, name);
/* Recover the typespec for the expression. This is really only
@@ -5816,7 +5816,7 @@ resolve_typebound_subroutine (gfc_code *code)
is present. */
ts = expr->symtree->n.sym->ts;
declared = ts.u.derived;
- c = gfc_find_component (declared, "$vptr", true, true);
+ c = gfc_find_component (declared, "_vptr", true, true);
if (c->ts.u.derived == NULL)
c->ts.u.derived = gfc_find_derived_vtab (declared);
@@ -5827,7 +5827,7 @@ resolve_typebound_subroutine (gfc_code *code)
name = name ? name : code->expr1->value.function.esym->name;
code->expr1->symtree = expr->symtree;
expr->symtree->n.sym->ts.u.derived = declared;
- gfc_add_component_ref (code->expr1, "$vptr");
+ gfc_add_vptr_component (code->expr1);
gfc_add_component_ref (code->expr1, name);
code->expr1->value.function.esym = NULL;
return SUCCESS;
@@ -5861,8 +5861,8 @@ resolve_typebound_subroutine (gfc_code *code)
if (new_ref)
code->expr1->ref = new_ref;
- /* '$vptr' points to the vtab, which contains the procedure pointers. */
- gfc_add_component_ref (code->expr1, "$vptr");
+ /* '_vptr' points to the vtab, which contains the procedure pointers. */
+ gfc_add_vptr_component (code->expr1);
gfc_add_component_ref (code->expr1, name);
/* Recover the typespec for the expression. This is really only
@@ -6404,7 +6404,7 @@ resolve_deallocate_expr (gfc_expr *e)
if (e->ts.type == BT_CLASS)
{
/* Only deallocate the DATA component. */
- gfc_add_component_ref (e, "$data");
+ gfc_add_data_component (e);
}
return SUCCESS;
@@ -7735,8 +7735,8 @@ resolve_select_type (gfc_code *code, gfc_namespace
ns->code->next = new_st;
code = new_st;
code->op = EXEC_SELECT;
- gfc_add_component_ref (code->expr1, "$vptr");
- gfc_add_component_ref (code->expr1, "$hash");
+ gfc_add_vptr_component (code->expr1);
+ gfc_add_hash_component (code->expr1);
/* Loop over TYPE IS / CLASS IS cases. */
for (body = code->block; body; body = body->block)
@@ -7756,14 +7756,14 @@ resolve_select_type (gfc_code *code, gfc_namespace
'global' one). */
if (c->ts.type == BT_CLASS)
- sprintf (name, "tmp$class$%s", c->ts.u.derived->name);
+ sprintf (name, "_tmp_class_%s", c->ts.u.derived->name);
else
- sprintf (name, "tmp$type$%s", c->ts.u.derived->name);
+ sprintf (name, "_tmp_type_%s", c->ts.u.derived->name);
st = gfc_find_symtree (ns->sym_root, name);
gcc_assert (st->n.sym->assoc);
st->n.sym->assoc->target = gfc_get_variable_expr (code->expr1->symtree);
if (c->ts.type == BT_DERIVED)
- gfc_add_component_ref (st->n.sym->assoc->target, "$data");
+ gfc_add_data_component (st->n.sym->assoc->target);
new_st = gfc_get_code ();
new_st->op = EXEC_BLOCK;
@@ -7880,7 +7880,7 @@ resolve_select_type (gfc_code *code, gfc_namespace
/* Set up arguments. */
new_st->expr1->value.function.actual = gfc_get_actual_arglist ();
new_st->expr1->value.function.actual->expr = gfc_get_variable_expr (code->expr1->symtree);
- gfc_add_component_ref (new_st->expr1->value.function.actual->expr, "$vptr");
+ gfc_add_vptr_component (new_st->expr1->value.function.actual->expr);
vtab = gfc_find_derived_vtab (body->ext.case_list->ts.u.derived);
st = gfc_find_symtree (vtab->ns->sym_root, vtab->name);
new_st->expr1->value.function.actual->next = gfc_get_actual_arglist ();
@@ -11193,8 +11193,8 @@ resolve_fl_derived (gfc_symbol *sym)
if (sym->attr.is_class && sym->ts.u.derived == NULL)
{
/* Fix up incomplete CLASS symbols. */
- gfc_component *data = gfc_find_component (sym, "$data", true, true);
- gfc_component *vptr = gfc_find_component (sym, "$vptr", true, true);
+ gfc_component *data = gfc_find_component (sym, "_data", true, true);
+ gfc_component *vptr = gfc_find_component (sym, "_vptr", true, true);
if (vptr->ts.u.derived == NULL)
{
gfc_symbol *vtab = gfc_find_derived_vtab (data->ts.u.derived);
Index: gcc/fortran/iresolve.c
===================================================================
--- gcc/fortran/iresolve.c (revision 166408)
+++ gcc/fortran/iresolve.c (working copy)
@@ -938,7 +938,7 @@ gfc_resolve_extends_type_of (gfc_expr *f, gfc_expr
/* Replace the first argument with the corresponding vtab. */
if (a->ts.type == BT_CLASS)
- gfc_add_component_ref (a, "$vptr");
+ gfc_add_vptr_component (a);
else if (a->ts.type == BT_DERIVED)
{
vtab = gfc_find_derived_vtab (a->ts.u.derived);
@@ -954,7 +954,7 @@ gfc_resolve_extends_type_of (gfc_expr *f, gfc_expr
/* Replace the second argument with the corresponding vtab. */
if (mo->ts.type == BT_CLASS)
- gfc_add_component_ref (mo, "$vptr");
+ gfc_add_vptr_component (mo);
else if (mo->ts.type == BT_DERIVED)
{
vtab = gfc_find_derived_vtab (mo->ts.u.derived);
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c (revision 166408)
+++ gcc/fortran/trans-decl.c (working copy)
@@ -3393,7 +3393,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gf
e = gfc_lval_expr_from_sym (sym);
if (sym->ts.type == BT_CLASS)
- gfc_add_component_ref (e, "$data");
+ gfc_add_data_component (e);
gfc_init_se (&se, NULL);
se.want_pointer = 1;
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c (revision 166408)
+++ gcc/fortran/match.c (working copy)
@@ -4516,9 +4516,9 @@ select_type_set_tmp (gfc_typespec *ts)
return;
if (ts->type == BT_CLASS)
- sprintf (name, "tmp$class$%s", ts->u.derived->name);
+ sprintf (name, "_tmp_class_%s", ts->u.derived->name);
else
- sprintf (name, "tmp$type$%s", ts->u.derived->name);
+ sprintf (name, "_tmp_type_%s", ts->u.derived->name);
gfc_get_sym_tree (name, gfc_current_ns, &tmp, false);
gfc_add_type (tmp->n.sym, ts, NULL);
gfc_set_sym_referenced (tmp->n.sym);
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c (revision 166408)
+++ gcc/fortran/trans-intrinsic.c (working copy)
@@ -4547,7 +4547,7 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *e
if (ss == gfc_ss_terminator)
{
if (arg->ts.type == BT_CLASS)
- gfc_add_component_ref (arg, "$data");
+ gfc_add_data_component (arg);
gfc_conv_expr_reference (&argse, arg);
@@ -4618,8 +4618,8 @@ gfc_conv_intrinsic_storage_size (gfc_se *se, gfc_e
{
if (arg->ts.type == BT_CLASS)
{
- gfc_add_component_ref (arg, "$vptr");
- gfc_add_component_ref (arg, "$size");
+ gfc_add_vptr_component (arg);
+ gfc_add_size_component (arg);
gfc_conv_expr (&argse, arg);
tmp = fold_convert (result_type, argse.expr);
goto done;
@@ -5070,7 +5070,7 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr)
/* Allocatable scalar. */
arg1se.want_pointer = 1;
if (arg1->expr->ts.type == BT_CLASS)
- gfc_add_component_ref (arg1->expr, "$data");
+ gfc_add_data_component (arg1->expr);
gfc_conv_expr (&arg1se, arg1->expr);
tmp = arg1se.expr;
}
@@ -5111,7 +5111,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
gfc_init_se (&arg2se, NULL);
arg1 = expr->value.function.actual;
if (arg1->expr->ts.type == BT_CLASS)
- gfc_add_component_ref (arg1->expr, "$data");
+ gfc_add_data_component (arg1->expr);
arg2 = arg1->next;
ss1 = gfc_walk_expr (arg1->expr);
@@ -5141,7 +5141,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
{
/* An optional target. */
if (arg2->expr->ts.type == BT_CLASS)
- gfc_add_component_ref (arg2->expr, "$data");
+ gfc_add_data_component (arg2->expr);
ss2 = gfc_walk_expr (arg2->expr);
nonzero_charlen = NULL_TREE;
@@ -5228,8 +5228,8 @@ gfc_conv_same_type_as (gfc_se *se, gfc_expr *expr)
if (a->ts.type == BT_CLASS)
{
- gfc_add_component_ref (a, "$vptr");
- gfc_add_component_ref (a, "$hash");
+ gfc_add_vptr_component (a);
+ gfc_add_hash_component (a);
}
else if (a->ts.type == BT_DERIVED)
a = gfc_get_int_expr (gfc_default_integer_kind, NULL,
@@ -5237,8 +5237,8 @@ gfc_conv_same_type_as (gfc_se *se, gfc_expr *expr)
if (b->ts.type == BT_CLASS)
{
- gfc_add_component_ref (b, "$vptr");
- gfc_add_component_ref (b, "$hash");
+ gfc_add_vptr_component (b);
+ gfc_add_hash_component (b);
}
else if (b->ts.type == BT_DERIVED)
b = gfc_get_int_expr (gfc_default_integer_kind, NULL,
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2010-11-06 23:56 ` Janus Weil
@ 2010-11-07 7:55 ` Tobias Burnus
2010-11-07 12:04 ` Janus Weil
0 siblings, 1 reply; 23+ messages in thread
From: Tobias Burnus @ 2010-11-07 7:55 UTC (permalink / raw)
To: Janus Weil; +Cc: Dominique Dhumieres, fortran, gcc-patches, tkoenig
Am 07.11.2010 00:56, schrieb Janus Weil:
> Yes, that is expected, because the patch changes the name of the vtab
> to "vtab$main$dt", so one needs to change the name of the subroutine
> in the test case in the same way in order to see the failure:
Dot? vtab.main.dt?
Tobias
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
2010-11-06 23:34 Dominique Dhumieres
@ 2010-11-06 23:56 ` Janus Weil
2010-11-07 7:55 ` Tobias Burnus
0 siblings, 1 reply; 23+ messages in thread
From: Janus Weil @ 2010-11-06 23:56 UTC (permalink / raw)
To: Dominique Dhumieres; +Cc: fortran, gcc-patches, tkoenig
>> If we are going to change the naming of the OOP stuff anyway, what about
>> the possible name collisions with -fdollar-ok ?
>
> With the patch for PR 46313, the test compiled with -fdollar-ok is
> compiled without problem on x86_64-apple-darwin10.
Yes, that is expected, because the patch changes the name of the vtab
to "vtab$main$dt", so one needs to change the name of the subroutine
in the test case in the same way in order to see the failure:
program main
type :: dt
! ...
end type dt
class(dt), pointer :: cp
contains
subroutine vtab$main$dt
end subroutine vtab$main$dt
end program main
Btw, I just tried the version with '@' instead of '$'. Unfortunately
the assembler doesn't seem to like that. I get tons of errors like:
/tmp/ccToz7yL.s:3: Error: junk at end of line, first unrecognized
character is `@'
/tmp/ccToz7yL.s:4: Error: invalid character '@' in mnemonic
Are there any other special characters we can exploit? What about the
pound sign or the ampersand? Any problems to expect with these? Or
should we rather stay with the dollar and ignore the problems with
-fdollar-ok?
Cheers,
Janus
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
@ 2010-11-06 23:34 Dominique Dhumieres
2010-11-06 23:56 ` Janus Weil
0 siblings, 1 reply; 23+ messages in thread
From: Dominique Dhumieres @ 2010-11-06 23:34 UTC (permalink / raw)
To: fortran; +Cc: gcc-patches, janus, tkoenig
> If we are going to change the naming of the OOP stuff anyway, what about
> the possible name collisions with -fdollar-ok ?
With the patch for PR 46313, the test compiled with -fdollar-ok is
compiled without problem on x86_64-apple-darwin10.
Otherwise, the patch has not disturbed my pet bugs!-)
Thanks,
Dominique
^ permalink raw reply [flat|nested] 23+ messages in thread
end of thread, other threads:[~2018-09-20 19:36 UTC | newest]
Thread overview: 23+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2010-11-06 20:11 [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue Janus Weil
2010-11-06 21:03 ` Thomas Koenig
2010-11-06 21:23 ` Janus Weil
2010-11-07 16:52 ` Tobias Burnus
2010-11-07 18:44 ` Janus Weil
2010-11-08 13:27 ` Tobias Burnus
2010-11-09 10:41 ` Janus Weil
2018-09-17 8:59 ` Bernhard Reutner-Fischer
2018-09-17 19:22 ` Janus Weil
2018-09-17 20:25 ` Janus Weil
2018-09-19 14:50 ` Bernhard Reutner-Fischer
2018-09-20 19:36 ` Janus Weil
2010-11-06 23:34 Dominique Dhumieres
2010-11-06 23:56 ` Janus Weil
2010-11-07 7:55 ` Tobias Burnus
2010-11-07 12:04 ` Janus Weil
2010-11-07 12:11 ` Tobias Schlüter
2010-11-07 13:19 ` Tobias Burnus
2010-11-07 14:21 ` Janus Weil
2010-11-07 15:34 ` Tobias Schlüter
2010-11-07 15:50 ` Janus Weil
2010-11-07 16:39 ` Tobias Schlüter
2010-11-07 16:30 ` Steve Kargl
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).