public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* Re: [patch, fortran]PR25829 Add support for F2003 I/O features
@ 2008-04-05 12:21 Tobias Burnus
  2008-04-05 16:30 ` Jerry DeLisle
  0 siblings, 1 reply; 19+ messages in thread
From: Tobias Burnus @ 2008-04-05 12:21 UTC (permalink / raw)
  To: Jerry DeLisle, fortran, gcc-patches

Hi Jerry,

> The patch is getting too big so i do not want to add any more until we
> get this in trunk,
> With that said, I have attached the latest patch and 7 new test cases.
> OK for trunk.

I think the patch is OK.

I added some more items below, but they can be fixed later.
(a), (b) and (c) are relatively simply, (d) needs more effort.
And (e) can be postponed or included in the (a) to (c) patch.

> I forgot a couple of things.  I still need to version the new symbol in
> gfortran,map and i still need to test for ABI breakage.  I will do this
> while the patch is being reviewed and report back here.

Thanks for remembering this.


a) First test case. The error message of sunf95 is clear and correct
(see C926) (it shows also another error message which is wrong...):

write(10,'(10f8.3)',  decimal="comma", id=j) a
                                          ^
"test.f90", Line = 13, Column = 43: ERROR: This ID= specifier requires
ASYNCHRONOUS='YES' specifier as well.

Expected: A correct test case and an error message
(Don't forget the asynchronous == 'Yes' check.)



b) The following is invalid as asynchronous= in data-transfer statements (!)
requires an initialization expression; see R913. (In OPEN it does not.)

character(len=10) :: a = 'No'
WRITE(*,*,asynchronous=a) ! invalid
END

The reason is to allow for a faster implemenation as this allows to
generate different code in the front end for READ/WRITE with
and without asynchronous.


c)   write(6,*,delim='quote') 'Hello'
Should print  "Hello"  (with quotes) and not Hello



d) INQUIRE has some problems (-> Follow up patch)


Not recognized:  asynchronous=str, decimal=str, encoding=str,
                 pending=<logical>, round=str, sign=str, size=<integer>

inquire(99,id=j)
-> not recognized, but also invalid without pending=<logical>

!-----------------------------------------------------------
implicit none
character(len=10) :: a,b,c,d,e,f
logical :: log
integer :: id,j
inquire(99,asynchronous=a,blank=b,decimal=c,encoding=d,id=id,pending=log, &
           round=E,sign=f,size=j)
print *, 'asynchronous=',a,'  blank=',b,'  decimal=',c,'  encoding=',d, &
         '  id=',id, '  pending=',log,'  round=',E,'  sign=',f,'
size=',j
! Expected: all strings 'UNDEFINED' and pending = .false.
END
!-----------------------------------------------------------



e) rounding edit decriptors (ru, rd, etc.) are not recognized by neither
the back nor the front end. Maybe one could recognize them and error out
with a not-implemented message?

Tobias

^ permalink raw reply	[flat|nested] 19+ messages in thread
* Re: [patch, fortran]PR25829 Add support for F2003 I/O features
@ 2008-04-01 21:10 Tobias Burnus
  2008-04-04  4:53 ` Jerry DeLisle
  0 siblings, 1 reply; 19+ messages in thread
From: Tobias Burnus @ 2008-04-01 21:10 UTC (permalink / raw)
  To: Jerry DeLisle, gcc-patches, fortran

> Please give it a spin and test if you can.  Any test cases people are
> willing to submit would be welcome.

DECIMAL="comma" does not work properly:

integer :: i
real :: a(10) = [ (i*1.3, i=1,10) ]
namelist /nm/ a
write(*,nml=nm,decimal='comma')
end

This should print
 &nm a = 1,3; 2,6; ...
but it prints:
 &nm a = 1,3, 2,6, ...

 * * *

The following program should print:
  1.3  4.0  5.0  5.0  7.0  0.0
but gfortran has:
  Fortran runtime error: Cannot match namelist object name

implicit none
integer :: i
real :: a(6) = 0.0
character(len=30) :: str = '&nm a = 1,3; 4, 5; 5; 7; /'
namelist /nm/ a
read(str,nml=nm,decimal='comma')
print *, a
end

 * * *

