From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 1372 invoked by alias); 4 Apr 2007 04:53:00 -0000 Received: (qmail 1355 invoked by uid 22791); 4 Apr 2007 04:52:58 -0000 X-Spam-Check-By: sourceware.org Received: from vms046pub.verizon.net (HELO vms046pub.verizon.net) (206.46.252.46) by sourceware.org (qpsmtpd/0.31) with ESMTP; Wed, 04 Apr 2007 05:52:54 +0100 Received: from [192.168.1.2] ([71.115.217.76]) by vms046.mailsrvcs.net (Sun Java System Messaging Server 6.2-6.01 (built Apr 3 2006)) with ESMTPA id <0JFY006ICIUPN523@vms046.mailsrvcs.net>; Tue, 03 Apr 2007 23:52:03 -0500 (CDT) Date: Wed, 04 Apr 2007 04:53:00 -0000 From: Jerry DeLisle Subject: [patch, fortran] PR31201 Too large unit number generates wrong code To: Fortran List Cc: gcc-patches Message-id: <46132E9C.1090301@verizon.net> MIME-version: 1.0 Content-type: multipart/mixed; boundary=------------090608070806000801030307 User-Agent: Thunderbird 1.5.0.10 (X11/20070302) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org X-SW-Source: 2007-04/txt/msg00126.txt.bz2 This is a multi-part message in MIME format. --------------090608070806000801030307 Content-Type: text/plain; charset=ISO-8859-1; format=flowed Content-Transfer-Encoding: 7bit Content-length: 2953 :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 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 PR fortran/31201 * ioparm.def: Modify "unit" to kind 8. 2007-04-03 Jerry DeLisle PR libgfortran/31201 * gfortran.dg/iomsg_1.f90: Update test. --------------090608070806000801030307 Content-Type: text/x-fortran; name="pr31201.f" Content-Transfer-Encoding: 7bit Content-Disposition: inline; filename="pr31201.f" Content-length: 368 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 --------------090608070806000801030307 Content-Type: text/x-fortran; name="iomsg_1.f90" Content-Transfer-Encoding: 7bit Content-Disposition: inline; filename="iomsg_1.f90" Content-length: 791 ! { 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 --------------090608070806000801030307 Content-Type: text/x-patch; name="pr31201.diff" Content-Transfer-Encoding: 7bit Content-Disposition: inline; filename="pr31201.diff" Content-length: 9139 =================================================================== *** 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); } --------------090608070806000801030307--