5 files changed, 579 insertions, 43 deletions

diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 1c23676..2677551 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -861,9 +861,15 @@ internal_proto (transfer_array_inner);
 extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
 internal_proto(set_integer);
 
+extern void set_unsigned (void *, GFC_UINTEGER_LARGEST, int);
+internal_proto(set_unsigned);
+
 extern GFC_UINTEGER_LARGEST si_max (int);
 internal_proto(si_max);
 
+extern GFC_UINTEGER_LARGEST us_max (int);
+internal_proto(us_max);
+
 extern int convert_real (st_parameter_dt *, void *, const char *, int);
 internal_proto(convert_real);
 
@@ -891,6 +897,10 @@ internal_proto(read_radix);
 extern void read_decimal (st_parameter_dt *, const fnode *, char *, int);
 internal_proto(read_decimal);
 
+extern void read_decimal_unsigned (st_parameter_dt *, const fnode *, char *,
+				   int);
+internal_proto(read_decimal_unsigned);
+
 extern void read_user_defined (st_parameter_dt *, void *);
 internal_proto(read_user_defined);
 
@@ -941,6 +951,9 @@ internal_proto(write_f);
 extern void write_i (st_parameter_dt *, const fnode *, const char *, int);
 internal_proto(write_i);
 
+extern void write_iu (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_iu);
+
 extern void write_l (st_parameter_dt *, const fnode *, char *, int);
 internal_proto(write_l);
 
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 96b2efe..5564629 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -697,8 +697,8 @@ convert_integer (st_parameter_dt *dtp, int length, int negative)
 
       if (dtp->u.p.repeat_count == 0)
 	{
-	  snprintf (message, IOMSG_LEN, "Zero repeat count in item %d of list input",
-		   dtp->u.p.item_count);
+	  snprintf (message, IOMSG_LEN, "Zero repeat count in item %d of list "
+		    "input", dtp->u.p.item_count);
 
 	  generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
 	  m = 1;
@@ -710,8 +710,8 @@ convert_integer (st_parameter_dt *dtp, int length, int negative)
 
  overflow:
   if (length == -1)
-    snprintf (message, IOMSG_LEN, "Repeat count overflow in item %d of list input",
-	     dtp->u.p.item_count);
+    snprintf (message, IOMSG_LEN, "Repeat count overflow in item %d of list "
+	      "input", dtp->u.p.item_count);
   else
     snprintf (message, IOMSG_LEN, "Integer overflow while reading item %d",
 	     dtp->u.p.item_count);
@@ -722,6 +722,86 @@ convert_integer (st_parameter_dt *dtp, int length, int negative)
   return 1;
 }
 
+/* Same as above, but for unsigneds, where overflow checks are only
+   preformed with -pedantic, except on the repeat count.  */
+
+static int
+convert_unsigned (st_parameter_dt *dtp, int length, int negative)
+{
+  char c, *buffer, message[IOMSG_LEN];
+  GFC_UINTEGER_LARGEST v, value, max, v_old;
+  int m;
+
+  if (compile_options.pedantic && negative)
+    goto overflow;
+
+  buffer = dtp->u.p.saved_string;
+  max = length == -1 ? MAX_REPEAT : us_max (length);
+
+  v = 0;
+  for (;;)
+    {
+      c = *buffer++;
+      if (c == '\0')
+	break;
+      c -= '0';
+      v_old = v;
+      v = v * 10 + c;
+
+      if (length == -1 && v > max)
+	goto overflow;
+      else if (compile_options.pedantic && v < v_old)
+	goto overflow;
+    }
+
+  m = 0;
+
+  if (length != -1)
+    {
+      if (negative)
+	value = -v;
+      else
+	value = v;
+
+      if (compile_options.pedantic && value > max)
+	goto overflow;
+      else
+	value = value & max;
+
+      set_unsigned (dtp->u.p.value, value, length);
+    }
+  else
+    {
+      dtp->u.p.repeat_count = v;
+
+      if (dtp->u.p.repeat_count == 0)
+	{
+	  snprintf (message, IOMSG_LEN, "Zero repeat count in item %d of list input",
+		   dtp->u.p.item_count);
+
+	  generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
+	  m = 1;
+	}
+    }
+  free_saved (dtp);
+  return m;
+
+ overflow:
+  if (length== -1)
+    snprintf (message, IOMSG_LEN, "Repeat count overflow in item %d of list input",
+	      dtp->u.p.item_count);
+  else if (negative)
+    snprintf (message, IOMSG_LEN, "Negative sign for unsigned integer "
+	      "in item %d of list input", dtp->u.p.item_count);
+  else
+    snprintf (message, IOMSG_LEN, "Unsigned integer overflow while reading "
+	      "item %d of list input", dtp->u.p.item_count);
+
+  free_saved (dtp);
+  generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
+
+  return 1;
+}
 
 /* Parse a repeat count for logical and complex values which cannot
    begin with a digit.  Returns nonzero if we are done, zero if we
@@ -990,11 +1070,10 @@ read_logical (st_parameter_dt *dtp, int length)
    used for repeat counts.  */
 
 static void
