2010-04-12 Jerry DeLisle <jvdelisle@gcc.gnu.org>

[pf3gnuchains/gcc-fork.git] / gcc / fortran / symbol.c

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index dbbc97c..4356845 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -27,6 +27,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "gfortran.h"
 #include "parse.h"
 #include "match.h"
+#include "constructor.h"
 
 
 /* Strings for all symbol attributes.  We use these for dumping the
@@ -3664,6 +3665,7 @@ gen_special_c_interop_ptr (int ptr_id, const char *ptr_name,
 {
   gfc_symtree *tmp_symtree;
   gfc_symbol *tmp_sym;
+  gfc_constructor *c;
 
   tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, ptr_name);
         
@@ -3725,10 +3727,11 @@ gen_special_c_interop_ptr (int ptr_id, const char *ptr_name,
   tmp_sym->value->expr_type = EXPR_STRUCTURE;
   tmp_sym->value->ts.type = BT_DERIVED;
   tmp_sym->value->ts.u.derived = tmp_sym->ts.u.derived;
-  tmp_sym->value->value.constructor = gfc_get_constructor ();
-  tmp_sym->value->value.constructor->expr = gfc_get_expr ();
-  tmp_sym->value->value.constructor->expr->expr_type = EXPR_NULL;
-  tmp_sym->value->value.constructor->expr->ts.is_iso_c = 1;
+  gfc_constructor_append_expr (&tmp_sym->value->value.constructor, NULL, NULL);
+  c = gfc_constructor_first (tmp_sym->value->value.constructor);
+  c->expr = gfc_get_expr ();
+  c->expr->expr_type = EXPR_NULL;
+  c->expr->ts.is_iso_c = 1;
   /* Must declare c_null_ptr and c_null_funptr as having the
      PARAMETER attribute so they can be used in init expressions.  */
   tmp_sym->attr.flavor = FL_PARAMETER;
@@ -3934,7 +3937,8 @@ gen_shape_param (gfc_formal_arglist **head,
       param_sym->as->upper[i] = NULL;
     }
   param_sym->as->rank = 1;
-  param_sym->as->lower[0] = gfc_int_expr (1);
+  param_sym->as->lower[0] = gfc_get_int_expr (gfc_default_integer_kind,
+                                             NULL, 1);
 
   /* The extent is unknown until we get it.  The length give us
      the rank the incoming pointer.  */
@@ -4277,7 +4281,8 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
 #define NAMED_CHARKNDCST(a,b,c) case a :
 #include "iso-c-binding.def"
 
-       tmp_sym->value = gfc_int_expr (c_interop_kinds_table[s].value);
+       tmp_sym->value = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+                                          c_interop_kinds_table[s].value);
 
        /* Initialize an integer constant expression node.  */
        tmp_sym->attr.flavor = FL_PARAMETER;
@@ -4307,20 +4312,16 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
 
        /* Initialize an integer constant expression node for the
           length of the character.  */
-       tmp_sym->value = gfc_get_expr (); 
-       tmp_sym->value->expr_type = EXPR_CONSTANT;
-       tmp_sym->value->ts.type = BT_CHARACTER;
-       tmp_sym->value->ts.kind = gfc_default_character_kind;
-       tmp_sym->value->where = gfc_current_locus;
+       tmp_sym->value = gfc_get_character_expr (gfc_default_character_kind,
+                                                &gfc_current_locus, NULL, 1);
        tmp_sym->value->ts.is_c_interop = 1;
        tmp_sym->value->ts.is_iso_c = 1;
        tmp_sym->value->value.character.length = 1;
-       tmp_sym->value->value.character.string = gfc_get_wide_string (2);
        tmp_sym->value->value.character.string[0]
          = (gfc_char_t) c_interop_kinds_table[s].value;
-       tmp_sym->value->value.character.string[1] = '\0';
        tmp_sym->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
-       tmp_sym->ts.u.cl->length = gfc_int_expr (1);
+       tmp_sym->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind,
+                                                    NULL, 1);
 
        /* May not need this in both attr and ts, but do need in
           attr for writing module file.  */
@@ -4756,8 +4757,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
       c->attr.codimension = attr->codimension;
       c->attr.abstract = ts->u.derived->attr.abstract;
       c->as = (*as);
-      c->initializer = gfc_get_expr ();
-      c->initializer->expr_type = EXPR_NULL;
+      c->initializer = gfc_get_null_expr (NULL);
 
       /* Add component '$vptr'.  */
       if (gfc_add_component (fclass, "$vptr", &c) == FAILURE)
@@ -4767,8 +4767,6 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
       gcc_assert (vtab);
       c->ts.u.derived = vtab->ts.u.derived;
       c->attr.pointer = 1;
-      c->initializer = gfc_get_expr ();
-      c->initializer->expr_type = EXPR_NULL;
     }
 
   /* Since the extension field is 8 bit wide, we can only have
@@ -4842,7 +4840,8 @@ gfc_find_derived_vtab (gfc_symbol *derived)
              c->ts.type = BT_INTEGER;
              c->ts.kind = 4;
              c->attr.access = ACCESS_PRIVATE;
-             c->initializer = gfc_int_expr (derived->hash_value);
+             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)
@@ -4854,20 +4853,21 @@ gfc_find_derived_vtab (gfc_symbol *derived)
                 so that the correct initializer can be set later on
                 (in gfc_conv_structure).  */
              c->ts.u.derived = derived;
-             c->initializer = gfc_int_expr (0);
+             c->initializer = gfc_get_int_expr (gfc_default_integer_kind,
+                                                NULL, 0);
 
              /* Add component $extends.  */
              if (gfc_add_component (vtype, "$extends", &c) == FAILURE)
                return NULL;
              c->attr.pointer = 1;
              c->attr.access = ACCESS_PRIVATE;
-             c->initializer = gfc_get_expr ();
              parent = gfc_get_derived_super_type (derived);
              if (parent)
                {
                  parent_vtab = gfc_find_derived_vtab (parent);
                  c->ts.type = BT_DERIVED;
                  c->ts.u.derived = parent_vtab->ts.u.derived;
+                 c->initializer = gfc_get_expr ();
                  c->initializer->expr_type = EXPR_VARIABLE;
                  gfc_find_sym_tree (parent_vtab->name, parent_vtab->ns, 0,
                                     &c->initializer->symtree);
@@ -4876,7 +4876,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
                {
                  c->ts.type = BT_DERIVED;
                  c->ts.u.derived = vtype;
-                 c->initializer->expr_type = EXPR_NULL;
+                 c->initializer = gfc_get_null_expr (NULL);
                }
            }
          vtab->ts.u.derived = vtype;