+      notify_std (&dtp->common, GFC_STD_F2003, "DC or DP descriptor "

Please use also in libgfortran the "Fortran 2003:" prefix.

 * * *

The patch looks otherwise OK. It would be great if some others could 
do some tests or code review as well. The code is too big to quickly
see whether everything is correct or whether checks are missing or ...

Tobias,
who is looking forward to the updated patch

^ permalink raw reply	[flat|nested] 19+ messages in thread
* Re: [patch, fortran]PR25829 Add support for F2003 I/O features
@ 2008-03-29 17:45 Tobias Burnus
  2008-03-29 19:57 ` Jerry DeLisle
  2008-04-01  4:31 ` Jerry DeLisle
  0 siblings, 2 replies; 19+ messages in thread
From: Tobias Burnus @ 2008-03-29 17:45 UTC (permalink / raw)
  To: Jerry DeLisle, fortran, gcc-patches

> - the matchers and checks for asynchronous, decimal, encoding,
> pending, round, sign, size, id for OPEN, READ, WRITE, and INQUIRE.
> - New WAIT statement.


Remarks regarding diagnostics in the front end
(Might go beyond your patch and might also regarding unimplemented
things.)

You should add checks which reject those with -std=f95: Both WAIT and
DECIMAL= etc. are accepted with -std=f95.

You should add checks for the arguments, the following is not rejected:
  write(99,asynchronous='yesS')
(They are checked for OPEN not for READ/WRITE)

The following is invalid. Asynchronous I/O is only allowed if io-unit is
a file-unit-number (C925):
  character(10) :: aa
  WRITE(aa,'(a)',asynchronous='yes')

The following is rejected because the ID= is not recognized:
   WRITE(99,asynchronous='no',id=j)
(It should be rejected since ID= is invalid for asynchronous='NO')

The following is invalid:
  WRITE(99,decimal="comma")
The reasons is that only formatted I/O (including namelists) are allowed
when DECIMAL=, BLANK= (blank is actually not recognized!), PAD=, SIGN=
or ROUND= appear. (C928).

For completeness:
  WRITE(99,'(a)',delim="zero")
this is rejected since DELIM= does not seem to be recognized, but the
example is also wrong: DELIM= is only valid for * or namelists.

> - implements the DECIMAL= feature.
It would be great if (e.g. in a follow up patch) you could also support
DP and DC:
  write(*,'(DP,e12.4,DC,e12.4)')  1.2, 1.3
(currently, they are already rejected by the front end)

> - implements a do nothing stub for the WAIT statement.
(The Fortran 2003 permits the use of synchronous I/O thus this is OK; but
it should be in the release notes. Unless, your full implementation is
almost ready to go in.)

I'm inclined to having encoding=, round=, size= rejected with a not-
implemented message (e.g. using sorry() of toplev.h or eith gfc_error).


The rest looked ok, though I have only skimmed over the libgfortran
part.


Tobias

^ permalink raw reply	[flat|nested] 19+ messages in thread
* [patch, fortran]PR25829 Add support for F2003 I/O features
@ 2008-03-16 21:48 Jerry DeLisle
  2008-03-16 22:03 ` FX Coudert
  0 siblings, 1 reply; 19+ messages in thread
From: Jerry DeLisle @ 2008-03-16 21:48 UTC (permalink / raw)
  To: Fortran List; +Cc: gcc-patches

[-- Attachment #1: Type: text/plain, Size: 5552 bytes --]

:ADDPATCH fortran:

This is a lengthy patch.  It was initiated by FX quite some time ago and I have 
have taken and advanced it to be useful.

I would like this to go into 4.4 branch for several reasons.

1. So we don't lose it and it is in sync with trunk.
2. It will allow others to see and augment this with any missing checks and 
features.
3. It will allow others to exercise and test it.
4. Get the configury magic figured out for using aio.h for systems that support 
it. (need help from others on this)

For the gfortran front end the patch implements:

- the matchers and checks for asynchronous, decimal, encoding, pending, round, 
sign, size, id for OPEN, READ, WRITE, and INQUIRE.
- New WAIT statement.

For the runtime library:

- implements a do nothing stub for the WAIT statement.  I plan another patch 
after this that will implement the actual asynchronous I/O.
- implements the DECIMAL= feature.
- Update the handling of sign.

Some very rough beginnings of test cases included.

Regression tested on x86-64.  OK for trunk after we get the configury stuff 
added for aio.h?

Jerry

2008-03-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
	    Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

	PR fortran/25829
	* dump-parse-tree.c (gfc_show_code_node): Show new I/O parameters.
	* gfortran.h (gfc_statement): Add ST_WAIT enumerator.
	(gfc_open): Add pointers for decimal, encoding, round, sign,
	asynchronous. (gfc_inquire): Add pointers for asynchronous, decimal,
	encoding, pending, round, sign, size, id.
	(gfc_wait): New typedef struct. (gfc_dt): Add pointers for id, pos,
	asynchronous, blank, decimal, delim, pad, round, sign.
	(gfc_exec_op): Add EXEC_WAIT enumerator. (gfc_code): Add pointer for
	wait. (gfc_free_wait), (gfc_resolve_wait): New function prototypes.
	* trans-stmt.h (gfc_trans_wait): New function prototype.
	* trans.c (gfc_trans_code): Add case for EXEC_WAIT.
	* io.c (io_tag): Add new tags for DECIMAL, ENCODING, ROUND, SIGN,
	ASYCHRONOUS, ID. (match_open_element): Add matchers for new tags.
	(gfc_free_open): Free new pointers. (gfc_resolve_open): Resolve new
	tags. (gfc_resolve_open): Remove comment around check for allowed
	values and ASYNCHRONOUS, update it.  Likewise for DECIMAL, ENCODING,
	ROUND, and SIGN. (match_dt_element): Add matching for new tags.
	(gfc_free_wait): New function. (gfc_resolve_wait): New function.
	(match_wait_element): New function. (gfc_match_wait): New function.
	* resolve.c (gfc_resolve_blocks): Add case for EXEC_WAIT.
	(resolve_code): Add case for EXEC_WAIT.
	* st.c (gfc_free_statement): Add case for EXEC_WAIT.
	* trans-io.c (ioparam_type): Add IOPARM_ptype_wait. (gfc_st_parameter):
	Add "wait" entry. (iocall): Add IOCALL_WAIT enumerator.
	(gfc_build_io_library_fndecls): Add function declaration for st_wait.
	(gfc_trans_open): Add mask bits for new I/O tags.
	(gfc_trans_inquire): Add mask bits for new I/O tags.
	(gfc_trans_wait): New translation function.
	(build_dt): Add mask bits for new I/O tags.
	* match.c (gfc_match_if) Add matcher for "wait".
	* match.h (gfc_match_wait): Prototype for new function.
	* ioparm.def: Add new I/O parameter definitions.
	* parse.c (decode_statement): Add match for "wait" statement.
	(next_statement): Add case for ST_WAIT. (gfc_ascii_statement): Same.
	* gfortran.map: Add symbol for _gfortran_st_wait.

2008-03-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
	    Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

	PR fortran/25829
	* 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 seprator.
	* 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: Include aio.h for future asynchronous support.
	(gfc_aio): New structure for tracking the aio control block.
	(io_mode): New enumerator for keeping track of whether we are doing
	the usual synchronous I/O or the new asychronous.
	(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 and pointer for
	asychronous I/O	control	structure.
	(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 and set paio pointer to NULL.
	(open_internal): Set paio pointer to NULL. (tempfile, regular_file,
	open_external): Fix whitespace. (output_stream, error_stream): Set
	method. (stream_offset): Fix whitespace.
	* transfer.c (st_option decimal_opt[]): New option array.
	(formatted_transfer_scalar): Set sf_read_comma flag based on new
	decimal_status flag. (data_transfer_init): Initialize new parameters.
	Add checks for decimal mode. (st_wait): Add new stub for WAIT.
	* write.c (write_decimal): Use new sign enumerators to set the sign.
	* 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.
	

[-- Attachment #2: f2003-io-RevC.diff --]
[-- Type: text/x-patch, Size: 55255 bytes --]

Index: gcc/fortran/dump-parse-tree.c
===================================================================
--- gcc/fortran/dump-parse-tree.c	(revision 133275)
+++ gcc/fortran/dump-parse-tree.c	(working copy)
@@ -1405,11 +1405,36 @@ gfc_show_code_node (int level, gfc_code 
 	  gfc_status (" PAD=");
 	  gfc_show_expr (open->pad);
 	}
+      if (open->decimal)
+	{
+	  gfc_status (" DECIMAL=");
+	  gfc_show_expr (open->decimal);
+	}
+      if (open->encoding)
+	{
+	  gfc_status (" ENCODING=");
+	  gfc_show_expr (open->encoding);
+	}
+      if (open->round)
+	{
+	  gfc_status (" ROUND=");
+	  gfc_show_expr (open->round);
+	}
+      if (open->sign)
+	{
+	  gfc_status (" SIGN=");
+	  gfc_show_expr (open->sign);
+	}
       if (open->convert)
 	{
 	  gfc_status (" CONVERT=");
 	  gfc_show_expr (open->convert);
 	}
+      if (open->asynchronous)
+	{
+	  gfc_status (" ASYNCHRONOUS=");
+	  gfc_show_expr (open->asynchronous);
+	}
       if (open->err != NULL)
 	gfc_status (" ERR=%d", open->err->value);
 
@@ -1616,6 +1641,46 @@ gfc_show_code_node (int level, gfc_code 
 	  gfc_status (" CONVERT=");
 	  gfc_show_expr (i->convert);
 	}
+      if (i->asynchronous)
+	{
+	  gfc_status (" ASYNCHRONOUS=");
+	  gfc_show_expr (i->asynchronous);
+	}
+      if (i->decimal)
+	{
+	  gfc_status (" DECIMAL=");
+	  gfc_show_expr (i->decimal);
+	}
+      if (i->encoding)
+	{
+	  gfc_status (" ENCODING=");
+	  gfc_show_expr (i->encoding);
+	}
+      if (i->pending)
+	{
+	  gfc_status (" PENDING=");
+	  gfc_show_expr (i->pending);
+	}
+      if (i->round)
+	{
+	  gfc_status (" ROUND=");
+	  gfc_show_expr (i->round);
+	}
+      if (i->sign)
+	{
+	  gfc_status (" SIGN=");
+	  gfc_show_expr (i->sign);
+	}
+      if (i->size)
+	{
+	  gfc_status (" SIZE=");
+	  gfc_show_expr (i->size);
+	}
+      if (i->id)
+	{
+	  gfc_status (" ID=");
+	  gfc_show_expr (i->id);
+	}
 
       if (i->err != NULL)
 	gfc_status (" ERR=%d", i->err->value);
@@ -1678,6 +1743,51 @@ gfc_show_code_node (int level, gfc_code 
 	  gfc_status (" ADVANCE=");
 	  gfc_show_expr (dt->advance);
 	}
+      if (dt->id)
+	{
+	  gfc_status (" ID=");
+	  gfc_show_expr (dt->id);
+	}
+      if (dt->pos)
+	{
+	  gfc_status (" POS=");
+	  gfc_show_expr (dt->pos);
+	}
+      if (dt->asynchronous)
+	{
+	  gfc_status (" ASYNCHRONOUS=");
+	  gfc_show_expr (dt->asynchronous);
+	}
+      if (dt->blank)
+	{
+	  gfc_status (" BLANK=");
+	  gfc_show_expr (dt->blank);
+	}
+      if (dt->decimal)
+	{
+	  gfc_status (" DECIMAL=");
+	  gfc_show_expr (dt->decimal);
+	}
+      if (dt->delim)
+	{
+	  gfc_status (" DELIM=");
+	  gfc_show_expr (dt->delim);
+	}
+      if (dt->pad)
+	{
+	  gfc_status (" PAD=");
+	  gfc_show_expr (dt->pad);
+	}
+      if (dt->round)
+	{
+	  gfc_status (" ROUND=");
+	  gfc_show_expr (dt->round);
+	}
+      if (dt->sign)
+	{
+	  gfc_status (" SIGN=");
+	  gfc_show_expr (dt->sign);
+	}
 
     show_dt_code:
       gfc_status_char ('\n');
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 133275)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -211,8 +211,8 @@ typedef enum
   ST_IF_BLOCK, ST_IMPLICIT, ST_IMPLICIT_NONE, ST_IMPORT, ST_INQUIRE, ST_INTERFACE,
   ST_PARAMETER, ST_MODULE, ST_MODULE_PROC, ST_NAMELIST, ST_NULLIFY, ST_OPEN,
   ST_PAUSE, ST_PRIVATE, ST_PROGRAM, ST_PUBLIC, ST_READ, ST_RETURN, ST_REWIND,
-  ST_STOP, ST_SUBROUTINE, ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, ST_WRITE,
-  ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE,
+  ST_STOP, ST_SUBROUTINE, ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, ST_WAIT, 
+  ST_WRITE, ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE,
   ST_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT,
   ST_ENUM, ST_ENUMERATOR, ST_END_ENUM,
   ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_CRITICAL,
@@ -1635,7 +1635,8 @@ gfc_alloc;
 typedef struct
 {
   gfc_expr *unit, *file, *status, *access, *form, *recl,
-    *blank, *position, *action, *delim, *pad, *iostat, *iomsg, *convert;
+    *blank, *position, *action, *delim, *pad, *iostat, *iomsg, *convert,
+    *decimal, *encoding, *round, *sign, *asynchronous;
   gfc_st_label *err;
 }
 gfc_open;
@@ -1662,7 +1663,8 @@ typedef struct
   gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named,
     *name, *access, *sequential, *direct, *form, *formatted,
     *unformatted, *recl, *nextrec, *blank, *position, *action, *read,
-    *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert, *strm_pos;
+    *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert, *strm_pos,
+    *asynchronous, *decimal, *encoding, *pending, *round, *sign, *size, *id;
 
   gfc_st_label *err;
 
@@ -1672,7 +1674,17 @@ gfc_inquire;
 
 typedef struct
 {
-  gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg;
+  gfc_expr *unit, *iostat, *iomsg, *id;
+  gfc_st_label *err, *end, *eor;
+}
+gfc_wait;
+
+
+typedef struct
+{
+  gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg,
+	   *id, *pos, *asynchronous, *blank, *decimal, *delim, *pad, *round,
+	   *sign;
 
   gfc_symbol *namelist;
   /* A format_label of `format_asterisk' indicates the "*" format */
@@ -1701,7 +1713,7 @@ typedef enum
   EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT,
   EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT,
   EXEC_ALLOCATE, EXEC_DEALLOCATE,
-  EXEC_OPEN, EXEC_CLOSE,
+  EXEC_OPEN, EXEC_CLOSE, EXEC_WAIT,
   EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
   EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH,
   EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
@@ -1738,6 +1750,7 @@ typedef struct gfc_code
     gfc_close *close;
     gfc_filepos *filepos;
     gfc_inquire *inquire;
+    gfc_wait *wait;
     gfc_dt *dt;
     gfc_forall_iterator *forall_iterator;
     struct gfc_code *whichloop;
@@ -2323,6 +2336,8 @@ void gfc_free_inquire (gfc_inquire *);
 try gfc_resolve_inquire (gfc_inquire *);
 void gfc_free_dt (gfc_dt *);
 try gfc_resolve_dt (gfc_dt *);
+void gfc_free_wait (gfc_wait *);
+try gfc_resolve_wait (gfc_wait *);
 
 /* module.c */
 void gfc_module_init_2 (void);
Index: gcc/fortran/trans-stmt.h
===================================================================
--- gcc/fortran/trans-stmt.h	(revision 133275)
+++ gcc/fortran/trans-stmt.h	(working copy)
@@ -69,3 +69,4 @@ tree gfc_trans_flush (gfc_code *);
 
 tree gfc_trans_transfer (gfc_code *);
 tree gfc_trans_dt_end (gfc_code *);
+tree gfc_trans_wait (gfc_code *);
Index: gcc/fortran/trans.c
===================================================================
--- gcc/fortran/trans.c	(revision 133275)
+++ gcc/fortran/trans.c	(working copy)
@@ -1108,6 +1108,10 @@ gfc_trans_code (gfc_code * code)
 	  res = gfc_trans_inquire (code);
 	  break;
 
+	case EXEC_WAIT:
+	  res = gfc_trans_wait (code);
+	  break;
+
 	case EXEC_REWIND:
 	  res = gfc_trans_rewind (code);
 	  break;
Index: gcc/fortran/io.c
===================================================================
--- gcc/fortran/io.c	(revision 133275)
+++ gcc/fortran/io.c	(working copy)
@@ -48,6 +48,10 @@ static const io_tag
 	tag_e_action	= {"ACTION", " action = %e", BT_CHARACTER},
 	tag_e_delim	= {"DELIM", " delim = %e", BT_CHARACTER},
 	tag_e_pad	= {"PAD", " pad = %e", BT_CHARACTER},
+	tag_e_decimal	= {"DECIMAL", " decimal = %e", BT_CHARACTER},
+	tag_e_encoding	= {"ENCODING", " encoding = %e", BT_CHARACTER},
+	tag_e_round	= {"ROUND", " round = %e", BT_CHARACTER},
+	tag_e_sign	= {"SIGN", " sign = %e", BT_CHARACTER},
 	tag_unit	= {"UNIT", " unit = %e", BT_INTEGER},
 	tag_advance	= {"ADVANCE", " advance = %e", BT_CHARACTER},
 	tag_rec		= {"REC", " rec = %e", BT_INTEGER},
@@ -82,7 +86,9 @@ static const io_tag
 	tag_strm_out    = {"POS", " pos = %v", BT_INTEGER},
 	tag_err		= {"ERR", " err = %l", BT_UNKNOWN},
 	tag_end		= {"END", " end = %l", BT_UNKNOWN},
-	tag_eor		= {"EOR", " eor = %l", BT_UNKNOWN};
+	tag_eor		= {"EOR", " eor = %l", BT_UNKNOWN},
+	tag_async	= {"ASYNCHRONOUS", " asynchronous = %e", BT_CHARACTER},
+	tag_id		= {"ID", " id = %e", BT_INTEGER};
 
 static gfc_dt *current_dt;
 
@@ -1224,6 +1230,9 @@ match_open_element (gfc_open *open)
 {
   match m;
 
+  m = match_etag (&tag_async, &open->asynchronous);
+  if (m != MATCH_NO)
+    return m;
   m = match_etag (&tag_unit, &open->unit);
   if (m != MATCH_NO)
     return m;
@@ -1263,6 +1272,18 @@ match_open_element (gfc_open *open)
   m = match_etag (&tag_e_pad, &open->pad);
   if (m != MATCH_NO)
     return m;
+  m = match_etag (&tag_e_decimal, &open->decimal);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_encoding, &open->encoding);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_round, &open->round);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_sign, &open->sign);
+  if (m != MATCH_NO)
+    return m;
   m = match_ltag (&tag_err, &open->err);
   if (m != MATCH_NO)
     return m;
