Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/fgetc_1.f90 @ 120:f93fa5091070
fix conv1.c
author | mir3636 |
---|---|
date | Thu, 08 Mar 2018 14:53:42 +0900 |
parents | 04ced10e8804 |
children | 84e7813d76e9 |
line wrap: on
line source
! Testcase for the FGETC and FPUTC intrinsics ! { dg-do run } character(len=5) s integer st s = "12345" open(10,status="scratch") write(10,"(A)") "abcde" rewind(10) call fgetc(10,s,st) if ((st /= 0) .or. (s /= "a ")) call abort call fgetc(10,s,st) close(10) open(10,status="scratch") s = "12345" call fputc(10,s,st) if (st /= 0) call abort call fputc(10,"2",st) if (st /= 0) call abort call fputc(10,"3 ",st) if (st /= 0) call abort rewind(10) call fgetc(10,s) if (s(1:1) /= "1") call abort call fgetc(10,s) if (s(1:1) /= "2") call abort call fgetc(10,s,st) if ((s(1:1) /= "3") .or. (st /= 0)) call abort call fgetc(10,s,st) if (st /= -1) call abort close (10) ! FGETC and FPUTC on units not opened should not work call fgetc(12,s,st) if (st /= -1) call abort call fputc(12,s,st) if (st /= -1) call abort end