Re: [Patch, Fortran, OOP] PR 46313: OOP-ABI issue, ALLOCATE issue, CLASS renaming issue

[Janus Weil <janus@gcc.gnu.org>]

[-- 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, &copy);
 		  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, &current_attr,&var_locus)
+      if (gfc_copy_attr (&CLASS_DATA (sym)->attr, &current_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,