+2008-01-22 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/34875
+ * trans-io.c (gfc_trans_transfer): If the array reference in a
+ read has a vector subscript, use gfc_conv_subref_array_arg to
+ copy back the temporary.
+
2008-01-22 Tobias Burnus <burnus@net-b.de>
PR fortran/34848
gfc_ss *ss;
gfc_se se;
tree tmp;
+ int n;
gfc_start_block (&block);
gfc_init_block (&body);
&& ref && ref->next == NULL
&& !is_subref_array (expr))
{
- /* Get the descriptor. */
- gfc_conv_expr_descriptor (&se, expr, ss);
- tmp = build_fold_addr_expr (se.expr);
+ bool seen_vector = false;
+
+ if (ref && ref->u.ar.type == AR_SECTION)
+ {
+ for (n = 0; n < ref->u.ar.dimen; n++)
+ if (ref->u.ar.dimen_type[n] == DIMEN_VECTOR)
+ seen_vector = true;
+ }
+
+ if (seen_vector && last_dt == READ)
+ {
+ /* Create a temp, read to that and copy it back. */
+ gfc_conv_subref_array_arg (&se, expr, 0, INTENT_OUT);
+ tmp = se.expr;
+ }
+ else
+ {
+ /* Get the descriptor. */
+ gfc_conv_expr_descriptor (&se, expr, ss);
+ tmp = build_fold_addr_expr (se.expr);
+ }
+
transfer_array_desc (&se, &expr->ts, tmp);
goto finish_block_label;
}
--- /dev/null
+! { dg-do run }
+!
+! Test the fix for PR34875, in which the read with a vector index
+! used to do nothing.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+Program QH0008
+
+ REAL(4) QDA(10)
+ REAL(4) QDA1(10)
+! Scramble the vector up a bit to make the test more interesting
+ integer, dimension(10) :: nfv1 = (/9,2,1,3,5,4,6,8,7,10/)
+! Set qda1 in ordinal order
+ qda1(nfv1) = nfv1
+ qda = -100
+ OPEN (UNIT = 47, &
+ STATUS = 'SCRATCH', &
+ FORM = 'UNFORMATTED', &
+ ACTION = 'READWRITE')
+ ISTAT = -314
+ REWIND (47, IOSTAT = ISTAT)
+ IF (ISTAT .NE. 0) call abort ()
+ ISTAT = -314
+! write qda1
+ WRITE (47,IOSTAT = ISTAT) QDA1
+ IF (ISTAT .NE. 0) call abort ()
+ ISTAT = -314
+ REWIND (47, IOSTAT = ISTAT)
+ IF (ISTAT .NE. 0) call abort ()
+! Do the vector index read that used to fail
+ READ (47,IOSTAT = ISTAT) QDA(NFV1)
+ IF (ISTAT .NE. 0) call abort ()
+! Unscramble qda using the vector index
+ IF (ANY (QDA(nfv1) .ne. QDA1) ) print *, qda, qda1
+ ISTAT = -314
+ REWIND (47, IOSTAT = ISTAT)
+ IF (ISTAT .NE. 0) call abort ()
+ qda = -200
+! Do the subscript read that was OK
+ READ (47,IOSTAT = ISTAT) QDA(1:10)
+ IF (ISTAT .NE. 0) call abort ()
+ IF (ANY (QDA .ne. QDA1) ) call abort ()
+END
+