gcc/testsuite/gfortran.dg/value_9.f90

   1 ! { dg-do run }
   2 ! PR fortran/110360 - ABI for scalar character(len=1),value dummy argument
   3
   4 program p
   5   implicit none
   6   character,               allocatable :: ca
   7   character,               pointer     :: cp
   8   character(len=:),        allocatable :: cd
   9   character      (kind=4), allocatable :: ca4
  10   character      (kind=4), pointer     :: cp4
  11   character(len=:,kind=4), allocatable :: cd4
  12   character                            :: c  =   "1"
  13   character      (kind=4)              :: c4 = 4_"4"
  14   character(len=3)                     :: d  =   "210"
  15   character(len=3,kind=4)              :: d4 = 4_"321"
  16   integer :: a = 65
  17   integer :: l = 2
  18   allocate (ca, cp, ca4, cp4)
  19
  20   ! Check len=1 actual argument cases first
  21   ca  =   "a"; cp  =   "b"; cd  =   "c"
  22   ca4 = 4_"d"; cp4 = 4_"e"; cd4 = 4_"f"
  23   call val  ("B","B", 1, 2)
  24   call val  ("A",char(65), 3, 4)
  25   call val  ("A",char(a), 5, 6)
  26   call val  ("A",mychar(65), 7, 8)
  27   call val  ("A",mychar(a), 9, 10)
  28   call val  ("1",c, 11, 12)
  29   call val  ("1",(c), 13, 14)
  30   call val4 (4_"C",4_"C", 15, 16)
  31   call val4 (4_"A",char(65,kind=4), 17, 18)
  32   call val4 (4_"A",char(a, kind=4), 19, 20)
  33   call val4 (4_"4",c4, 21, 22)
  34   call val4 (4_"4",(c4), 23, 24)
  35   call val  (ca,ca, 25, 26)
  36   call val  (cp,cp, 27, 28)
  37   call val  (cd,cd, 29, 30)
  38   call val  (ca,(ca), 31, 32)
  39   call val4 (ca4,ca4, 33, 34)
  40   call val4 (cp4,cp4, 35, 36)
  41   call val4 (cd4,cd4, 37, 38)
  42   call val4 (cd4,(cd4), 39, 40)
  43   call sub  ("S", 41, 42)
  44   call sub4 (4_"T", 43, 44)
  45
  46   ! Check that always the first character of the string is finally used
  47   call val  (  "U++",  "U--", 45, 46)
  48   call val4 (4_"V**",4_"V//", 47, 48)
  49   call sub  (  "WTY", 49, 50)
  50   call sub4 (4_"ZXV", 51, 52)
  51   call val  (  "234",  d    , 53, 54)
  52   call val4 (4_"345",  d4   , 55, 56)
  53   call val  (  "234", (d)   , 57, 58)
  54   call val4 (4_"345", (d4)  , 59, 60)
  55   call val  (  "234",  d (1:2), 61, 62)
  56   call val4 (4_"345",  d4(1:2), 63, 64)
  57   call val  (  "234",  d (1:l), 65, 66)
  58   call val4 (4_"345",  d4(1:l), 67, 68)
  59   call val  ("1",c // d, 69, 70)
  60   call val  ("1",trim (c // d), 71, 72)
  61   call val4 (4_"4",c4 // d4, 73, 74)
  62   call val4 (4_"4",trim (c4 // d4), 75, 76)
  63   cd = "gkl"; cd4 = 4_"hmn"
  64   call val  (cd,cd, 77, 78)
  65   call val4 (cd4,cd4, 79, 80)
  66   call sub  (cd, 81, 82)
  67   call sub4 (cd4, 83, 84)
  68   deallocate (ca, cp, ca4, cp4, cd, cd4)
  69 contains
  70   subroutine val (x, c, err1, err2)
  71     character(kind=1), intent(in) :: x  ! control: pass by reference
  72     character(kind=1), value      :: c
  73     integer, intent(in) :: err1, err2
  74     print *, "by value(kind=1): ", c
  75     if (c /= x)   stop err1
  76     c = "*"
  77     if (c /= "*") stop err2
  78   end
  79
  80   subroutine val4 (x, c, err1, err2)
  81     character(kind=4), intent(in) :: x  ! control: pass by reference
  82     character(kind=4), value      :: c
  83     integer, intent(in) :: err1, err2
  84     print *, "by value(kind=4): ", c
  85     if (c /= x)     stop err1
  86     c = 4_"#"
  87     if (c /= 4_"#") stop err2
  88   end
  89
  90   subroutine sub (s, err1, err2)
  91     character(*), intent(in) :: s
  92     integer,      intent(in) :: err1, err2
  93     call val (s, s, err1, err2)
  94   end
  95   subroutine sub4 (s, err1, err2)
  96     character(kind=4,len=*), intent(in) :: s
  97     integer,                 intent(in) :: err1, err2
  98     call val4 (s, s, err1, err2)
  99   end
 100
 101   character function mychar (i)
 102     integer, intent(in) :: i
 103     mychar = char (i)
 104   end
 105 end