OSDN Git Service

2009-10-01 Tobias Burnus <burnus@net-b.de>
[pf3gnuchains/gcc-fork.git] / gcc / fortran / data.c
index 5ffdd5b..6cddb3c 100644 (file)
@@ -1,12 +1,13 @@
 /* Supporting functions for resolving DATA statement.
-   Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
+   Free Software Foundation, Inc.
    Contributed by Lifang Zeng <zlf605@hotmail.com>
 
 This file is part of GCC.
 
 GCC is free software; you can redistribute it and/or modify it under
 the terms of the GNU General Public License as published by the Free
-Software Foundation; either version 2, or (at your option) any later
+Software Foundation; either version 3, or (at your option) any later
 version.
 
 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
@@ -15,42 +16,37 @@ FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
 for more details.
 
 You should have received a copy of the GNU General Public License
-along with GCC; see the file COPYING.  If not, write to the Free
-Software Foundation, 59 Temple Place - Suite 330,Boston, MA
-02111-1307, USA.  */
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
 
 
 /* Notes for DATA statement implementation:
-                                                                               
+                                                                              
    We first assign initial value to each symbol by gfc_assign_data_value
-   during resolveing DATA statement. Refer to check_data_variable and
+   during resolving DATA statement. Refer to check_data_variable and
    traverse_data_list in resolve.c.
-                                                                               
-   The complexity exists in the handleing of array section, implied do
+                                                                              
+   The complexity exists in the handling of array section, implied do
    and array of struct appeared in DATA statement.
-                                                                               
+                                                                              
    We call gfc_conv_structure, gfc_con_array_array_initializer,
    etc., to convert the initial value. Refer to trans-expr.c and
    trans-array.c.  */
 
 #include "config.h"
-#include "system.h"
-#include "coretypes.h"
-#include "toplev.h"
 #include "gfortran.h"
-#include "assert.h"
-#include "trans.h"
+#include "data.h"
 
 static void formalize_init_expr (gfc_expr *);
 
 /* Calculate the array element offset.  */
 
 static void
-get_array_index (gfc_array_ref * ar, mpz_t * offset)
+get_array_index (gfc_array_ref *ar, mpz_t *offset)
 {
   gfc_expr *e;
   int i;
-  try re;
+  gfc_try re;
   mpz_t delta;
   mpz_t tmp;
 
@@ -65,14 +61,15 @@ get_array_index (gfc_array_ref * ar, mpz_t * offset)
       if ((gfc_is_constant_expr (ar->as->lower[i]) == 0)
          || (gfc_is_constant_expr (ar->as->upper[i]) == 0)
          || (gfc_is_constant_expr (e) == 0))
-       gfc_error ("non-constant array in DATA statement %L.", &ar->where);        
+       gfc_error ("non-constant array in DATA statement %L", &ar->where);
+
       mpz_set (tmp, e->value.integer);
       mpz_sub (tmp, tmp, ar->as->lower[i]->value.integer);
       mpz_mul (tmp, tmp, delta);
       mpz_add (*offset, tmp, *offset);
 
       mpz_sub (tmp, ar->as->upper[i]->value.integer,
-      ar->as->lower[i]->value.integer);
+              ar->as->lower[i]->value.integer);
       mpz_add_ui (tmp, tmp, 1);
       mpz_mul (delta, tmp, delta);
     }
@@ -84,14 +81,50 @@ get_array_index (gfc_array_ref * ar, mpz_t * offset)
 /* Find if there is a constructor which offset is equal to OFFSET.  */
 
 static gfc_constructor *