@@ -1295,6 +1316,10 @@ gfc_free_open (gfc_open *open)
   gfc_free_expr (open->action);
   gfc_free_expr (open->delim);
   gfc_free_expr (open->pad);
+  gfc_free_expr (open->decimal);
+  gfc_free_expr (open->encoding);
+  gfc_free_expr (open->round);
+  gfc_free_expr (open->sign);
   gfc_free_expr (open->convert);
   gfc_free (open);
 }
@@ -1319,6 +1344,10 @@ gfc_resolve_open (gfc_open *open)
   RESOLVE_TAG (&tag_e_action, open->action);
   RESOLVE_TAG (&tag_e_delim, open->delim);
   RESOLVE_TAG (&tag_e_pad, open->pad);
+  RESOLVE_TAG (&tag_e_decimal, open->sign);
+  RESOLVE_TAG (&tag_e_encoding, open->round);
+  RESOLVE_TAG (&tag_e_round, open->encoding);
+  RESOLVE_TAG (&tag_e_sign, open->decimal);
   RESOLVE_TAG (&tag_convert, open->convert);
 
   if (gfc_reference_st_label (open->err, ST_LABEL_TARGET) == FAILURE)
@@ -1501,17 +1530,15 @@ gfc_match_open (void)
     }
 
   /* Checks on the ASYNCHRONOUS specifier.  */
-  /* TODO: code is ready, just needs uncommenting when async I/O support
-     is added ;-)
   if (open->asynchronous && open->asynchronous->expr_type == EXPR_CONSTANT)
     {
       static const char * asynchronous[] = { "YES", "NO", NULL };
 
       if (!compare_to_allowed_values
-		("action", asynchronous, NULL, NULL,
+		("ASYNCHRONOUS", asynchronous, NULL, NULL,
 		 open->asynchronous->value.character.string, "OPEN", warn))
 	goto cleanup;
-    }*/
+    }
   
   /* Checks on the BLANK specifier.  */
   if (open->blank && open->blank->expr_type == EXPR_CONSTANT)
@@ -1525,7 +1552,6 @@ gfc_match_open (void)
     }
 
   /* Checks on the DECIMAL specifier.  */
-  /* TODO: uncomment this code when DECIMAL support is added 
   if (open->decimal && open->decimal->expr_type == EXPR_CONSTANT)
     {
       static const char * decimal[] = { "COMMA", "POINT", NULL };
@@ -1534,7 +1560,7 @@ gfc_match_open (void)
 				      open->decimal->value.character.string,
 				      "OPEN", warn))
 	goto cleanup;
-    } */
+    }
 
   /* Checks on the DELIM specifier.  */
   if (open->delim && open->delim->expr_type == EXPR_CONSTANT)
@@ -1548,7 +1574,6 @@ gfc_match_open (void)
     }
 
   /* Checks on the ENCODING specifier.  */
-  /* TODO: uncomment this code when ENCODING support is added 
   if (open->encoding && open->encoding->expr_type == EXPR_CONSTANT)
     {
       static const char * encoding[] = { "UTF-8", "DEFAULT", NULL };
@@ -1557,7 +1582,7 @@ gfc_match_open (void)
 				      open->encoding->value.character.string,
 				      "OPEN", warn))
 	goto cleanup;
-    } */
+    }
 
   /* Checks on the FORM specifier.  */
   if (open->form && open->form->expr_type == EXPR_CONSTANT)
@@ -1593,7 +1618,6 @@ gfc_match_open (void)
     }
 
   /* Checks on the ROUND specifier.  */
-  /* TODO: uncomment this code when ROUND support is added 
   if (open->round && open->round->expr_type == EXPR_CONSTANT)
     {
       static const char * round[] = { "UP", "DOWN", "ZERO", "NEAREST",
@@ -1603,10 +1627,9 @@ gfc_match_open (void)
 				      open->round->value.character.string,
 				      "OPEN", warn))
 	goto cleanup;
-    } */
+    }
 
   /* Checks on the SIGN specifier.  */
-  /* TODO: uncomment this code when SIGN support is added 
   if (open->sign && open->sign->expr_type == EXPR_CONSTANT)
     {
       static const char * sign[] = { "PLUS", "SUPPRESS", "PROCESSOR_DEFINED",
@@ -1616,7 +1639,7 @@ gfc_match_open (void)
 				      open->sign->value.character.string,
 				      "OPEN", warn))
 	goto cleanup;
-    } */
+    }
 
 #define warn_or_error(...) \
 { \
@@ -1674,11 +1697,8 @@ gfc_match_open (void)
 
   /* Things that are not allowed for unformatted I/O.  */
   if (open->form && open->form->expr_type == EXPR_CONSTANT
-      && (open->delim
-	  /* TODO uncomment this code when F2003 support is finished */
-	  /* || open->decimal || open->encoding || open->round
-	     || open->sign */
-	  || open->pad || open->blank)
+      && (open->delim || open->decimal || open->encoding || open->round
+	  || open->sign || open->pad || open->blank)
       && strncasecmp (open->form->value.character.string,
 		      "unformatted", 11) == 0)
     {
@@ -2203,6 +2223,12 @@ match_dt_element (io_kind k, gfc_dt *dt)
       return MATCH_YES;
     }
 
+  m = match_etag (&tag_async, &dt->asynchronous);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_decimal, &dt->decimal);
+  if (m != MATCH_NO)
+    return m;
   m = match_etag (&tag_rec, &dt->rec);
   if (m != MATCH_NO)
     return m;
@@ -3025,12 +3051,14 @@ gfc_match_read (void)
   return match_io (M_READ);
 }
 
+
 match
 gfc_match_write (void)
 {
   return match_io (M_WRITE);
 }
 
