]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
re PR fortran/37498 (Incorrect array value returned - 4.3 ABI Broken)
authorJerry DeLisle <jvdelisle@gcc.gnu.org>
Fri, 26 Sep 2008 06:19:42 +0000 (06:19 +0000)
committerJerry DeLisle <jvdelisle@gcc.gnu.org>
Fri, 26 Sep 2008 06:19:42 +0000 (06:19 +0000)
2008-09-25  Jerry DeLisle  <jvdelisle@gcc.gnu.org

PR libfortran/37498
* list_read.c (eat_separator): Revert previous patch and move
delim_status, decimal_status, and pad_status to gfc_unit.
(parse_real): Ditto. (read_real): Ditto.
* read.c (read_a): Likewise. (read_a_char4): Likewise.
(read_f): Likewise.
* inquire.c (inquire_via_unit): Add missing check for
IOPARM_INQUIRE_HAS_FLAGS2. (inquire_via_filename): Likewise.
* io.h (unit_sign_s): Move delim_status, decimal_status, and pad_status
to gfc_unit.
* transfer.c (read_sf): Ditto. (read_block_form): Ditto.
(formatted_transfer_scalar): Ditto. (data_transfer_init): Ditto.
* write.c (write_default_char4): Ditto. (write_utf8_char4): Ditto.
(write_character): Ditto. (write_real_g0): Ditto.
(list_formatted_write_scalar): Ditto. (nml_write_obj): Ditto.
(namelist_write): Ditto.
* write_float.def (calculate_sign): Ditto. (output_float): Ditto.

From-SVN: r140684

libgfortran/ChangeLog
libgfortran/io/inquire.c
libgfortran/io/io.h
libgfortran/io/list_read.c
libgfortran/io/read.c
libgfortran/io/transfer.c
libgfortran/io/write.c
libgfortran/io/write_float.def

index 660be4329eab656ed3d8f24fd8070615b63d98bf..150fc15b93a74b59aef432e099cd7d6ceec90434 100644 (file)
@@ -1,3 +1,23 @@
+2008-09-25  Jerry DeLisle  <jvdelisle@gcc.gnu.org
+
+       PR libfortran/37498
+       * list_read.c (eat_separator): Revert previous patch and move
+       delim_status, decimal_status, and pad_status to gfc_unit.
+       (parse_real): Ditto. (read_real): Ditto.
+       * read.c (read_a): Likewise. (read_a_char4): Likewise.
+       (read_f): Likewise.
+       * inquire.c (inquire_via_unit): Add missing check for
+       IOPARM_INQUIRE_HAS_FLAGS2. (inquire_via_filename): Likewise.
+       * io.h (unit_sign_s): Move delim_status, decimal_status, and pad_status
+       to gfc_unit.
+       * transfer.c (read_sf): Ditto. (read_block_form): Ditto.
+       (formatted_transfer_scalar): Ditto. (data_transfer_init): Ditto.
+       * write.c (write_default_char4): Ditto. (write_utf8_char4): Ditto.
+       (write_character): Ditto. (write_real_g0): Ditto.
+       (list_formatted_write_scalar): Ditto. (nml_write_obj): Ditto.
+       (namelist_write): Ditto.
+       * write_float.def (calculate_sign): Ditto. (output_float): Ditto.
+
 2008-09-24  Tobias Burnus  <burnus@net-b.de>
 
        * runtime/compile_options.c (init_compile_options):
index 9eb63d7b4d700dab82b0bb2d67bd4dd5fb539c31..3b5f3f74473ae144e10ef4a309e63cec9321739d 100644 (file)
@@ -252,125 +252,128 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
       cf_strcpy (iqp->pad, iqp->pad_len, p);
     }
 
