This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[gfortran] PR 14565 -formatted write to an un-opened unit causes asegv


Summary:

If a unit is not opened, it is opened with default flag values. 

While debugging this problem, also added a call to "ftruncate" in
REWIND, because if you were writing and then you rewind, the last writes
need to be committed to the disk before you use the unit again.  

This fixes NIST test FM100.FOR, and keeps about 4 others from aborting
at run-time. One more small step :)

 

gcc/gcc/testsuite/gfortran.fortran-torture/execute/un_opened_unit.f90

       Integer I,J
       Do I = 1,10
          Write(99,*)I
       EndDo
       Rewind(99)
       Do I = 1,10
          Read(99,*)J
          If (J.ne.I) Then
             Print*,'read ',J,' expected ',I
             Call Abort
          EndIf
       EndDo
       End

2004-03-26  Bud Davis <bdavis9659@comcast.net>
                                                                                                                                                  
        PR gfortran/14565
        * io/open.c (new_unit),
        * io/io.h : new_unit is now visible
        * io/transfer.c (data_transfer_init): open unit if no OPEN statement.
        * io/transfer.c (data_transfer_init): remove compile warnings.
        * io/rewind.c (st_rewind): ftruncate if writing.



tested on i686 / gnu / linux.  No additional regressions.


--bud davis






? gcc/gcc/testsuite/gfortran.fortran-torture/execute/un_opened_unit.f90
Index: gcc/libgfortran/io/io.h
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/Attic/io.h,v
retrieving revision 1.1.2.6
diff -c -3 -p -r1.1.2.6 io.h
*** gcc/libgfortran/io/io.h     24 Mar 2004 12:14:03 -0000      1.1.2.6
--- gcc/libgfortran/io/io.h     26 Mar 2004 14:01:34 -0000
*************** unit_t *get_unit (int);
*** 478,483 ****
--- 478,486 ----
  #define test_endfile prefix(test_endfile)
  void test_endfile (unit_t *);
   
+ #define new_unit prefix(new_unit)
+ void new_unit (unit_flags *);
+
  /* format.c */
   
  #define parse_format prefix(parse_format)
Index: gcc/libgfortran/io/open.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/Attic/open.c,v
retrieving revision 1.1.2.5
diff -c -3 -p -r1.1.2.5 open.c
*** gcc/libgfortran/io/open.c   24 Mar 2004 10:52:56 -0000      1.1.2.5
--- gcc/libgfortran/io/open.c   26 Mar 2004 14:01:34 -0000
*************** edit_modes (unit_t * u, unit_flags * fla
*** 247,253 ****
   
  /* new_unit()-- Open an unused unit */
   
! static void
  new_unit (unit_flags * flags)
  {
    unit_t *u;
--- 247,253 ----
   
  /* new_unit()-- Open an unused unit */
   
! void
  new_unit (unit_flags * flags)
  {
    unit_t *u;
Index: gcc/libgfortran/io/rewind.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/Attic/rewind.c,v
retrieving revision 1.1.2.2
diff -c -3 -p -r1.1.2.2 rewind.c
*** gcc/libgfortran/io/rewind.c 19 Sep 2003 19:11:12 -0000      1.1.2.2
--- gcc/libgfortran/io/rewind.c 26 Mar 2004 14:01:34 -0000
*************** st_rewind (void)
*** 40,45 ****
--- 40,47 ----
                        "Cannot REWIND a file opened for DIRECT access");
        else
        {
+           if (g.mode==WRITING)
+             struncate(u->s);
          u->last_record = 0;
          if (sseek (u->s, 0) == FAILURE)
            generate_error (ERROR_OS, NULL);
Index: gcc/libgfortran/io/transfer.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/Attic/transfer.c,v
retrieving revision 1.1.2.9
diff -c -3 -p -r1.1.2.9 transfer.c
*** gcc/libgfortran/io/transfer.c       24 Mar 2004 12:14:03 -0000      1.1.2.9
--- gcc/libgfortran/io/transfer.c       26 Mar 2004 14:01:35 -0000
*************** pre_position (void)
*** 873,878 ****
--- 873,879 ----
  static void
  data_transfer_init (int read_flag)
  {
+   unit_flags u_flags;  /* used for creating a unit if needed */
   
    g.mode = read_flag ? READING : WRITING;
   
*************** data_transfer_init (int read_flag)
*** 881,887 ****
   
    current_unit = get_unit (read_flag);
    if (current_unit == NULL)
!     return;
   
    if (is_internal_unit() && g.mode==WRITING)
      empty_internal_buffer (current_unit->s);
--- 882,902 ----
   
    current_unit = get_unit (read_flag);
    if (current_unit == NULL)
!   {  /* open the unit with some default flags */
!      memset (&u_flags, '\0', sizeof (u_flags));
!      u_flags.access = ACCESS_SEQUENTIAL;
!      u_flags.action = ACTION_READWRITE;
!      u_flags.form = FORM_UNSPECIFIED;
!      u_flags.delim = DELIM_UNSPECIFIED;
!      u_flags.blank = BLANK_UNSPECIFIED;
!      u_flags.pad = PAD_UNSPECIFIED;
!      u_flags.status = STATUS_UNKNOWN;
!      new_unit(&u_flags);
!      current_unit = get_unit (read_flag);
!   }
!
!   if (current_unit == NULL)
!     return;
   
    if (is_internal_unit() && g.mode==WRITING)
      empty_internal_buffer (current_unit->s);
*************** data_transfer_init (int read_flag)
*** 929,942 ****
   
    /* Check the record number */
   
!   if (current_unit->flags.access == ACCESS_DIRECT && ioparm.rec == NULL)
      {
        generate_error (ERROR_MISSING_OPTION,
                      "Direct access data transfer requires record number");
        return;
      }
   
!   if (current_unit->flags.access == ACCESS_SEQUENTIAL && ioparm.rec != NULL)
      {
        generate_error (ERROR_OPTION_CONFLICT,
                      "Record number not allowed for sequential access data transfer");
--- 944,957 ----
   
    /* Check the record number */
   
!   if (current_unit->flags.access == ACCESS_DIRECT && ioparm.rec == 0)
      {
        generate_error (ERROR_MISSING_OPTION,
                      "Direct access data transfer requires record number");
        return;
      }
   
!   if (current_unit->flags.access == ACCESS_SEQUENTIAL && ioparm.rec != 0)
      {
        generate_error (ERROR_OPTION_CONFLICT,
                      "Record number not allowed for sequential access data transfer");
*************** data_transfer_init (int read_flag)
*** 998,1004 ****
   
    /* Sanity checks on the record number */
   
!   if (ioparm.rec != NULL)
      {
        if (ioparm.rec <= 0)
        {
--- 1013,1019 ----
   
    /* Sanity checks on the record number */
   
!   if (ioparm.rec)
      {
        if (ioparm.rec <= 0)
        {






Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]