-read_integer (st_parameter_dt *dtp, int length)
+read_integer (st_parameter_dt *dtp, int length, bt type)
 {
   char message[IOMSG_LEN];
   int c, negative;
-
   negative = 0;
 
   c = next_char (dtp);
@@ -1055,8 +1134,11 @@ read_integer (st_parameter_dt *dtp, int length)
     }
 
  repeat:
-  if (convert_integer (dtp, -1, 0))
-    return;
+  if (type == BT_INTEGER)
+    {
+      if (convert_integer (dtp, -1, 0))
+	return;
+    }
 
   /* Get the real integer.  */
 
@@ -1077,6 +1159,9 @@ read_integer (st_parameter_dt *dtp, int length)
       return;
 
     case '-':
+      if (compile_options.pedantic && type == BT_UNSIGNED)
+	goto bad_integer;
+
       negative = 1;
       /* Fall through...  */
 
@@ -1127,8 +1212,13 @@ read_integer (st_parameter_dt *dtp, int length)
   else if (c != '\n')
     eat_line (dtp);
 
-  snprintf (message, IOMSG_LEN, "Bad integer for item %d in list input",
+  if (type == BT_INTEGER)
+    snprintf (message, IOMSG_LEN, "Bad integer for item %d in list input",
 	      dtp->u.p.item_count);
+  else
+    snprintf (message, IOMSG_LEN, "Bad unsigned for item %d in list input",
+	      dtp->u.p.item_count);
+
   free_line (dtp);
   generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
 
@@ -1139,17 +1229,27 @@ read_integer (st_parameter_dt *dtp, int length)
   eat_separator (dtp);
 
   push_char (dtp, '\0');
-  if (convert_integer (dtp, length, negative))
+  if (type == BT_INTEGER)
     {
-       free_saved (dtp);
-       return;
+      if (convert_integer (dtp, length, negative))
+	{
+	  free_saved (dtp);
+	  return;
+	}
+    }
+  else
+    {
+      if (convert_unsigned (dtp, length, negative))
+	{
+	  free_saved (dtp);
+	  return;
+	}
     }
 
   free_saved (dtp);
-  dtp->u.p.saved_type = BT_INTEGER;
+  dtp->u.p.saved_type = type;
 }
 
-
 /* Read a character variable.  */
 
 static void
@@ -2224,7 +2324,8 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p,
   switch (type)
     {
     case BT_INTEGER:
-      read_integer (dtp, kind);
+    case BT_UNSIGNED:
+      read_integer (dtp, kind, type);
       break;
     case BT_LOGICAL:
       read_logical (dtp, kind);
@@ -2318,6 +2419,7 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p,
       break;
 
     case BT_INTEGER:
+    case BT_UNSIGNED:
     case BT_LOGICAL:
       memcpy (p, dtp->u.p.value, size);
       break;
@@ -3029,7 +3131,8 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info *nl, index_type offset,
           switch (nl->type)
 	  {
 	  case BT_INTEGER:
-	    read_integer (dtp, len);
+	  case BT_UNSIGNED:
+	    read_integer (dtp, len, nl->type);
             break;
 
 	  case BT_LOGICAL:
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index 7a9e341..aa866bf 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -54,7 +54,7 @@ set_integer (void *dest, GFC_INTEGER_LARGEST value, int length)
       }
       break;
 #endif
-/* length=10 comes about for kind=10 real/complex BOZ, cf. PR41711. */
+/* length=10 comes about for kind=10 real/complex BOZ, see PR41711. */
     case 10:
     case 16:
       {
@@ -92,6 +92,62 @@ set_integer (void *dest, GFC_INTEGER_LARGEST value, int length)
     }
 }
 