-  if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0)
-    *iqp->pending = 0;
-  
-  if ((cf2 & IOPARM_INQUIRE_HAS_ID) != 0)
-    *iqp->id = 0;
-
-  if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
+  if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
     {
-      if (u == NULL || u->flags.form != FORM_FORMATTED)
-       p = undefined;
-      else
-       switch (u->flags.encoding)
-         {
-         case ENCODING_DEFAULT:
-           p = "UNKNOWN";
-           break;
-         case ENCODING_UTF8:
-           p = "UTF-8";
-           break;
-         default:
-           internal_error (&iqp->common, "inquire_via_unit(): Bad encoding");
-         }
-
-      cf_strcpy (iqp->encoding, iqp->encoding_len, p);
-    }
-
-  if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
-    {
-      if (u == NULL || u->flags.form != FORM_FORMATTED)
-       p = undefined;
-      else
-       switch (u->flags.decimal)
-         {
-         case DECIMAL_POINT:
-           p = "POINT";
-           break;
-         case DECIMAL_COMMA:
-           p = "COMMA";
-           break;
-         default:
-           internal_error (&iqp->common, "inquire_via_unit(): Bad comma");
-         }
-
-      cf_strcpy (iqp->decimal, iqp->decimal_len, p);
-    }
-
-  if ((cf2 & IOPARM_INQUIRE_HAS_ASYNCHRONOUS) != 0)
-    {
-      if (u == NULL)
-       p = undefined;
-      else
-       switch (u->flags.async)
-         {
-         case ASYNC_YES:
-           p = "YES";
-           break;
-         case ASYNC_NO:
-           p = "NO";
-           break;
-         default:
-           internal_error (&iqp->common, "inquire_via_unit(): Bad async");
-         }
+      if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0)
+       *iqp->pending = 0;
+  
+      if ((cf2 & IOPARM_INQUIRE_HAS_ID) != 0)
+        *iqp->id = 0;
 
-      cf_strcpy (iqp->asynchronous, iqp->asynchronous_len, p);
-    }
+      if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
+       {
+         if (u == NULL || u->flags.form != FORM_FORMATTED)
+           p = undefined;
+          else
+           switch (u->flags.encoding)
+             {
+             case ENCODING_DEFAULT:
+               p = "UNKNOWN";
+               break;
+             case ENCODING_UTF8:
+               p = "UTF-8";
+               break;
+             default:
+               internal_error (&iqp->common, "inquire_via_unit(): Bad encoding");
+             }
+
+         cf_strcpy (iqp->encoding, iqp->encoding_len, p);
+       }
 
-  if ((cf2 & IOPARM_INQUIRE_HAS_SIGN) != 0)
-    {
-      if (u == NULL)
-       p = undefined;
-      else
-       switch (u->flags.sign)
-         {
-         case SIGN_PROCDEFINED:
-           p = "PROCESSOR_DEFINED";
-           break;
-         case SIGN_SUPPRESS:
-           p = "SUPPRESS";
-           break;
-         case SIGN_PLUS:
-           p = "PLUS";
-           break;
-         default:
-           internal_error (&iqp->common, "inquire_via_unit(): Bad sign");
-         }
+      if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
+       {
+         if (u == NULL || u->flags.form != FORM_FORMATTED)
+           p = undefined;
+         else
+           switch (u->flags.decimal)
+             {
+             case DECIMAL_POINT:
+               p = "POINT";
+               break;
+             case DECIMAL_COMMA:
+               p = "COMMA";
+               break;
+             default:
+               internal_error (&iqp->common, "inquire_via_unit(): Bad comma");
+             }
+
+         cf_strcpy (iqp->decimal, iqp->decimal_len, p);
+       }
 
-      cf_strcpy (iqp->sign, iqp->sign_len, p);
-    }
+      if ((cf2 & IOPARM_INQUIRE_HAS_ASYNCHRONOUS) != 0)
+       {
+         if (u == NULL)
+           p = undefined;
+         else
+           switch (u->flags.async)
+           {
+             case ASYNC_YES:
+               p = "YES";
+               break;
+             case ASYNC_NO:
+               p = "NO";
+               break;
+             default:
+               internal_error (&iqp->common, "inquire_via_unit(): Bad async");
+           }
+
+         cf_strcpy (iqp->asynchronous, iqp->asynchronous_len, p);
+       }
 
