PR fortran/25829 28655

2008-04-05  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/25829 28655
	* gfortran.map: Add new symbol, _gfortran_st_wait.
	* libgfortran.h (st_paramter_common): Add new I/O parameters.
	* open.c (st_option decimal_opt[], st_option encoding_opt[],
	st_option round_opt[], st_option sign_opt[], st_option async_opt[]): New
	parameter option arrays. (edit_modes): Add checks for new parameters.
	(new_unit): Likewise. (st_open): Likewise.
	* list_read.c (CASE_SEPERATORS): Add ';' as a valid separator.
	(eat_separator): Handle deimal comma. (read_logical): Fix whitespace.
	(parse_real): Handle decimal comma. (read_real): Handle decimal comma.
	* read.c (read_a): Use decimal status flag to allow comma in place of a
	decimal point. (read_f): Allow comma as acceptable character in float.
	According to decimal flag, substitute a period for a comma.
	(read_x): If decimal status flag is comma, disable the read_comma flag,
	not allowing comma as a delimiter, an extension otherwise.
	* io.h: (unit_decimal, unit_encoding, unit_round, unit_sign,
	unit_async): New enumerators. Add all new I/O parameters.
	* unix.c (unix_stream, int_stream): Add io_mode	asychronous I/O	control.
	(move_pos_offset, fd_alloc_w_at): Fix some whitespace.
	(fd_sfree): Use new enumerator. (fd_read): Likewise.
	(fd_write): Likewise. (fd_close): Fix whitespace.
	(fd_open): Use new enumertors. (tempfile, regular_file,
	open_external): Fix whitespace. (output_stream, error_stream): Set
	method. (stream_offset): Fix whitespace.
	* transfer.c: (st_option decimal_opt[], sign_opt[], blank_opt[]): New
	option arrays. 	(formatted_transfer_scalar): Set sf_read_comma flag
	based on new decimal_status flag. (data_transfer_init): Initialize new
	parameters. Add checks for decimal, sign, and blank. (st_wait): New stub.
	* format.c: (format_lex): Add format specifiers DP, DC, and D.
	(parse_format_list): Parse the new specifiers.
	* write.c (write_decimal): Use new sign enumerators to set the sign.
	(write_complex): Handle decimal comma and semi-colon separator.
	(nml_write_obj): Likewise.
	* write_float.def: Revise sign enumerators. (calculate_sign): Use new
	sign enumerators. (output_float): Likewise. Use new decimal_status flag
	to set the decimal character to a point or a comma.

From-SVN: r133943

1 files changed, 141 insertions, 1 deletions

diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index 0a409ed..5259684 100644
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -1,6 +1,7 @@
-/* Copyright (C) 2002, 2003, 2004, 2005, 2007
+/* Copyright (C) 2002, 2003, 2004, 2005, 2007, 2008
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
+   F2003 I/O support contributed by Jerry DeLisle
 
 This file is part of the GNU Fortran 95 runtime library (libgfortran).
 
@@ -97,6 +98,39 @@ static const st_option pad_opt[] =
   { NULL, 0}
 };
 
+static const st_option decimal_opt[] =
+{
+  { "point", DECIMAL_POINT},
+  { "comma", DECIMAL_COMMA},
+  { NULL, 0}
+};
+
+static const st_option encoding_opt[] =
+{
+  { "utf-8", ENCODING_UTF8},
+  { "default", ENCODING_DEFAULT},
+  { NULL, 0}
+};
+
+static const st_option round_opt[] =
+{
+  { "up", ROUND_UP},
+  { "down", ROUND_DOWN},
+  { "zero", ROUND_ZERO},
+  { "nearest", ROUND_NEAREST},
+  { "compatible", ROUND_COMPATIBLE},
+  { "processor_defined", ROUND_PROCDEFINED},
+  { NULL, 0}
+};
+
+static const st_option sign_opt[] =
+{
+  { "plus", SIGN_PLUS},
+  { "suppress", SIGN_SUPPRESS},
+  { "processor_defined", SIGN_PROCDEFINED},
+  { NULL, 0}
+};
+
 static const st_option convert_opt[] =
 {
   { "native", GFC_CONVERT_NATIVE},
@@ -106,6 +140,12 @@ static const st_option convert_opt[] =
   { NULL, 0}
 };
 
+static const st_option async_opt[] =
+{
+  { "yes", ASYNC_YES},
+  { "no", ASYNC_NO},
+  { NULL, 0}
+};
 
 /* Given a unit, test to see if the file is positioned at the terminal
    point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE.
@@ -179,6 +219,26 @@ edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
 	generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
 			"PAD parameter conflicts with UNFORMATTED form in "
 			"OPEN statement");
+
+      if (flags->decimal != DECIMAL_UNSPECIFIED)
+	generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
+			"DECIMAL parameter conflicts with UNFORMATTED form in "
+			"OPEN statement");
+
+      if (flags->encoding != ENCODING_UNSPECIFIED)
+	generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
+			"ENCODING parameter conflicts with UNFORMATTED form in "
+			"OPEN statement");
+
+      if (flags->round != ROUND_UNSPECIFIED)
+	generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
+			"ROUND parameter conflicts with UNFORMATTED form in "
+			"OPEN statement");
+
+      if (flags->sign != SIGN_UNSPECIFIED)
+	generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
+			"SIGN parameter conflicts with UNFORMATTED form in "
+			"OPEN statement");
     }
 
   if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK)
@@ -190,6 +250,14 @@ edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
 	u->flags.delim = flags->delim;
       if (flags->pad != PAD_UNSPECIFIED)
 	u->flags.pad = flags->pad;
+      if (flags->decimal != DECIMAL_UNSPECIFIED)
+	u->flags.decimal = flags->decimal;
+      if (flags->encoding != ENCODING_UNSPECIFIED)
+	u->flags.encoding = flags->encoding;
+      if (flags->round != ROUND_UNSPECIFIED)
+	u->flags.round = flags->round;
+      if (flags->sign != SIGN_UNSPECIFIED)
+	u->flags.sign = flags->sign;
     }
 
   /* Reposition the file if necessary.  */