+/* set_integer()-- All of the integer assignments come here to
+   actually place the value into memory.  */
+
+void
+set_unsigned (void *dest, GFC_UINTEGER_LARGEST value, int length)
+{
+  NOTE ("set_integer: %lld %p", (long long int) value, dest);
+  switch (length)
+    {
+#ifdef HAVE_GFC_UINTEGER_16
+#ifdef HAVE_GFC_REAL_17
+    case 17:
+      {
+	GFC_UINTEGER_16 tmp = value;
+	memcpy (dest, (void *) &tmp, 16);
+      }
+      break;
+#endif
+/* length=10 comes about for kind=10 real/complex BOZ, cf. PR41711.  */
+    case 10:
+    case 16:
+      {
+	GFC_UINTEGER_16 tmp = value;
+	memcpy (dest, (void *) &tmp, length);
+      }
+      break;
+#endif
+    case 8:
+      {
+	GFC_UINTEGER_8 tmp = value;
+	memcpy (dest, (void *) &tmp, length);
+      }
+      break;
+    case 4:
+      {
+	GFC_UINTEGER_4 tmp = value;
+	memcpy (dest, (void *) &tmp, length);
+      }
+      break;
+    case 2:
+      {
+	GFC_UINTEGER_2 tmp = value;
+	memcpy (dest, (void *) &tmp, length);
+      }
+      break;
+    case 1:
+      {
+	GFC_UINTEGER_1 tmp = value;
+	memcpy (dest, (void *) &tmp, length);
+      }
+      break;
+    default:
+      internal_error (NULL, "Bad integer kind");
+    }
+}
+
 
 /* Max signed value of size give by length argument.  */
 
@@ -132,6 +188,28 @@ si_max (int length)
     }
 }
 
+GFC_UINTEGER_LARGEST
+us_max (int length)
+{
+  switch (length)
+    {
+#ifdef HAVE_GFC_UINTEGER_16
+    case 17:
+    case 16:
+      return GFC_UINTEGER_16_HUGE;
+#endif
+    case 8:
+      return GFC_UINTEGER_8_HUGE;
+    case 4:
+      return GFC_UINTEGER_4_HUGE;
+    case 2:
+      return GFC_UINTEGER_2_HUGE;
+    case 1:
+      return GFC_UINTEGER_1_HUGE;
+    default:
+      internal_error (NULL, "Bad unsigned kind");
+    }
+}
 
 /* convert_real()-- Convert a character representation of a floating
    point number to the machine number.  Returns nonzero if there is an
@@ -392,7 +470,7 @@ read_utf8 (st_parameter_dt *dtp, size_t *nbytes)
     if ((c & ~masks[nb-1]) == patns[nb-1])
       goto found;
   goto invalid;
-	
+
  found:
   c = (c & masks[nb-1]);
   nread = nb - 1;
@@ -423,7 +501,7 @@ read_utf8 (st_parameter_dt *dtp, size_t *nbytes)
     goto invalid;
 
   return c;
-      
+
  invalid:
   generate_error (&dtp->common, LIBERROR_READ_VALUE, "Invalid UTF-8 encoding");
   return (gfc_char4_t) '?';
@@ -466,7 +544,7 @@ read_default_char1 (st_parameter_dt *dtp, char *p, size_t len, size_t width)
   size_t m;
 
   s = read_block_form (dtp, &width);
-  
+
   if (s == NULL)
     return;
   if (width > len)
@@ -610,7 +688,7 @@ read_a_char4 (st_parameter_dt *dtp, const fnode *f, char *p, size_t length)
     read_utf8_char4 (dtp, p, length, w);
   else
     read_default_char4 (dtp, p, length, w);
-  
+
   dtp->u.p.sf_read_comma =
     dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA ? 0 : 1;
 }
@@ -651,7 +729,7 @@ next_char (st_parameter_dt *dtp, char **p, size_t *w)
   if (c != ' ')
     return c;
   if (dtp->u.p.blank_status != BLANK_UNSPECIFIED)
-    return ' ';  /* return a blank to signal a null */ 
+    return ' ';  /* return a blank to signal a null */
 
   /* At this point, the rest of the field has to be trailing blanks */
 
