Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/fgetc_2.f90 @ 127:4c56639505ff
fix function.c and add CbC-example Makefile
author | mir3636 |
---|---|
date | Wed, 11 Apr 2018 18:46:58 +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) st = fgetc(10,s) if ((st /= 0) .or. (s /= "a ")) call abort st = fgetc(10,s) close(10) open(10,status="scratch") s = "12345" st = fputc(10,s) if (st /= 0) call abort st = fputc(10,"2") if (st /= 0) call abort st = fputc(10,"3 ") if (st /= 0) call abort rewind(10) st = fgetc(10,s) if (s(1:1) /= "1") call abort st = fgetc(10,s) if (s(1:1) /= "2") call abort st = fgetc(10,s) if ((s(1:1) /= "3") .or. (st /= 0)) call abort st = fgetc(10,s) if (st /= -1) call abort close (10) ! FGETC and FPUTC on units not opened should not work st = fgetc(12,s) if (st /= -1) call abort st = fputc(12,s) if (st /= -1) call abort end