-find_con_by_offset (mpz_t offset, gfc_constructor *con)
+find_con_by_offset (splay_tree spt, mpz_t offset)
 {
-  for (; con; con = con->next)
+  mpz_t tmp;
+  gfc_constructor *ret = NULL;
+  gfc_constructor *con;
+  splay_tree_node sptn;
+
+  /* The complexity is due to needing quick access to the linked list of
+     constructors.  Both a linked list and a splay tree are used, and both
+     are kept up to date if they are array elements (which is the only time
+     that a specific constructor has to be found).  */  
+
+  gcc_assert (spt != NULL);
+  mpz_init (tmp);
+
+  sptn = splay_tree_lookup (spt, (splay_tree_key) mpz_get_si (offset));
+
+  if (sptn)
+    ret = (gfc_constructor*) sptn->value;  
+  else
     {
-      if (mpz_cmp (offset, con->n.offset) == 0)
-        return con;
+       /* Need to check and see if we match a range, so we will pull
+         the next lowest index and see if the range matches.  */
+       sptn = splay_tree_predecessor (spt,
+                                     (splay_tree_key) mpz_get_si (offset));
+       if (sptn)
+        {
+           con = (gfc_constructor*) sptn->value;
+           if (mpz_cmp_ui (con->repeat, 1) > 0)
+             {
+                mpz_init (tmp);
+                mpz_add (tmp, con->n.offset, con->repeat);
+                if (mpz_cmp (offset, tmp) < 0)
+                  ret = con;
+                mpz_clear (tmp);
+             }
+           else 
+             ret = NULL; /* The range did not match.  */
+        }
+      else
+       ret = NULL; /* No pred, so no match.  */
     }
-  return NULL;
+
+  return ret;
 }
 
 
@@ -103,123 +136,151 @@ find_con_by_component (gfc_component *com, gfc_constructor *con)
   for (; con; con = con->next)
     {
       if (com == con->n.component)
-        return con;
+       return con;
     }
   return NULL;
 }
 
-/* Assign RVALUE to LVALUE where we assume that LVALUE is a substring
-   reference. We do a little more than that: if LVALUE already has an
-   initialization, we put RVALUE into the existing initialization as
-   per the rules of assignment to a substring. If LVALUE has no
-   initialization yet, we initialize it to all blanks, then filling in
-   the RVALUE.  */
 