@@ -730,19 +808,19 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
       c = next_char (dtp, &p, &w);
       if (c == '\0')
 	break;
-	
+
       if (c == ' ')
         {
 	  if (dtp->u.p.blank_status == BLANK_NULL)
 	    {
 	      /* Skip spaces.  */
 	      for ( ; w > 0; p++, w--)
-		if (*p != ' ') break; 
+		if (*p != ' ') break;
 	      continue;
 	    }
 	  if (dtp->u.p.blank_status == BLANK_ZERO) c = '0';
         }
-        
+
       if (c < '0' || c > '9')
 	goto bad;
 
@@ -778,6 +856,119 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 
 }
 
+/* read_decimal_unsigned() - almost the same as above.  Checks for sign
+   and overflow are performed with -pedantic.  */
+
+void
+read_decimal_unsigned (st_parameter_dt *dtp, const fnode *f, char *dest,
+		       int length)
+{
+  GFC_UINTEGER_LARGEST value, old_value;
+  size_t w;
+  int negative;
+  char c, *p;
+
+  w = f->u.w;
+
+  /* This is a legacy extension, and the frontend will only allow such cases
+   * through when -fdec-format-defaults is passed.
+   */
+  if (w == (size_t) DEFAULT_WIDTH)
+    w = default_width_for_integer (length);
+
+  p = read_block_form (dtp, &w);
+
+  if (p == NULL)
+    return;
+
+  p = eat_leading_spaces (&w, p);
+  if (w == 0)
+    {
+      set_unsigned (dest, (GFC_UINTEGER_LARGEST) 0, length);
+      return;
+    }
+
+  negative = 0;
+
+  switch (*p)
+    {
+    case '-':
+      if (compile_options.pedantic)
+	goto no_sign;
+
+      negative = 1;
+
+      /* Fall through.  */
+
+    case '+':
+      p++;
+      if (--w == 0)
+	goto bad;
+      /* Fall through.  */
+
+    default:
+      break;
+    }
+
+  /* At this point we have a digit-string.  */
+  value = 0;
+
+  for (;;)
+    {
+      c = next_char (dtp, &p, &w);
+      if (c == '\0')
+	break;
+
+      if (c == ' ')
+	{
+	  if (dtp->u.p.blank_status == BLANK_NULL)
+	    {
+	      /* Skip spaces.  */
+	      for ( ; w > 0; p++, w--)
+		if (*p != ' ') break;
+	      continue;
+	    }
+	  if (dtp->u.p.blank_status == BLANK_ZERO) c = '0';
+	}
+
+      if (c < '0' || c > '9')
+	goto bad;
+
+      c -= '0';
+      old_value = value;
+      value = 10 * value + c;
+      if (compile_options.pedantic && value < old_value)
+	goto overflow;
+    }
+
+  if (negative)
+    value = -value;
+
+  if (compile_options.pedantic && value > us_max (length))
+    goto overflow;
+
+  set_unsigned (dest, value, length);
+  return;
+
+ bad:
+  generate_error (&dtp->common, LIBERROR_READ_VALUE,
+		  "Bad value during unsigned integer read");
+  next_record (dtp, 1);
+  return;
+
+ no_sign:
+  generate_error (&dtp->common, LIBERROR_READ_VALUE,
+		  "Negative sign for unsigned integer read");
+  next_record (dtp, 1);
+  return;
+
+ overflow:
+  generate_error (&dtp->common, LIBERROR_READ_OVERFLOW,
+		  "Value overflowed during unsigned integer read");
+  next_record (dtp, 1);
+
+}
+
 
 /* read_radix()-- This function reads values for non-decimal radixes.
    The difference here is that we treat the values here as unsigned
@@ -992,7 +1183,7 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
   if (w == 0)
     goto zero;
 
-  /* Check for Infinity or NaN.  */    
+  /* Check for Infinity or NaN.  */
   if (unlikely ((w >= 3 && (*p == 'i' || *p == 'I' || *p == 'n' || *p == 'N'))))
     {
       int seen_paren = 0;
@@ -1034,9 +1225,9 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 	  ++p;
 	  ++out;
 	}
