Update copyright years.

[thirdparty/gcc.git] / libgfortran / intrinsics / unpack_generic.c

diff --git a/libgfortran/intrinsics/unpack_generic.c b/libgfortran/intrinsics/unpack_generic.c
index c57914f06cfd54bc89697e1b57d2a62f97abb390..b1e611ae2cc65963e0dccfe8e1196f05e0f633c6 100644 (file)
--- a/libgfortran/intrinsics/unpack_generic.c
+++ b/libgfortran/intrinsics/unpack_generic.c
@@ -1,5 +1,5 @@
 /* Generic implementation of the UNPACK intrinsic
-   Copyright (C) 2002-2013 Free Software Foundation, Inc.
+   Copyright (C) 2002-2020 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
 This file is part of the GNU Fortran runtime library (libgfortran).
@@ -24,7 +24,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 <http://www.gnu.org/licenses/>.  */
 
 #include "libgfortran.h"
-#include <stdlib.h>
 #include <assert.h>
 #include <string.h>
 
@@ -125,7 +124,7 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector,
          rs *= extent[n];
        }
       ret->offset = 0;
-      ret->base_addr = xmalloc (rs * size);
+      ret->base_addr = xmallocarray (rs, size);
     }
   else
     {
@@ -223,7 +222,6 @@ unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
     {
     case GFC_DTYPE_LOGICAL_1:
     case GFC_DTYPE_INTEGER_1:
-    case GFC_DTYPE_DERIVED_1:
       unpack1_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) vector,
                  mask, (gfc_array_i1 *) field);
       return;
@@ -318,7 +316,16 @@ unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
 # endif
 #endif
 
-    case GFC_DTYPE_DERIVED_2:
+    }
+
+  switch (GFC_DESCRIPTOR_SIZE(ret))
+    {
+    case 1:
+      unpack1_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) vector,
+                 mask, (gfc_array_i1 *) field);
+      return;
+
+    case 2:
       if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(vector->base_addr)
          || GFC_UNALIGNED_2(field->base_addr))
        break;
@@ -329,7 +336,7 @@ unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
          return;
        }
 
-    case GFC_DTYPE_DERIVED_4:
+    case 4:
       if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(vector->base_addr)
          || GFC_UNALIGNED_4(field->base_addr))
        break;
@@ -340,7 +347,7 @@ unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
          return;
        }
 
-    case GFC_DTYPE_DERIVED_8:
+    case 8:
       if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(vector->base_addr)
          || GFC_UNALIGNED_8(field->base_addr))
        break;
@@ -352,7 +359,7 @@ unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
        }
 
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_DERIVED_16:
+    case 16:
       if (GFC_UNALIGNED_16(ret->base_addr)
          || GFC_UNALIGNED_16(vector->base_addr)
          || GFC_UNALIGNED_16(field->base_addr))
@@ -364,6 +371,8 @@ unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
          return;
        }
 #endif
+    default:
+      break;
     }
 
   unpack_internal (ret, vector, mask, field, size);
@@ -434,7 +443,6 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
     {
     case GFC_DTYPE_LOGICAL_1:
     case GFC_DTYPE_INTEGER_1:
-    case GFC_DTYPE_DERIVED_1:
       unpack0_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) vector,
                  mask, (GFC_INTEGER_1 *) field);
       return;
@@ -529,7 +537,16 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
 # endif
 #endif
 
-    case GFC_DTYPE_DERIVED_2:
+    }
+
+  switch (GFC_DESCRIPTOR_SIZE(ret))
+    {
+    case 1:
+      unpack0_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) vector,
+                 mask, (GFC_INTEGER_1 *) field);
+      return;
+
+    case 2:
       if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(vector->base_addr)
          || GFC_UNALIGNED_2(field))
        break;
@@ -540,7 +557,7 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
          return;
        }
 
-    case GFC_DTYPE_DERIVED_4:
+    case 4:
       if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(vector->base_addr)
          || GFC_UNALIGNED_4(field))
        break;
@@ -551,7 +568,7 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
          return;
        }
 
-    case GFC_DTYPE_DERIVED_8:
+    case 8:
       if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(vector->base_addr)
          || GFC_UNALIGNED_8(field))
        break;
@@ -563,7 +580,7 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
        }
 
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_DERIVED_16:
+    case 16:
       if (GFC_UNALIGNED_16(ret->base_addr)
          || GFC_UNALIGNED_16(vector->base_addr)
          || GFC_UNALIGNED_16(field))
@@ -575,11 +592,10 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
          return;
        }
 #endif
-
     }
 
   memset (&tmp, 0, sizeof (tmp));
-  tmp.dtype = 0;
+  GFC_DTYPE_CLEAR(&tmp);
   tmp.base_addr = field;
   unpack_internal (ret, vector, mask, &tmp, GFC_DESCRIPTOR_SIZE (vector));
 }
@@ -603,7 +619,7 @@ unpack0_char (gfc_array_char *ret,
     unpack_bounds (ret, vector, mask, NULL);
 
   memset (&tmp, 0, sizeof (tmp));
-  tmp.dtype = 0;
+  GFC_DTYPE_CLEAR(&tmp);
   tmp.base_addr = field;
   unpack_internal (ret, vector, mask, &tmp, vector_length);
 }
@@ -627,7 +643,7 @@ unpack0_char4 (gfc_array_char *ret,
     unpack_bounds (ret, vector, mask, NULL);
 
   memset (&tmp, 0, sizeof (tmp));
-  tmp.dtype = 0;
+  GFC_DTYPE_CLEAR(&tmp);
   tmp.base_addr = field;
   unpack_internal (ret, vector, mask, &tmp,
                   vector_length * sizeof (gfc_char4_t));