-static void
-assign_substring_data_value (gfc_expr * lvalue, gfc_expr * rvalue)
+/* Create a character type initialization expression from RVALUE.
+   TS [and REF] describe [the substring of] the variable being initialized.
+   INIT is the existing initializer, not NULL.  Initialization is performed
+   according to normal assignment rules.  */
+
+static gfc_expr *
+create_character_intializer (gfc_expr *init, gfc_typespec *ts,
+                            gfc_ref *ref, gfc_expr *rvalue)
 {
-  gfc_symbol *symbol;
-  gfc_expr *expr, *init;
-  gfc_ref *ref;
-  int len, i;
-  int start, end;
-  char *c, *d;
+  int len, start, end;
+  gfc_char_t *dest;
            
-  symbol = lvalue->symtree->n.sym;
-  ref = lvalue->ref;
-  init = symbol->value;
+  gfc_extract_int (ts->u.cl->length, &len);
 
-  assert (symbol->ts.type == BT_CHARACTER);
-  assert (symbol->ts.cl->length->expr_type == EXPR_CONSTANT);
-  assert (symbol->ts.cl->length->ts.type == BT_INTEGER);
-  assert (symbol->ts.kind == 1);
-
-  gfc_extract_int (symbol->ts.cl->length, &len);
-           
   if (init == NULL)
     {
-      /* Setup the expression to hold the constructor.  */
-      expr = gfc_get_expr ();
-      expr->expr_type = EXPR_CONSTANT;
-      expr->ts.type = BT_CHARACTER;
-      expr->ts.kind = 1;
-             
-      expr->value.character.length = len;
-      expr->value.character.string = gfc_getmem (len);
-      memset (expr->value.character.string, ' ', len);
-
-      symbol->value = expr;
+      /* Create a new initializer.  */
+      init = gfc_get_expr ();
+      init->expr_type = EXPR_CONSTANT;
+      init->ts = *ts;
+      
+      dest = gfc_get_wide_string (len + 1);
+      dest[len] = '\0';
+      init->value.character.length = len;
+      init->value.character.string = dest;
+      /* Blank the string if we're only setting a substring.  */
+      if (ref != NULL)
+       gfc_wide_memset (dest, ' ', len);
     }
   else
-    expr = init;
-         
-  /* Now that we have allocated the memory for the string,
-     fill in the initialized places, truncating the
-     intialization string if necessary, i.e.
-     DATA a(1:2) /'123'/
-     doesn't initialize a(3:3).  */
-
-  gfc_extract_int (ref->u.ss.start, &start);
-  gfc_extract_int (ref->u.ss.end, &end);
-           
-  assert (start >= 1);
-  assert (end <= len);
+    dest = init->value.character.string;
 
-  len = rvalue->value.character.length;
-  c = rvalue->value.character.string;
-  d = &expr->value.character.string[start - 1];
+  if (ref)
+    {
+      gfc_expr *start_expr, *end_expr;
 
-  for (i = 0; i <= end - start && i < len; i++)
-    d[i] = c[i];
+      gcc_assert (ref->type == REF_SUBSTRING);
 
-  /* Pad with spaces. I.e. 
-     DATA a(1:2) /'a'/
-     intializes a(1:2) to 'a ' per the rules for assignment.  
-     If init == NULL we don't need to do this, as we have
-     intialized the whole string to blanks above.  */
+      /* Only set a substring of the destination.  Fortran substring bounds
+        are one-based [start, end], we want zero based [start, end).  */
+      start_expr = gfc_copy_expr (ref->u.ss.start);
+      end_expr = gfc_copy_expr (ref->u.ss.end);
 
-  if (init != NULL)
-    for (; i <= end - start; i++)
-      d[i] = ' ';
+      if ((gfc_simplify_expr (start_expr, 1) == FAILURE)
+         || (gfc_simplify_expr (end_expr, 1)) == FAILURE)
+       {
+         gfc_error ("failure to simplify substring reference in DATA "
+                    "statement at %L", &ref->u.ss.start->where);
+         return NULL;
+       }
+
+      gfc_extract_int (start_expr, &start);
+      start--;
+      gfc_extract_int (end_expr, &end);
+    }
+  else
+    {
+      /* Set the whole string.  */
+      start = 0;
+      end = len;
+    }
+
+  /* Copy the initial value.  */
+  if (rvalue->ts.type == BT_HOLLERITH)
+    len = rvalue->representation.length;
+  else
+    len = rvalue->value.character.length;
+
+  if (len > end - start)
+    {
+      len = end - start;
+      gfc_warning_now ("initialization string truncated to match variable "
+                      "at %L", &rvalue->where);
+    }
 
-  return;
+  if (rvalue->ts.type == BT_HOLLERITH)
+    {
+      int i;
+      for (i = 0; i < len; i++)
+       dest[start+i] = rvalue->representation.string[i];
+    }
+  else
+    memcpy (&dest[start], rvalue->value.character.string,
+           len * sizeof (gfc_char_t));
+
+  /* Pad with spaces.  Substrings will already be blanked.  */
+  if (len < end - start && ref == NULL)
+    gfc_wide_memset (&dest[start + len], ' ', end - (start + len));
+
+  if (rvalue->ts.type == BT_HOLLERITH)
+    {
+      init->representation.length = init->value.character.length;
+      init->representation.string
+       = gfc_widechar_to_char (init->value.character.string,
+                               init->value.character.length);
+    }
+
+  return init;
 }
 
+
 /* Assign the initial value RVALUE to  LVALUE's symbol->value. If the
    LVALUE already has an initialization, we extend this, otherwise we
    create a new one.  */
 