-	 
+
       *out = '\0';
-      
+
       if (seen_paren != 0 && seen_paren != 2)
 	goto bad_float;
 
@@ -1133,7 +1324,7 @@ found_digit:
       ++p;
       --w;
     }
-  
+
   /* No exponent has been seen, so we use the current scale factor.  */
   exponent = - dtp->u.p.scale_factor;
   goto done;
@@ -1171,7 +1362,7 @@ exponent:
 	  ++p;
 	  --w;
 	}
-	
+
       /* Only allow trailing blanks.  */
       while (w > 0)
 	{
@@ -1180,7 +1371,7 @@ exponent:
 	  ++p;
 	  --w;
 	}
-    }    
+    }
   else  /* BZ or BN status is enabled.  */
     {
       while (w > 0)
@@ -1220,7 +1411,7 @@ done:
      significand.  */
   else if (!seen_int_digit && !seen_dec_digit)
     {
-      notify_std (&dtp->common, GFC_STD_LEGACY, 
+      notify_std (&dtp->common, GFC_STD_LEGACY,
 		  "REAL input of style 'E+NN'");
       *(out++) = '0';
     }
@@ -1313,20 +1504,20 @@ read_x (st_parameter_dt *dtp, size_t n)
   if ((dtp->u.p.current_unit->pad_status == PAD_NO || is_internal_unit (dtp))
       && dtp->u.p.current_unit->bytes_left < (gfc_offset) n)
     n = dtp->u.p.current_unit->bytes_left;
-    
+
   if (n == 0)
     return;
-    
+
   if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8)
     {
       gfc_char4_t c;
       size_t nbytes, j;
-    
+
       /* Proceed with decoding one character at a time.  */
       for (j = 0; j < n; j++)
 	{
 	  c = read_utf8 (dtp, &nbytes);
-    
+
 	  /* Check for a short read and if so, break out.  */
 	  if (nbytes == 0 || c == (gfc_char4_t)0)
 	    break;
@@ -1363,7 +1554,7 @@ read_x (st_parameter_dt *dtp, size_t n)
 	     the rest of the I/O statement.  Set the corresponding flag.  */
 	  if (dtp->u.p.advance_status == ADVANCE_NO || dtp->u.p.seen_dollar)
 	    dtp->u.p.eor_condition = 1;
-	    
+
 	  /* If we encounter a CR, it might be a CRLF.  */
 	  if (q == '\r') /* Probably a CRLF */
 	    {
@@ -1377,7 +1568,7 @@ read_x (st_parameter_dt *dtp, size_t n)
 	  goto done;
 	}
       n++;
-    } 
+    }
 
  done:
   if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ||
@@ -1386,4 +1577,3 @@ read_x (st_parameter_dt *dtp, size_t n)
   dtp->u.p.current_unit->bytes_left -= n;
   dtp->u.p.current_unit->strm_pos += (gfc_offset) n;
 }
-
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index a86099d..64f394d 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -56,6 +56,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
       transfer_complex
       transfer_real128
       transfer_complex128
+      transfer_unsigned
 
     and for WRITE
 
@@ -67,6 +68,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
       transfer_complex_write
       transfer_real128_write
       transfer_complex128_write
+      transfer_unsigned_write
 
     These subroutines do not return status. The *128 functions
     are in the file transfer128.c.
@@ -82,6 +84,12 @@ export_proto(transfer_integer);
 extern void transfer_integer_write (st_parameter_dt *, void *, int);
 export_proto(transfer_integer_write);
 
+extern void transfer_unsigned (st_parameter_dt *, void *, int);
+export_proto(transfer_unsigned);
+
+extern void transfer_unsigned_write (st_parameter_dt *, void *, int);
+export_proto(transfer_unsigned_write);
+
 extern void transfer_real (st_parameter_dt *, void *, int);
 export_proto(transfer_real);
 
