Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/gfortran.dg/intrinsic_std_1.f90 @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
1 ! { dg-do compile } | |
2 ! { dg-options "-std=f95 -Wintrinsics-std" } | |
3 | |
4 ! | |
5 ! See intrinsic_std_6.f90 for the dump check. | |
6 ! | |
7 | |
8 ! PR fortran/33141 | |
9 ! Check for the expected behavior when an intrinsic function/subroutine is | |
10 ! called that is not available in the defined standard or that is a GNU | |
11 ! extension: | |
12 ! There should be a warning emitted on the call, and the reference should be | |
13 ! treated like an external call. | |
14 ! For declaring a non-standard intrinsic INTRINSIC, a hard error should be | |
15 ! generated, of course. | |
16 | |
17 SUBROUTINE no_implicit | |
18 IMPLICIT NONE | |
19 REAL :: asinh ! { dg-warning "Fortran 2008" } | |
20 | |
21 ! abort is a GNU extension | |
22 CALL abort () ! { dg-warning "extension" } | |
23 | |
24 ! ASINH is an intrinsic of F2008 | |
25 ! The warning should be issued in the declaration above where it is declared | |
26 ! EXTERNAL. | |
27 WRITE (*,*) ASINH (1.) ! { dg-warning "Fortran 2008" } | |
28 END SUBROUTINE no_implicit | |
29 | |
30 SUBROUTINE implicit_type | |
31 ! acosh has implicit type | |
32 | |
33 WRITE (*,*) ACOSH (1.) ! { dg-warning "Fortran 2008" } | |
34 WRITE (*,*) ACOSH (1.) ! { dg-bogus "Fortran 2008" } | |
35 END SUBROUTINE implicit_type | |
36 | |
37 SUBROUTINE specification_expression | |
38 CHARACTER(KIND=selected_char_kind("ascii")) :: x | |
39 ! { dg-error "must be an intrinsic function" "" { target "*-*-*" } .-1 } | |
40 ! { dg-warning "Fortran 2003" "" { target "*-*-*" } .-2 } | |
41 END SUBROUTINE specification_expression | |
42 | |
43 SUBROUTINE intrinsic_decl | |
44 IMPLICIT NONE | |
45 INTRINSIC :: atanh ! { dg-error "Fortran 2008" } | |
46 INTRINSIC :: abort ! { dg-error "extension" } | |
47 END SUBROUTINE intrinsic_decl |