+
 match
 gfc_match_print (void)
 {
@@ -3289,3 +3317,116 @@ gfc_resolve_inquire (gfc_inquire *inquir
 
   return SUCCESS;
 }
+
+
+void
+gfc_free_wait (gfc_wait *wait)
+{
+  if (wait == NULL)
+    return;
+
+  gfc_free_expr (wait->unit);
+  gfc_free_expr (wait->iostat);
+  gfc_free_expr (wait->iomsg);
+  gfc_free_expr (wait->id);
+}
+
+
+try
+gfc_resolve_wait (gfc_wait *wait)
+{
+  RESOLVE_TAG (&tag_unit, wait->unit);
+  RESOLVE_TAG (&tag_iomsg, wait->iomsg);
+  RESOLVE_TAG (&tag_iostat, wait->iostat);
+  RESOLVE_TAG (&tag_id, wait->id);
+
+  if (gfc_reference_st_label (wait->err, ST_LABEL_TARGET) == FAILURE)
+    return FAILURE;
+  
+  if (gfc_reference_st_label (wait->end, ST_LABEL_TARGET) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+/* Match an element of a WAIT statement.  */
+
+#define RETM   if (m != MATCH_NO) return m;
+
+static match
+match_wait_element (gfc_wait *wait)
+{
+  match m;
+
+  m = match_etag (&tag_unit, &wait->unit);
+  RETM m = match_ltag (&tag_err, &wait->err);
+  RETM m = match_ltag (&tag_end, &wait->eor);
+  RETM m = match_ltag (&tag_eor, &wait->end);
+  RETM m = match_out_tag (&tag_iomsg, &wait->iomsg);
+  RETM m = match_out_tag (&tag_iostat, &wait->iostat);
+  RETM m = match_etag (&tag_id, &wait->id);
+  RETM return MATCH_NO;
+}
+
+#undef RETM
+
+
+match
+gfc_match_wait (void)
+{
+  gfc_wait *wait;
+  match m;
+  locus loc;
+
+  m = gfc_match_char ('(');
+  if (m == MATCH_NO)
+    return m;
+
+  wait = gfc_getmem (sizeof (gfc_wait));
+
+  loc = gfc_current_locus;
+
+  m = match_wait_element (wait);
+  if (m == MATCH_ERROR)
+    goto cleanup;
+  if (m == MATCH_NO)
+    {
+      m = gfc_match_expr (&wait->unit);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+    }
+
+  for (;;)
+    {
+      if (gfc_match_char (')') == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+
+      m = match_wait_element (wait);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+    }
+
+  if (gfc_pure (NULL))
+    {
+      gfc_error ("WAIT statement not allowed in PURE procedure at %C");
+      return MATCH_ERROR;
+    }
+
+  new_st.op = EXEC_WAIT;
+  new_st.ext.wait = wait;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_WAIT);
+
+cleanup:
+  gfc_free_wait (wait);
+  return MATCH_ERROR;
+}
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 133275)
+++ gcc/fortran/resolve.c	(working copy)
@@ -5997,6 +5997,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_nam
 	case EXEC_READ:
 	case EXEC_WRITE:
 	case EXEC_IOLENGTH:
+	case EXEC_WAIT:
 	  break;
 
 	case EXEC_OMP_ATOMIC:
@@ -6406,6 +6407,15 @@ resolve_code (gfc_code *code, gfc_namesp
 	  resolve_branch (code->ext.inquire->err, code);
 	  break;
 
+	case EXEC_WAIT:
+	  if (gfc_resolve_wait (code->ext.wait) == FAILURE)
+	    break;
+
+	  resolve_branch (code->ext.wait->err, code);
+	  resolve_branch (code->ext.wait->end, code);
+	  resolve_branch (code->ext.wait->eor, code);
+	  break;
+
 	case EXEC_READ:
 	case EXEC_WRITE:
 	  if (gfc_resolve_dt (code->ext.dt) == FAILURE)
Index: gcc/fortran/st.c
===================================================================
--- gcc/fortran/st.c	(revision 133275)
+++ gcc/fortran/st.c	(working copy)
@@ -146,6 +146,10 @@ gfc_free_statement (gfc_code *p)
       gfc_free_inquire (p->ext.inquire);
       break;
 
+    case EXEC_WAIT:
+      gfc_free_wait (p->ext.wait);
+      break;
+
     case EXEC_READ:
     case EXEC_WRITE:
       gfc_free_dt (p->ext.dt);
Index: gcc/fortran/trans-io.c
===================================================================
--- gcc/fortran/trans-io.c	(revision 133275)
+++ gcc/fortran/trans-io.c	(working copy)
@@ -45,6 +45,7 @@ enum ioparam_type
   IOPARM_ptype_filepos,
   IOPARM_ptype_inquire,
   IOPARM_ptype_dt,
+  IOPARM_ptype_wait,
   IOPARM_ptype_num
 };
 
@@ -96,7 +97,8 @@ static GTY(()) gfc_st_parameter st_param
   { "close", NULL },
   { "filepos", NULL },
   { "inquire", NULL },
-  { "dt", NULL }
+  { "dt", NULL },
+  { "wait", NULL }
 };
 
 static GTY(()) gfc_st_parameter_field st_parameter_field[] =
@@ -133,6 +135,7 @@ enum iocall
   IOCALL_FLUSH,
   IOCALL_SET_NML_VAL,
   IOCALL_SET_NML_VAL_DIM,
+  IOCALL_WAIT,
   IOCALL_NUM
 };
 
@@ -372,6 +375,11 @@ gfc_build_io_library_fndecls (void)
     gfc_build_library_function_decl(get_identifier (PREFIX("st_iolength")),
 				    void_type_node, 1, dt_parm_type);
 
+  parm_type = build_pointer_type (st_parameter[IOPARM_ptype_wait].type);
+  iocall[IOCALL_WAIT] =
+    gfc_build_library_function_decl (get_identifier (PREFIX("st_wait")),
+				     gfc_int4_type_node, 1, parm_type);
+
   parm_type = build_pointer_type (st_parameter[IOPARM_ptype_filepos].type);
   iocall[IOCALL_REWIND] =
     gfc_build_library_function_decl (get_identifier (PREFIX("st_rewind")),
@@ -921,6 +929,24 @@ gfc_trans_open (gfc_code * code)
   if (p->pad)
     mask |= set_string (&block, &post_block, var, IOPARM_open_pad, p->pad);
 
+  if (p->decimal)
+    mask |= set_string (&block, &post_block, var, IOPARM_open_decimal,
+			p->decimal);
+
+  if (p->encoding)
+    mask |= set_string (&block, &post_block, var, IOPARM_open_encoding,
+			p->encoding);
+
+  if (p->round)
+    mask |= set_string (&block, &post_block, var, IOPARM_open_round, p->round);
+
+  if (p->sign)
+    mask |= set_string (&block, &post_block, var, IOPARM_open_sign, p->sign);
+
+  if (p->asynchronous)
+    mask |= set_string (&block, &post_block, var, IOPARM_open_asynchronous,
+			p->asynchronous);
+
   if (p->convert)
     mask |= set_string (&block, &post_block, var, IOPARM_open_convert,
 			p->convert);
@@ -1117,7 +1143,7 @@ gfc_trans_inquire (gfc_code * code)
   stmtblock_t block, post_block;
   gfc_inquire *p;
   tree tmp, var;
-  unsigned int mask = 0;
+  unsigned int mask = 0, mask2 = 0;
 
   gfc_start_block (&block);
   gfc_init_block (&post_block);
@@ -1248,6 +1274,43 @@ gfc_trans_inquire (gfc_code * code)
     mask |= set_parameter_ref (&block, &post_block, var,
 			       IOPARM_inquire_strm_pos_out, p->strm_pos);
 
+  /* The second series of flags.  */
+  if (p->asynchronous)
+    mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_asynchronous,
+			 p->asynchronous);
+
+  if (p->decimal)
+    mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_decimal,
+			 p->decimal);
+
+  if (p->encoding)
+    mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_encoding,
+			 p->encoding);
+
+  if (p->round)
+    mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_round,
+			 p->round);
+
+  if (p->sign)
+    mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_sign,
+			 p->sign);
+
+  if (p->pending)
+    mask2 |= set_parameter_ref (&block, &post_block, var,
+				IOPARM_inquire_pending, p->pending);
+
+  if (p->size)
+    mask2 |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_size,
+				p->size);
+
+  if (p->id)
+    mask2 |= set_parameter_value (&block, var, IOPARM_inquire_id, p->id);
+
+  set_parameter_const (&block, var, IOPARM_inquire_flags2, mask2);
+
+  if (mask2)
+    mask |= IOPARM_inquire_flags2;
+
   set_parameter_const (&block, var, IOPARM_common_flags, mask);
 
   if (p->unit)
@@ -1266,6 +1329,56 @@ gfc_trans_inquire (gfc_code * code)
   return gfc_finish_block (&block);
 }
 