-  if ((cf2 & IOPARM_INQUIRE_HAS_ROUND) != 0)
-    {
-      if (u == NULL)
-       p = undefined;
-      else
-       switch (u->flags.round)
-         {
-         case ROUND_UP:
-           p = "UP";
-           break;
-         case ROUND_DOWN:
-           p = "DOWN";
-           break;
-         case ROUND_ZERO:
-           p = "ZERO";
-           break;
-         case ROUND_NEAREST:
-           p = "NEAREST";
-           break;
-         case ROUND_COMPATIBLE:
-           p = "COMPATIBLE";
-           break;
-         case ROUND_PROCDEFINED:
-           p = "PROCESSOR_DEFINED";
-           break;
-         default:
-           internal_error (&iqp->common, "inquire_via_unit(): Bad round");
-         }
+      if ((cf2 & IOPARM_INQUIRE_HAS_SIGN) != 0)
+       {
+         if (u == NULL)
+           p = undefined;
+         else
+           switch (u->flags.sign)
+           {
+             case SIGN_PROCDEFINED:
+               p = "PROCESSOR_DEFINED";
+               break;
+             case SIGN_SUPPRESS:
+               p = "SUPPRESS";
+               break;
+             case SIGN_PLUS:
+               p = "PLUS";
+               break;
+             default:
+               internal_error (&iqp->common, "inquire_via_unit(): Bad sign");
+           }
+
+         cf_strcpy (iqp->sign, iqp->sign_len, p);
+       }
 
-      cf_strcpy (iqp->round, iqp->round_len, p);
+      if ((cf2 & IOPARM_INQUIRE_HAS_ROUND) != 0)
+       {
+         if (u == NULL)
+           p = undefined;
+         else
+           switch (u->flags.round)
+           {
+             case ROUND_UP:
+               p = "UP";
+               break;
+             case ROUND_DOWN:
+               p = "DOWN";
+               break;
+             case ROUND_ZERO:
+               p = "ZERO";
+               break;
+             case ROUND_NEAREST:
+               p = "NEAREST";
+               break;
+             case ROUND_COMPATIBLE:
+               p = "COMPATIBLE";
+               break;
+             case ROUND_PROCDEFINED:
+               p = "PROCESSOR_DEFINED";
+               break;
+             default:
+               internal_error (&iqp->common, "inquire_via_unit(): Bad round");
+           }
+
+         cf_strcpy (iqp->round, iqp->round_len, p);
+       }
     }
 
   if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
@@ -581,14 +584,26 @@ inquire_via_filename (st_parameter_inquire *iqp)
   if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
     cf_strcpy (iqp->pad, iqp->pad_len, undefined);
 
-  if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
-    cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
+  if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
+    {
+      if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
+       cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
   
-  if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
-    cf_strcpy (iqp->delim, iqp->delim_len, undefined);
+      if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
+       cf_strcpy (iqp->delim, iqp->delim_len, undefined);
+
+      if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
+       cf_strcpy (iqp->decimal, iqp->decimal_len, undefined);
 
-  if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
-    cf_strcpy (iqp->decimal, iqp->decimal_len, undefined);
+      if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
+       cf_strcpy (iqp->delim, iqp->delim_len, undefined);
+
+      if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0)
+       cf_strcpy (iqp->pad, iqp->pad_len, undefined);
+  
+      if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
+       cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
+    }
 
   if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
     cf_strcpy (iqp->position, iqp->position_len, undefined);
@@ -613,15 +628,6 @@ inquire_via_filename (st_parameter_inquire *iqp)
       p = inquire_read (iqp->file, iqp->file_len);
       cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
     }
