matmul.m4, [...]: Allocate space if return value has NULL in its data field.
authorVictor Leikehman <lei@il.ibm.com>
Mon, 9 Aug 2004 14:34:39 +0000 (14:34 +0000)
committerPaul Brook <pbrook@gcc.gnu.org>
Mon, 9 Aug 2004 14:34:39 +0000 (14:34 +0000)
2004-09-09  Victor Leikehman  <lei@il.ibm.com>

* m4/matmul.m4, m4/matmull.m4, intrinsics/eoshift0.c,
intrinsics/eoshift2.c, intrinsics/transpose_generic.c:
Allocate space if return value has NULL in its data field.
* generated/*.c: Regenerate.

From-SVN: r85717

16 files changed:
libgfortran/ChangeLog
libgfortran/generated/matmul_c4.c
libgfortran/generated/matmul_c8.c
libgfortran/generated/matmul_i4.c
libgfortran/generated/matmul_i8.c
libgfortran/generated/matmul_l4.c
libgfortran/generated/matmul_l8.c
libgfortran/generated/matmul_r4.c
libgfortran/generated/matmul_r8.c
libgfortran/generated/transpose_i4.c
libgfortran/generated/transpose_i8.c
libgfortran/intrinsics/eoshift0.c
libgfortran/intrinsics/eoshift2.c
libgfortran/intrinsics/transpose_generic.c
libgfortran/m4/matmul.m4
libgfortran/m4/matmull.m4

index fc7f6654c2c49f2e45ed5d33c92fb19742c0c158..cc27e33325c05cf97103f5c7bcd49200f4d345b6 100644 (file)
@@ -1,3 +1,10 @@
+2004-09-09  Victor Leikehman  <lei@il.ibm.com>
+
+       * m4/matmul.m4, m4/matmull.m4, intrinsics/eoshift0.c,
+       intrinsics/eoshift2.c, intrinsics/transpose_generic.c:
+       Allocate space if return value has NULL in its data field.
+       * generated/*.c: Regenerate.
+
 2004-08-06  Janne Blomqvist  <jblomqvi@cc.hut.fi>
 
        * intrinsics/env.c: New file.
index beb4453024e6d640edf4bfca5e52abde829e0bda..7967e97064692965aab48b43d7fb9314743d0864 100644 (file)
@@ -2,7 +2,7 @@
    Copyright 2002 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
-This file is part of the GNU Fortran 95 runtime library (libgfor).
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
 
 Libgfortran is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -51,6 +51,36 @@ __matmul_c4 (gfc_array_c4 * retarray, gfc_array_c4 * a, gfc_array_c4 * b)
 
   assert (GFC_DESCRIPTOR_RANK (a) == 2
           || GFC_DESCRIPTOR_RANK (b) == 2);
+
+  if (retarray->data == NULL)
+    {
+      if (GFC_DESCRIPTOR_RANK (a) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else if (GFC_DESCRIPTOR_RANK (b) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+          
+          retarray->dim[1].lbound = 0;
+          retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[1].stride = retarray->dim[0].ubound+1;
+        }
+          
+      retarray->data = internal_malloc (sizeof (GFC_COMPLEX_4) * size0 (retarray));
+      retarray->base = 0;
+    }
+
   abase = a->data;
   bbase = b->data;
   dest = retarray->data;
index a306764d4b9c813b65219e9af184f81de0111f66..7ed46ec57a91ce91e0a6c0d4df175fb1955b3c41 100644 (file)
@@ -2,7 +2,7 @@
    Copyright 2002 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
-This file is part of the GNU Fortran 95 runtime library (libgfor).
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
 
 Libgfortran is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -51,6 +51,36 @@ __matmul_c8 (gfc_array_c8 * retarray, gfc_array_c8 * a, gfc_array_c8 * b)
 
   assert (GFC_DESCRIPTOR_RANK (a) == 2
           || GFC_DESCRIPTOR_RANK (b) == 2);
+
+  if (retarray->data == NULL)
+    {
+      if (GFC_DESCRIPTOR_RANK (a) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else if (GFC_DESCRIPTOR_RANK (b) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+          
+          retarray->dim[1].lbound = 0;
+          retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[1].stride = retarray->dim[0].ubound+1;
+        }
+          
+      retarray->data = internal_malloc (sizeof (GFC_COMPLEX_8) * size0 (retarray));
+      retarray->base = 0;
+    }
+
   abase = a->data;
   bbase = b->data;
   dest = retarray->data;
index 44b30a4e1403165a276c2a0d96c7d5f5854ed028..0db573cf60c671760b39c3aa7b7a7a834d0c3d68 100644 (file)
@@ -2,7 +2,7 @@
    Copyright 2002 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
-This file is part of the GNU Fortran 95 runtime library (libgfor).
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
 
 Libgfortran is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -51,6 +51,36 @@ __matmul_i4 (gfc_array_i4 * retarray, gfc_array_i4 * a, gfc_array_i4 * b)
 
   assert (GFC_DESCRIPTOR_RANK (a) == 2
           || GFC_DESCRIPTOR_RANK (b) == 2);
+
+  if (retarray->data == NULL)
+    {
+      if (GFC_DESCRIPTOR_RANK (a) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else if (GFC_DESCRIPTOR_RANK (b) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+          
+          retarray->dim[1].lbound = 0;
+          retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[1].stride = retarray->dim[0].ubound+1;
+        }
+          
+      retarray->data = internal_malloc (sizeof (GFC_INTEGER_4) * size0 (retarray));
+      retarray->base = 0;
+    }
+
   abase = a->data;
   bbase = b->data;
   dest = retarray->data;
index 1ca7827647825d5fb8565abf752facc233b387ac..1a8e8dcb6b954dffea74fc9d56b6746442b83180 100644 (file)
@@ -2,7 +2,7 @@
    Copyright 2002 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
-This file is part of the GNU Fortran 95 runtime library (libgfor).
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
 
 Libgfortran is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -51,6 +51,36 @@ __matmul_i8 (gfc_array_i8 * retarray, gfc_array_i8 * a, gfc_array_i8 * b)
 
   assert (GFC_DESCRIPTOR_RANK (a) == 2
           || GFC_DESCRIPTOR_RANK (b) == 2);
+
+  if (retarray->data == NULL)
+    {
+      if (GFC_DESCRIPTOR_RANK (a) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else if (GFC_DESCRIPTOR_RANK (b) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+          
+          retarray->dim[1].lbound = 0;
+          retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[1].stride = retarray->dim[0].ubound+1;
+        }
+          
+      retarray->data = internal_malloc (sizeof (GFC_INTEGER_8) * size0 (retarray));
+      retarray->base = 0;
+    }
+
   abase = a->data;
   bbase = b->data;
   dest = retarray->data;
index f141b65100098032fcd368884c68c229a2e989a2..80e64823675535753fc73ca585fcdf15887362f7 100644 (file)
@@ -50,6 +50,36 @@ __matmul_l4 (gfc_array_l4 * retarray, gfc_array_l4 * a, gfc_array_l4 * b)
 
   assert (GFC_DESCRIPTOR_RANK (a) == 2
           || GFC_DESCRIPTOR_RANK (b) == 2);
+
+  if (retarray->data == NULL)
+    {
+      if (GFC_DESCRIPTOR_RANK (a) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else if (GFC_DESCRIPTOR_RANK (b) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+          
+          retarray->dim[1].lbound = 0;
+          retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[1].stride = retarray->dim[0].ubound+1;
+        }
+          
+      retarray->data = internal_malloc (sizeof (GFC_LOGICAL_4) * size0 (retarray));
+      retarray->base = 0;
+    }
+
   abase = a->data;
   if (GFC_DESCRIPTOR_SIZE (a) != 4)
     {
index 49243afd9ad316dea3920c5dcd5935114fa6f99f..c842146e2d07e3d078bd1c5ffc07fa5c61496bc8 100644 (file)
@@ -50,6 +50,36 @@ __matmul_l8 (gfc_array_l8 * retarray, gfc_array_l4 * a, gfc_array_l4 * b)
 
   assert (GFC_DESCRIPTOR_RANK (a) == 2
           || GFC_DESCRIPTOR_RANK (b) == 2);
+
+  if (retarray->data == NULL)
+    {
+      if (GFC_DESCRIPTOR_RANK (a) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else if (GFC_DESCRIPTOR_RANK (b) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+          
+          retarray->dim[1].lbound = 0;
+          retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[1].stride = retarray->dim[0].ubound+1;
+        }
+          
+      retarray->data = internal_malloc (sizeof (GFC_LOGICAL_8) * size0 (retarray));
+      retarray->base = 0;
+    }
+
   abase = a->data;
   if (GFC_DESCRIPTOR_SIZE (a) != 4)
     {
index dea706bb7d121d65521bdd54897d53650f9862e8..7d111369b12ddb88ac00665c16abfefc99febdb2 100644 (file)
@@ -2,7 +2,7 @@
    Copyright 2002 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
-This file is part of the GNU Fortran 95 runtime library (libgfor).
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
 
 Libgfortran is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -51,6 +51,36 @@ __matmul_r4 (gfc_array_r4 * retarray, gfc_array_r4 * a, gfc_array_r4 * b)
 
   assert (GFC_DESCRIPTOR_RANK (a) == 2
           || GFC_DESCRIPTOR_RANK (b) == 2);
+
+  if (retarray->data == NULL)
+    {
+      if (GFC_DESCRIPTOR_RANK (a) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else if (GFC_DESCRIPTOR_RANK (b) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+          
+          retarray->dim[1].lbound = 0;
+          retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[1].stride = retarray->dim[0].ubound+1;
+        }
+          
+      retarray->data = internal_malloc (sizeof (GFC_REAL_4) * size0 (retarray));
+      retarray->base = 0;
+    }
+
   abase = a->data;
   bbase = b->data;
   dest = retarray->data;
index dfe4841615a12ab78097941cdd818b9bc930cf8e..5ab66fe073dbb1a9b9f513cd35b1ccbc0e6bc2bf 100644 (file)
@@ -2,7 +2,7 @@
    Copyright 2002 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
-This file is part of the GNU Fortran 95 runtime library (libgfor).
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
 
 Libgfortran is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -51,6 +51,36 @@ __matmul_r8 (gfc_array_r8 * retarray, gfc_array_r8 * a, gfc_array_r8 * b)
 
   assert (GFC_DESCRIPTOR_RANK (a) == 2
           || GFC_DESCRIPTOR_RANK (b) == 2);
+
+  if (retarray->data == NULL)
+    {
+      if (GFC_DESCRIPTOR_RANK (a) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else if (GFC_DESCRIPTOR_RANK (b) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+          
+          retarray->dim[1].lbound = 0;
+          retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[1].stride = retarray->dim[0].ubound+1;
+        }
+          
+      retarray->data = internal_malloc (sizeof (GFC_REAL_8) * size0 (retarray));
+      retarray->base = 0;
+    }
+
   abase = a->data;
   bbase = b->data;
   dest = retarray->data;
index 930aad9f07d2f57a494942025e7ae723c0fb0d51..97eb1a0d140614cf92462f1ff467423f25fcbb59 100644 (file)
@@ -40,9 +40,8 @@ __transpose_4 (gfc_array_i4 * ret, gfc_array_i4 * source)
 
   if (ret->data == NULL)
     {
-      ret->data = internal_malloc (sizeof (GFC_INTEGER_4) * size0 (source));
-      ret->base = 0;
-      ret->dtype = source->dtype;
+      assert (GFC_DESCRIPTOR_RANK (ret) == 2);
+      assert (ret->dtype == source->dtype);
 
       ret->dim[0].lbound = 0;
       ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
@@ -51,6 +50,9 @@ __transpose_4 (gfc_array_i4 * ret, gfc_array_i4 * source)
       ret->dim[1].lbound = 0;
       ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
       ret->dim[1].stride = ret->dim[0].ubound+1;
+
+      ret->data = internal_malloc (sizeof (GFC_INTEGER_4) * size0 (ret));
+      ret->base = 0;
     }
 
   if (ret->dim[0].stride == 0)
index c4554e6c2109cd95b038c9ddb8381592a3a2b49e..4c842d48520a819cd1cdce72c105ade6c8b60bff 100644 (file)
@@ -40,9 +40,8 @@ __transpose_8 (gfc_array_i8 * ret, gfc_array_i8 * source)
 
   if (ret->data == NULL)
     {
-      ret->data = internal_malloc (sizeof (GFC_INTEGER_8) * size0 (source));
-      ret->base = 0;
-      ret->dtype = source->dtype;
+      assert (GFC_DESCRIPTOR_RANK (ret) == 2);
+      assert (ret->dtype == source->dtype);
 
       ret->dim[0].lbound = 0;
       ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
@@ -51,6 +50,9 @@ __transpose_8 (gfc_array_i8 * ret, gfc_array_i8 * source)
       ret->dim[1].lbound = 0;
       ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
       ret->dim[1].stride = ret->dim[0].ubound+1;
+
+      ret->data = internal_malloc (sizeof (GFC_INTEGER_8) * size0 (ret));
+      ret->base = 0;
     }
 
   if (ret->dim[0].stride == 0)
index f86f4bd883f9b0060057e04c79c0845a5cbb3c2a..fca1ef08fff44a5660b953c7aa7b63f777cdcc1e 100644 (file)
@@ -1,4 +1,4 @@
-/* Generic implementation of the RESHAPE intrinsic
+/* Generic implementation of the EOSHIFT intrinsic
    Copyright 2002 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
@@ -32,7 +32,7 @@ static const char zeros[16] =
    sizeof(int) < sizeof (index_type).  */
 
 static void
