OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [optional_absent_1.f90] - Blame information for rev 774

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! { dg-options "-std=f2008 -fall-intrinsics" }
3
!
4
! Passing a null pointer or deallocated variable to an
5
! optional, non-pointer, non-allocatable dummy.
6
!
7
program test
8
  implicit none
9
  integer, pointer :: ps => NULL(), pa(:) => NULL()
10
  integer, allocatable :: as, aa(:)
11
 
12
  call scalar(ps)
13
  call scalar(as)
14
  call scalar()
15
  call scalar(NULL())
16
 
17
  call assumed_size(pa)
18
  call assumed_size(aa)
19
  call assumed_size()
20
  call assumed_size(NULL(pa))
21
 
22
  call assumed_shape(pa)
23
  call assumed_shape(aa)
24
  call assumed_shape()
25
  call assumed_shape(NULL())
26
 
27
  call ptr_func(.true., ps)
28
  call ptr_func(.true., null())
29
  call ptr_func(.false.)
30
contains
31
  subroutine scalar(a)
32
    integer, optional :: a
33
    if (present(a)) call abort()
34
  end subroutine scalar
35
  subroutine assumed_size(a)
36
    integer, optional :: a(*)
37
    if (present(a)) call abort()
38
  end subroutine assumed_size
39
  subroutine assumed_shape(a)
40
    integer, optional :: a(:)
41
    if (present(a)) call abort()
42
  end subroutine assumed_shape
43
  subroutine ptr_func(is_psnt, a)
44
    integer, optional, pointer :: a
45
    logical :: is_psnt
46
    if (is_psnt .neqv. present(a)) call abort()
47
  end subroutine ptr_func
48
end program test

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.