@@ -1410,6 +1418,9 @@ type_name (bt type)
     case BT_INTEGER:
       p = "INTEGER";
       break;
+    case BT_UNSIGNED:
+      p = "UNSIGNED";
+      break;
     case BT_LOGICAL:
       p = "LOGICAL";
       break;
@@ -1485,6 +1496,31 @@ require_type (st_parameter_dt *dtp, bt expected, bt actual, const fnode *f)
   return 1;
 }
 
+/* Check that the actual matches one of two expected types; issue an error
+   if that is not the case.  */
+
+
+static int
+require_one_of_two_types (st_parameter_dt *dtp, bt expected1, bt expected2,
+			  bt actual, const fnode *f)
+{
+  char buffer[BUFLEN];
+
+  if (actual == expected1)
+    return 0;
+
+  if (actual == expected2)
+    return 0;
+
+  snprintf (buffer, BUFLEN,
+	    "Expected %s or %s for item %d in formatted transfer, got %s",
+	    type_name (expected1), type_name (expected2),
+	    dtp->u.p.item_count - 1, type_name (actual));
+
+  format_error (dtp, f, buffer);
+  return 1;
+
+}
 
 /* Check that the dtio procedure required for formatted IO is present.  */
 
@@ -1627,9 +1663,12 @@ formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind
 	case FMT_I:
 	  if (n == 0)
 	    goto need_read_data;
-	  if (require_type (dtp, BT_INTEGER, type, f))
+	  if (require_one_of_two_types (dtp, BT_INTEGER, BT_UNSIGNED, type, f))
 	    return;
-	  read_decimal (dtp, f, p, kind);
+	  if (type == BT_INTEGER)
+	    read_decimal (dtp, f, p, kind);
+	  else
+	    read_decimal_unsigned (dtp, f, p, kind);
 	  break;
 
 	case FMT_B:
@@ -2123,9 +2162,12 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
 	case FMT_I:
 	  if (n == 0)
 	    goto need_data;
-	  if (require_type (dtp, BT_INTEGER, type, f))
+	  if (require_one_of_two_types (dtp, BT_INTEGER, BT_UNSIGNED, type, f))
 	    return;
-	  write_i (dtp, f, p, kind);
+	  if (type == BT_INTEGER)
+	    write_i (dtp, f, p, kind);
+	  else
+	    write_iu (dtp, f, p, kind);
 	  break;
 
 	case FMT_B:
@@ -2609,6 +2651,18 @@ transfer_integer_write (st_parameter_dt *dtp, void *p, int kind)
 }
 
 void
+transfer_unsigned (st_parameter_dt *dtp, void *p, int kind)
+{
+    wrap_scalar_transfer (dtp, BT_UNSIGNED, p, kind, kind, 1);
+}
+
+void
+transfer_unsigned_write (st_parameter_dt *dtp, void *p, int kind)
+{
+  transfer_unsigned (dtp, p, kind);
+}
+
+void
 transfer_real (st_parameter_dt *dtp, void *p, int kind)
 {
   size_t size;
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 91d1da2..2f414c6 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -949,7 +949,134 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
   return;
 }
 
+/* Same as above, but somewhat simpler because we only treat unsigned
+   numbers.  */
 
