1 /* Implementation of Fortran 2003 Polymorphism.
2 Copyright (C) 2009, 2010
3 Free Software Foundation, Inc.
4 Contributed by Paul Richard Thomas & Janus Weil
6 This file is part of GCC.
8 GCC is free software; you can redistribute it and/or modify it under
9 the terms of the GNU General Public License as published by the Free
10 Software Foundation; either version 3, or (at your option) any later
13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 You should have received a copy of the GNU General Public License
19 along with GCC; see the file COPYING3. If not see
20 <http://www.gnu.org/licenses/>. */
23 /* class.c -- This file contains the front end functions needed to service
24 the implementation of Fortran 2003 polymorphism and other
25 object-oriented features. */
28 /* Outline of the internal representation:
30 Each CLASS variable is encapsulated by a class container, which is a
31 structure with two fields:
32 * $data: A pointer to the actual data of the variable. This field has the
33 declared type of the class variable and its attributes
34 (pointer/allocatable/dimension/...).
35 * $vptr: A pointer to the vtable entry (see below) of the dynamic type.
37 For each derived type we set up a "vtable" entry, i.e. a structure with the
39 * $hash: A hash value serving as a unique identifier for this type.
40 * $size: The size in bytes of the derived type.
41 * $extends: A pointer to the vtable entry of the parent derived type.
42 In addition to these fields, each vtable entry contains additional procedure
43 pointer components, which contain pointers to the procedures which are bound
44 to the type's "methods" (type-bound procedures). */
50 #include "constructor.h"
53 /* Insert a reference to the component of the given name.
54 Only to be used with CLASS containers. */
57 gfc_add_component_ref (gfc_expr
*e
, const char *name
)
59 gfc_ref
**tail
= &(e
->ref
);
61 gfc_symbol
*derived
= e
->symtree
->n
.sym
->ts
.u
.derived
;
64 if ((*tail
)->type
== REF_COMPONENT
)
65 derived
= (*tail
)->u
.c
.component
->ts
.u
.derived
;
66 if ((*tail
)->type
== REF_ARRAY
&& (*tail
)->next
== NULL
)
68 tail
= &((*tail
)->next
);
70 if (*tail
!= NULL
&& strcmp (name
, "$data") == 0)
72 (*tail
) = gfc_get_ref();
74 (*tail
)->type
= REF_COMPONENT
;
75 (*tail
)->u
.c
.sym
= derived
;
76 (*tail
)->u
.c
.component
= gfc_find_component (derived
, name
, true, true);
77 gcc_assert((*tail
)->u
.c
.component
);
79 e
->ts
= (*tail
)->u
.c
.component
->ts
;
83 /* Build a NULL initializer for CLASS pointers,
84 initializing the $data and $vptr components to zero. */
87 gfc_class_null_initializer (gfc_typespec
*ts
)
92 init
= gfc_get_structure_constructor_expr (ts
->type
, ts
->kind
,
93 &ts
->u
.derived
->declared_at
);
96 for (comp
= ts
->u
.derived
->components
; comp
; comp
= comp
->next
)
98 gfc_constructor
*ctor
= gfc_constructor_get();
99 ctor
->expr
= gfc_get_expr ();
100 ctor
->expr
->expr_type
= EXPR_NULL
;
101 ctor
->expr
->ts
= comp
->ts
;
102 gfc_constructor_append (&init
->value
.constructor
, ctor
);
109 /* Build a polymorphic CLASS entity, using the symbol that comes from
110 build_sym. A CLASS entity is represented by an encapsulating type,
111 which contains the declared type as '$data' component, plus a pointer
112 component '$vptr' which determines the dynamic type. */
115 gfc_build_class_symbol (gfc_typespec
*ts
, symbol_attribute
*attr
,
116 gfc_array_spec
**as
, bool delayed_vtab
)
118 char name
[GFC_MAX_SYMBOL_LEN
+ 5];
123 /* Determine the name of the encapsulating type. */
124 if ((*as
) && (*as
)->rank
&& attr
->allocatable
)
125 sprintf (name
, "class$%s_%d_a", ts
->u
.derived
->name
, (*as
)->rank
);
126 else if ((*as
) && (*as
)->rank
)
127 sprintf (name
, "class$%s_%d", ts
->u
.derived
->name
, (*as
)->rank
);
128 else if (attr
->pointer
)
129 sprintf (name
, "class$%s_p", ts
->u
.derived
->name
);
130 else if (attr
->allocatable
)
131 sprintf (name
, "class$%s_a", ts
->u
.derived
->name
);
133 sprintf (name
, "class$%s", ts
->u
.derived
->name
);
135 gfc_find_symbol (name
, ts
->u
.derived
->ns
, 0, &fclass
);
139 /* If not there, create a new symbol. */
140 fclass
= gfc_new_symbol (name
, ts
->u
.derived
->ns
);
141 st
= gfc_new_symtree (&ts
->u
.derived
->ns
->sym_root
, name
);
143 gfc_set_sym_referenced (fclass
);
145 fclass
->ts
.type
= BT_UNKNOWN
;
146 fclass
->attr
.abstract
= ts
->u
.derived
->attr
.abstract
;
147 if (ts
->u
.derived
->f2k_derived
)
148 fclass
->f2k_derived
= gfc_get_namespace (NULL
, 0);
149 if (gfc_add_flavor (&fclass
->attr
, FL_DERIVED
,
150 NULL
, &gfc_current_locus
) == FAILURE
)
153 /* Add component '$data'. */
154 if (gfc_add_component (fclass
, "$data", &c
) == FAILURE
)
157 c
->ts
.type
= BT_DERIVED
;
158 c
->attr
.access
= ACCESS_PRIVATE
;
159 c
->ts
.u
.derived
= ts
->u
.derived
;
160 c
->attr
.class_pointer
= attr
->pointer
;
161 c
->attr
.pointer
= attr
->pointer
|| attr
->dummy
;
162 c
->attr
.allocatable
= attr
->allocatable
;
163 c
->attr
.dimension
= attr
->dimension
;
164 c
->attr
.codimension
= attr
->codimension
;
165 c
->attr
.abstract
= ts
->u
.derived
->attr
.abstract
;
167 c
->initializer
= NULL
;
169 /* Add component '$vptr'. */
170 if (gfc_add_component (fclass
, "$vptr", &c
) == FAILURE
)
172 c
->ts
.type
= BT_DERIVED
;
174 c
->ts
.u
.derived
= NULL
;
177 vtab
= gfc_find_derived_vtab (ts
->u
.derived
, false);
179 c
->ts
.u
.derived
= vtab
->ts
.u
.derived
;
184 /* Since the extension field is 8 bit wide, we can only have
185 up to 255 extension levels. */
186 if (ts
->u
.derived
->attr
.extension
== 255)
188 gfc_error ("Maximum extension level reached with type '%s' at %L",
189 ts
->u
.derived
->name
, &ts
->u
.derived
->declared_at
);
193 fclass
->attr
.extension
= ts
->u
.derived
->attr
.extension
+ 1;
194 fclass
->attr
.is_class
= 1;
195 ts
->u
.derived
= fclass
;
196 attr
->allocatable
= attr
->pointer
= attr
->dimension
= 0;
197 (*as
) = NULL
; /* XXX */
203 add_proc_component (gfc_component
*c
, gfc_symbol
*vtype
,
204 gfc_symtree
*st
, gfc_symbol
*specific
,
205 bool is_generic
, bool is_generic_specific
)
207 /* Add procedure component. */
210 if (gfc_add_component (vtype
, specific
->name
, &c
) == FAILURE
)
212 c
->ts
.interface
= specific
;
214 else if (c
&& is_generic_specific
)
216 c
->ts
.interface
= st
->n
.tb
->u
.specific
->n
.sym
;
220 c
= gfc_find_component (vtype
, st
->name
, true, true);
221 if (!c
&& gfc_add_component (vtype
, st
->name
, &c
) == FAILURE
)
223 c
->ts
.interface
= st
->n
.tb
->u
.specific
->n
.sym
;
227 c
->tb
= XCNEW (gfc_typebound_proc
);
230 c
->attr
.procedure
= 1;
231 c
->attr
.proc_pointer
= 1;
232 c
->attr
.flavor
= FL_PROCEDURE
;
233 c
->attr
.access
= ACCESS_PRIVATE
;
234 c
->attr
.external
= 1;
236 c
->attr
.if_source
= IFSRC_IFBODY
;
238 /* A static initializer cannot be used here because the specific
239 function is not a constant; internal compiler error: in
240 output_constant, at varasm.c:4623 */
241 c
->initializer
= NULL
;
246 add_proc_comps (gfc_component
*c
, gfc_symbol
*vtype
,
247 gfc_symtree
*st
, bool is_generic
)
249 if (c
== NULL
&& !is_generic
)
251 add_proc_component (c
, vtype
, st
, NULL
, false, false);
253 else if (is_generic
&& st
->n
.tb
&& vtype
->components
== NULL
)
256 gfc_symbol
* specific
;
257 for (g
= st
->n
.tb
->u
.generic
; g
; g
= g
->next
)
261 specific
= g
->specific
->u
.specific
->n
.sym
;
262 add_proc_component (NULL
, vtype
, st
, specific
, true, false);
265 else if (c
->attr
.proc_pointer
&& c
->tb
)
269 c
->ts
.interface
= st
->n
.tb
->u
.specific
->n
.sym
;
274 add_procs_to_declared_vtab1 (gfc_symtree
*st
, gfc_symbol
*vtype
,
279 char name
[3 * GFC_MAX_SYMBOL_LEN
+ 10];
285 add_procs_to_declared_vtab1 (st
->left
, vtype
, resolved
);
288 add_procs_to_declared_vtab1 (st
->right
, vtype
, resolved
);
293 if (!st
->n
.tb
->is_generic
&& st
->n
.tb
->u
.specific
)
295 c
= gfc_find_component (vtype
, st
->name
, true, true);
296 add_proc_comps (c
, vtype
, st
, false);
298 else if (st
->n
.tb
->is_generic
)
300 c
= gfc_find_component (vtype
, st
->name
, true, true);
304 /* Add derived type component with generic name. */
305 if (gfc_add_component (vtype
, st
->name
, &c
) == FAILURE
)
307 c
->ts
.type
= BT_DERIVED
;
308 c
->attr
.flavor
= FL_VARIABLE
;
311 /* Add a special empty derived type as a placeholder. */
312 sprintf (name
, "$empty");
313 gfc_find_symbol (name
, vtype
->ns
, 0, &generic
);
316 gfc_get_symbol (name
, vtype
->ns
, &generic
);
317 generic
->attr
.flavor
= FL_DERIVED
;
319 gfc_set_sym_referenced (generic
);
320 generic
->ts
.type
= BT_UNKNOWN
;
321 generic
->attr
.zero_comp
= 1;
324 c
->ts
.u
.derived
= generic
;
331 copy_vtab_proc_comps (gfc_symbol
*declared
, gfc_symbol
*vtype
,
334 gfc_component
*c
, *cmp
;
337 vtab
= gfc_find_derived_vtab (declared
, resolved
);
339 for (cmp
= vtab
->ts
.u
.derived
->components
; cmp
; cmp
= cmp
->next
)
341 if (gfc_find_component (vtype
, cmp
->name
, true, true))
344 if (gfc_add_component (vtype
, cmp
->name
, &c
) == FAILURE
)
347 if (cmp
->ts
.type
== BT_DERIVED
)
350 c
->ts
.u
.derived
= cmp
->ts
.u
.derived
;
351 c
->attr
.flavor
= FL_VARIABLE
;
353 c
->initializer
= NULL
;
357 c
->tb
= XCNEW (gfc_typebound_proc
);
359 c
->attr
.procedure
= 1;
360 c
->attr
.proc_pointer
= 1;
361 c
->attr
.flavor
= FL_PROCEDURE
;
362 c
->attr
.access
= ACCESS_PRIVATE
;
363 c
->attr
.external
= 1;
364 c
->ts
.interface
= cmp
->ts
.interface
;
366 c
->attr
.if_source
= IFSRC_IFBODY
;
367 c
->initializer
= NULL
;
372 add_procs_to_declared_vtab (gfc_symbol
*declared
, gfc_symbol
*vtype
,
373 gfc_symbol
*derived
, bool resolved
)
375 gfc_symbol
* super_type
;
377 super_type
= gfc_get_derived_super_type (declared
);
379 if (super_type
&& (super_type
!= declared
))
380 add_procs_to_declared_vtab (super_type
, vtype
, derived
, resolved
);
382 if (declared
!= derived
)
383 copy_vtab_proc_comps (declared
, vtype
, resolved
);
385 if (declared
->f2k_derived
&& declared
->f2k_derived
->tb_sym_root
)
386 add_procs_to_declared_vtab1 (declared
->f2k_derived
->tb_sym_root
,
389 if (declared
->f2k_derived
&& declared
->f2k_derived
->tb_uop_root
)
390 add_procs_to_declared_vtab1 (declared
->f2k_derived
->tb_uop_root
,
396 void add_generic_specifics (gfc_symbol
*declared
, gfc_symbol
*vtab
,
400 gfc_symbol
* specific1
;
401 gfc_symbol
* specific2
;
402 gfc_symtree
*st
= NULL
;
405 /* Find the generic procedure using the component name. */
406 st
= gfc_find_typebound_proc (declared
, NULL
, name
, true, NULL
);
408 st
= gfc_find_typebound_user_op (declared
, NULL
, name
, true, NULL
);
413 /* Add procedure pointer components for the specific procedures. */
414 for (g
= st
->n
.tb
->u
.generic
; g
; g
= g
->next
)
418 specific1
= g
->specific_st
->n
.tb
->u
.specific
->n
.sym
;
420 c
= vtab
->ts
.u
.derived
->components
;
423 /* Override identical specific interface. */
424 if (vtab
->ts
.u
.derived
->components
)
426 for (; c
; c
= c
->next
)
428 specific2
= c
->ts
.interface
;
429 if (gfc_compare_interfaces (specific2
, specific1
,
430 specific1
->name
, 0, 0, NULL
, 0))
435 add_proc_component (c
, vtab
->ts
.u
.derived
, g
->specific_st
,
437 vtab
->ts
.u
.derived
->attr
.zero_comp
= 0;
443 add_generics_to_declared_vtab (gfc_symbol
*declared
, gfc_symbol
*vtype
,
444 gfc_symbol
*derived
, bool resolved
)
447 gfc_symtree
*st
= NULL
;
449 char name
[2 * GFC_MAX_SYMBOL_LEN
+ 8];
450 gfc_symbol
* super_type
;
452 gcc_assert (resolved
);
454 for (cmp
= vtype
->components
; cmp
; cmp
= cmp
->next
)
456 if (cmp
->ts
.type
!= BT_DERIVED
)
459 /* The only derived type that does not represent a generic
460 procedure is the pointer to the parent vtab. */
461 if (cmp
->ts
.u
.derived
462 && strcmp (cmp
->ts
.u
.derived
->name
, "$extends") == 0)
465 /* Find the generic procedure using the component name. */
466 st
= gfc_find_typebound_proc (declared
, NULL
, cmp
->name
,
469 st
= gfc_find_typebound_user_op (declared
, NULL
, cmp
->name
,
472 /* Should be an error but we pass on it for now. */
473 if (st
== NULL
|| !st
->n
.tb
->is_generic
)
478 /* Build a vtab and a special vtype, with only the procedure
479 pointer fields, to carry the pointers to the specific
480 procedures. Should this name ever be changed, the same
481 should be done in trans-expr.c(gfc_trans_assign_vtab_procs). */
482 sprintf (name
, "vtab$%s$%s", vtype
->name
, cmp
->name
);
483 gfc_find_symbol (name
, derived
->ns
, 0, &vtab
);
486 gfc_get_symbol (name
, derived
->ns
, &vtab
);
487 vtab
->ts
.type
= BT_DERIVED
;
488 vtab
->attr
.flavor
= FL_VARIABLE
;
489 vtab
->attr
.target
= 1;
490 vtab
->attr
.save
= SAVE_EXPLICIT
;
493 gfc_set_sym_referenced (vtab
);
494 sprintf (name
, "%s$%s", vtype
->name
, cmp
->name
);
496 gfc_find_symbol (name
, derived
->ns
, 0, &cmp
->ts
.u
.derived
);
497 if (cmp
->ts
.u
.derived
== NULL
498 || (strcmp (cmp
->ts
.u
.derived
->name
, "$empty") == 0))
500 gfc_get_symbol (name
, derived
->ns
, &cmp
->ts
.u
.derived
);
501 if (gfc_add_flavor (&cmp
->ts
.u
.derived
->attr
, FL_DERIVED
,
502 NULL
, &gfc_current_locus
) == FAILURE
)
504 cmp
->ts
.u
.derived
->refs
++;
505 gfc_set_sym_referenced (cmp
->ts
.u
.derived
);
506 cmp
->ts
.u
.derived
->attr
.vtype
= 1;
507 cmp
->ts
.u
.derived
->attr
.zero_comp
= 1;
509 vtab
->ts
.u
.derived
= cmp
->ts
.u
.derived
;
512 /* Store this for later use in setting the pointer. */
513 cmp
->ts
.interface
= vtab
;
515 if (vtab
->ts
.u
.derived
->components
)
518 super_type
= gfc_get_derived_super_type (declared
);
520 if (super_type
&& (super_type
!= declared
))
521 add_generic_specifics (super_type
, vtab
, cmp
->name
);
523 add_generic_specifics (declared
, vtab
, cmp
->name
);
528 /* Find the symbol for a derived type's vtab. A vtab has the following
530 $hash a hash value used to identify the derived type
531 $size the size in bytes of the derived type
532 $extends a pointer to the vtable of the parent derived type
534 procedure pointer components for the specific typebound procedures
535 structure pointers to reduced vtabs that contain procedure
536 pointers to the specific procedures. */
539 gfc_find_derived_vtab (gfc_symbol
*derived
, bool resolved
)
542 gfc_symbol
*vtab
= NULL
, *vtype
= NULL
;
543 char name
[2 * GFC_MAX_SYMBOL_LEN
+ 8];
547 for (; ns
; ns
= ns
->parent
)
553 sprintf (name
, "vtab$%s", derived
->name
);
554 gfc_find_symbol (name
, ns
, 0, &vtab
);
558 gfc_get_symbol (name
, ns
, &vtab
);
559 vtab
->ts
.type
= BT_DERIVED
;
560 vtab
->attr
.flavor
= FL_VARIABLE
;
561 vtab
->attr
.target
= 1;
562 vtab
->attr
.save
= SAVE_EXPLICIT
;
565 gfc_set_sym_referenced (vtab
);
566 sprintf (name
, "vtype$%s", derived
->name
);
568 gfc_find_symbol (name
, ns
, 0, &vtype
);
572 gfc_symbol
*parent
= NULL
, *parent_vtab
= NULL
;
574 gfc_get_symbol (name
, ns
, &vtype
);
575 if (gfc_add_flavor (&vtype
->attr
, FL_DERIVED
,
576 NULL
, &gfc_current_locus
) == FAILURE
)
579 gfc_set_sym_referenced (vtype
);
581 /* Add component '$hash'. */
582 if (gfc_add_component (vtype
, "$hash", &c
) == FAILURE
)
584 c
->ts
.type
= BT_INTEGER
;
586 c
->attr
.access
= ACCESS_PRIVATE
;
587 c
->initializer
= gfc_get_int_expr (gfc_default_integer_kind
,
588 NULL
, derived
->hash_value
);
590 /* Add component '$size'. */
591 if (gfc_add_component (vtype
, "$size", &c
) == FAILURE
)
593 c
->ts
.type
= BT_INTEGER
;
595 c
->attr
.access
= ACCESS_PRIVATE
;
596 /* Remember the derived type in ts.u.derived,
597 so that the correct initializer can be set later on
598 (in gfc_conv_structure). */
599 c
->ts
.u
.derived
= derived
;
600 c
->initializer
= gfc_get_int_expr (gfc_default_integer_kind
,
603 /* Add component $extends. */
604 if (gfc_add_component (vtype
, "$extends", &c
) == FAILURE
)
607 c
->attr
.access
= ACCESS_PRIVATE
;
608 parent
= gfc_get_derived_super_type (derived
);
611 parent_vtab
= gfc_find_derived_vtab (parent
, resolved
);
612 c
->ts
.type
= BT_DERIVED
;
613 c
->ts
.u
.derived
= parent_vtab
->ts
.u
.derived
;
614 c
->initializer
= gfc_get_expr ();
615 c
->initializer
->expr_type
= EXPR_VARIABLE
;
616 gfc_find_sym_tree (parent_vtab
->name
, parent_vtab
->ns
,
617 0, &c
->initializer
->symtree
);
621 c
->ts
.type
= BT_DERIVED
;
622 c
->ts
.u
.derived
= vtype
;
623 c
->initializer
= gfc_get_null_expr (NULL
);
626 add_procs_to_declared_vtab (derived
, vtype
, derived
, resolved
);
627 vtype
->attr
.vtype
= 1;
630 vtab
->ts
.u
.derived
= vtype
;
631 vtab
->value
= gfc_default_initializer (&vtab
->ts
);
635 /* Catch the call just before the backend declarations are built, so that
636 the generic procedures have been resolved and the specific procedures
637 have formal interfaces that can be compared. */
639 && vtab
->ts
.u
.derived
640 && vtab
->ts
.u
.derived
->backend_decl
== NULL
)
641 add_generics_to_declared_vtab (derived
, vtab
->ts
.u
.derived
,
648 /* General worker function to find either a type-bound procedure or a
649 type-bound user operator. */
652 find_typebound_proc_uop (gfc_symbol
* derived
, gfc_try
* t
,
653 const char* name
, bool noaccess
, bool uop
,
659 /* Set correct symbol-root. */
660 gcc_assert (derived
->f2k_derived
);
661 root
= (uop
? derived
->f2k_derived
->tb_uop_root
662 : derived
->f2k_derived
->tb_sym_root
);
664 /* Set default to failure. */
668 /* Try to find it in the current type's namespace. */
669 res
= gfc_find_symtree (root
, name
);
670 if (res
&& res
->n
.tb
&& !res
->n
.tb
->error
)
676 if (!noaccess
&& derived
->attr
.use_assoc
677 && res
->n
.tb
->access
== ACCESS_PRIVATE
)
680 gfc_error ("'%s' of '%s' is PRIVATE at %L",
681 name
, derived
->name
, where
);
689 /* Otherwise, recurse on parent type if derived is an extension. */
690 if (derived
->attr
.extension
)
692 gfc_symbol
* super_type
;
693 super_type
= gfc_get_derived_super_type (derived
);
694 gcc_assert (super_type
);
696 return find_typebound_proc_uop (super_type
, t
, name
,
697 noaccess
, uop
, where
);
705 /* Find a type-bound procedure or user operator by name for a derived-type
706 (looking recursively through the super-types). */
709 gfc_find_typebound_proc (gfc_symbol
* derived
, gfc_try
* t
,
710 const char* name
, bool noaccess
, locus
* where
)
712 return find_typebound_proc_uop (derived
, t
, name
, noaccess
, false, where
);
716 gfc_find_typebound_user_op (gfc_symbol
* derived
, gfc_try
* t
,
717 const char* name
, bool noaccess
, locus
* where
)
719 return find_typebound_proc_uop (derived
, t
, name
, noaccess
, true, where
);
723 /* Find a type-bound intrinsic operator looking recursively through the
724 super-type hierarchy. */
727 gfc_find_typebound_intrinsic_op (gfc_symbol
* derived
, gfc_try
* t
,
728 gfc_intrinsic_op op
, bool noaccess
,
731 gfc_typebound_proc
* res
;
733 /* Set default to failure. */
737 /* Try to find it in the current type's namespace. */
738 if (derived
->f2k_derived
)
739 res
= derived
->f2k_derived
->tb_op
[op
];
744 if (res
&& !res
->error
)
750 if (!noaccess
&& derived
->attr
.use_assoc
751 && res
->access
== ACCESS_PRIVATE
)
754 gfc_error ("'%s' of '%s' is PRIVATE at %L",
755 gfc_op2string (op
), derived
->name
, where
);
763 /* Otherwise, recurse on parent type if derived is an extension. */
764 if (derived
->attr
.extension
)
766 gfc_symbol
* super_type
;
767 super_type
= gfc_get_derived_super_type (derived
);
768 gcc_assert (super_type
);
770 return gfc_find_typebound_intrinsic_op (super_type
, t
, op
,
779 /* Get a typebound-procedure symtree or create and insert it if not yet
780 present. This is like a very simplified version of gfc_get_sym_tree for
781 tbp-symtrees rather than regular ones. */
784 gfc_get_tbp_symtree (gfc_symtree
**root
, const char *name
)
788 result
= gfc_find_symtree (*root
, name
);
791 result
= gfc_new_symtree (root
, name
);