public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [patch, fortran] PR31201 Too large unit number generates wrong code
@ 2007-04-04  4:53 Jerry DeLisle
  2007-04-04  5:47 ` FX Coudert
  0 siblings, 1 reply; 4+ messages in thread
From: Jerry DeLisle @ 2007-04-04  4:53 UTC (permalink / raw)
  To: Fortran List; +Cc: gcc-patches

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

:ADDPATCH fortran:

The attached patch fixes this issue by first changing the type of the unit 
number to GFC_IO_INT which is an 8 byte value (or 4 bytes if a system does not 
support 8).  The size of the unit parameters in the front end are appropriately 
adjusted.

I took this approach because the f95 standard defines the unit number as a 
scaler_int_expr.  Therefore it is legal to use any integer expression that may 
not have a value determined except at runtime.

Then I defined MAX_UNIT to be 99999.  I figured this is enough.  Regardless, it 
should be set to a value that fits in a positive 32 bit integer.  Whatever is 
settled on needs to be documented in the manual.

The size of unit is adjusted accordingly in st_parameter_common which is used by 
OPEN, CLOSE, READ, WRITE, INQUIRE, BACKSPACE, REWIND, and ENDFILE.

A new function, check_unit (st_parameter_common *), is added to the library that 
checks the unit number and generates an error if it is out of the allowed range, 
0 to 99999.

Check_unit is then called in each of the affected statements.

I suspect this modifies the ABI since the size of st_parameter_common is changed.

iomsg_1.f90 in the test suite had to be adjusted for the error message which is 
now generic across all statements.

RFC Also note:  I found an unfreed memory block from libgfortran/runtime/main.c 
with valgrind while testing.  I added a free in "cleanup" which appears to have 
eliminated this, however, it causes many failures in the testsuite.  I am not 
sure if it was specific to the test case I had or not.  I left that change out. 
  I have not seen this in previous test I have done.  I will have to revert this 
patch and see if it is still there.  I don't see how it would be related to this 
patch.

Regression tested on x86-64-Gnu/Linux.  Valgrind tested on runtime executable of 
the test case.

OK for trunk?  This should not go to 4.2.

I will dejanuize the test case and expand it some.

Regards,

Jerry

2007-04-03  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/31201
	* libgfortran.h: Define MAX_UNIT.
	(struct st_parameter_common) Change unit type to GFC_IO_INT.
	* io/io.h (struct st_parameter_filepos): Update type of *number.
	(struct gfc_unit): Update type of *unit_number.
	(check_unit):  Add function prototype for this new function.
	* io/unit.c (check_unit): New function
	* io/file_pos.c (st_backspace, st_endfile, st_rewind, st_flush): Use new
	function, check_unit.
	* io/open.c (st_open): Use new function.
	* io/close.c (st_close): Use new function.
	* io/inquire.c (inquire_via_unit): Use MAX_UNIT.
	* io/transfer.c (data_transfer_init): Delete old code not needed.
	(st_read): Use new function. (st_write): Use new function.

2007-04-03  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/31201
	* ioparm.def: Modify "unit" to kind 8.

2007-04-03  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/31201
	* gfortran.dg/iomsg_1.f90: Update test.



[-- Attachment #2: pr31201.f --]
[-- Type: text/x-fortran, Size: 368 bytes --]

      integer*8  :: k= 99999
      integer*4  :: j= 11
      logical  ex,op
      print *, k
      write(k) k
      rewind(k)
      read(k) k
      open (99999)
      INQUIRE(unit=k, exist=ex,opened=op)
      print *, ex, op
      IF (ex) THEN
         OPEN(unit=k)
         INQUIRE(unit=j, opened=op)
         IF (op) CALL ABORT()
      ENDIF
      close(k)
      end

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

! { dg-do run }
! Test implementation of the iomsg tag.
program iomsg_test
  character(len=70) ch

  ! Test that iomsg is left unchanged with no error
  ch = 'asdf'
  open(10, status='scratch', iomsg=ch, iostat=i)
  if (ch .ne. 'asdf') call abort

  ! Test iomsg with data transfer statement
  read(10,'(I2)', iomsg=ch, end=100) k
  call abort
100 continue
  if (ch .ne. 'End of file') call abort

  ! Test iomsg with open
  open (-3, err=200, iomsg=ch)

  call abort
200 continue
  if (ch .ne. 'Bad unit number in statement') call abort

  ! Test iomsg with close
  close(23,status="no_idea", err=500, iomsg=ch) ! { dg-warning "STATUS specifier in CLOSE statement.*has invalid value" }
500 continue
  if (ch .ne. "Bad STATUS parameter in CLOSE statement") call abort
end program iomsg_test

[-- Attachment #4: pr31201.diff --]
[-- Type: text/x-patch, Size: 9139 bytes --]

===================================================================
*** gcc/testsuite/gfortran.dg/iomsg_1.f90	(revision 123402)
--- gcc/testsuite/gfortran.dg/iomsg_1.f90	(working copy)
*************** program iomsg_test
*** 19,25 ****
  
    call abort
  200 continue
!   if (ch .ne. 'Bad unit number in OPEN statement') call abort
  
    ! Test iomsg with close
    close(23,status="no_idea", err=500, iomsg=ch) ! { dg-warning "STATUS specifier in CLOSE statement.*has invalid value" }
--- 19,25 ----
  
    call abort
  200 continue
!   if (ch .ne. 'Bad unit number in statement') call abort
  
    ! Test iomsg with close
    close(23,status="no_idea", err=500, iomsg=ch) ! { dg-warning "STATUS specifier in CLOSE statement.*has invalid value" }
Index: gcc/fortran/ioparm.def
===================================================================
*** gcc/fortran/ioparm.def	(revision 123402)
--- gcc/fortran/ioparm.def	(working copy)
***************
*** 9,15 ****
  #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,  iomsg,		1 << 6,  char2)
--- 9,15 ----
  #define IOPARM_common_eor		(1 << 4)
  #endif
  IOPARM (common,  flags,		0,       int4)
! IOPARM (common,  unit,		0,       intio)
  IOPARM (common,  filename,	0,       pchar)
  IOPARM (common,  line,		0,       int4)
  IOPARM (common,  iomsg,		1 << 6,  char2)
*************** IOPARM (filepos, common,	0,	 common)
*** 32,38 ****
  IOPARM (inquire, common,	0,	 common)
  IOPARM (inquire, exist,		1 << 7,  pint4)
  IOPARM (inquire, opened,	1 << 8,  pint4)
! IOPARM (inquire, number,	1 << 9,  pint4)
  IOPARM (inquire, named,		1 << 10, pint4)
  IOPARM (inquire, nextrec,	1 << 11, pint4)
  IOPARM (inquire, recl_out,	1 << 12, pint4)
--- 32,38 ----
  IOPARM (inquire, common,	0,	 common)
  IOPARM (inquire, exist,		1 << 7,  pint4)
  IOPARM (inquire, opened,	1 << 8,  pint4)
! IOPARM (inquire, number,	1 << 9,  pintio)
  IOPARM (inquire, named,		1 << 10, pint4)
  IOPARM (inquire, nextrec,	1 << 11, pint4)
  IOPARM (inquire, recl_out,	1 << 12, pint4)
Index: libgfortran/libgfortran.h
===================================================================
*** libgfortran/libgfortran.h	(revision 123402)
--- libgfortran/libgfortran.h	(working copy)
*************** iexport_data_proto(filename);
*** 488,493 ****
--- 488,496 ----
     Default value is 1 Gb.  */
  #define DEFAULT_RECL 1073741824
  
+ /* The maximum allowed unit number for I/O operations.  */
+ #define MAX_UNIT 99999
+ 
  typedef enum
  { CONVERT_NONE=-1, CONVERT_NATIVE, CONVERT_SWAP, CONVERT_BIG, CONVERT_LITTLE }
  unit_convert;
*************** unit_convert;
*** 499,505 ****
  typedef struct st_parameter_common
  {
    GFC_INTEGER_4 flags;
!   GFC_INTEGER_4 unit;
    const char *filename;
    GFC_INTEGER_4 line;
    CHARACTER2 (iomsg);
--- 502,508 ----
  typedef struct st_parameter_common
  {
    GFC_INTEGER_4 flags;
!   GFC_IO_INT unit;
    const char *filename;
    GFC_INTEGER_4 line;
    CHARACTER2 (iomsg);
Index: libgfortran/io/file_pos.c
===================================================================
*** libgfortran/io/file_pos.c	(revision 123402)
--- libgfortran/io/file_pos.c	(working copy)
*************** st_backspace (st_parameter_filepos *fpp)
*** 194,199 ****
--- 194,201 ----
  
    library_start (&fpp->common);
  
+   check_unit (&fpp->common);
+ 
    u = find_unit (fpp->common.unit);
    if (u == NULL)
      {
*************** st_endfile (st_parameter_filepos *fpp)
*** 256,261 ****
--- 258,265 ----
  
    library_start (&fpp->common);
  
+   check_unit (&fpp->common);
+ 
    u = find_unit (fpp->common.unit);
    if (u != NULL)
      {
*************** st_rewind (st_parameter_filepos *fpp)
*** 288,293 ****
--- 292,299 ----
  
    library_start (&fpp->common);
  
+   check_unit (&fpp->common);
+ 
    u = find_unit (fpp->common.unit);
    if (u != NULL)
      {
*************** st_flush (st_parameter_filepos *fpp)
*** 347,352 ****
--- 353,360 ----
  
    library_start (&fpp->common);
  
+   check_unit (&fpp->common);
+ 
    u = find_unit (fpp->common.unit);
    if (u != NULL)
      {
Index: libgfortran/io/open.c
===================================================================
*** libgfortran/io/open.c	(revision 123403)
--- libgfortran/io/open.c	(working copy)
*************** st_open (st_parameter_open *opp)
*** 632,641 ****
      }
  
    flags.convert = conv;
! 
!   if (opp->common.unit < 0)
!     generate_error (&opp->common, ERROR_BAD_OPTION,
! 		    "Bad unit number in OPEN statement");
  
    if (flags.position != POSITION_UNSPECIFIED
        && flags.access == ACCESS_DIRECT)
--- 632,639 ----
      }
  
    flags.convert = conv;
!   
!   check_unit (&opp->common);
  
    if (flags.position != POSITION_UNSPECIFIED
        && flags.access == ACCESS_DIRECT)
Index: libgfortran/io/close.c
===================================================================
*** libgfortran/io/close.c	(revision 123402)
--- libgfortran/io/close.c	(working copy)
*************** st_close (st_parameter_close *clp)
*** 69,74 ****
--- 69,76 ----
      return;
    }
  
+   check_unit (&clp->common);
+ 
    u = find_unit (clp->common.unit);
    if (u != NULL)
      {
Index: libgfortran/io/io.h
===================================================================
*** libgfortran/io/io.h	(revision 123403)
--- libgfortran/io/io.h	(working copy)
*************** st_parameter_filepos;
*** 271,278 ****
  typedef struct
  {
    st_parameter_common common;
!   GFC_INTEGER_4 *exist, *opened, *number, *named;
!   GFC_INTEGER_4 *nextrec, *recl_out;
    GFC_IO_INT *strm_pos_out;
    CHARACTER1 (file);
    CHARACTER2 (access);
--- 271,279 ----
  typedef struct
  {
    st_parameter_common common;
!   GFC_INTEGER_4 *exist, *opened;
!   GFC_IO_INT *number;
!   GFC_INTEGER_4 *named, *nextrec, *recl_out;
    GFC_IO_INT *strm_pos_out;
    CHARACTER1 (file);
    CHARACTER2 (access);
*************** unit_flags;
*** 436,442 ****
  
  typedef struct gfc_unit
  {
!   int unit_number;
    stream *s;
    
    /* Treap links.  */
--- 437,443 ----
  
  typedef struct gfc_unit
  {
!   GFC_IO_INT unit_number;
    stream *s;
    
    /* Treap links.  */
*************** internal_proto(get_unit);
*** 693,698 ****
--- 694,702 ----
  extern void unlock_unit (gfc_unit *);
  internal_proto(unlock_unit);
  
+ extern void check_unit (st_parameter_common *);
+ internal_proto(check_unit);
+ 
  /* open.c */
  
  extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
Index: libgfortran/io/inquire.c
===================================================================
*** libgfortran/io/inquire.c	(revision 123402)
--- libgfortran/io/inquire.c	(working copy)
*************** inquire_via_unit (st_parameter_inquire *
*** 47,53 ****
    GFC_INTEGER_4 cf = iqp->common.flags;
  
    if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
!     *iqp->exist = iqp->common.unit >= 0;
  
    if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
      *iqp->opened = (u != NULL);
--- 47,53 ----
    GFC_INTEGER_4 cf = iqp->common.flags;
  
    if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
!     *iqp->exist = (iqp->common.unit >= 0 && iqp->common.unit <= MAX_UNIT);
  
    if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
      *iqp->opened = (u != NULL);
Index: libgfortran/io/unit.c
===================================================================
*** libgfortran/io/unit.c	(revision 123402)
--- libgfortran/io/unit.c	(working copy)
*************** close_units (void)
*** 678,680 ****
--- 678,689 ----
      close_unit_1 (unit_root, 1);
    __gthread_mutex_unlock (&unit_lock);
  }
+ 
+ /* check_unit()-- Check for validity of unit.  */
+ 
+ void
+ check_unit (st_parameter_common *common)
+ {
+   if (common->unit < 0 || common->unit > MAX_UNIT)
+      generate_error (common, ERROR_BAD_OPTION, "Bad unit number in statement");
+ }
Index: libgfortran/io/transfer.c
===================================================================
*** libgfortran/io/transfer.c	(revision 123403)
--- libgfortran/io/transfer.c	(working copy)
*************** data_transfer_init (st_parameter_dt *dtp
*** 1705,1718 ****
       st_parameter_open opp;
       unit_convert conv;
  
-      if (dtp->common.unit < 0)
-      {
-        close_unit (dtp->u.p.current_unit);
-        dtp->u.p.current_unit = NULL;
-        generate_error (&dtp->common, ERROR_BAD_OPTION,
- 		       "Bad unit number in OPEN statement");
-        return;
-      }
       memset (&u_flags, '\0', sizeof (u_flags));
       u_flags.access = ACCESS_SEQUENTIAL;
       u_flags.action = ACTION_READWRITE;
--- 1705,1710 ----
*************** st_read (st_parameter_dt *dtp)
*** 2690,2695 ****
--- 2682,2689 ----
  {
    library_start (&dtp->common);
  
+   check_unit (&dtp->common);
+ 
    data_transfer_init (dtp, 1);
  
    /* Handle complications dealing with the endfile record.  */
*************** void
*** 2745,2750 ****
--- 2739,2747 ----
  st_write (st_parameter_dt *dtp)
  {
    library_start (&dtp->common);
+ 
+   check_unit (&dtp->common);
+ 
    data_transfer_init (dtp, 0);
  }
  

^ permalink raw reply	[flat|nested] 4+ messages in thread

end of thread, other threads:[~2007-04-04  6:52 UTC | newest]

Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2007-04-04  4:53 [patch, fortran] PR31201 Too large unit number generates wrong code Jerry DeLisle
2007-04-04  5:47 ` FX Coudert
2007-04-04  6:21   ` Jerry DeLisle
2007-04-04  6:52     ` François-Xavier Coudert

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).