-
-  if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
-    cf_strcpy (iqp->delim, iqp->delim_len, undefined);
-
-  if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0)
-    cf_strcpy (iqp->pad, iqp->pad_len, undefined);
-  
-  if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
-    cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
 }
 
 
index 1f6041db7daf1fcd300c82d4396421693f7be2db..710224de21dec0691a152589402d0c35ebbd7b9b 100644 (file)
@@ -541,9 +541,6 @@ typedef struct st_parameter_44
      kind.  */
   char value[32];
   gfc_offset size_used;
-  unit_pad pad_status;
-  unit_decimal decimal_status;
-  unit_delim delim_status;
 } st_parameter_44;
 
 typedef struct st_parameter_dt
@@ -646,6 +643,9 @@ typedef struct gfc_unit
 
   unit_mode mode;
   unit_flags flags;
+  unit_pad pad_status;
+  unit_decimal decimal_status;
+  unit_delim delim_status;
 
   /* recl                 -- Record length of the file.
      last_record          -- Last record number read or written
index 47f4786b5758a69e7edd626f95075cfc63c1f5b9..bcde3e1d49b4f50cdfb3d76c631aef05a82bf957 100644 (file)
@@ -324,8 +324,7 @@ eat_separator (st_parameter_dt *dtp)
   switch (c)
     {
     case ',':
-      if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
-         && dtp->u.p.decimal_status == DECIMAL_COMMA)
+      if (dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
        {
          unget_char (dtp, c);
          break;
@@ -935,8 +934,8 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
     default:
       if (dtp->u.p.namelist_mode)
        {
-         if (dtp->u.p.delim_status == DELIM_APOSTROPHE
-             || dtp->u.p.delim_status == DELIM_QUOTE
+         if (dtp->u.p.current_unit->delim_status == DELIM_APOSTROPHE
+             || dtp->u.p.current_unit->delim_status == DELIM_QUOTE
              || c == '&' || c == '$' || c == '/')
            {
              unget_char (dtp, c);
@@ -1117,8 +1116,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
       c = next_char (dtp);
     }
 
-  if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
-      && c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
+  if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
     c = '.';
   
   if (!isdigit (c) && c != '.')
@@ -1136,8 +1134,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
   for (;;)
     {
       c = next_char (dtp);
-      if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
-         && c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
+      if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
        c = '.';
       switch (c)
        {
@@ -1308,17 +1305,9 @@ eol_1:
   else
     unget_char (dtp, c);
 
-  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-    {
-      if (next_char (dtp)
-         !=  (dtp->u.p.decimal_status == DECIMAL_POINT ? ',' : ';'))
-       goto bad_complex;
-    }
-  else
-    {
-      if (next_char (dtp) != ',')
-       goto bad_complex;
-    }
+  if (next_char (dtp)
+      !=  (dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? ',' : ';'))
+    goto bad_complex;
 
 eol_2:
   eat_spaces (dtp);
@@ -1371,8 +1360,7 @@ read_real (st_parameter_dt *dtp, int length)
   seen_dp = 0;
 
   c = next_char (dtp);
-  if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
-      && c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
+  if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
     c = '.';
   switch (c)
     {
@@ -1409,8 +1397,7 @@ read_real (st_parameter_dt *dtp, int length)
   for (;;)
     {
       c = next_char (dtp);
-      if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
-         && c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
+      if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
        c = '.';
       switch (c)
        {
@@ -1476,8 +1463,7 @@ read_real (st_parameter_dt *dtp, int length)
       c = next_char (dtp);
     }
 
-  if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
-      && c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
+  if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
     c = '.';
 
   if (!isdigit (c) && c != '.')
@@ -1502,8 +1488,7 @@ read_real (st_parameter_dt *dtp, int length)
   for (;;)
     {
       c = next_char (dtp);
-      if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
-         && c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
+      if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
        c = '.';
       switch (c)
        {
index e35a7b1bdc3af01452e964bf8a815df084681f2f..5fb1e3cb98ffa425a6b37ae2f04e7b3943eeb48b 100644 (file)
@@ -440,9 +440,8 @@ read_a (st_parameter_dt *dtp, const fnode *f, char *p, int length)
   else
     read_default_char1 (dtp, p, length, w);
 
-  dtp->u.p.sf_read_comma = 1;
-  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-    dtp->u.p.sf_read_comma = dtp->u.p.decimal_status == DECIMAL_COMMA ? 0 : 1;
+  dtp->u.p.sf_read_comma =
+    dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA ? 0 : 1;
 }
 
 
@@ -468,9 +467,8 @@ read_a_char4 (st_parameter_dt *dtp, const fnode *f, char *p, int length)
   else
     read_default_char4 (dtp, p, length, w);
   
-  dtp->u.p.sf_read_comma = 1;
-  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-    dtp->u.p.sf_read_comma = dtp->u.p.decimal_status == DECIMAL_COMMA ? 0 : 1;
+  dtp->u.p.sf_read_comma =
+    dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA ? 0 : 1;
 }
 
 /* eat_leading_spaces()-- Given a character pointer and a width,
@@ -842,9 +840,9 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
       switch (*p)
        {
        case ',':
-         if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
-             && (dtp->u.p.decimal_status == DECIMAL_COMMA && *p == ','))
-               *p = '.';
+         if (dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA
+               && *p == ',')
+           *p = '.';
          else
            goto bad_float;
          /* Fall through */
