1! RUN: bbc %s -emit-fir -hlfir=false --canonicalize -o - | FileCheck %s 2 3! CHECK-LABEL: stop_test 4subroutine stop_test() 5 ! CHECK-DAG: %[[c0:.*]] = arith.constant 0 : i32 6 ! CHECK-DAG: %[[false:.*]] = arith.constant false 7 ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c0]], %[[false]], %[[false]]) 8 ! CHECK-NEXT: fir.unreachable 9 stop 10end subroutine 11 12! CHECK-LABEL: stop_code 13subroutine stop_code() 14 stop 42 15 ! CHECK-DAG: %[[c42:.*]] = arith.constant 42 : i32 16 ! CHECK-DAG: %[[false:.*]] = arith.constant false 17 ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c42]], %[[false]], %[[false]]) 18 ! CHECK-NEXT: fir.unreachable 19end subroutine 20 21! CHECK-LABEL: stop_error 22subroutine stop_error() 23 error stop 24 ! CHECK-DAG: %[[c_1:.*]] = arith.constant 1 : i32 25 ! CHECK-DAG: %[[true:.*]] = arith.constant true 26 ! CHECK-DAG: %[[false:.*]] = arith.constant false 27 ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c_1]], %[[true]], %[[false]]) 28 ! CHECK-NEXT: fir.unreachable 29end subroutine 30 31! CHECK-LABEL: stop_quiet 32subroutine stop_quiet() 33 logical :: b 34 stop, quiet = b 35 ! CHECK-DAG: %[[c0:.*]] = arith.constant 0 : i32 36 ! CHECK-DAG: %[[false:.*]] = arith.constant false 37 ! CHECK: %[[ALLOCA:.*]] = fir.alloca !fir.logical<4> {bindc_name = "b", uniq_name = "_QFstop_quietEb"} 38 ! CHECK: %[[b:.*]] = fir.load %[[ALLOCA]] 39 ! CHECK: %[[bi1:.*]] = fir.convert %[[b]] : (!fir.logical<4>) -> i1 40 ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c0]], %[[false]], %[[bi1]]) 41 ! CHECK-NEXT: fir.unreachable 42end subroutine 43 44! CHECK-LABEL: stop_quiet_constant 45subroutine stop_quiet_constant() 46 stop, quiet = .true. 47 ! CHECK-DAG: %[[true:.*]] = arith.constant true 48 ! CHECK-DAG: %[[false:.*]] = arith.constant false 49 ! CHECK-DAG: %[[c0:.*]] = arith.constant 0 : i32 50 ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c0]], %[[false]], %[[true]]) 51 ! CHECK-NEXT: fir.unreachable 52end subroutine 53 54! CHECK-LABEL: stop_error_code_quiet 55subroutine stop_error_code_quiet(b) 56 logical :: b 57 error stop 66, quiet = b 58 ! CHECK-DAG: %[[c66:.*]] = arith.constant 66 : i32 59 ! CHECK-DAG: %[[true:.*]] = arith.constant true 60 ! CHECK-DAG: %[[b:.*]] = fir.load %arg0 61 ! CHECK-DAG: %[[bi1:.*]] = fir.convert %[[b]] : (!fir.logical<4>) -> i1 62 ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c66]], %[[true]], %[[bi1]]) 63 ! CHECK-NEXT: fir.unreachable 64end subroutine 65 66! CHECK-LABEL: stop_char_lit 67subroutine stop_char_lit 68 ! CHECK-DAG: %[[false:.*]] = arith.constant false 69 ! CHECK-DAG: %[[five:.*]] = arith.constant 5 : index 70 ! CHECK-DAG: %[[lit:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,5>> 71 ! CHECK-DAG: %[[buff:.*]] = fir.convert %[[lit]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<i8> 72 ! CHECK-DAG: %[[len:.*]] = fir.convert %[[five]] : (index) -> i64 73 ! CHECK: fir.call @{{.*}}StopStatementText(%[[buff]], %[[len]], %[[false]], %[[false]]) {{.*}}: 74 ! CHECK-NEXT: fir.unreachable 75 stop 'crash' 76end subroutine stop_char_lit 77 78! CHECK-DAG: func private @_Fortran{{.*}}StopStatement(i32, i1, i1) 79! CHECK-DAG: func private @_Fortran{{.*}}StopStatementText(!fir.ref<i8>, i64, i1, i1) 80