2005-07-07 Thomas Koenig <Thomas.Koenig@online.de>

[pf3gnuchains/gcc-fork.git] / libgfortran / m4 / eoshift3.m4

diff --git a/libgfortran/m4/eoshift3.m4 b/libgfortran/m4/eoshift3.m4
index a94f572..1e04113 100644 (file)
--- a/libgfortran/m4/eoshift3.m4
+++ b/libgfortran/m4/eoshift3.m4
@@ -1,5 +1,5 @@
 `/* Implementation of the EOSHIFT intrinsic
-   Copyright 2002 Free Software Foundation, Inc.
+   Copyright 2002, 2005 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
 This file is part of the GNU Fortran 95 runtime library (libgfortran).
@@ -49,28 +49,28 @@ eoshift3_`'atype_kind (gfc_array_char *ret, gfc_array_char *array,
                       atype_name *pwhich)
 {
   /* r.* indicates the return array.  */
-  index_type rstride[GFC_MAX_DIMENSIONS - 1];
+  index_type rstride[GFC_MAX_DIMENSIONS];
   index_type rstride0;
   index_type roffset;
   char *rptr;
   char *dest;
   /* s.* indicates the source array.  */
-  index_type sstride[GFC_MAX_DIMENSIONS - 1];
+  index_type sstride[GFC_MAX_DIMENSIONS];
   index_type sstride0;
   index_type soffset;
   const char *sptr;
   const char *src;
 `  /* h.* indicates the shift array.  */'
-  index_type hstride[GFC_MAX_DIMENSIONS - 1];
+  index_type hstride[GFC_MAX_DIMENSIONS];
   index_type hstride0;
   const atype_name *hptr;
   /* b.* indicates the bound array.  */
-  index_type bstride[GFC_MAX_DIMENSIONS - 1];
+  index_type bstride[GFC_MAX_DIMENSIONS];
   index_type bstride0;
   const char *bptr;
 
-  index_type count[GFC_MAX_DIMENSIONS - 1];
-  index_type extent[GFC_MAX_DIMENSIONS - 1];
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
   index_type dim;
   index_type size;
   index_type len;
@@ -79,12 +79,37 @@ eoshift3_`'atype_kind (gfc_array_char *ret, gfc_array_char *array,
   atype_name sh;
   atype_name delta;
 
+  /* The compiler cannot figure out that these are set, initialize
+     them to avoid warnings.  */
+  len = 0;
+  soffset = 0;
+  roffset = 0;
+
   if (pwhich)
     which = *pwhich - 1;
   else
     which = 0;
 
   size = GFC_DESCRIPTOR_SIZE (ret);
+  if (ret->data == NULL)
+    {
+      int i;
+
+      ret->data = internal_malloc_size (size * size0 ((array_t *)array));
+      ret->base = 0;
+      ret->dtype = array->dtype;
+      for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
+        {
+          ret->dim[i].lbound = 0;
+          ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+
+          if (i == 0)
+            ret->dim[i].stride = 1;
+          else
+            ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+        }
+    }
+
 
   extent[0] = 1;
   count[0] = 0;
@@ -111,7 +136,7 @@ eoshift3_`'atype_kind (gfc_array_char *ret, gfc_array_char *array,
 
           hstride[n] = h->dim[n].stride;
           if (bound)
-            bstride[n] = bound->dim[n].stride;
+            bstride[n] = bound->dim[n].stride * size;
           else
             bstride[n] = 0;
           n++;
@@ -143,7 +168,14 @@ eoshift3_`'atype_kind (gfc_array_char *ret, gfc_array_char *array,
     {
 `      /* Do the shift for this dimension.  */'
       sh = *hptr;
-      delta = (sh >= 0) ? sh: -sh;
+      if (( sh >= 0 ? sh : -sh ) > len)
+       {
+         delta = len;
+         sh = len;
+       }
+      else
+       delta = (sh >= 0) ? sh: -sh;
+
       if (sh > 0)
         {
           src = &sptr[delta * soffset];