@@ -1079,17 +1077,9 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 void
 read_x (st_parameter_dt * dtp, int n)
 {
-  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-    {
-      if ((dtp->u.p.pad_status == PAD_NO || is_internal_unit (dtp))
-         && dtp->u.p.current_unit->bytes_left < n)
-       n = dtp->u.p.current_unit->bytes_left;
-    }
-  else
-    {
-      if (is_internal_unit (dtp) && dtp->u.p.current_unit->bytes_left < n)
-       n = dtp->u.p.current_unit->bytes_left;
-    }
+  if ((dtp->u.p.current_unit->pad_status == PAD_NO || is_internal_unit (dtp))
+       && dtp->u.p.current_unit->bytes_left < n)
+    n = dtp->u.p.current_unit->bytes_left;
 
   dtp->u.p.sf_read_comma = 0;
   if (n > 0)
index e707fbc510e41db6fec65f8a10ae42d97739e5a9..cf93a286f981c63fb4eec7103b246e0d09388650 100644 (file)
@@ -264,8 +264,7 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
          /* Without padding, terminate the I/O statement without assigning
             the value.  With padding, the value still needs to be assigned,
             so we can just continue with a short read.  */
-         if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
-             && dtp->u.p.pad_status == PAD_NO)
+         if (dtp->u.p.current_unit->pad_status == PAD_NO)
            {
              if (no_error)
                break;
@@ -333,8 +332,7 @@ read_block_form (st_parameter_dt *dtp, void *buf, size_t *nbytes)
             dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
          else
            {
-             if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
-                 && dtp->u.p.pad_status == PAD_NO)
+             if (dtp->u.p.current_unit->pad_status == PAD_NO)
                {
                  /* Not enough data left.  */
                  generate_error (&dtp->common, LIBERROR_EOR, NULL);
@@ -381,8 +379,7 @@ read_block_form (st_parameter_dt *dtp, void *buf, size_t *nbytes)
 
   if (nread != *nbytes)
     {                          /* Short read, this shouldn't happen.  */
-      if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
-         && dtp->u.p.pad_status == PAD_YES)
+      if (dtp->u.p.current_unit->pad_status == PAD_YES)
        *nbytes = nread;
       else
        {
@@ -953,10 +950,8 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
   /* Set this flag so that commas in reads cause the read to complete before
      the entire field has been read.  The next read field will start right after
      the comma in the stream.  (Set to 0 for character reads).  */
-  dtp->u.p.sf_read_comma = 1;
-
-  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-    dtp->u.p.sf_read_comma = dtp->u.p.decimal_status == DECIMAL_COMMA ? 0 : 1;
+  dtp->u.p.sf_read_comma =
+    dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA ? 0 : 1;
 
   dtp->u.p.line_buffer = scratch;
 
@@ -1375,12 +1370,12 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
 
        case FMT_DC:
          consume_data_flag = 0;
-         dtp->u.p.decimal_status = DECIMAL_COMMA;
+         dtp->u.p.current_unit->decimal_status = DECIMAL_COMMA;
          break;
 
        case FMT_DP:
          consume_data_flag = 0;
-         dtp->u.p.decimal_status = DECIMAL_POINT;
+         dtp->u.p.current_unit->decimal_status = DECIMAL_POINT;
          break;
 
        case FMT_P:
@@ -2073,57 +2068,52 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
   if (dtp->u.p.advance_status == ADVANCE_UNSPECIFIED)
     dtp->u.p.advance_status = ADVANCE_YES;
 
-  /* To maintain ABI check these only if we have the F2003 flag set.  */
-  if(cf & IOPARM_DT_HAS_F2003)
-    {
-      /* Check the decimal mode.  */
-      dtp->u.p.decimal_status
+  /* Check the decimal mode.  */
+  dtp->u.p.current_unit->decimal_status
        = !(cf & IOPARM_DT_HAS_DECIMAL) ? DECIMAL_UNSPECIFIED :
          find_option (&dtp->common, dtp->u.p.decimal, dtp->u.p.decimal_len,
                        decimal_opt, "Bad DECIMAL parameter in data transfer "
                        "statement");
 
-      if (dtp->u.p.decimal_status == DECIMAL_UNSPECIFIED)
-       dtp->u.p.decimal_status = dtp->u.p.current_unit->flags.decimal;
+  if (dtp->u.p.current_unit->decimal_status == DECIMAL_UNSPECIFIED)
+       dtp->u.p.current_unit->decimal_status = dtp->u.p.current_unit->flags.decimal;
 
-      /* Check the sign mode. */
-      dtp->u.p.sign_status
+  /* Check the sign mode. */
+  dtp->u.p.sign_status
        = !(cf & IOPARM_DT_HAS_SIGN) ? SIGN_UNSPECIFIED :
          find_option (&dtp->common, dtp->u.p.sign, dtp->u.p.sign_len, sign_opt,
                        "Bad SIGN parameter in data transfer statement");
   
-      if (dtp->u.p.sign_status == SIGN_UNSPECIFIED)
+  if (dtp->u.p.sign_status == SIGN_UNSPECIFIED)
        dtp->u.p.sign_status = dtp->u.p.current_unit->flags.sign;
 
-      /* Check the blank mode.  */
-      dtp->u.p.blank_status
+  /* Check the blank mode.  */
+  dtp->u.p.blank_status
        = !(cf & IOPARM_DT_HAS_BLANK) ? BLANK_UNSPECIFIED :
          find_option (&dtp->common, dtp->u.p.blank, dtp->u.p.blank_len,
                        blank_opt,
                        "Bad BLANK parameter in data transfer statement");
   
-      if (dtp->u.p.blank_status == BLANK_UNSPECIFIED)
+  if (dtp->u.p.blank_status == BLANK_UNSPECIFIED)
        dtp->u.p.blank_status = dtp->u.p.current_unit->flags.blank;
   
-      /* Check the delim mode.  */
-      dtp->u.p.delim_status
+  /* Check the delim mode.  */
+  dtp->u.p.current_unit->delim_status
        = !(cf & IOPARM_DT_HAS_DELIM) ? DELIM_UNSPECIFIED :
          find_option (&dtp->common, dtp->u.p.delim, dtp->u.p.delim_len,
-                       delim_opt,
-                       "Bad DELIM parameter in data transfer statement");
+         delim_opt, "Bad DELIM parameter in data transfer statement");
   
-      if (dtp->u.p.delim_status == DELIM_UNSPECIFIED)
-       dtp->u.p.delim_status = dtp->u.p.current_unit->flags.delim;
+  if (dtp->u.p.current_unit->delim_status == DELIM_UNSPECIFIED)
+    dtp->u.p.current_unit->delim_status = dtp->u.p.current_unit->flags.delim;
 
-      /* Check the pad mode.  */
-      dtp->u.p.pad_status
+  /* Check the pad mode.  */
+  dtp->u.p.current_unit->pad_status
        = !(cf & IOPARM_DT_HAS_PAD) ? PAD_UNSPECIFIED :
          find_option (&dtp->common, dtp->u.p.pad, dtp->u.p.pad_len, pad_opt,
                        "Bad PAD parameter in data transfer statement");
   
-      if (dtp->u.p.pad_status == PAD_UNSPECIFIED)
-       dtp->u.p.pad_status = dtp->u.p.current_unit->flags.pad;
-    }
+  if (dtp->u.p.current_unit->pad_status == PAD_UNSPECIFIED)
+       dtp->u.p.current_unit->pad_status = dtp->u.p.current_unit->flags.pad;
 
   /* Sanity checks on the record number.  */
   if ((cf & IOPARM_DT_HAS_REC) != 0)
index 121a9b19f2ea80e3a84650d20e071fdc5c071509..020f473da7ff5e07326443769570913ef3ba50a7 100644 (file)
@@ -65,9 +65,7 @@ write_default_char4 (st_parameter_dt *dtp, gfc_char4_t *source,
     }
 
   /* Get ready to handle delimiters if needed.  */
-  d = ' ';
-  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-  switch (dtp->u.p.delim_status)
+  switch (dtp->u.p.current_unit->delim_status)
     {
     case DELIM_APOSTROPHE:
       d = '\'';
@@ -129,9 +127,7 @@ write_utf8_char4 (st_parameter_dt *dtp, gfc_char4_t *source,
     }
 
   /* Get ready to handle delimiters if needed.  */
-  d = ' ';
-  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-  switch (dtp->u.p.delim_status)
+  switch (dtp->u.p.current_unit->delim_status)
     {
     case DELIM_APOSTROPHE:
       d = '\'';
@@ -882,9 +878,7 @@ write_character (st_parameter_dt *dtp, const char *source, int kind, int length)
   int i, extra;
   char *p, d;
 
-  d = ' ';
-  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-  switch (dtp->u.p.delim_status)
+  switch (dtp->u.p.current_unit->delim_status)
     {
     case DELIM_APOSTROPHE:
       d = '\'';
@@ -1022,10 +1016,8 @@ write_real_g0 (st_parameter_dt *dtp, const char *source, int length, int d)
 static void
 write_complex (st_parameter_dt *dtp, const char *source, int kind, size_t size)
 {
-  char semi_comma = ',';
-
-  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-    semi_comma = dtp->u.p.decimal_status == DECIMAL_POINT ? ',' : ';';
+  char semi_comma =
+       dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? ',' : ';';
 
   if (write_char (dtp, '('))
     return;
@@ -1072,17 +1064,9 @@ list_formatted_write_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
     }
   else
     {
-      if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-       {
-         if (type != BT_CHARACTER || !dtp->u.p.char_flag ||
-             dtp->u.p.delim_status != DELIM_NONE)
-           write_separator (dtp);
-       }
-      else
-       {
-          if (type != BT_CHARACTER || !dtp->u.p.char_flag)
-           write_separator (dtp);
-       }
+      if (type != BT_CHARACTER || !dtp->u.p.char_flag ||
+       dtp->u.p.current_unit->delim_status != DELIM_NONE)
+      write_separator (dtp);
     }
 
   switch (type)
@@ -1197,10 +1181,8 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
   /* Set the character to be used to separate values
      to a comma or semi-colon.  */
 
-  char semi_comma = ',';
-
-  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-    semi_comma = dtp->u.p.decimal_status == DECIMAL_POINT ? ',' : ';';
+  char semi_comma =
+       dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? ',' : ';';
 
   /* Write namelist variable names in upper case. If a derived type,
      nothing is output.  If a component, base and base_name are set.  */
@@ -1315,25 +1297,20 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
               break;
 
            case GFC_DTYPE_CHARACTER:
-             if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-               {
-                 tmp_delim = dtp->u.p.delim_status;
-                 if (dtp->u.p.nml_delim == '"')
-                   dtp->u.p.delim_status = DELIM_QUOTE;
-                 if (dtp->u.p.nml_delim == '\'')
-                   dtp->u.p.delim_status = DELIM_APOSTROPHE;
-                 write_character (dtp, p, 1, obj->string_length);
-                 dtp->u.p.delim_status = tmp_delim;
-               }
-             else
-               write_character (dtp, p, 1, obj->string_length);
+             tmp_delim = dtp->u.p.current_unit->delim_status;
+             if (dtp->u.p.nml_delim == '"')
+               dtp->u.p.current_unit->delim_status = DELIM_QUOTE;
+             if (dtp->u.p.nml_delim == '\'')
+               dtp->u.p.current_unit->delim_status = DELIM_APOSTROPHE;
+             write_character (dtp, p, 1, obj->string_length);
+               dtp->u.p.current_unit->delim_status = tmp_delim;
               break;
 
            case GFC_DTYPE_REAL:
              write_real (dtp, p, len);
               break;
 
-           case GFC_DTYPE_COMPLEX:
+          case GFC_DTYPE_COMPLEX:
              dtp->u.p.no_leading_blank = 0;
              num++;
               write_complex (dtp, p, len, obj_size);
@@ -1464,9 +1441,7 @@ namelist_write (st_parameter_dt *dtp)
   unit_delim tmp_delim = DELIM_UNSPECIFIED;
 
   /* Set the delimiter for namelist output.  */
-if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-  {
-  tmp_delim = dtp->u.p.delim_status;
+  tmp_delim = dtp->u.p.current_unit->delim_status;
   switch (tmp_delim)
     {
     case (DELIM_QUOTE):
@@ -1483,8 +1458,8 @@ if (dtp->common.flags & IOPARM_DT_HAS_F2003)
     }
 
   /* Temporarily disable namelist delimters.  */
-  dtp->u.p.delim_status = DELIM_NONE;
-  }
+  dtp->u.p.current_unit->delim_status = DELIM_NONE;
+
   write_character (dtp, "&", 1, 1);
 
   /* Write namelist name in upper case - f95 std.  */
@@ -1507,8 +1482,7 @@ if (dtp->common.flags & IOPARM_DT_HAS_F2003)
   write_character (dtp, "  /", 1, 3);
   namelist_write_newline (dtp);
   /* Restore the original delimiter.  */
-  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-    dtp->u.p.delim_status = tmp_delim;
+  dtp->u.p.current_unit->delim_status = tmp_delim;
 }
 
 #undef NML_DIGITS
index d51c8ed7f525d6d9919561027b166e3c299492bb..0ee8f3560c4373d914caf8d3862c980826e02c6a 100644 (file)
@@ -404,10 +404,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
       out += nbefore;
     }
   /* Output the decimal point.  */
-  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-    *(out++) = dtp->u.p.decimal_status == DECIMAL_POINT ? '.' : ',';
-  else
-    *(out++) = '.';
+  *(out++) = dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? '.' : ',';
 
   /* Output leading zeros after the decimal point.  */
   if (nzero > 0)