-void
-gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
+gfc_try
+gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
 {
   gfc_ref *ref;
   gfc_expr *init;
   gfc_expr *expr;
   gfc_constructor *con;
   gfc_constructor *last_con;
+  gfc_constructor *pred;
   gfc_symbol *symbol;
+  gfc_typespec *last_ts;
   mpz_t offset;
-
-  ref = lvalue->ref;
-  if (ref != NULL && ref->type == REF_SUBSTRING)
-    {
-      /* No need to go through the for (; ref; ref->next) loop, since
-        a single substring lvalue will only refer to a single
-        substring, and therefore ref->next == NULL.  */
-      assert (ref->next == NULL);      
-      assign_substring_data_value (lvalue, rvalue);
-      return;
-    }
+  splay_tree spt;
+  splay_tree_node sptn;
 
   symbol = lvalue->symtree->n.sym;
   init = symbol->value;
+  last_ts = &symbol->ts;
   last_con = NULL;
   mpz_init_set_si (offset, 0);
 
-  for (; ref; ref = ref->next)
+  /* Find/create the parent expressions for subobject references.  */
+  for (ref = lvalue->ref; ref; ref = ref->next)
     {
+      /* Break out of the loop if we find a substring.  */
+      if (ref->type == REF_SUBSTRING)
+       {
+         /* A substring should always be the last subobject reference.  */
+         gcc_assert (ref->next == NULL);
+         break;
+       }
+
       /* Use the existing initializer expression if it exists.  Otherwise
-         create a new one.  */
+        create a new one.  */
       if (init == NULL)
        expr = gfc_get_expr ();
       else
@@ -229,38 +290,277 @@ gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
       switch (ref->type)
        {
        case REF_ARRAY:
+         if (init && expr->expr_type != EXPR_ARRAY)
+           {
+             gfc_error ("'%s' at %L already is initialized at %L",
+                        lvalue->symtree->n.sym->name, &lvalue->where,
+                        &init->where);
+             return FAILURE;
+           }
+
          if (init == NULL)
            {
+             /* The element typespec will be the same as the array
+                typespec.  */
+             expr->ts = *last_ts;
              /* Setup the expression to hold the constructor.  */
              expr->expr_type = EXPR_ARRAY;
-             if (ref->next)
+             expr->rank = ref->u.ar.as->rank;
+           }
+
+         if (ref->u.ar.type == AR_ELEMENT)
+           get_array_index (&ref->u.ar, &offset);
+         else
+           mpz_set (offset, index);
+
+         /* Check the bounds.  */
+         if (mpz_cmp_si (offset, 0) < 0)
+           {
+             gfc_error ("Data element below array lower bound at %L",
+                        &lvalue->where);
+             return FAILURE;
+           }
+         else
+           {
+             mpz_t size;
+             if (spec_size (ref->u.ar.as, &size) == SUCCESS)
                {
-                 assert (ref->next->type == REF_COMPONENT);
-                 expr->ts.type = BT_DERIVED;
+                 if (mpz_cmp (offset, size) >= 0)
+                 {
+                   mpz_clear (size);
+                   gfc_error ("Data element above array upper bound at %L",
+                              &lvalue->where);
+                   return FAILURE;
+                 }
+                 mpz_clear (size);
+               }
+           }
+
+         /* Splay tree containing offset and gfc_constructor.  */
+         spt = expr->con_by_offset;
+
+         if (spt == NULL)
+           {
+              spt = splay_tree_new (splay_tree_compare_ints, NULL, NULL);
+              expr->con_by_offset = spt; 
+              con = NULL;
+           }
+        else
+         con = find_con_by_offset (spt, offset);
+
+         if (con == NULL)
+           {
+             splay_tree_key j;
+
+             /* Create a new constructor.  */
+             con = gfc_get_constructor ();
+             mpz_set (con->n.offset, offset);
+             j = (splay_tree_key) mpz_get_si (offset);
+             sptn = splay_tree_insert (spt, j, (splay_tree_value) con);
+             /* Fix up the linked list.  */
+             sptn = splay_tree_predecessor (spt, j);
+             if (sptn == NULL)
+               {  /* Insert at the head.  */
+                  con->next = expr->value.constructor;
+                  expr->value.constructor = con;
                }
              else
-               expr->ts = rvalue->ts;
+               {  /* Insert in the chain.  */
+                  pred = (gfc_constructor*) sptn->value;
+                  con->next = pred->next;
+                  pred->next = con;
+               }
+           }
+         break;
+
+       case REF_COMPONENT:
+         if (init == NULL)
+           {
+             /* Setup the expression to hold the constructor.  */
+             expr->expr_type = EXPR_STRUCTURE;
+             expr->ts.type = BT_DERIVED;
+             expr->ts.u.derived = ref->u.c.sym;
+           }
+         else
+           gcc_assert (expr->expr_type == EXPR_STRUCTURE);
+         last_ts = &ref->u.c.component->ts;
+
+         /* Find the same element in the existing constructor.  */
+         con = expr->value.constructor;
+         con = find_con_by_component (ref->u.c.component, con);
+
+         if (con == NULL)
+           {
+             /* Create a new constructor.  */
+             con = gfc_get_constructor ();
+             con->n.component = ref->u.c.component;
+             con->next = expr->value.constructor;
+             expr->value.constructor = con;
+           }
+         break;
+
+       default:
+         gcc_unreachable ();
+       }
+
+      if (init == NULL)
+       {
+         /* Point the container at the new expression.  */
+         if (last_con == NULL)
+           symbol->value = expr;
+         else
+           last_con->expr = expr;
+       }
+      init = con->expr;
+      last_con = con;
+    }
+
+  if (ref || last_ts->type == BT_CHARACTER)
+    {
+      if (lvalue->ts.u.cl->length == NULL && !(ref && ref->u.ss.length != NULL))
+       return FAILURE;
+      expr = create_character_intializer (init, last_ts, ref, rvalue);
+    }
+  else
+    {
+      /* Overwriting an existing initializer is non-standard but usually only
+        provokes a warning from other compilers.  */
+      if (init != NULL)
+       {
+         /* Order in which the expressions arrive here depends on whether
+            they are from data statements or F95 style declarations.
+            Therefore, check which is the most recent.  */
+         expr = (LOCATION_LINE (init->where.lb->location)
+                 > LOCATION_LINE (rvalue->where.lb->location))
+              ? init : rvalue;
+         gfc_notify_std (GFC_STD_GNU, "Extension: re-initialization "
+                         "of '%s' at %L", symbol->name, &expr->where);
+       }
+
+      expr = gfc_copy_expr (rvalue);
+      if (!gfc_compare_types (&lvalue->ts, &expr->ts))
+       gfc_convert_type (expr, &lvalue->ts, 0);
+    }
+
+  if (last_con == NULL)
+    symbol->value = expr;
+  else
+    last_con->expr = expr;
+
+  return SUCCESS;
+}
+
+
+/* Similarly, but initialize REPEAT consecutive values in LVALUE the same
+   value in RVALUE.  For the nonce, LVALUE must refer to a full array, not
+   an array section.  */
+
+void
+gfc_assign_data_value_range (gfc_expr *lvalue, gfc_expr *rvalue,
+                            mpz_t index, mpz_t repeat)
+{
+  gfc_ref *ref;
+  gfc_expr *init, *expr;
+  gfc_constructor *con, *last_con;
+  gfc_constructor *pred;
+  gfc_symbol *symbol;
+  gfc_typespec *last_ts;
+  mpz_t offset;
+  splay_tree spt;
+  splay_tree_node sptn;
+
+  symbol = lvalue->symtree->n.sym;
+  init = symbol->value;
+  last_ts = &symbol->ts;
+  last_con = NULL;
+  mpz_init_set_si (offset, 0);
+
+  /* Find/create the parent expressions for subobject references.  */
+  for (ref = lvalue->ref; ref; ref = ref->next)
+    {
+      /* Use the existing initializer expression if it exists.
+        Otherwise create a new one.  */
+      if (init == NULL)
+       expr = gfc_get_expr ();
+      else
+       expr = init;
+
+      /* Find or create this element.  */
+      switch (ref->type)
+       {
+       case REF_ARRAY:
+         if (init == NULL)
+           {
+             /* The element typespec will be the same as the array
+                typespec.  */
+             expr->ts = *last_ts;
+             /* Setup the expression to hold the constructor.  */
+             expr->expr_type = EXPR_ARRAY;
              expr->rank = ref->u.ar.as->rank;
            }
          else
-           assert (expr->expr_type == EXPR_ARRAY);
+           gcc_assert (expr->expr_type == EXPR_ARRAY);
 
          if (ref->u.ar.type == AR_ELEMENT)
-           get_array_index (&ref->u.ar, &offset);
+           {
+             get_array_index (&ref->u.ar, &offset);
+
+             /* This had better not be the bottom of the reference.
+                We can still get to a full array via a component.  */
+             gcc_assert (ref->next != NULL);
+           }
          else
-           mpz_set (offset, index);
+           {
+             mpz_set (offset, index);
+
+             /* We're at a full array or an array section.  This means
+                that we've better have found a full array, and that we're
+                at the bottom of the reference.  */
+             gcc_assert (ref->u.ar.type == AR_FULL);
+             gcc_assert (ref->next == NULL);
+           }
 
          /* Find the same element in the existing constructor.  */
-         con = expr->value.constructor;
-         con = find_con_by_offset (offset, con);
+
+         /* Splay tree containing offset and gfc_constructor.  */
+         spt = expr->con_by_offset;
+
+         if (spt == NULL)
+           {
+              spt = splay_tree_new (splay_tree_compare_ints, NULL, NULL);
+              expr->con_by_offset = spt;
+              con = NULL;
+           }
+         else 
+           con = find_con_by_offset (spt, offset);
 
          if (con == NULL)
            {
+             splay_tree_key j;
              /* Create a new constructor.  */
-             con = gfc_get_constructor();
+             con = gfc_get_constructor ();
              mpz_set (con->n.offset, offset);
-             gfc_insert_constructor (expr, con);
+             j = (splay_tree_key) mpz_get_si (offset);
+         
+             if (ref->next == NULL)
+               mpz_set (con->repeat, repeat);
+             sptn = splay_tree_insert (spt, j, (splay_tree_value) con);
+             /* Fix up the linked list.  */
+             sptn = splay_tree_predecessor (spt, j);
+             if (sptn == NULL)
+               {  /* Insert at the head.  */
+                  con->next = expr->value.constructor;
+                  expr->value.constructor = con;
+               }
+             else
+               {  /* Insert in the chain.  */
+                  pred = (gfc_constructor*) sptn->value;
+                  con->next = pred->next;
+                  pred->next = con;
+               }
            }
+         else
+           gcc_assert (ref->next != NULL);
          break;
 
        case REF_COMPONENT:
@@ -269,10 +569,11 @@ gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
              /* Setup the expression to hold the constructor.  */
              expr->expr_type = EXPR_STRUCTURE;
              expr->ts.type = BT_DERIVED;
-             expr->ts.derived = ref->u.c.sym;
+             expr->ts.u.derived = ref->u.c.sym;
            }
          else
-           assert (expr->expr_type == EXPR_STRUCTURE);
+           gcc_assert (expr->expr_type == EXPR_STRUCTURE);
+         last_ts = &ref->u.c.component->ts;
 
          /* Find the same element in the existing constructor.  */
          con = expr->value.constructor;
@@ -286,12 +587,15 @@ gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
              con->next = expr->value.constructor;
              expr->value.constructor = con;
            }
+
+         /* Since we're only intending to initialize arrays here,
+            there better be an inner reference.  */
+         gcc_assert (ref->next != NULL);
          break;
 
-       /* case REF_SUBSTRING: dealt with separately above. */
-       
+       case REF_SUBSTRING:
        default:
-         abort ();
+         gcc_unreachable ();
        }
 
       if (init == NULL)