@@ -289,6 +357,62 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
 	}
     }
 
+  if (flags->decimal == DECIMAL_UNSPECIFIED)
+    flags->decimal = DECIMAL_POINT;
+  else
+    {
+      if (flags->form == FORM_UNFORMATTED)
+	{
+	  generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
+			  "DECIMAL parameter conflicts with UNFORMATTED form "
+			  "in OPEN statement");
+	  goto fail;
+	}
+    }
+
+  if (flags->encoding == ENCODING_UNSPECIFIED)
+    flags->encoding = ENCODING_DEFAULT;
+  else
+    {
+      if (flags->form == FORM_UNFORMATTED)
+	{
+	  generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
+			  "ENCODING parameter conflicts with UNFORMATTED form in "
+			  "OPEN statement");
+	  goto fail;
+	}
+    }
+
+  /* NB: the value for ROUND when it's not specified by the user does not
+         have to be PROCESSOR_DEFINED; the standard says that it is
+	 processor dependent, and requires that it is one of the
+	 possible value (see F2003, 9.4.5.13).  */
+  if (flags->round == ROUND_UNSPECIFIED)
+    flags->round = ROUND_PROCDEFINED;
+  else
+    {
+      if (flags->form == FORM_UNFORMATTED)
+	{
+	  generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
+			  "ROUND parameter conflicts with UNFORMATTED form in "
+			  "OPEN statement");
+	  goto fail;
+	}
+    }
+
+  if (flags->sign == SIGN_UNSPECIFIED)
+    flags->sign = SIGN_PROCDEFINED;
+  else
+    {
+      if (flags->form == FORM_UNFORMATTED)
+	{
+	  generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
+			  "SIGN parameter conflicts with UNFORMATTED form in "
+			  "OPEN statement");
+	  goto fail;
+	}
+    }
+
   if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT)
    {
      generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
@@ -607,6 +731,22 @@ st_open (st_parameter_open *opp)
     find_option (&opp->common, opp->pad, opp->pad_len,
 		 pad_opt, "Bad PAD parameter in OPEN statement");
 
+  flags.decimal = !(cf & IOPARM_OPEN_HAS_DECIMAL) ? DECIMAL_UNSPECIFIED :
+    find_option (&opp->common, opp->decimal, opp->decimal_len,
+		 decimal_opt, "Bad DECIMAL parameter in OPEN statement");
+
+  flags.encoding = !(cf & IOPARM_OPEN_HAS_ENCODING) ? ENCODING_UNSPECIFIED :
+    find_option (&opp->common, opp->encoding, opp->encoding_len,
+		 encoding_opt, "Bad ENCODING parameter in OPEN statement");
+
+  flags.round = !(cf & IOPARM_OPEN_HAS_ROUND) ? ROUND_UNSPECIFIED :
+    find_option (&opp->common, opp->round, opp->round_len,
+		 round_opt, "Bad ROUND parameter in OPEN statement");
+
+  flags.sign = !(cf & IOPARM_OPEN_HAS_SIGN) ? SIGN_UNSPECIFIED :
+    find_option (&opp->common, opp->sign, opp->sign_len,
+		 sign_opt, "Bad SIGN parameter in OPEN statement");
+
   flags.form = !(cf & IOPARM_OPEN_HAS_FORM) ? FORM_UNSPECIFIED :
     find_option (&opp->common, opp->form, opp->form_len,
 		 form_opt, "Bad FORM parameter in OPEN statement");