2008-01-20 Jerry DeLisle <jvdelisle@gcc.gnu.org>
authorjvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 20 Jan 2008 06:48:39 +0000 (06:48 +0000)
committerjvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 20 Jan 2008 06:48:39 +0000 (06:48 +0000)
PR libfortran/34795
* gfortran.dg/inquire_13.f90: New test.

PR libfortran/34659
* gfortran.dg/continuation_9.f90: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@131673 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/continuation_9.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/inquire_13.f90 [new file with mode: 0644]

index 6909a8c..03aa014 100644 (file)
@@ -1,3 +1,11 @@
+2008-01-20  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libfortran/34795
+       * gfortran.dg/inquire_13.f90: New test.
+       
+       PR libfortran/34659
+       * gfortran.dg/continuation_9.f90: New test.
+
 2008-01-20  Richard Sandiford  <rsandifo@nildram.co.uk>
 
        PR target/34831
@@ -49,9 +57,9 @@
        * gfortran.dg/bom_error.f90: Ditto.
        * gfortran.dg/func_decl_4.f90: Ditto.
 
-2007-01-18  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+2008-01-18  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
-       PR target/34782
+       PR libfortran/34782
        * gfortran.dg/fmt_t_6.f: New test.
 
 2008-01-18  Tobias Burnus  <burnus@net-b.de>
diff --git a/gcc/testsuite/gfortran.dg/continuation_9.f90 b/gcc/testsuite/gfortran.dg/continuation_9.f90
new file mode 100644 (file)
index 0000000..7cd9c9d
--- /dev/null
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+  &  
+&
+ &
+end
+! { dg-error "not allowed by itself in line 3" "" {target "*-*-*"} 0 }
+! { dg-error "not allowed by itself in line 4" "" {target "*-*-*"} 0 }
+! { dg-error "not allowed by itself in line 5" "" {target "*-*-*"} 0 }
diff --git a/gcc/testsuite/gfortran.dg/inquire_13.f90 b/gcc/testsuite/gfortran.dg/inquire_13.f90
new file mode 100644 (file)
index 0000000..366e383
--- /dev/null
@@ -0,0 +1,101 @@
+! { dg-do run }
+! PR34795 inquire statement , direct= specifier incorrectly returns YES
+! Test case from PR, modified by Jerry DeLisle  <jvdelisle@gcc.gnu.org
+program testinquire
+implicit none
+character drct*7, acc*12, frmt*12, seqn*12, fname*15
+logical opn
+
+fname="inquire_13_test"
+inquire(unit=6, direct=drct, opened=opn, access=acc)
+if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
+
+inquire(unit=10, direct=drct, opened=opn, access=acc)
+if (drct.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") call abort
+
+inquire(unit=10, direct=drct, opened=opn, access=acc, formatted=frmt)
+if (drct.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") call abort
+if (frmt.ne."UNKNOWN") call abort
+
+open(unit=19,file=fname,status='replace',err=170,form="formatted")
+inquire(unit=19, direct=drct, opened=opn, access=acc,formatted=frmt)
+if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL")  call abort
+if (frmt.ne."YES")  call abort
+
+! Inquire on filename, open file with DIRECT and FORMATTED
+inquire(file=fname, direct=drct, opened=opn, access=acc, FORMATTED=frmt)
+if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL")  call abort
+if (frmt.ne."YES") call abort
+close(19)
+
+! Inquire on filename, closed file with DIRECT and FORMATTED
+inquire(file=fname, direct=drct, opened=opn, access=acc, formatted=frmt)
+if (drct.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") call abort
+if (frmt.ne."UNKNOWN") call abort
+
+open(unit=19,file=fname,status='replace',err=170,form="unformatted")
+inquire(unit=19, direct=drct, opened=opn, access=acc, formatted=frmt)
+if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
+if (frmt.ne."NO")  call abort
+close(19)
+       
+open(unit=19,file=fname,status='replace',err=170,form="formatted")
+
+inquire(unit=19, direct=drct, opened=opn, access=acc, unformatted=frmt)
+if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
+
+! Inquire on filename, open file with DIRECT and UNFORMATTED
+inquire(file=fname, direct=drct, opened=opn, access=acc, UNFORMATTED=frmt)
+if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL")  call abort
+if (frmt.ne."NO") call abort
+close(19)
+
+! Inquire on filename, closed file with DIRECT and UNFORMATTED
+inquire(file=fname, direct=drct, opened=opn, access=acc, unformatted=frmt)
+if (drct.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") call abort
+if (frmt.ne."UNKNOWN") call abort
+
+open(unit=19,file=fname,status='replace',err=170,form="unformatted")
+
+inquire(unit=19, direct=drct, opened=opn, access=acc,unformatted=frmt)
+if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
+if (frmt.ne."YES")  call abort
+close(19)
+      
+open(unit=19,file=fname,status='replace',err=170)
+
+inquire(unit=19, direct=drct, opened=opn, access=acc)
+if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
+close(19)
+
+open(unit=19,file=fname,status='replace',err=170,access='SEQUENTIAL')
+
+inquire(unit=19, direct=drct, opened=opn, access=acc)
+if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
+
+! Inquire on filename, open file with SEQUENTIAL
+inquire(file=fname, SEQUENTIAL=seqn, opened=opn, access=acc)
+if (seqn.ne."YES" .and. .not.opn .and. acc.ne."DIRECT") call abort
+close(19)
+
+! Inquire on filename, closed file with SEQUENTIAL
+inquire(file=fname, SEQUENTIAL=seqn, opened=opn, access=acc)
+if (seqn.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") call abort
+
+open(unit=19,file=fname,status='replace',err=170,form='UNFORMATTED',access='DIRECT',recl=72)
+
+inquire(unit=19, direct=drct, opened=opn, access=acc)
+if (drct.ne."YES" .and. .not.opn .and. acc.ne."DIRECT") call abort
+
+! Inquire on filename, open file with DIRECT
+inquire(file=fname, direct=drct, opened=opn, access=acc)
+if (drct.ne."YES" .and. .not.opn .and. acc.ne."DIRECT") call abort
+close(19, status="delete")
+
+! Inquire on filename, closed file with DIRECT
+inquire(file=fname, direct=drct, opened=opn, access=acc)
+if (drct.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") call abort
+stop
+
+170   write(*,*) "ERROR: unable to open testdirect.f"
+end