+
+tree
+gfc_trans_wait (gfc_code * code)
+{
+  stmtblock_t block, post_block;
+  gfc_wait *p;
+  tree tmp, var;
+  unsigned int mask = 0;
+
+  gfc_start_block (&block);
+  gfc_init_block (&post_block);
+
+  var = gfc_create_var (st_parameter[IOPARM_ptype_wait].type,
+			"wait_parm");
+
+  set_error_locus (&block, var, &code->loc);
+  p = code->ext.wait;
+
+  /* Set parameters here.  */
+  if (p->iomsg)
+    mask |= set_string (&block, &post_block, var, IOPARM_common_iomsg,
+			p->iomsg);
+
+  if (p->iostat)
+    mask |= set_parameter_ref (&block, &post_block, var, IOPARM_common_iostat,
+			       p->iostat);
+
+  if (p->err)
+    mask |= IOPARM_common_err;
+
+  if (p->id)
+    mask |= set_parameter_value (&block, var, IOPARM_wait_id, p->id);
+
+  set_parameter_const (&block, var, IOPARM_common_flags, mask);
+
+  if (p->unit)
+    set_parameter_value (&block, var, IOPARM_common_unit, p->unit);
+
+  tmp = build_fold_addr_expr (var);
+  tmp = build_call_expr (iocall[IOCALL_WAIT], 1, tmp);
+  gfc_add_expr_to_block (&block, tmp);
+
+  gfc_add_block_to_block (&block, &post_block);
+
+  io_result (&block, var, p->err, NULL, NULL);
+
+  return gfc_finish_block (&block);
+
+}
+
 static gfc_expr *
 gfc_new_nml_name_expr (const char * name)
 {
@@ -1583,6 +1696,41 @@ build_dt (tree function, gfc_code * code
       if (dt->end)
 	mask |= IOPARM_common_end;
 
+      if (dt->id)
+	mask |= set_parameter_ref (&block, &post_end_block, var,
+				   IOPARM_dt_id, dt->id);
+
+      if (dt->pos)
+	mask |= set_parameter_value (&block, var, IOPARM_dt_pos, dt->pos);
+
+      if (dt->asynchronous)
+	mask |= set_string (&block, &post_block, var, IOPARM_dt_asynchronous,
+			    dt->asynchronous);
+
+      if (dt->blank)
+	mask |= set_string (&block, &post_block, var, IOPARM_dt_blank,
+			    dt->blank);
+
+      if (dt->decimal)
+	mask |= set_string (&block, &post_block, var, IOPARM_dt_decimal,
+			    dt->decimal);
+
+      if (dt->delim)
+	mask |= set_string (&block, &post_block, var, IOPARM_dt_delim,
+			    dt->delim);
+
+      if (dt->pad)
+	mask |= set_string (&block, &post_block, var, IOPARM_dt_pad,
+			    dt->pad);
+
+      if (dt->round)
+	mask |= set_string (&block, &post_block, var, IOPARM_dt_round,
+			    dt->round);
+
+      if (dt->sign)
+	mask |= set_string (&block, &post_block, var, IOPARM_dt_sign,
+			    dt->sign);
+
       if (dt->rec)
 	mask |= set_parameter_value (&block, var, IOPARM_dt_rec, dt->rec);
 
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c	(revision 133275)
+++ gcc/fortran/match.c	(working copy)
@@ -1533,6 +1533,7 @@ gfc_match_if (gfc_statement *if_type)
   match ("return", gfc_match_return, ST_RETURN)
   match ("rewind", gfc_match_rewind, ST_REWIND)
   match ("stop", gfc_match_stop, ST_STOP)
+  match ("wait", gfc_match_wait, ST_WAIT)
   match ("where", match_simple_where, ST_WHERE)
   match ("write", gfc_match_write, ST_WRITE)
 
Index: gcc/fortran/match.h
===================================================================
--- gcc/fortran/match.h	(revision 133275)
+++ gcc/fortran/match.h	(working copy)
@@ -212,6 +212,7 @@ match gfc_match_rewind (void);
 match gfc_match_flush (void);
 match gfc_match_inquire (void);
 match gfc_match_read (void);
+match gfc_match_wait (void);
 match gfc_match_write (void);
 match gfc_match_print (void);
 
Index: gcc/fortran/ioparm.def
===================================================================
--- gcc/fortran/ioparm.def	(revision 133275)
+++ gcc/fortran/ioparm.def	(working copy)
@@ -8,10 +8,10 @@
 #define IOPARM_common_end		(1 << 3)
 #define IOPARM_common_eor		(1 << 4)
 #endif
-IOPARM (common,  flags,		0,       int4)
-IOPARM (common,  unit,		0,       int4)
-IOPARM (common,  filename,	0,       pchar)
-IOPARM (common,  line,		0,       int4)
+IOPARM (common,  flags,		0,	 int4)
+IOPARM (common,  unit,		0,	 int4)
+IOPARM (common,  filename,	0,	 pchar)
+IOPARM (common,  line,		0,	 int4)
 IOPARM (common,  iomsg,		1 << 6,  char2)
 IOPARM (common,  iostat,	1 << 5,  pint4)
 IOPARM (open,    common,	0,	 common)
@@ -25,7 +25,12 @@ IOPARM (open,    position,	1 << 13, char
 IOPARM (open,    action,	1 << 14, char2)
 IOPARM (open,    delim,		1 << 15, char1)
 IOPARM (open,    pad,		1 << 16, char2)
-IOPARM (open,    convert,       1 << 17, char1)
+IOPARM (open,    convert,	1 << 17, char1)
+IOPARM (open,    decimal,	1 << 18, char2)
+IOPARM (open,    encoding,	1 << 19, char1)
+IOPARM (open,    round,		1 << 20, char2)
+IOPARM (open,    sign,		1 << 21, char1)
+IOPARM (open,    asynchronous,	1 << 22, char2)
 IOPARM (close,   common,	0,	 common)
 IOPARM (close,   status,	1 << 7,  char1)
 IOPARM (filepos, common,	0,	 common)
@@ -53,7 +58,18 @@ IOPARM (inquire, unformatted,	1 << 26, c
 IOPARM (inquire, read,		1 << 27, char2)
 IOPARM (inquire, write,		1 << 28, char1)
 IOPARM (inquire, readwrite,	1 << 29, char2)
-IOPARM (inquire, convert,       1 << 30, char1)
+IOPARM (inquire, convert,	1 << 30, char1)
+IOPARM (inquire, flags2,	1 << 31, int4)
+IOPARM (inquire, asynchronous,	1 << 0,  char1)
+IOPARM (inquire, decimal,	1 << 1,  char2)
+IOPARM (inquire, encoding,	1 << 2,  char1)
+IOPARM (inquire, round,		1 << 3,  char2)
+IOPARM (inquire, sign,		1 << 4,  char1)
+IOPARM (inquire, pending,	1 << 5,  pint4)
+IOPARM (inquire, size,		1 << 6,  pint4)
+IOPARM (inquire, id,		1 << 7,  intio)
+IOPARM (wait,    common,	0,	 common)
+IOPARM (wait,    id,		1 << 7,  intio)
 #ifndef IOPARM_dt_list_format
 #define IOPARM_dt_list_format		(1 << 7)
 #define IOPARM_dt_namelist_read_mode	(1 << 8)
@@ -67,4 +83,13 @@ IOPARM (dt,      format,	1 << 12, char1)
 IOPARM (dt,      advance,	1 << 13, char2)
 IOPARM (dt,      internal_unit,	1 << 14, char1)
 IOPARM (dt,      namelist_name,	1 << 15, char2)
-IOPARM (dt,      u,		0,       pad)
+IOPARM (dt,      id,		1 << 16, pintio)
+IOPARM (dt,      pos,		1 << 17, intio)
+IOPARM (dt,      asynchronous, 	1 << 18, char1)
+IOPARM (dt,      blank,		1 << 19, char2)
+IOPARM (dt,      decimal,	1 << 20, char1)
+IOPARM (dt,      delim,		1 << 21, char2)
+IOPARM (dt,      pad,		1 << 22, char1)
+IOPARM (dt,      round,		1 << 23, char2)
+IOPARM (dt,      sign,		1 << 24, char1)
+IOPARM (dt,      u,		0,	 pad)
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c	(revision 133275)
+++ gcc/fortran/parse.c	(working copy)
@@ -440,6 +440,7 @@ decode_statement (void)
       break;
 
     case 'w':
+      match ("wait", gfc_match_wait, ST_WAIT);
       match ("write", gfc_match_write, ST_WRITE);
       break;
     }
@@ -861,9 +862,9 @@ next_statement (void)
   case ST_CLOSE: case ST_CONTINUE: case ST_DEALLOCATE: case ST_END_FILE: \
   case ST_GOTO: case ST_INQUIRE: case ST_NULLIFY: case ST_OPEN: \
   case ST_READ: case ST_RETURN: case ST_REWIND: case ST_SIMPLE_IF: \
-  case ST_PAUSE: case ST_STOP: case ST_WRITE: case ST_ASSIGNMENT: \
+  case ST_PAUSE: case ST_STOP: case ST_WAIT: case ST_WRITE: \
   case ST_POINTER_ASSIGNMENT: case ST_EXIT: case ST_CYCLE: \
-  case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \
+  case ST_ASSIGNMENT: case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \
   case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \
   case ST_OMP_BARRIER
 
@@ -1268,6 +1269,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_WHERE:
       p = "WHERE";
       break;
+    case ST_WAIT:
+      p = "WAIT";
+      break;
     case ST_WRITE:
       p = "WRITE";
       break;
Index: libgfortran/gfortran.map
===================================================================
--- libgfortran/gfortran.map	(revision 133275)
+++ libgfortran/gfortran.map	(working copy)
@@ -954,6 +954,7 @@ GFORTRAN_1.0 {
     _gfortran_st_set_nml_var_dim;
     _gfortran_st_write;
     _gfortran_st_write_done;
+    _gfortran_st_wait;
     _gfortran_sum_c10;
     _gfortran_sum_c16;
     _gfortran_sum_c4;
Index: libgfortran/libgfortran.h
===================================================================
--- libgfortran/libgfortran.h	(revision 133275)
+++ libgfortran/libgfortran.h	(working copy)
@@ -447,6 +447,11 @@ st_parameter_common;
 #define IOPARM_OPEN_HAS_DELIM           (1 << 15)
 #define IOPARM_OPEN_HAS_PAD             (1 << 16)
 #define IOPARM_OPEN_HAS_CONVERT         (1 << 17)
+#define IOPARM_OPEN_HAS_DECIMAL		(1 << 18)
+#define IOPARM_OPEN_HAS_ENCODING	(1 << 19)
+#define IOPARM_OPEN_HAS_ROUND		(1 << 20)
+#define IOPARM_OPEN_HAS_SIGN		(1 << 21)
+#define IOPARM_OPEN_HAS_ASYNCHRONOUS	(1 << 22)
 
 /* library start function and end macro.  These can be expanded if needed
    in the future.  cmp is st_parameter_common *cmp  */
Index: libgfortran/io/open.c
===================================================================
--- libgfortran/io/open.c	(revision 133275)
+++ libgfortran/io/open.c	(working copy)
@@ -97,6 +97,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 +139,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 +218,26 @@ edit_modes (st_parameter_open *opp, gfc_
 	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 +249,14 @@ edit_modes (st_parameter_open *opp, gfc_
 	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 +356,62 @@ new_unit (st_parameter_open *opp, gfc_un
 	}
     }
 
+  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 +730,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");
Index: libgfortran/io/list_read.c
===================================================================
--- libgfortran/io/list_read.c	(revision 133275)
+++ libgfortran/io/list_read.c	(working copy)
@@ -52,12 +52,12 @@ Boston, MA 02110-1301, USA.  */
                       case '5': case '6': case '7': case '8': case '9'
 
 #define CASE_SEPARATORS  case ' ': case ',': case '/': case '\n': case '\t': \
-                         case '\r'
+                         case '\r': case ';'
 
 /* This macro assumes that we're operating on a variable.  */
 
 #define is_separator(c) (c == '/' ||  c == ',' || c == '\n' || c == ' ' \
-                         || c == '\t' || c == '\r')
+                         || c == '\t' || c == '\r' || c == ';')
 
 /* Maximum repeat count.  Less than ten times the maximum signed int32.  */
 
Index: libgfortran/io/read.c
===================================================================
--- libgfortran/io/read.c	(revision 133275)
+++ libgfortran/io/read.c	(working copy)
@@ -246,7 +246,8 @@ read_a (st_parameter_dt *dtp, const fnod
 
   dtp->u.p.sf_read_comma = 0;
   source = read_block (dtp, &w);
-  dtp->u.p.sf_read_comma = 1;
+  dtp->u.p.sf_read_comma =
+    dtp->u.p.decimal_status == DECIMAL_COMMA ? 0 : 1;
   if (source == NULL)
     return;
   if (w > length)
@@ -601,7 +602,7 @@ read_f (st_parameter_dt *dtp, const fnod
   /* A digit, a '.' or a exponent character ('e', 'E', 'd' or 'D')
      is required at this point */
 
-  if (!isdigit (*p) && *p != '.' && *p != 'd' && *p != 'D'
+  if (!isdigit (*p) && *p != '.' && *p != ',' && *p != 'd' && *p != 'D'
       && *p != 'e' && *p != 'E')
     goto bad_float;
 
@@ -614,6 +615,10 @@ read_f (st_parameter_dt *dtp, const fnod
     {
       switch (*p)
 	{
+	case ',':
+	  if (dtp->u.p.decimal_status == DECIMAL_COMMA && *p == ',')
+	    *p = '.';
+	  /* Fall through */
 	case '.':
 	  if (seen_dp)
 	    goto bad_float;
@@ -852,10 +857,11 @@ read_x (st_parameter_dt *dtp, int n)
 	  && dtp->u.p.current_unit->bytes_left < n)
 	n = dtp->u.p.current_unit->bytes_left;
 
-      dtp->u.p.sf_read_comma = 0;
+      dtp->u.p.sf_read_comma =
+	dtp->u.p.decimal_status == DECIMAL_COMMA ? 0 : 1;
       if (n > 0)
 	read_sf (dtp, &n, 1);
-      dtp->u.p.sf_read_comma = 1;
+      dtp->u.p.sf_read_comma = 0;
     }
   else
     dtp->u.p.current_unit->strm_pos += (gfc_offset) n;
Index: libgfortran/io/io.h
===================================================================
--- libgfortran/io/io.h	(revision 133275)
+++ libgfortran/io/io.h	(working copy)
@@ -35,6 +35,7 @@ Boston, MA 02110-1301, USA.  */
 
 #include <setjmp.h>
 #include <gthr.h>
+#include <aio.h>
 
 /* Basic types used in data transfers.  */
 
@@ -44,7 +45,6 @@ typedef enum
 }
 bt;
 
-
 struct st_parameter_dt;
 
 typedef struct stream
@@ -61,6 +61,17 @@ typedef struct stream
 }
 stream;
 
+typedef struct gfc_aio
+{
+  int id;
+  struct aiocb *a;
+  struct gfc_aio *next;
+}
+gfc_aio;
+
+typedef enum
+{ SYNC_BUFFERED, SYNC_UNBUFFERED, ASYNC }
+io_mode;
 
 /* Macros for doing file I/O given a stream.  */
 
@@ -205,6 +216,23 @@ typedef enum
 unit_pad;
 
 typedef enum
+{ DECIMAL_POINT, DECIMAL_COMMA, DECIMAL_UNSPECIFIED }
+unit_decimal;
+
+typedef enum
+{ ENCODING_UTF8, ENCODING_DEFAULT, ENCODING_UNSPECIFIED }
+unit_encoding;
+
+typedef enum
+{ ROUND_UP, ROUND_DOWN, ROUND_ZERO, ROUND_NEAREST, ROUND_COMPATIBLE,
+  ROUND_PROCDEFINED, ROUND_UNSPECIFIED }
+unit_round;
+
+typedef enum
+{ SIGN_PLUS, SIGN_SUPPRESS, SIGN_PROCDEFINED, SIGN_UNSPECIFIED }
+unit_sign;
+
+typedef enum
 { ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED }
 unit_advance;
 
@@ -212,6 +240,10 @@ typedef enum
 {READING, WRITING}
 unit_mode;
 
+typedef enum
+{ ASYNC_YES, ASYNC_NO, AYSYNC_UNSPECIFIED }
+unit_async;
+
 #define CHARACTER1(name) \
 	      char * name; \
 	      gfc_charlen_type name ## _len
@@ -233,6 +265,11 @@ typedef struct
   CHARACTER1 (delim);
   CHARACTER2 (pad);
   CHARACTER1 (convert);
+  CHARACTER2 (decimal);
+  CHARACTER1 (encoding);
+  CHARACTER2 (round);
+  CHARACTER1 (sign);
+  CHARACTER2 (asynchronous);
 }
 st_parameter_open;
 
@@ -275,6 +312,16 @@ st_parameter_filepos;
 #define IOPARM_INQUIRE_HAS_WRITE	(1 << 28)
 #define IOPARM_INQUIRE_HAS_READWRITE	(1 << 29)
 #define IOPARM_INQUIRE_HAS_CONVERT	(1 << 30)
+#define IOPARM_INQUIRE_HAS_FLAGS2	(1 << 31)
+
+#define IOPARM_INQUIRE_HAS_ASYNCHRONOUS	(1 << 0)
+#define IOPARM_INQUIRE_HAS_DECIMAL	(1 << 1)
+#define IOPARM_INQUIRE_HAS_ENCODING	(1 << 2)
+#define IOPARM_INQUIRE_HAS_PENDING	(1 << 3)
+#define IOPARM_INQUIRE_HAS_ROUND	(1 << 4)
+#define IOPARM_INQUIRE_HAS_SIGN		(1 << 5)
+#define IOPARM_INQUIRE_HAS_SIZE		(1 << 6)
+#define IOPARM_INQUIRE_HAS_ID		(1 << 7)
 
 typedef struct
 {
@@ -299,6 +346,15 @@ typedef struct
   CHARACTER1 (write);
   CHARACTER2 (readwrite);
   CHARACTER1 (convert);
+  GFC_INTEGER_4 flags2;
+  CHARACTER1 (asynchronous);
+  CHARACTER1 (decimal);
+  CHARACTER1 (encoding);
+  CHARACTER1 (pending);
+  CHARACTER1 (round);
+  CHARACTER1 (sign);
+  GFC_INTEGER_4 *size;
+  GFC_IO_INT id;
 }
 st_parameter_inquire;
 
@@ -314,6 +370,15 @@ struct format_data;
 #define IOPARM_DT_HAS_ADVANCE			(1 << 13)
 #define IOPARM_DT_HAS_INTERNAL_UNIT		(1 << 14)
 #define IOPARM_DT_HAS_NAMELIST_NAME		(1 << 15)
+#define IOPARM_DT_HAS_ID			(1 << 16)
+#define IOPARM_DT_HAS_POS			(1 << 17)
+#define IOPARM_DT_HAS_ASYNCHRONOUS		(1 << 18)
+#define IOPARM_DT_HAS_BLANK			(1 << 19)
+#define IOPARM_DT_HAS_DECIMAL			(1 << 20)
+#define IOPARM_DT_HAS_DELIM			(1 << 21)
+#define IOPARM_DT_HAS_PAD			(1 << 22)
+#define IOPARM_DT_HAS_ROUND			(1 << 23)
+#define IOPARM_DT_HAS_SIGN			(1 << 24)
 /* Internal use bit.  */
 #define IOPARM_DT_IONML_SET			(1 << 31)
 
@@ -327,6 +392,15 @@ typedef struct st_parameter_dt
   CHARACTER2 (advance);
   CHARACTER1 (internal_unit);
   CHARACTER2 (namelist_name);
+  GFC_IO_INT *id;
+  GFC_IO_INT pos;
+  CHARACTER1 (asynchronous);
+  CHARACTER2 (blank);
+  CHARACTER1 (decimal);
+  CHARACTER2 (delim);
+  CHARACTER1 (pad);
+  CHARACTER2 (round);
+  CHARACTER1 (sign);
   /* Private part of the structure.  The compiler just needs
      to reserve enough space.  */
   union
@@ -341,7 +415,7 @@ typedef struct st_parameter_dt
 	  int item_count;
 	  unit_mode mode;
 	  unit_blank blank_status;
-	  enum {SIGN_S, SIGN_SS, SIGN_SP} sign_status;
+	  enum { SIGN_S, SIGN_SS, SIGN_SP } sign_status;
 	  int scale_factor;
 	  int max_pos; /* Maximum righthand column written to.  */
 	  /* Number of skips + spaces to be done for T and X-editing.  */
@@ -354,6 +428,7 @@ typedef struct st_parameter_dt
 	       2 if an EOR was encountered due to a 2-bytes marker (CRLF) */
 	  int sf_seen_eor;
 	  unit_advance advance_status;
+	  unit_decimal decimal_status;
 
 	  unsigned reversion_flag : 1; /* Format reversion has occurred.  */
 	  unsigned first_item : 1;
@@ -422,6 +497,16 @@ extern char check_st_parameter_dt[sizeof
 				  >= sizeof (((st_parameter_dt *) 0)->u.p)
 				  ? 1 : -1];
 
+#define IOPARM_WAIT_HAS_ID		(1 << 7)
+
+typedef struct
+{
+  st_parameter_common common;
+  CHARACTER1 (id);
+}
+st_parameter_wait;
+
+
 #undef CHARACTER1
 #undef CHARACTER2
 
@@ -436,8 +521,13 @@ typedef struct
   unit_position position;
   unit_status status;
   unit_pad pad;
+  unit_decimal decimal;
+  unit_encoding encoding;
+  unit_round round;
+  unit_sign sign;
   unit_convert convert;
   int has_recl;
+  unit_async async;
 }
 unit_flags;
 
@@ -748,6 +838,9 @@ internal_proto(next_record);
 extern void reverse_memcpy (void *, const void *, size_t);
 internal_proto (reverse_memcpy);
 
+extern void st_wait (st_parameter_wait *);
+export_proto(st_wait);
+
 /* read.c */
 
 extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
Index: libgfortran/io/unix.c
===================================================================
--- libgfortran/io/unix.c	(revision 133275)
+++ libgfortran/io/unix.c	(working copy)
@@ -93,8 +93,6 @@ id_from_fd (const int fd)
 
 #endif
 
-
-
 #ifndef SSIZE_MAX
 #define SSIZE_MAX SHRT_MAX
 #endif
@@ -153,7 +151,9 @@ typedef struct
 
   int special_file;		/* =1 if the fd refers to a special file */
 
-  int unbuffered;               /* =1 if the stream is not buffered */
+  io_mode method;		/* Method of stream I/O being used */
+
+  gfc_aio *paio;		/* Pointer to asynchronous I/O structure */
 
   char *buffer;
   char small_buffer[BUFFER_SIZE];
@@ -184,7 +184,8 @@ typedef struct
 
   int special_file;		/* =1 if the fd refers to a special file */
 
-  int unbuffered;               /* =1 if the stream is not buffered */
+  io_mode method;		/* Method of stream I/O being used */
+  gfc_aio *paio;		/* Pointer to asynchronous I/O structure */
 
   char *buffer;
 }
@@ -238,15 +239,15 @@ move_pos_offset (stream* st, int pos_off
       str->logical_offset += pos_off;
 
       if (str->dirty_offset + str->ndirty > str->logical_offset)
-        {
-          if (str->ndirty + pos_off > 0)
-            str->ndirty += pos_off;
-          else
-            {
-              str->dirty_offset +=  pos_off + pos_off;
-              str->ndirty = 0;
-            }
-        }
+	{
+	  if (str->ndirty + pos_off > 0)
+	    str->ndirty += pos_off;
+	  else
+	    {
+	      str->dirty_offset +=  pos_off + pos_off;
+	      str->ndirty = 0;
+	    }
+	}
 
     return pos_off;
   }
@@ -615,23 +616,23 @@ fd_alloc_w_at (unix_stream * s, int *len
       || where > s->dirty_offset + s->ndirty    
       || s->dirty_offset > where + *len)
     {  /* Discontiguous blocks, start with a clean buffer.  */  
-        /* Flush the buffer.  */  
-       if (s->ndirty != 0)    
-         fd_flush (s);  
-       s->dirty_offset = where;  
-       s->ndirty = *len;
+	/* Flush the buffer.  */  
+      if (s->ndirty != 0)    
+	fd_flush (s);  
+      s->dirty_offset = where;  
+      s->ndirty = *len;
     }
   else
     {  
       gfc_offset start;  /* Merge with the existing data.  */  
       if (where < s->dirty_offset)    
-        start = where;  
+	start = where;  
       else    
-        start = s->dirty_offset;  
+	start = s->dirty_offset;  
       if (where + *len > s->dirty_offset + s->ndirty)    
-        s->ndirty = where + *len - start;  
+	s->ndirty = where + *len - start;  
       else    
-        s->ndirty = s->dirty_offset + s->ndirty - start;  
+	s->ndirty = s->dirty_offset + s->ndirty - start;  
       s->dirty_offset = start;
     }
 
@@ -655,7 +656,7 @@ fd_sfree (unix_stream * s)
 {
   if (s->ndirty != 0 &&
       (s->buffer != s->small_buffer || options.all_unbuffered ||
-       s->unbuffered))
+       s->method == SYNC_UNBUFFERED))
     return fd_flush (s);
 
   return SUCCESS;
@@ -777,7 +778,7 @@ fd_read (unix_stream * s, void * buf, si
   void *p;
   int tmp, status;
 
-  if (*nbytes < BUFFER_SIZE && !s->unbuffered)
+  if (*nbytes < BUFFER_SIZE && s->method == SYNC_BUFFERED)
     {
       tmp = *nbytes;
       p = fd_alloc_r_at (s, &tmp, -1);
@@ -825,7 +826,7 @@ fd_write (unix_stream * s, const void * 
   void *p;
   int tmp, status;
 
-  if (*nbytes < BUFFER_SIZE && !s->unbuffered)
+  if (*nbytes < BUFFER_SIZE && s->method == SYNC_BUFFERED)
     {
       tmp = *nbytes;
       p = fd_alloc_w_at (s, &tmp, -1);
@@ -874,7 +875,7 @@ fd_close (unix_stream * s)
   if (s->fd != STDOUT_FILENO && s->fd != STDERR_FILENO)
     {
       if (close (s->fd) < 0)
-        return FAILURE;
+	return FAILURE;
     }
 
   free_mem (s);
@@ -887,7 +888,9 @@ static void
 fd_open (unix_stream * s)
 {
   if (isatty (s->fd))
-    s->unbuffered = 1;
+    s->method = SYNC_UNBUFFERED;
+  else
+    s->method = SYNC_BUFFERED;
 
   s->st.alloc_r_at = (void *) fd_alloc_r_at;
   s->st.alloc_w_at = (void *) fd_alloc_w_at;
@@ -899,6 +902,7 @@ fd_open (unix_stream * s)
   s->st.write = (void *) fd_write;
   s->st.set = (void *) fd_sset;
 
+  s->paio = NULL;
   s->buffer = NULL;
 }
 
@@ -1097,6 +1101,7 @@ open_internal (char *base, int length, g
   s = get_mem (sizeof (int_stream));
   memset (s, '\0', sizeof (int_stream));
 
+  s->paio = NULL;
   s->buffer = base;
   s->buffer_offset = offset;
 
@@ -1224,7 +1229,7 @@ tempfile (st_parameter_open *opp)
     do
 #if defined(HAVE_CRLF) && defined(O_BINARY)
       fd = open (template, O_RDWR | O_CREAT | O_EXCL | O_BINARY,
-                 S_IREAD | S_IWRITE);
+		 S_IREAD | S_IWRITE);
 #else
       fd = open (template, O_RDWR | O_CREAT | O_EXCL, S_IREAD | S_IWRITE);
 #endif
@@ -1335,11 +1340,11 @@ regular_file (st_parameter_open *opp, un
   if (fd >=0)
     {
       flags->action = ACTION_READ;
-      return fd;               /* success */
+      return fd;		/* success */
     }
   
   if (errno != EACCES)
-    return fd;                 /* failure */
+    return fd;			/* failure */
 
   /* retry for write-only access */
   rwflag = O_WRONLY;
@@ -1347,9 +1352,9 @@ regular_file (st_parameter_open *opp, un
   if (fd >=0)
     {
       flags->action = ACTION_WRITE;
-      return fd;               /* success */
+      return fd;		/* success */
     }
-  return fd;                   /* failure */
+  return fd;			/* failure */
 }
 
 
@@ -1366,7 +1371,7 @@ open_external (st_parameter_open *opp, u
     {
       fd = tempfile (opp);
       if (flags->action == ACTION_UNSPECIFIED)
-        flags->action = ACTION_READWRITE;
+	flags->action = ACTION_READWRITE;
 
 #if HAVE_UNLINK_OPEN_FILE
       /* We can unlink scratch files now and it will go away when closed. */
@@ -1431,7 +1436,7 @@ output_stream (void)
 
   s = fd_to_stream (STDOUT_FILENO, PROT_WRITE);
   if (options.unbuffered_preconnected)
-    ((unix_stream *) s)->unbuffered = 1;
+    ((unix_stream *) s)->method = SYNC_UNBUFFERED;
   return s;
 }
 
@@ -1450,7 +1455,7 @@ error_stream (void)
 
   s = fd_to_stream (STDERR_FILENO, PROT_WRITE);
   if (options.unbuffered_preconnected)
-    ((unix_stream *) s)->unbuffered = 1;
+    ((unix_stream *) s)->method = SYNC_UNBUFFERED;
   return s;
 }
 
@@ -2050,13 +2055,13 @@ stream_offset (stream *s)
       the solution used by f2c.  Each record contains a pair of length
       markers:
 
-        Length of record n in bytes
-        Data of record n
-        Length of record n in bytes
-
-        Length of record n+1 in bytes
-        Data of record n+1
-        Length of record n+1 in bytes
+	Length of record n in bytes
+	Data of record n
+	Length of record n in bytes
+
+	Length of record n+1 in bytes
+	Data of record n+1
+	Length of record n+1 in bytes
 
      The length is stored at the end of a record to allow backspacing to the
      previous record.  Between data transfer statements, the file pointer
Index: libgfortran/io/transfer.c
===================================================================
--- libgfortran/io/transfer.c	(revision 133275)
+++ libgfortran/io/transfer.c	(working copy)
@@ -93,6 +93,13 @@ static const st_option advance_opt[] = {
 };
 
 
+static const st_option decimal_opt[] = {
+  {"point", DECIMAL_POINT},
+  {"comma", DECIMAL_COMMA},
+  {NULL, 0}
+};
+
+
 typedef enum
 { FORMATTED_SEQUENTIAL, UNFORMATTED_SEQUENTIAL,
   FORMATTED_DIRECT, UNFORMATTED_DIRECT, FORMATTED_STREAM, UNFORMATTED_STREAM
@@ -915,7 +922,7 @@ formatted_transfer_scalar (st_parameter_
   /* 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;
+  dtp->u.p.sf_read_comma = dtp->u.p.decimal_status == DECIMAL_COMMA ? 0 : 1;
   dtp->u.p.line_buffer = scratch;
 
   for (;;)
@@ -1774,6 +1781,10 @@ data_transfer_init (st_parameter_dt *dtp
      u_flags.delim = DELIM_UNSPECIFIED;
      u_flags.blank = BLANK_UNSPECIFIED;
      u_flags.pad = PAD_UNSPECIFIED;
+     u_flags.decimal = DECIMAL_UNSPECIFIED;
+     u_flags.encoding = ENCODING_UNSPECIFIED;
+     u_flags.round = ROUND_UNSPECIFIED;
+     u_flags.sign = SIGN_UNSPECIFIED;
      u_flags.status = STATUS_UNKNOWN;
 
      conv = get_unformatted_convert (dtp->common.unit);
@@ -1963,6 +1974,16 @@ data_transfer_init (st_parameter_dt *dtp
   if (dtp->u.p.advance_status == ADVANCE_UNSPECIFIED)
     dtp->u.p.advance_status = ADVANCE_YES;
 
+  /* Check the decimal mode.  */
+
+  dtp->u.p.decimal_status
+    = !(cf & IOPARM_DT_HAS_DECIMAL) ? DECIMAL_UNSPECIFIED :
+      find_option (&dtp->common, dtp->decimal, dtp->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;
+
   /* Sanity checks on the record number.  */
   if ((cf & IOPARM_DT_HAS_REC) != 0)
     {
@@ -2922,6 +2943,16 @@ st_write_done (st_parameter_dt *dtp)
   library_end ();
 }
 
+
+/* F2003: This is a stub for the runtime portion of the WAIT statement.  */
+void
+st_wait (st_parameter_wait *wtp)
+{
+  if (wtp != NULL)
+    *wtp->common.iostat = 0;
+}
+
+
 /* Receives the scalar information for namelist objects and stores it
    in a linked list of namelist_info types.  */
 
Index: libgfortran/io/write.c
===================================================================
--- libgfortran/io/write.c	(revision 133275)
+++ libgfortran/io/write.c	(working copy)
@@ -361,7 +361,7 @@ write_decimal (st_parameter_dt *dtp, con
   if (n < 0)
     n = -n;
 
-  nsign = sign == SIGN_NONE ? 0 : 1;
+  nsign = sign == S_NONE ? 0 : 1;
   q = conv (n, itoa_buf, sizeof (itoa_buf));
 
   digits = strlen (q);
@@ -395,13 +395,13 @@ write_decimal (st_parameter_dt *dtp, con
 
   switch (sign)
     {
-    case SIGN_PLUS:
+    case S_PLUS:
       *p++ = '+';
       break;
-    case SIGN_MINUS:
+    case S_MINUS:
       *p++ = '-';
       break;
-    case SIGN_NONE:
+    case S_NONE:
       break;
     }
 
Index: libgfortran/io/write_float.def
===================================================================
--- libgfortran/io/write_float.def	(revision 133275)
+++ libgfortran/io/write_float.def	(working copy)
@@ -31,7 +31,7 @@ Boston, MA 02110-1301, USA.  */
 #include "config.h"
 
 typedef enum
-{ SIGN_NONE, SIGN_MINUS, SIGN_PLUS }
+{ S_NONE, S_MINUS, S_PLUS }
 sign_t;
 
 /* Given a flag that indicates if a value is negative or not, return a
@@ -40,21 +40,21 @@ sign_t;
 static sign_t
 calculate_sign (st_parameter_dt *dtp, int negative_flag)
 {
-  sign_t s = SIGN_NONE;
+  sign_t s = S_NONE;
 
   if (negative_flag)
-    s = SIGN_MINUS;
+    s = S_MINUS;
   else
     switch (dtp->u.p.sign_status)
       {
       case SIGN_SP:
-	s = SIGN_PLUS;
+	s = S_PLUS;
 	break;
       case SIGN_SS:
-	s = SIGN_NONE;
+	s = S_NONE;
 	break;
       case SIGN_S:
-	s = options.optional_plus ? SIGN_PLUS : SIGN_NONE;
+	s = options.optional_plus ? S_PLUS : S_NONE;
 	break;
       }
 
@@ -336,7 +336,7 @@ output_float (st_parameter_dt *dtp, cons
 
   /* Pick a field size if none was specified.  */
   if (w <= 0)
-    w = nbefore + nzero + nafter + (sign != SIGN_NONE ? 2 : 1);
+    w = nbefore + nzero + nafter + (sign != S_NONE ? 2 : 1);
 
   /* Create the ouput buffer.  */
   out = write_block (dtp, w);
@@ -362,7 +362,7 @@ output_float (st_parameter_dt *dtp, cons
 
   /* Work out how much padding is needed.  */
   nblanks = w - (nbefore + nzero + nafter + edigits + 1);
-  if (sign != SIGN_NONE)
+  if (sign != S_NONE)
     nblanks--;
 
   /* Check the value fits in the specified field width.  */
@@ -390,9 +390,9 @@ output_float (st_parameter_dt *dtp, cons
     }
 
   /* Output the initial sign (if any).  */
-  if (sign == SIGN_PLUS)
+  if (sign == S_PLUS)
     *(out++) = '+';
-  else if (sign == SIGN_MINUS)
+  else if (sign == S_MINUS)
     *(out++) = '-';
 
   /* Output an optional leading zero.  */
@@ -421,7 +421,7 @@ output_float (st_parameter_dt *dtp, cons
       out += nbefore;
     }
   /* Output the decimal point.  */
-  *(out++) = '.';
+  *(out++) = dtp->u.p.decimal_status == DECIMAL_POINT ? '.' : ',';
 
   /* Output leading zeros after the decimal point.  */
   if (nzero > 0)

[-- Attachment #3: test1.f90 --]
[-- Type: text/x-fortran, Size: 613 bytes --]

real :: a(10), b(10)
real :: c
integer :: istat
character(25) :: msg
a = 23.45
open(10, file='mydata', asynchronous="yes")
write(10,'(10f8.3)', asynchronous="yes", decimal="comma") a
rewind(10)
read(10,'(10f8.3)', asynchronous="yes", decimal="comma") b
print *, b
c = 3.14
write(*, *, decimal="comma") c

rewind(10)
write(10,'(10f8.3)', asynchronous="yes", decimal="point") a
rewind(10)
read(10,'(10f8.3)', asynchronous="yes", decimal="point") b
write(*, *, decimal="comma") b


! Do some stuff b

wait(unit=10, err=25, iostat=istat, iomsg=msg, end=35, id=27)

! Do some stuff with a
25 continue

35 continue
end

[-- Attachment #4: test2.f90 --]
[-- Type: text/x-fortran, Size: 374 bytes --]

integer :: istat
character(25) :: msg
real, dimension(10) :: a, b

a = 43.21
open(10, file='mydata', asynchronous="yes")
write(10,'(10f8.3)', asynchronous="yes", decimal="comma") a
rewind(10)
read(10,'(10f8.3)', asynchronous="yes", decimal="comma") b
istat = 123456
wait(unit=10, err=25, iostat=istat, iomsg=msg, end=35, id=27)

print *, istat

25 continue

35 continue
end

^ permalink raw reply	[flat|nested] 19+ messages in thread
end of thread, other threads:[~2008-04-06  9:25 UTC | newest]

Thread overview: 19+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2008-04-05 12:21 [patch, fortran]PR25829 Add support for F2003 I/O features Tobias Burnus
2008-04-05 16:30 ` Jerry DeLisle
2008-04-05 17:31   ` NightStrike
2008-04-05 17:58     ` Jerry DeLisle
     [not found]   ` <47F7FE02.3070407@net-b.de>
     [not found]     ` <1207454811.15229.2.camel@lenova.localdomain>
2008-04-06 10:00       ` Tobias Burnus
  -- strict thread matches above, loose matches on Subject: below --
2008-04-01 21:10 Tobias Burnus
2008-04-04  4:53 ` Jerry DeLisle
2008-03-29 17:45 Tobias Burnus
2008-03-29 19:57 ` Jerry DeLisle
2008-04-01  4:31 ` Jerry DeLisle
2008-04-01 11:47   ` Tobias Burnus
2008-04-01 14:15     ` Jerry DeLisle
     [not found]       ` <47F494AC.30003@net-b.de>
2008-04-05  9:24         ` Jerry DeLisle
2008-04-05  9:27           ` Jerry DeLisle
2008-04-01 14:15     ` Jerry DeLisle
2008-03-16 21:48 Jerry DeLisle
2008-03-16 22:03 ` FX Coudert
2008-03-17  0:25   ` Jerry DeLisle
2008-03-17  7:52     ` Janne Blomqvist

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).