+static void
+write_decimal_unsigned (st_parameter_dt *dtp, const fnode *f,
+			const char *source, int len)
+{
+  GFC_UINTEGER_LARGEST n = 0;
+  int w, m, digits, nsign, nzero, nblank;
+  char *p;
+  const char *q;
+  sign_t sign;
+  char itoa_buf[GFC_BTOA_BUF_SIZE];
+
+  w = f->u.integer.w;
+  m = f->format == FMT_G ? -1 : f->u.integer.m;
+
+  n = extract_uint (source, len);
+
+  /* Special case:  */
+  if (m == 0 && n == 0)
+    {
+      if (w == 0)
+	w = 1;
+
+      p = write_block (dtp, w);
+      if (p == NULL)
+	return;
+
+      if (unlikely (is_char4_unit (dtp)))
+	{
+	  gfc_char4_t *p4 = (gfc_char4_t *) p;
+	  memset4 (p4, ' ', w);
+	}
+      else
+	memset (p, ' ', w);
+      goto done;
+    }
+
+  /* Just in case somebody wants a + sign.  */
+  sign = calculate_sign (dtp, false);
+  nsign = sign == S_NONE ? 0 : 1;
+
+  q = gfc_itoa (n, itoa_buf, sizeof (itoa_buf));
+  digits = strlen (q);
+
+  /* Select a width if none was specified.  The idea here is to always
+     print something.  */
+  if (w == DEFAULT_WIDTH)
+    w = default_width_for_integer (len);
+
+  if (w == 0)
+    w = ((digits < m) ? m : digits) + nsign;
+
+  p = write_block (dtp, w);
+  if (p == NULL)
+    return;
+
+  nzero = 0;
+  if (digits < m)
+    nzero = m - digits;
+
+  /* See if things will work.  */
+
+  nblank = w - (nsign + nzero + digits);
+
+  if (unlikely (is_char4_unit (dtp)))
+    {
+      gfc_char4_t *p4 = (gfc_char4_t *)p;
+      if (nblank < 0)
+	{
+	  memset4 (p4, '*', w);
+	  goto done;
+	}
+
+      if (!dtp->u.p.namelist_mode)
+	{
+	  memset4 (p4, ' ', nblank);
+	  p4 += nblank;
+	}
+
+      if (sign == S_PLUS)
+	*p4++ = '+';
+
+      memset4 (p4, '0', nzero);
+      p4 += nzero;
+
+      memcpy4 (p4, q, digits);
+
+      if (dtp->u.p.namelist_mode)
+	{
+	  p4 += digits;
+	  memset4 (p4, ' ', nblank);
+	}
+
+      return;
+    }
+
+  if (nblank < 0)
+    {
+      star_fill (p, w);
+      goto done;
+    }
+
+  if (!dtp->u.p.namelist_mode)
+    {
+      memset (p, ' ', nblank);
+      p += nblank;
+    }
+
+  if (sign == S_PLUS)
+    *p++ = '+';
+
+  memset (p, '0', nzero);
+  p += nzero;
+
+  memcpy (p, q, digits);
+
+  if (dtp->u.p.namelist_mode)
+    {
+      p += digits;
+      memset (p, ' ', nblank);
+    }
+
+ done:
+  return;
+
+}
 /* Convert hexadecimal to ASCII.  */
 
 static const char *
@@ -1240,6 +1367,11 @@ write_i (st_parameter_dt *dtp, const fnode *f, const char *p, int len)
   write_decimal (dtp, f, p, len);
 }
 
+void
+write_iu (st_parameter_dt *dtp, const fnode *f, const char *p, int len)
+{
+  write_decimal_unsigned (dtp, f, p, len);
+}
 
 void
 write_b (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
@@ -1404,6 +1536,47 @@ write_integer (st_parameter_dt *dtp, const char *source, int kind)
   write_decimal (dtp, &f, source, kind);
 }
 
+/* Write a list-directed unsigned value.  We use the same formatting
+   as for integer.  */
+
+static void
+write_unsigned (st_parameter_dt *dtp, const char *source, int kind)
+{
+  int width;
+  fnode f;
+
+  switch (kind)
+    {
+    case 1:
+      width = 4;
+      break;
+
+    case 2:
+      width = 6;
+      break;
+
+    case 4:
+      width = 11;
+      break;
+
+    case 8:
+      width = 20;
+      break;
+
+    case 16:
+      width = 40;
+      break;
+
+    default:
+      width = 0;
+      break;
+    }
+  f.u.integer.w = width;
+  f.u.integer.m = -1;
+  f.format = FMT_NONE;
+  write_decimal_unsigned (dtp, &f, source, kind);
+}
+
 
 /* Write a list-directed string.  We have to worry about delimiting
    the strings if the file has been opened in that mode.  */
@@ -1942,6 +2115,9 @@ list_formatted_write_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
     case BT_INTEGER:
       write_integer (dtp, p, kind);
       break;
+    case BT_UNSIGNED:
+      write_unsigned (dtp, p, kind);
+      break;
     case BT_LOGICAL:
       write_logical (dtp, p, kind);
       break;