@@ -306,20 +610,24 @@ gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
       last_con = con;
     }
 
-  expr = gfc_copy_expr (rvalue);
-  if (!gfc_compare_types (&lvalue->ts, &expr->ts))
-    gfc_convert_type (expr, &lvalue->ts, 0);
+  if (last_ts->type == BT_CHARACTER)
+    expr = create_character_intializer (init, last_ts, NULL, rvalue);
+  else
+    {
+      /* We should never be overwriting an existing initializer.  */
+      gcc_assert (!init);
+
+      expr = gfc_copy_expr (rvalue);
+      if (!gfc_compare_types (&lvalue->ts, &expr->ts))
+       gfc_convert_type (expr, &lvalue->ts, 0);
+    }
 
   if (last_con == NULL)
     symbol->value = expr;
   else
-    {
-      assert (!last_con->expr);
-      last_con->expr = expr;
-    }
+    last_con->expr = expr;
 }
 
-
 /* Modify the index of array section and re-calculate the array offset.  */
 
 void 
@@ -357,10 +665,9 @@ gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar,
       else
        cmp = mpz_cmp (section_index[i], ar->as->upper[i]->value.integer);
 
-      if ((cmp > 0 && forwards)
-         || (cmp < 0 && ! forwards))
+      if ((cmp > 0 && forwards) || (cmp < 0 && !forwards))
        {
-          /* Reset index to start, then loop to advance the next index.  */
+         /* Reset index to start, then loop to advance the next index.  */
          if (ar->start[i])
            mpz_set (section_index[i], ar->start[i]->value.integer);
          else
@@ -380,7 +687,7 @@ gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar,
       mpz_add (*offset_ret, tmp, *offset_ret);
 
       mpz_sub (tmp, ar->as->upper[i]->value.integer, 
-               ar->as->lower[i]->value.integer);
+              ar->as->lower[i]->value.integer);
       mpz_add_ui (tmp, tmp, 1);
       mpz_mul (delta, tmp, delta);
     }