-__eoshift0 (const gfc_array_char * ret, const gfc_array_char * array,
+__eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
     int shift, const char * pbound, int which)
 {
   /* r.* indicates the return array.  */
@@ -60,6 +60,25 @@ __eoshift0 (const gfc_array_char * ret, const gfc_array_char * array,
 
   size = GFC_DESCRIPTOR_SIZE (ret);
 
+  if (ret->data == NULL)
+    {
+      int i;
+
+      ret->data = internal_malloc (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;
+        }
+    }
+
   which = which - 1;
 
   extent[0] = 1;
@@ -170,7 +189,7 @@ __eoshift0 (const gfc_array_char * ret, const gfc_array_char * array,
 
 
 void
-__eoshift0_4 (const gfc_array_char * ret, const gfc_array_char * array,
+__eoshift0_4 (gfc_array_char * ret, const gfc_array_char * array,
     const GFC_INTEGER_4 * pshift, const char * pbound,
     const GFC_INTEGER_4 * pdim)
 {
@@ -179,7 +198,7 @@ __eoshift0_4 (const gfc_array_char * ret, const gfc_array_char * array,
 
 
 void
-__eoshift0_8 (const gfc_array_char * ret, const gfc_array_char * array,
+__eoshift0_8 (gfc_array_char * ret, const gfc_array_char * array,
     const GFC_INTEGER_8 * pshift, const char * pbound,
     const GFC_INTEGER_8 * pdim)
 {
index 038588f78d2958d1a65b0b45dd3bb1278b4f1579..18c3f558ae0300158dce3cd0d6d6ee80eb04db5a 100644 (file)
@@ -1,4 +1,4 @@
-/* Generic implementation of the RESHAPE intrinsic
+/* Generic implementation of the EOSHIFT intrinsic
    Copyright 2002 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
@@ -32,7 +32,7 @@ static const char zeros[16] =
    sizeof(int) < sizeof (index_type).  */
 
 static void
-__eoshift2 (const gfc_array_char * ret, const gfc_array_char * array,
+__eoshift2 (gfc_array_char * ret, const gfc_array_char * array,
     int shift, const gfc_array_char * bound, int which)
 {
   /* r.* indicates the return array.  */
@@ -61,6 +61,25 @@ __eoshift2 (const gfc_array_char * ret, const gfc_array_char * array,
 
   size = GFC_DESCRIPTOR_SIZE (ret);
 
+  if (ret->data == NULL)
+    {
+      int i;
+
+      ret->data = internal_malloc (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;
+        }
+    }
+
   which = which - 1;
 
   extent[0] = 1;
@@ -186,7 +205,7 @@ __eoshift2 (const gfc_array_char * ret, const gfc_array_char * array,
 
 
 void
-__eoshift2_4 (const gfc_array_char * ret, const gfc_array_char * array,
+__eoshift2_4 (gfc_array_char * ret, const gfc_array_char * array,
     const GFC_INTEGER_4 * pshift, const gfc_array_char * bound,
     const GFC_INTEGER_4 * pdim)
 {
@@ -195,7 +214,7 @@ __eoshift2_4 (const gfc_array_char * ret, const gfc_array_char * array,
 
 
 void
-__eoshift2_8 (const gfc_array_char * ret, const gfc_array_char * array,
+__eoshift2_8 (gfc_array_char * ret, const gfc_array_char * array,
     const GFC_INTEGER_8 * pshift, const gfc_array_char * bound,
     const GFC_INTEGER_8 * pdim)
 {
index d72ae5a4b81451eae8bb852c26822b58fdad6351..b9bdbe4a04165cc3c9bc2280e920525235d64063 100644 (file)
@@ -43,6 +43,23 @@ __transpose (gfc_array_char * ret, gfc_array_char * source)
           && GFC_DESCRIPTOR_RANK (ret) == 2);
 
   size = GFC_DESCRIPTOR_SIZE (source);
+
+  if (ret->data == NULL)
+    {
+      assert (ret->dtype == source->dtype);
+
+      ret->dim[0].lbound = 0;
+      ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
+      ret->dim[0].stride = 1;
+
+      ret->dim[1].lbound = 0;
+      ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
+      ret->dim[1].stride = ret->dim[0].ubound+1;
+
+      ret->data = internal_malloc (size * size0 ((array_t*)ret));
+      ret->base = 0;
+    }
+
   sxstride = source->dim[0].stride * size;
   if (sxstride == 0)
     sxstride = size;
index 26b241dedad0db63f2d570c54188b1a9b9d01935..7a54b05595cacec5136b1982219ed3500665ab8e 100644 (file)
@@ -2,7 +2,7 @@
    Copyright 2002 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
-This file is part of the GNU Fortran 95 runtime library (libgfor).
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
 
 Libgfortran is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
@@ -52,6 +52,36 @@ void
 
   assert (GFC_DESCRIPTOR_RANK (a) == 2
           || GFC_DESCRIPTOR_RANK (b) == 2);
+
+  if (retarray->data == NULL)
+    {
+      if (GFC_DESCRIPTOR_RANK (a) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else if (GFC_DESCRIPTOR_RANK (b) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+          
+          retarray->dim[1].lbound = 0;
+          retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[1].stride = retarray->dim[0].ubound+1;
+        }
+          
+      retarray->data = internal_malloc (sizeof (rtype_name) * size0 (retarray));
+      retarray->base = 0;
+    }
+
   abase = a->data;
   bbase = b->data;
   dest = retarray->data;
index 4ee32fb94310ee39a02cba183d05ae2170c9f5ed..804127ec005527851ba388b0e7439582ffa7235c 100644 (file)
@@ -51,6 +51,36 @@ void
 
   assert (GFC_DESCRIPTOR_RANK (a) == 2
           || GFC_DESCRIPTOR_RANK (b) == 2);
+
+  if (retarray->data == NULL)
+    {
+      if (GFC_DESCRIPTOR_RANK (a) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else if (GFC_DESCRIPTOR_RANK (b) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+          
+          retarray->dim[1].lbound = 0;
+          retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[1].stride = retarray->dim[0].ubound+1;
+        }
+          
+      retarray->data = internal_malloc (sizeof (rtype_name) * size0 (retarray));
+      retarray->base = 0;
+    }
+
   abase = a->data;
   if (GFC_DESCRIPTOR_SIZE (a) != 4)
     {