Implement decimal list-directed I/O.

6 files changed, 56 insertions, 7 deletions

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index d7bbcf6..1e3262f 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -677,7 +677,6 @@ enum gfc_isym_id
   GFC_ISYM_STOPPED_IMAGES,
   GFC_ISYM_STORAGE_SIZE,
   GFC_ISYM_STRIDE,
-  GFC_ISYM_SU_KIND,
   GFC_ISYM_SUM,
   GFC_ISYM_SYMLINK,
   GFC_ISYM_SYMLNK,
@@ -706,7 +705,12 @@ enum gfc_isym_id
   GFC_ISYM_Y0,
   GFC_ISYM_Y1,
   GFC_ISYM_YN,
-  GFC_ISYM_YN2
+  GFC_ISYM_YN2,
+
+  /* Add this at the end, so maybe the module format
+     remains compatible.  */
+  GFC_ISYM_SU_KIND
+
 };
 
 enum init_local_logical
@@ -4108,7 +4112,7 @@ void gfc_convert_mpz_to_signed (mpz_t, int);
 gfc_expr *gfc_simplify_ieee_functions (gfc_expr *);
 bool gfc_is_constant_array_expr (gfc_expr *);
 bool gfc_is_size_zero_array (gfc_expr *);
-void gfc_convert_mpz_to_unsigned (mpz_t, int);
+void gfc_convert_mpz_to_unsigned (mpz_t, int, bool check = true);
 
 /* trans-array.cc  */
 
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index c1aa0bc..63b0bcf 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -229,7 +229,8 @@ convert_unsigned (const char *buffer, int kind, int radix, locus *where)
   mpz_set_str (e->value.integer, t, radix);
 
   k = gfc_validate_kind (BT_UNSIGNED, kind, false);
-  gfc_convert_mpz_to_unsigned (e->value.integer, gfc_unsigned_kinds[k].bit_size);
+  gfc_convert_mpz_to_unsigned (e->value.integer, gfc_unsigned_kinds[k].bit_size,
+			       false);
 
   return e;
 }
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index b96f5ee..a8c9397 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -148,7 +148,7 @@ get_kind (bt type, gfc_expr *k, const char *name, int default_kind)
    be accomplished by masking out the high bits.  */
 
 void
-gfc_convert_mpz_to_unsigned (mpz_t x, int bitsize)
+gfc_convert_mpz_to_unsigned (mpz_t x, int bitsize, bool check)
 {
   mpz_t mask;
 
@@ -171,7 +171,7 @@ gfc_convert_mpz_to_unsigned (mpz_t x, int bitsize)
     {
       /* Confirm that no bits above the signed range are set if we
 	 are doing range checking.  */
-      if (flag_range_check != 0)
+      if (check && flag_range_check != 0)
 	gcc_assert (mpz_scan1 (x, bitsize-1) == ULONG_MAX);
     }
 }
diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index 7ab82fa..e9e67a0 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -117,6 +117,8 @@ enum iocall
   IOCALL_WRITE_DONE,
   IOCALL_X_INTEGER,
   IOCALL_X_INTEGER_WRITE,
+  IOCALL_X_UNSIGNED,
+  IOCALL_X_UNSIGNED_WRITE,
   IOCALL_X_LOGICAL,
   IOCALL_X_LOGICAL_WRITE,
   IOCALL_X_CHARACTER,
@@ -335,6 +337,14 @@ gfc_build_io_library_fndecls (void)
 	get_identifier (PREFIX("transfer_integer_write")), ". w R . ",
 	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
 
+  iocall[IOCALL_X_UNSIGNED] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_unsigned")), ". w W . ",
+	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
+
+  iocall[IOCALL_X_UNSIGNED_WRITE] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_unsigned_write")), ". w R . ",
+	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
+
   iocall[IOCALL_X_LOGICAL] = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("transfer_logical")), ". w W . ",
 	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
@@ -2341,6 +2351,15 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr,
 
       break;
 
+    case BT_UNSIGNED:
+      arg2 = build_int_cst (unsigned_type_node, kind);
+      if (last_dt == READ)
+	function = iocall[IOCALL_X_UNSIGNED];
+      else
+	function = iocall[IOCALL_X_UNSIGNED_WRITE];
+
+      break;
+
     case BT_REAL:
       arg2 = build_int_cst (integer_type_node, kind);
       if (last_dt == READ)
diff --git a/gcc/testsuite/gfortran.dg/unsigned_1.f90 b/gcc/testsuite/gfortran.dg/unsigned_1.f90
index a5f110a..ed1a6ee 100644
--- a/gcc/testsuite/gfortran.dg/unsigned_1.f90
+++ b/gcc/testsuite/gfortran.dg/unsigned_1.f90
@@ -1,11 +1,16 @@
 ! { dg-do run }
 ! { dg-options "-funsigned" }
-! Test basic assignment, arithmetic and a condition.
+! Test some arithmetic ans selected_unsigned_kind.
 program memain
   unsigned :: u, v
+  integer, parameter :: u1 = selected_unsigned_kind(2), &
+       u2 = selected_unsigned_kind(4), &
+       u4 = selected_unsigned_kind(6), &
+       u8 = selected_unsigned_kind(10)
   u = 1u
   v = 42u
   if (u + v /= 43u) then
      stop 1
   end if
+  if (u1 /= 1 .or. u2 /= 2 .or. u4 /= 4 .or. u8 /= 8) stop 2
 end program memain
diff --git a/gcc/testsuite/gfortran.dg/unsigned_2.f90 b/gcc/testsuite/gfortran.dg/unsigned_2.f90
new file mode 100644
index 0000000..e55e0f5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unsigned_2.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! { dg-additional-options -funsigned }
+! Test some list-directed I/O
+program main
+  implicit none
+  unsigned :: uw, ur, vr
+  unsigned(kind=8) :: u8
+  uw = 10u
+  open (10, status="scratch")
+  write (10,*) uw,-1
+  rewind 10
+  read (10,*) ur,vr
+  if (ur /= 10u .or. vr /= 4294967295u) stop 1
+  rewind 10
+  write (10,*) 17179869184u_8
+  rewind 10
+  read (10,*) u8
+  if (u8 /= 17179869184u_8) stop 2
+end program main
+