@@ -390,10 +697,10 @@ gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar,
 
 
 /* Rearrange a structure constructor so the elements are in the specified
-   order.  Also insert NULL entries if neccessary.  */
+   order.  Also insert NULL entries if necessary.  */
 
 static void
-formalize_structure_cons (gfc_expr * expr)
+formalize_structure_cons (gfc_expr *expr)
 {
   gfc_constructor *head;
   gfc_constructor *tail;
@@ -404,12 +711,12 @@ formalize_structure_cons (gfc_expr * expr)
 
   c = expr->value.constructor;
 
-  /* Constructor is already fomalized.  */
-  if (c->n.component == NULL)
+  /* Constructor is already formalized.  */
+  if (!c || c->n.component == NULL)
     return;
 
   head = tail = NULL;
-  for (order = expr->ts.derived->components; order; order = order->next)
+  for (order = expr->ts.u.derived->components; order; order = order->next)
     {
       /* Find the next component.  */
       last = NULL;
@@ -446,16 +753,16 @@ formalize_structure_cons (gfc_expr * expr)
          tail = tail->next;
        }
     }
-  assert (c == NULL);
+  gcc_assert (c == NULL);
   expr->value.constructor = head;
 }
 
 
-/* Make sure an initialization expression is in normalized form.  Ie. all
+/* Make sure an initialization expression is in normalized form, i.e., all
    elements of the constructors are in the correct order.  */
 
 static void
-formalize_init_expr (gfc_expr * expr)
+formalize_init_expr (gfc_expr *expr)
 {
   expr_t type;
   gfc_constructor *c;
@@ -527,14 +834,14 @@ gfc_get_section_index (gfc_array_ref *ar, mpz_t *section_index, mpz_t *offset)
          break;
 
        case DIMEN_VECTOR:
-         gfc_todo_error ("Vectors sections in data statements");
+         gfc_internal_error ("TODO: Vector sections in data statements");
 
        default:
-         abort ();
+         gcc_unreachable ();
        }
 
       mpz_sub (tmp, ar->as->upper[i]->value.integer, 
-               ar->as->lower[i]->value.integer);
+              ar->as->lower[i]->value.integer);
       mpz_add_ui (tmp, tmp, 1);
       mpz_mul (delta, tmp, delta);
     }