Fortran: Fix bind(C) character length checks
authorTobias Burnus <tobias@codesourcery.com>
Wed, 21 Jul 2021 07:36:48 +0000 (09:36 +0200)
committerTobias Burnus <tobias@codesourcery.com>
Wed, 21 Jul 2021 07:36:48 +0000 (09:36 +0200)
gcc/fortran/ChangeLog:

* decl.c (gfc_verify_c_interop_param): Update for F2008 + F2018
changes; reject unsupported bits with 'Error: Sorry,'.
* trans-expr.c (gfc_conv_procedure_call): Fix condition to
For using CFI descriptor with characters.

gcc/testsuite/ChangeLog:

* gfortran.dg/iso_c_binding_char_1.f90: Update dg-error.
* gfortran.dg/pr32599.f03: Use -std=-f2003 + update comment.
* gfortran.dg/bind_c_char_10.f90: New test.
* gfortran.dg/bind_c_char_6.f90: New test.
* gfortran.dg/bind_c_char_7.f90: New test.
* gfortran.dg/bind_c_char_8.f90: New test.
* gfortran.dg/bind_c_char_9.f90: New test.

gcc/fortran/decl.c
gcc/fortran/trans-expr.c
gcc/testsuite/gfortran.dg/bind_c_char_10.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/bind_c_char_6.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/bind_c_char_7.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/bind_c_char_8.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/bind_c_char_9.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90
gcc/testsuite/gfortran.dg/pr32599.f03

index 413c7a7..05081c4 100644 (file)
@@ -1552,20 +1552,115 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
            }
 
           /* Character strings are only C interoperable if they have a
-             length of 1.  */
-          if (sym->ts.type == BT_CHARACTER && !sym->attr.dimension)
+            length of 1.  However, as argument they are either iteroperable
+            when passed as descriptor (which requires len=: or len=*) or
+            when having a constant length or are always passed by
+            descriptor.  */
+         if (sym->ts.type == BT_CHARACTER)
            {
              gfc_charlen *cl = sym->ts.u.cl;
-             if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT
-                  || mpz_cmp_si (cl->length->value.integer, 1) != 0)
+
+             if (sym->attr.allocatable || sym->attr.pointer)
                {
-                 gfc_error ("Character argument %qs at %L "
-                            "must be length 1 because "
-                            "procedure %qs is BIND(C)",
-                            sym->name, &sym->declared_at,
-                            sym->ns->proc_name->name);
+                 /* F2018, 18.3.6 (6).  */
+                 if (!sym->ts.deferred)
+                   {
+                     if (sym->attr.allocatable)
+                       gfc_error ("Allocatable character dummy argument %qs "
+                                  "at %L must have deferred length as "
+                                  "procedure %qs is BIND(C)", sym->name,
+                                  &sym->declared_at, sym->ns->proc_name->name);
+                     else
+                       gfc_error ("Pointer character dummy argument %qs at %L "
+                                  "must have deferred length as procedure %qs "
+                                  "is BIND(C)", sym->name, &sym->declared_at,
+                                  sym->ns->proc_name->name);
+                     retval = false;
+                   }
+                 else if (!gfc_notify_std (GFC_STD_F2018,
+                                           "Deferred-length character dummy "
+                                           "argument %qs at %L of procedure "
+                                           "%qs with BIND(C) attribute",
+                                           sym->name, &sym->declared_at,
+                                           sym->ns->proc_name->name))
+                   retval = false;
+                 else if (!sym->attr.dimension)
+                   {
+                     /* FIXME: Use CFI array descriptor for scalars.  */
+                     gfc_error ("Sorry, deferred-length scalar character dummy "
+                                "argument %qs at %L of procedure %qs with "
+                                "BIND(C) not yet supported", sym->name,
+                                &sym->declared_at, sym->ns->proc_name->name);
+                     retval = false;
+                   }
+               }
+             else if (sym->attr.value
+                      && (!cl || !cl->length
+                          || cl->length->expr_type != EXPR_CONSTANT
+                          || mpz_cmp_si (cl->length->value.integer, 1) != 0))
+               {
+                 gfc_error ("Character dummy argument %qs at %L must be "
+                            "of length 1 as it has the VALUE attribute",
+                            sym->name, &sym->declared_at);
                  retval = false;
                }
+             else if (!cl || !cl->length)
+               {
+                 /* Assumed length; F2018, 18.3.6 (5)(2).
+                    Uses the CFI array descriptor.  */
+                 if (!gfc_notify_std (GFC_STD_F2018,
+                                     "Assumed-length character dummy argument "
+                                     "%qs at %L of procedure %qs with BIND(C) "
+                                     "attribute", sym->name, &sym->declared_at,
+                                     sym->ns->proc_name->name))
+                   retval = false;
+                 else if (!sym->attr.dimension
+                          || sym->as->type == AS_ASSUMED_SIZE
+                          || sym->as->type == AS_EXPLICIT)
+                   {
+                     /* FIXME: Valid - should use the CFI array descriptor, but
+                        not yet handled for scalars and assumed-/explicit-size
+                        arrays.  */
+                     gfc_error ("Sorry, character dummy argument %qs at %L "
+                                "with assumed length is not yet supported for "
+                                "procedure %qs with BIND(C) attribute",
+                                sym->name, &sym->declared_at,
+                                sym->ns->proc_name->name);
+                     retval = false;
+                   }
+               }
+             else if (cl->length->expr_type != EXPR_CONSTANT)
+               {
+                 /* F2018, 18.3.6, (5), item 4.  */
+                 if (!sym->attr.dimension
+                     || sym->as->type == AS_ASSUMED_SIZE
+                     || sym->as->type == AS_EXPLICIT)
+                   {
+                     gfc_error ("Character dummy argument %qs at %L must be "
+                                "of constant length or assumed length, "
+                                "unless it has assumed shape or assumed rank, "
+                                "as procedure %qs has the BIND(C) attribute",
+                                sym->name, &sym->declared_at,
+                                sym->ns->proc_name->name);
+                     retval = false;
+                   }
+                 else if (!gfc_notify_std (GFC_STD_F2018,
+                                           "Character dummy argument %qs at "
+                                           "%L with nonconstant length as "
+                                           "procedure %qs is BIND(C)",
+                                           sym->name, &sym->declared_at,
+                                           sym->ns->proc_name->name))
+                   retval = false;
+               }
+            else if (mpz_cmp_si (cl->length->value.integer, 1) != 0
+                     && !gfc_notify_std (GFC_STD_F2008,
+                                         "Character dummy argument %qs at %L "
+                                         "with length greater than 1 for "
+                                         "procedure %qs with BIND(C) "
+                                         "attribute",
+                                         sym->name, &sym->declared_at,
+                                         sym->ns->proc_name->name))
+              retval = false;
            }
 
          /* We have to make sure that any param to a bind(c) routine does
index 9e0dcde..b18a9ec 100644 (file)
@@ -5757,18 +5757,16 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
        arg = arg->next, formal = formal ? formal->next : NULL, ++argc)
     {
       bool finalized = false;
-      bool non_unity_length_string = false;
+      bool assumed_length_string = false;
       tree derived_array = NULL_TREE;
 
       e = arg->expr;
       fsym = formal ? formal->sym : NULL;
       parm_kind = MISSING;
 
-      if (fsym && fsym->ts.type == BT_CHARACTER && fsym->ts.u.cl
-         && (!fsym->ts.u.cl->length
-             || fsym->ts.u.cl->length->expr_type != EXPR_CONSTANT
-             || mpz_cmp_si (fsym->ts.u.cl->length->value.integer, 1) != 0))
-       non_unity_length_string = true;
+      if (fsym && fsym->ts.type == BT_CHARACTER
+         && (!fsym->ts.u.cl || !fsym->ts.u.cl->length))
+       assumed_length_string = true;
 
       /* If the procedure requires an explicit interface, the actual
         argument is passed according to the corresponding formal
@@ -6002,8 +6000,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 
              else if (sym->attr.is_bind_c && e
                       && (is_CFI_desc (fsym, NULL)
-                          || non_unity_length_string))
-               /* Implement F2018, C.12.6.1: paragraph (2).  */
+                          || assumed_length_string))
+               /* Implement F2018, 18.3.6, list item (5), bullet point 2.  */
                gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym);
 
              else if (fsym && fsym->attr.value)
@@ -6447,8 +6445,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
                }
 
              if (sym->attr.is_bind_c && e
-                 && (is_CFI_desc (fsym, NULL) || non_unity_length_string))
-               /* Implement F2018, C.12.6.1: paragraph (2).  */
+                 && (is_CFI_desc (fsym, NULL) || assumed_length_string))
+               /* Implement F2018, 18.3.6, list item (5), bullet point 2.  */
                gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym);
 
              else if (e->expr_type == EXPR_VARIABLE
diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_10.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_10.f90
new file mode 100644 (file)
index 0000000..3595851
--- /dev/null
@@ -0,0 +1,480 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+
+! F2018  - examples with array descriptor
+
+module m
+  use iso_c_binding, only: c_char
+  implicit none (type, external)
+
+contains
+
+! Assumed-shape array, nonallocatable/nonpointer
+
+subroutine as1 (x1) bind(C)
+  character(kind=c_char, len=1) :: x1(:)
+  if (size(x1) /= 6) stop
+  if (len(x1) /= 1) stop  
+  if (any (x1 /= ['g', &
+                  'd', &
+                  'f', &
+                  's', &
+                  '3', &
+                  '5'])) stop 1
+  x1 = ['1', &
+        'h', &
+        'f', &
+        '3', &
+        '4', &
+        'h']
+end
+
+subroutine as2 (x2) bind(C)
+  character(kind=c_char, len=2) :: x2(:)
+  if (size(x2) /= 6) stop
+  if (len(x2) /= 2) stop  
+  if (any (x2 /= ['ab', &
+                  'fd', &
+                  'D4', &
+                  '54', &
+                  'ga', &
+                  'hg'])) stop
+  x2 = ['ab', &
+        'hd', &
+        'fj', &
+        'a4', &
+        '4a', &
+        'hf']
+end
+
+subroutine as3 (xn, n) bind(C)
+  integer :: n
+  character(kind=c_char, len=n) :: xn(:)
+  if (size(xn) /= 6) stop
+  if (len(xn) /= 5) stop  
+  if (any (xn /= ['DDGhf', &
+                 'hdrh$', &
+                 'fDGSl', &
+                 'DFHs3', &
+                 '43grG', &
+                 'hFG$k'])) stop
+  xn = ['FDGhf', &
+       'hdrhg', &
+       'fDgFl', &
+       'DFHs3', &
+       '4a54G', &
+       'hSs6k']
+end
+
+subroutine as4 (xstar) bind(C)
+  character(kind=c_char, len=*) :: xstar(:)
+  if (size(xstar) /= 6) stop
+  if (len(xstar) /= 5) stop  
+  if (any (xstar /= ['DDGhf', &
+                     'hdrh$', &
+                     'fDGSl', &
+                     'DFHs3', &
+                     '43grG', &
+                     'hFG$k'])) stop
+  xstar = ['FDGhf', &
+           'hdrhg', &
+           'fDgFl', &
+           'DFHs3', &
+           '4a54G', &
+           'hSs6k']
+end
+
+! Assumed-rank array, nonallocatable/nonpointer
+
+subroutine ar1 (x1) bind(C)
+  character(kind=c_char, len=1) :: x1(..)
+  if (size(x1) /= 6) stop
+  if (len(x1) /= 1) stop  
+  select rank(x1)
+    rank(1)
+      if (any (x1 /= ['g', &
+                      'd', &
+                      'f', &
+                      's', &
+                      '3', &
+                      '5'])) stop
+      x1 = ['1', &
+            'h', &
+            'f', &
+            '3', &
+            '4', &
+            'h']
+  rank default
+    stop
+  end select
+end
+
+subroutine ar2 (x2) bind(C)
+  character(kind=c_char, len=2) :: x2(..)
+  if (size(x2) /= 6) stop
+  if (len(x2) /= 2) stop  
+  select rank(x2)
+    rank(1)
+      if (any (x2 /= ['ab', &
+                      'fd', &
+                      'D4', &
+                      '54', &
+                      'ga', &
+                      'hg'])) stop
+      x2 = ['ab', &
+            'hd', &
+            'fj', &
+            'a4', &
+            '4a', &
+            'hf']
+    rank default
+      stop
+  end select
+end
+
+subroutine ar3 (xn, n) bind(C)
+  integer :: n
+  character(len=n) :: xn(..)
+  if (size(xn) /= 6) stop
+  if (len(xn) /= 5) stop  
+  select rank(xn)
+    rank(1)
+      if (any (xn /= ['DDGhf', &
+                      'hdrh$', &
+                      'fDGSl', &
+                      'DFHs3', &
+                      '43grG', &
+                      'hFG$k'])) stop
+      xn = ['FDGhf', &
+            'hdrhg', &
+            'fDgFl', &
+            'DFHs3', &
+            '4a54G', &
+            'hSs6k']
+  rank default
+    stop
+  end select
+end
+
+subroutine ar4 (xstar) bind(C)
+  character(kind=c_char, len=*) :: xstar(..)
+  if (size(xstar) /= 6) stop
+  if (len(xstar) /= 5) stop  
+  select rank(xstar)
+    rank(1)
+      if (any (xstar /= ['DDGhf', &
+                         'hdrh$', &
+                         'fDGSl', &
+                         'DFHs3', &
+                         '43grG', &
+                         'hFG$k'])) stop
+      xstar = ['FDGhf', &
+               'hdrhg', &
+               'fDgFl', &
+               'DFHs3', &
+               '4a54G', &
+               'hSs6k']
+  rank default
+    stop
+  end select
+end
+
+! ALLOCATABLE
+
+! Assumed-shape array, allocatable
+
+subroutine a5a (xcolon) bind(C)
+  character(kind=c_char, len=:), allocatable :: xcolon(:)
+  if (.not. allocated (xcolon)) stop
+  if (size(xcolon) /= 6) stop
+  if (len(xcolon) /= 5) stop  
+  if (any (xcolon /= ['DDGhf', &
+                     'hdrh$', &
+                     'fDGSl', &
+                     'DFHs3', &
+                     '43grG', &
+                     'hFG$k'])) stop
+  xcolon = ['FDGhf', &
+           'hdrhg', &
+           'fDgFl', &
+           'DFHs3', &
+           '4a54G', &
+           'hSs6k']
+end
+
+! Assumed-rank array, allocatable
+
+subroutine a5ar (xcolon) bind(C)
+  character(kind=c_char, len=:), allocatable :: xcolon(..)
+  if (.not. allocated (xcolon)) stop
+  if (size(xcolon) /= 6) stop
+  if (len(xcolon) /= 5) stop  
+  select rank(xcolon)
+    rank(1)
+      if (any (xcolon /= ['DDGhf', &
+                         'hdrh$', &
+                         'fDGSl', &
+                         'DFHs3', &
+                         '43grG', &
+                         'hFG$k'])) stop
+      xcolon = ['FDGhf', &
+               'hdrhg', &
+               'fDgFl', &
+               'DFHs3', &
+               '4a54G', &
+               'hSs6k']
+  rank default
+    stop
+  end select
+end
+
+! POINTER
+! Assumed-shape array, pointer
+
+subroutine a5p (xcolon) bind(C)
+  character(kind=c_char, len=:), pointer :: xcolon(:)
+  if (.not. associated (xcolon)) stop
+  if (size(xcolon) /= 6) stop
+  if (len(xcolon) /= 5) stop  
+  if (any (xcolon /= ['DDGhf', &
+                     'hdrh$', &
+                     'fDGSl', &
+                     'DFHs3', &
+                     '43grG', &
+                     'hFG$k'])) stop
+  xcolon = ['FDGhf', &
+           'hdrhg', &
+           'fDgFl', &
+           'DFHs3', &
+           '4a54G', &
+           'hSs6k']
+end
+
+! Assumed-rank array, pointer
+
+subroutine a5pr (xcolon) bind(C)
+  character(kind=c_char, len=:), pointer :: xcolon(..)
+  if (.not. associated (xcolon)) stop
+  if (size(xcolon) /= 6) stop
+  if (len(xcolon) /= 5) stop  
+  select rank(xcolon)
+    rank(1)
+      if (any (xcolon /= ['DDGhf', &
+                         'hdrh$', &
+                         'fDGSl', &
+                         'DFHs3', &
+                         '43grG', &
+                         'hFG$k'])) stop
+      xcolon = ['FDGhf', &
+               'hdrhg', &
+               'fDgFl', &
+               'DFHs3', &
+               '4a54G', &
+               'hSs6k']
+  rank default
+    stop
+  end select
+end
+end module m
+
+program main
+  use m
+  implicit none (type, external)
+  character(kind=c_char, len=1) :: str1a6(6)
+  character(kind=c_char, len=2) :: str2a6(6)
+  character(kind=c_char, len=5) :: str5a6(6)
+
+  character(kind=c_char, len=:), allocatable :: astr5a6(:)
+  character(kind=c_char, len=:), pointer :: pstr5a6(:)
+
+  allocate (character(kind=c_char, len=5) :: astr5a6(6), pstr5a6(6))
+
+  ! assumed shape - with array descriptor
+
+  str1a6 = ['g', &
+            'd', &
+            'f', &
+            's', &
+            '3', &
+            '5']
+  call as1 (str1a6)
+  if (any (str1a6 /= ['1', &
+                      'h', &
+                      'f', &
+                      '3', &
+                      '4', &
+                      'h'])) stop
+  str2a6 = ['ab', &
+            'fd', &
+            'D4', &
+            '54', &
+            'ga', &
+            'hg']
+  call as2 (str2a6)
+  if (any (str2a6 /= ['ab', &
+                      'hd', &
+                      'fj', &
+                      'a4', &
+                      '4a', &
+                      'hf'])) stop
+
+  str5a6 = ['DDGhf', &
+            'hdrh$', &
+            'fDGSl', &
+            'DFHs3', &
+            '43grG', &
+            'hFG$k']
+  call as3 (str5a6, 5)
+  if (any (str5a6 /= ['FDGhf', &
+                      'hdrhg', &
+                      'fDgFl', &
+                      'DFHs3', &
+                      '4a54G', &
+                      'hSs6k'])) stop
+
+  str5a6 = ['DDGhf', &
+            'hdrh$', &
+            'fDGSl', &
+            'DFHs3', &
+            '43grG', &
+            'hFG$k']
+  call as4 (str5a6)
+  if (any (str5a6 /= ['FDGhf', &
+                      'hdrhg', &
+                      'fDgFl', &
+                      'DFHs3', &
+                      '4a54G', &
+                      'hSs6k'])) stop
+
+  ! assumed rank - with array descriptor
+
+  str1a6 = ['g', &
+            'd', &
+            'f', &
+            's', &
+            '3', &
+            '5']
+  call ar1 (str1a6)
+  if (any (str1a6 /= ['1', &
+                      'h', &
+                      'f', &
+                      '3', &
+                      '4', &
+                      'h'])) stop
+  str2a6 = ['ab', &
+            'fd', &
+            'D4', &
+            '54', &
+            'ga', &
+            'hg']
+  call ar2 (str2a6)
+  if (any (str2a6 /= ['ab', &
+                      'hd', &
+                      'fj', &
+                      'a4', &
+                      '4a', &
+                      'hf'])) stop
+
+  str5a6 = ['DDGhf', &
+            'hdrh$', &
+            'fDGSl', &
+            'DFHs3', &
+            '43grG', &
+            'hFG$k']
+  call ar3 (str5a6, 5)
+  if (any (str5a6 /= ['FDGhf', &
+                      'hdrhg', &
+                      'fDgFl', &
+                      'DFHs3', &
+                      '4a54G', &
+                      'hSs6k'])) stop
+
+
+  str5a6 = ['DDGhf', &
+            'hdrh$', &
+            'fDGSl', &
+            'DFHs3', &
+            '43grG', &
+            'hFG$k']
+  call ar4 (str5a6)
+  if (any (str5a6 /= ['FDGhf', &
+                      'hdrhg', &
+                      'fDgFl', &
+                      'DFHs3', &
+                      '4a54G', &
+                      'hSs6k'])) stop
+
+  ! allocatable - with array descriptor
+  astr5a6(:) = ['DDGhf', &
+                'hdrh$', &
+                'fDGSl', &
+                'DFHs3', &
+                '43grG', &
+                'hFG$k']
+  call a5a (astr5a6)
+  if (any (astr5a6 /= ['FDGhf', &
+                       'hdrhg', &
+                       'fDgFl', &
+                       'DFHs3', &
+                       '4a54G', &
+                       'hSs6k'])) stop
+
+  astr5a6(:) = ['DDGhf', &
+                'hdrh$', &
+                'fDGSl', &
+                'DFHs3', &
+                '43grG', &
+                'hFG$k']
+  call a5ar (astr5a6)
+  if (any (astr5a6 /= ['FDGhf', &
+                       'hdrhg', &
+                       'fDgFl', &
+                       'DFHs3', &
+                       '4a54G', &
+                       'hSs6k'])) stop
+
+
+  ! pointer - with array descriptor
+  pstr5a6 = ['DDGhf', &
+             'hdrh$', &
+             'fDGSl', &
+             'DFHs3', &
+             '43grG', &
+             'hFG$k']
+  call a5p (pstr5a6)
+  if (any (pstr5a6 /= ['FDGhf', &
+                       'hdrhg', &
+                       'fDgFl', &
+                       'DFHs3', &
+                       '4a54G', &
+                       'hSs6k'])) stop
+
+  pstr5a6 = ['DDGhf', &
+             'hdrh$', &
+             'fDGSl', &
+             'DFHs3', &
+             '43grG', &
+             'hFG$k']
+  call a5pr (pstr5a6)
+  if (any (pstr5a6 /= ['FDGhf', &
+                       'hdrhg', &
+                       'fDgFl', &
+                       'DFHs3', &
+                       '4a54G', &
+                       'hSs6k'])) stop
+  deallocate (astr5a6, pstr5a6)
+end
+
+! All arguments shall use array descriptors
+! { dg-final { scan-tree-dump-times "void as1 \\(struct array01_character\\(kind=1\\) & restrict x1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void as2 \\(struct array01_character\\(kind=1\\) & restrict x2\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void as4 \\(struct array01_character\\(kind=1\\) & restrict xstar\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void as3 \\(struct array01_character\\(kind=1\\) & restrict xn, integer(kind=4) & restrict n)
+! { dg-final { scan-tree-dump-times "void ar1 \\(struct array15_character\\(kind=1\\) & restrict x1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void ar2 \\(struct array15_character\\(kind=1\\) & restrict x2\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void ar3 \\(struct array15_character\\(kind=1\\) & restrict xn, integer(kind=4) & restrict n)
+! { dg-final { scan-tree-dump-times "void ar4 \\(struct array15_character\\(kind=1\\) & restrict xstar\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void a5a \\(struct array01_character\\(kind=1\\) & restrict xcolon\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void a5ar \\(struct array15_character\\(kind=1\\) & restrict xcolon\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void a5p \\(struct array01_character\\(kind=1\\) & xcolon\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void a5pr \\(struct array15_character\\(kind=1\\) & xcolon\\)" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_6.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_6.f90
new file mode 100644 (file)
index 0000000..23e1d92
--- /dev/null
@@ -0,0 +1,262 @@
+! { dg-do compile }
+! { dg-additional-options "-std=f2003 -fimplicit-none" }
+
+! F2003 only permits length=1 character dummy args
+
+! Scalar, nonallocatable/nonpointer
+
+subroutine s1 (x1) bind(C)
+  character(len=1) :: x1
+end
+
+subroutine s2 (x2) bind(C) ! { dg-error "Fortran 2008: Character dummy argument 'x2' at .1. with length greater than 1 for procedure 's2' with BIND\\(C\\) attribute" }
+  character(len=2) :: x2
+end
+
+subroutine s3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 's3' has the BIND\\(C\\) attribute" }
+  integer :: n
+  character(len=n) :: xn
+end
+
+subroutine s4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 's4' with BIND\\(C\\) attribute" }
+  character(len=*) :: xstar
+end
+
+! Assumed-shape array, nonallocatable/nonpointer
+
+subroutine as1 (x1) bind(C)  ! { dg-error "Fortran 2018: Assumed-shape array 'x1' at .1. as dummy argument to the BIND\\(C\\) procedure 'as1' at .2." }
+  character(len=1) :: x1(:)
+end
+
+subroutine as2 (x2) bind(C) ! { dg-error "Fortran 2008: Character dummy argument 'x2' at .1. with length greater than 1 for procedure 'as2' with BIND\\(C\\) attribute" }
+                            ! { dg-error "Fortran 2018: Assumed-shape array 'x2' at .1. as dummy argument to the BIND\\(C\\) procedure 'as2' at .2." "" { target *-*-* } .-1 }
+  character(len=2) :: x2(:,:)
+end
+
+subroutine as3 (xn, n) bind(C) ! { dg-error "Fortran 2018: Character dummy argument 'xn' at .1. with nonconstant length as procedure 'as3' is BIND\\(C\\)" }
+                            ! { dg-error "Fortran 2018: Assumed-shape array 'xn' at .1. as dummy argument to the BIND\\(C\\) procedure 'as3' at .2." "" { target *-*-* } .-1 }
+  integer :: n
+  character(len=n) :: xn(:,:,:)
+end
+
+subroutine as4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 'as4' with BIND\\(C\\) attribute" }
+                            ! { dg-error "Fortran 2018: Assumed-shape array 'xstar' at .1. as dummy argument to the BIND\\(C\\) procedure 'as4' at .2." "" { target *-*-* } .-1 }
+  character(len=*) :: xstar(:,:,:,:)
+end
+
+! Assumed-rank array, nonallocatable/nonpointer
+
+subroutine ar1 (x1) bind(C) ! { dg-error "Symbol 'x1' at .1. has no IMPLICIT type" }
+  character(len=1) :: x1(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine ar2 (x2) bind(C) ! { dg-error "Symbol 'x2' at .1. has no IMPLICIT type" }
+  character(len=2) :: x2(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine ar3 (xn, n) bind(C) ! { dg-error "Symbol 'xn' at .1. has no IMPLICIT type" }
+  integer :: n
+  character(len=n) :: xn(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine ar4 (xstar) bind(C) ! { dg-error "Symbol 'xstar' at .1. has no IMPLICIT type" }
+  character(len=*) :: xstar(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+! Assumed-size array, nonallocatable/nonpointer
+
+subroutine az1 (x1) bind(C)
+  character(len=1) :: x1(*)
+end
+
+subroutine az2 (x2) bind(C) ! { dg-error "Fortran 2008: Character dummy argument 'x2' at .1. with length greater than 1 for procedure 'az2' with BIND\\(C\\) attribute" }
+  character(len=2) :: x2(*)
+end
+                                             
+subroutine az3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 'az3' has the BIND\\(C\\) attribute" }
+  integer :: n
+  character(len=n) :: xn(*)
+end
+
+subroutine az4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 'az4' with BIND\\(C\\) attribute" }
+  character(len=*) :: xstar(*)
+end
+
+! Explicit-size array, nonallocatable/nonpointer
+
+subroutine ae1 (x1) bind(C)
+  character(len=1) :: x1(5)
+end
+
+subroutine ae2 (x2) bind(C) ! { dg-error "Fortran 2008: Character dummy argument 'x2' at .1. with length greater than 1 for procedure 'ae2' with BIND\\(C\\) attribute" }
+  character(len=2) :: x2(7)
+end
+
+subroutine ae3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae3' has the BIND\\(C\\) attribute" }
+  integer :: n
+  character(len=n) :: xn(9)
+end
+
+subroutine ae4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 'ae4' with BIND\\(C\\) attribute" }
+  character(len=*) :: xstar(3)
+end
+
+! ALLOCATABLE
+! Scalar, allocatable
+
+subroutine s1a (x1) bind(C) ! { dg-error "Allocatable character dummy argument 'x1' at .1. must have deferred length as procedure 's1a' is BIND\\(C\\)" }
+                            ! { dg-error "Fortran 2018: Variable 'x1' at .1. with ALLOCATABLE attribute in procedure 's1a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=1), allocatable :: x1
+end
+
+subroutine s2a (x2) bind(C) ! { dg-error "Allocatable character dummy argument 'x2' at .1. must have deferred length as procedure 's2a' is BIND\\(C\\)" }
+                            ! { dg-error "Fortran 2018: Variable 'x2' at .1. with ALLOCATABLE attribute in procedure 's2a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=2), allocatable :: x2
+end
+
+subroutine s3a (xn, n) bind(C) ! { dg-error "Allocatable character dummy argument 'xn' at .1. must have deferred length as procedure 's3a' is BIND\\(C\\)" }
+                               ! { dg-error "Fortran 2018: Variable 'xn' at .1. with ALLOCATABLE attribute in procedure 's3a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  integer :: n
+  character(len=n), allocatable :: xn
+end
+
+subroutine s4a (xstar) bind(C) ! { dg-error "Allocatable character dummy argument 'xstar' at .1. must have deferred length as procedure 's4a' is BIND\\(C\\)" }
+                               ! { dg-error "Fortran 2018: Variable 'xstar' at .1. with ALLOCATABLE attribute in procedure 's4a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=*), allocatable :: xstar
+end
+
+subroutine s5a (xcolon) bind(C) ! { dg-error "Fortran 2018: Deferred-length character dummy argument 'xcolon' at .1. of procedure 's5a' with BIND\\(C\\) attribute" }
+                                ! { dg-error "Fortran 2018: Variable 'xcolon' at .1. with ALLOCATABLE attribute in procedure 's5a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=:), allocatable :: xcolon
+end
+
+! Assumed-shape array, allocatable
+
+subroutine a1a (x1) bind(C) ! { dg-error "Allocatable character dummy argument 'x1' at .1. must have deferred length as procedure 'a1a' is BIND\\(C\\)" }
+                            ! { dg-error "Fortran 2018: Variable 'x1' at .1. with ALLOCATABLE attribute in procedure 'a1a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=1), allocatable :: x1(:)
+end
+
+subroutine a2a (x2) bind(C) ! { dg-error "Allocatable character dummy argument 'x2' at .1. must have deferred length as procedure 'a2a' is BIND\\(C\\)" }
+                            ! { dg-error "Fortran 2018: Variable 'x2' at .1. with ALLOCATABLE attribute in procedure 'a2a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=2), allocatable :: x2(:,:)
+end
+
+subroutine a3a (xn, n) bind(C) ! { dg-error "Allocatable character dummy argument 'xn' at .1. must have deferred length as procedure 'a3a' is BIND\\(C\\)" }
+                               ! { dg-error "Fortran 2018: Variable 'xn' at .1. with ALLOCATABLE attribute in procedure 'a3a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  integer :: n
+  character(len=n), allocatable :: xn(:,:,:)
+end
+
+subroutine a4a (xstar) bind(C) ! { dg-error "Allocatable character dummy argument 'xstar' at .1. must have deferred length as procedure 'a4a' is BIND\\(C\\)" }
+                               ! { dg-error "Fortran 2018: Variable 'xstar' at .1. with ALLOCATABLE attribute in procedure 'a4a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=*), allocatable :: xstar(:,:,:,:)
+end
+
+subroutine a5a (xcolon) bind(C) ! { dg-error "Fortran 2018: Deferred-length character dummy argument 'xcolon' at .1. of procedure 'a5a' with BIND\\(C\\) attribute" }
+                                ! { dg-error "Fortran 2018: Variable 'xcolon' at .1. with ALLOCATABLE attribute in procedure 'a5a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=:), allocatable :: xcolon(:)
+end
+
+! Assumed-rank array, allocatable
+
+subroutine a1ar (x1) bind(C) ! { dg-error "Symbol 'x1' at .1. has no IMPLICIT type" }
+  character(len=1), allocatable :: x1(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a2ar (x2) bind(C) ! { dg-error "Symbol 'x2' at .1. has no IMPLICIT type" }
+  character(len=2), allocatable :: x2(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a3ar (xn, n) bind(C) ! { dg-error "Symbol 'xn' at .1. has no IMPLICIT type" }
+  integer :: n
+  character(len=n), allocatable :: xn(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a4ar (xstar) bind(C) ! { dg-error "Symbol 'xstar' at .1. has no IMPLICIT type" }
+  character(len=*), allocatable :: xstar(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a5ar (xcolon) bind(C) ! { dg-error "Symbol 'xcolon' at .1. has no IMPLICIT type" }
+  character(len=:), allocatable :: xcolon(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+! POINTER
+! Scalar, pointer
+
+subroutine s1p (x1) bind(C) ! { dg-error "Pointer character dummy argument 'x1' at .1. must have deferred length as procedure 's1p' is BIND\\(C\\)" }
+                            ! { dg-error "Fortran 2018: Variable 'x1' at .1. with POINTER attribute in procedure 's1p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=1), pointer :: x1
+end
+
+subroutine s2p (x2) bind(C) ! { dg-error "Pointer character dummy argument 'x2' at .1. must have deferred length as procedure 's2p' is BIND\\(C\\)" }
+                            ! { dg-error "Fortran 2018: Variable 'x2' at .1. with POINTER attribute in procedure 's2p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=2), pointer :: x2
+end
+
+subroutine s3p (xn, n) bind(C) ! { dg-error "Pointer character dummy argument 'xn' at .1. must have deferred length as procedure 's3p' is BIND\\(C\\)" }
+                               ! { dg-error "Fortran 2018: Variable 'xn' at .1. with POINTER attribute in procedure 's3p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  integer :: n
+  character(len=n), pointer :: xn
+end
+
+subroutine s4p (xstar) bind(C) ! { dg-error "Pointer character dummy argument 'xstar' at .1. must have deferred length as procedure 's4p' is BIND\\(C\\)" }
+                               ! { dg-error "Fortran 2018: Variable 'xstar' at .1. with POINTER attribute in procedure 's4p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=*), pointer :: xstar
+end
+
+subroutine s5p (xcolon) bind(C) ! { dg-error "Fortran 2018: Deferred-length character dummy argument 'xcolon' at .1. of procedure 's5p' with BIND\\(C\\) attribute" }
+                            ! { dg-error "Fortran 2018: Variable 'xcolon' at .1. with POINTER attribute in procedure 's5p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=:), pointer :: xcolon
+end
+
+! Assumed-shape array, pointer
+
+subroutine a1p (x1) bind(C) ! { dg-error "Pointer character dummy argument 'x1' at .1. must have deferred length as procedure 'a1p' is BIND\\(C\\)" }
+                            ! { dg-error "Fortran 2018: Variable 'x1' at .1. with POINTER attribute in procedure 'a1p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=1), pointer :: x1(:)
+end
+
+subroutine a2p (x2) bind(C) ! { dg-error "Pointer character dummy argument 'x2' at .1. must have deferred length as procedure 'a2p' is BIND\\(C\\)" }
+                            ! { dg-error "Fortran 2018: Variable 'x2' at .1. with POINTER attribute in procedure 'a2p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=2), pointer :: x2(:,:)
+end
+
+subroutine a3p (xn, n) bind(C) ! { dg-error "Pointer character dummy argument 'xn' at .1. must have deferred length as procedure 'a3p' is BIND\\(C\\)" }
+                               ! { dg-error "Fortran 2018: Variable 'xn' at .1. with POINTER attribute in procedure 'a3p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  integer :: n
+  character(len=n), pointer :: xn(:,:,:)
+end
+
+subroutine a4p (xstar) bind(C) ! { dg-error "Pointer character dummy argument 'xstar' at .1. must have deferred length as procedure 'a4p' is BIND\\(C\\)" }
+                               ! { dg-error "Fortran 2018: Variable 'xstar' at .1. with POINTER attribute in procedure 'a4p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=*), pointer :: xstar(:,:,:,:)
+end
+
+subroutine a5p (xcolon) bind(C) ! { dg-error "Fortran 2018: Deferred-length character dummy argument 'xcolon' at .1. of procedure 'a5p' with BIND\\(C\\) attribute" }
+                                ! { dg-error "Fortran 2018: Variable 'xcolon' at .1. with POINTER attribute in procedure 'a5p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=:), pointer :: xcolon(:)
+end
+
+! Assumed-rank array, pointer
+
+subroutine a1pr (x1) bind(C) ! { dg-error "Symbol 'x1' at .1. has no IMPLICIT type" }
+  character(len=1), pointer :: x1(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a2pr (x2) bind(C) ! { dg-error "Symbol 'x2' at .1. has no IMPLICIT type" }
+  character(len=2), pointer :: x2(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a3pr (xn, n) bind(C) ! { dg-error "Symbol 'xn' at .1. has no IMPLICIT type" }
+  integer :: n
+  character(len=n), pointer :: xn(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a4pr (xstar) bind(C) ! { dg-error "Symbol 'xstar' at .1. has no IMPLICIT type" }
+  character(len=*), pointer :: xstar(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a5pr (xcolon) bind(C) ! { dg-error "Symbol 'xcolon' at .1. has no IMPLICIT type" }
+  character(len=:), pointer :: xcolon(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_7.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_7.f90
new file mode 100644 (file)
index 0000000..a9b8c3b
--- /dev/null
@@ -0,0 +1,261 @@
+! { dg-do compile }
+! { dg-additional-options "-std=f2008 -fimplicit-none" }
+
+! F2008 permits constant character lengths for dummy arguments
+
+! Scalar, nonallocatable/nonpointer
+
+subroutine s1 (x1) bind(C)
+  character(len=1) :: x1
+end
+
+subroutine s2 (x2) bind(C)
+  character(len=2) :: x2
+end
+
+subroutine s3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 's3' has the BIND\\(C\\) attribute" }
+  integer :: n
+  character(len=n) :: xn
+end
+
+subroutine s4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 's4' with BIND\\(C\\) attribute" }
+  character(len=*) :: xstar
+end
+
+! Assumed-shape array, nonallocatable/nonpointer
+
+subroutine as1 (x1) bind(C)  ! { dg-error "Fortran 2018: Assumed-shape array 'x1' at .1. as dummy argument to the BIND\\(C\\) procedure 'as1' at .2." }
+  character(len=1) :: x1(:)
+end
+
+subroutine as2 (x2) bind(C) ! { dg-error "Fortran 2018: Assumed-shape array 'x2' at .1. as dummy argument to the BIND\\(C\\) procedure 'as2' at .2." }
+  character(len=2) :: x2(:,:)
+end
+
+subroutine as3 (xn, n) bind(C) ! { dg-error "Fortran 2018: Character dummy argument 'xn' at .1. with nonconstant length as procedure 'as3' is BIND\\(C\\)" }
+                               ! { dg-error "Fortran 2018: Assumed-shape array 'xn' at .1. as dummy argument to the BIND\\(C\\) procedure 'as3' at .2." "" { target *-*-* } .-1 }
+  integer :: n
+  character(len=n) :: xn(:,:,:)
+end
+
+subroutine as4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 'as4' with BIND\\(C\\) attribute" }
+                               ! { dg-error "Fortran 2018: Assumed-shape array 'xstar' at .1. as dummy argument to the BIND\\(C\\) procedure 'as4' at .2." "" { target *-*-* } .-1 }
+  character(len=*) :: xstar(:,:,:,:)
+end
+
+! Assumed-rank array, nonallocatable/nonpointer
+
+subroutine ar1 (x1) bind(C) ! { dg-error "Symbol 'x1' at .1. has no IMPLICIT type" }
+  character(len=1) :: x1(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine ar2 (x2) bind(C) ! { dg-error "Symbol 'x2' at .1. has no IMPLICIT type" }
+  character(len=2) :: x2(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine ar3 (xn, n) bind(C) ! { dg-error "Symbol 'xn' at .1. has no IMPLICIT type" }
+  integer :: n
+  character(len=n) :: xn(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine ar4 (xstar) bind(C) ! { dg-error "Symbol 'xstar' at .1. has no IMPLICIT type" }
+  character(len=*) :: xstar(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+! Assumed-size array, nonallocatable/nonpointer
+
+subroutine az1 (x1) bind(C)
+  character(len=1) :: x1(*)
+end
+
+subroutine az2 (x2) bind(C)
+  character(len=2) :: x2(*)
+end
+
+subroutine az3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 'az3' has the BIND\\(C\\) attribute" }
+  integer :: n
+  character(len=n) :: xn(*)
+end
+
+subroutine az4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 'az4' with BIND\\(C\\) attribute" }
+  character(len=*) :: xstar(*)
+end
+
+! Explicit-size array, nonallocatable/nonpointer
+
+subroutine ae1 (x1) bind(C)
+  character(len=1) :: x1(5)
+end
+
+subroutine ae2 (x2) bind(C)
+  character(len=2) :: x2(7)
+end
+
+subroutine ae3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae3' has the BIND\\(C\\) attribute" }
+  integer :: n
+  character(len=n) :: xn(9)
+end
+
+subroutine ae4 (xstar) bind(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'xstar' at .1. of procedure 'ae4' with BIND\\(C\\) attribute" }
+  character(len=*) :: xstar(3)
+end
+
+! ALLOCATABLE
+! Scalar, allocatable
+
+subroutine s1a (x1) bind(C) ! { dg-error "Allocatable character dummy argument 'x1' at .1. must have deferred length as procedure 's1a' is BIND\\(C\\)" }
+                            ! { dg-error "Fortran 2018: Variable 'x1' at .1. with ALLOCATABLE attribute in procedure 's1a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=1), allocatable :: x1
+end
+
+subroutine s2a (x2) bind(C) ! { dg-error "Allocatable character dummy argument 'x2' at .1. must have deferred length as procedure 's2a' is BIND\\(C\\)" }
+                            ! { dg-error "Fortran 2018: Variable 'x2' at .1. with ALLOCATABLE attribute in procedure 's2a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=2), allocatable :: x2
+end
+
+subroutine s3a (xn, n) bind(C) ! { dg-error "Allocatable character dummy argument 'xn' at .1. must have deferred length as procedure 's3a' is BIND\\(C\\)" }
+                               ! { dg-error "Fortran 2018: Variable 'xn' at .1. with ALLOCATABLE attribute in procedure 's3a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  integer :: n
+  character(len=n), allocatable :: xn
+end
+
+subroutine s4a (xstar) bind(C) ! { dg-error "Allocatable character dummy argument 'xstar' at .1. must have deferred length as procedure 's4a' is BIND\\(C\\)" }
+                               ! { dg-error "Fortran 2018: Variable 'xstar' at .1. with ALLOCATABLE attribute in procedure 's4a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=*), allocatable :: xstar
+end
+
+subroutine s5a (xcolon) bind(C) ! { dg-error "Fortran 2018: Deferred-length character dummy argument 'xcolon' at .1. of procedure 's5a' with BIND\\(C\\) attribute" }
+                                ! { dg-error "Fortran 2018: Variable 'xcolon' at .1. with ALLOCATABLE attribute in procedure 's5a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=:), allocatable :: xcolon
+end
+
+! Assumed-shape array, allocatable
+
+subroutine a1a (x1) bind(C) ! { dg-error "Allocatable character dummy argument 'x1' at .1. must have deferred length as procedure 'a1a' is BIND\\(C\\)" }
+                            ! { dg-error "Fortran 2018: Variable 'x1' at .1. with ALLOCATABLE attribute in procedure 'a1a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=1), allocatable :: x1(:)
+end
+
+subroutine a2a (x2) bind(C) ! { dg-error "Allocatable character dummy argument 'x2' at .1. must have deferred length as procedure 'a2a' is BIND\\(C\\)" }
+                            ! { dg-error "Fortran 2018: Variable 'x2' at .1. with ALLOCATABLE attribute in procedure 'a2a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=2), allocatable :: x2(:,:)
+end
+
+subroutine a3a (xn, n) bind(C) ! { dg-error "Allocatable character dummy argument 'xn' at .1. must have deferred length as procedure 'a3a' is BIND\\(C\\)" }
+                               ! { dg-error "Fortran 2018: Variable 'xn' at .1. with ALLOCATABLE attribute in procedure 'a3a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  integer :: n
+  character(len=n), allocatable :: xn(:,:,:)
+end
+
+subroutine a4a (xstar) bind(C) ! { dg-error "Allocatable character dummy argument 'xstar' at .1. must have deferred length as procedure 'a4a' is BIND\\(C\\)" }
+                               ! { dg-error "Fortran 2018: Variable 'xstar' at .1. with ALLOCATABLE attribute in procedure 'a4a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=*), allocatable :: xstar(:,:,:,:)
+end
+
+subroutine a5a (xcolon) bind(C) ! { dg-error "Fortran 2018: Deferred-length character dummy argument 'xcolon' at .1. of procedure 'a5a' with BIND\\(C\\) attribute" }
+                                ! { dg-error "Fortran 2018: Variable 'xcolon' at .1. with ALLOCATABLE attribute in procedure 'a5a' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=:), allocatable :: xcolon(:)
+end
+
+! Assumed-rank array, allocatable
+
+subroutine a1ar (x1) bind(C) ! { dg-error "Symbol 'x1' at .1. has no IMPLICIT type" }
+  character(len=1), allocatable :: x1(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a2ar (x2) bind(C) ! { dg-error "Symbol 'x2' at .1. has no IMPLICIT type" }
+  character(len=2), allocatable :: x2(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a3ar (xn, n) bind(C) ! { dg-error "Symbol 'xn' at .1. has no IMPLICIT type" }
+  integer :: n
+  character(len=n), allocatable :: xn(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a4ar (xstar) bind(C) ! { dg-error "Symbol 'xstar' at .1. has no IMPLICIT type" }
+  character(len=*), allocatable :: xstar(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a5ar (xcolon) bind(C) ! { dg-error "Symbol 'xcolon' at .1. has no IMPLICIT type" }
+  character(len=:), allocatable :: xcolon(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+! POINTER
+! Scalar, pointer
+
+subroutine s1p (x1) bind(C) ! { dg-error "Pointer character dummy argument 'x1' at .1. must have deferred length as procedure 's1p' is BIND\\(C\\)" }
+                            ! { dg-error "Fortran 2018: Variable 'x1' at .1. with POINTER attribute in procedure 's1p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=1), pointer :: x1
+end
+
+subroutine s2p (x2) bind(C) ! { dg-error "Pointer character dummy argument 'x2' at .1. must have deferred length as procedure 's2p' is BIND\\(C\\)" }
+                            ! { dg-error "Fortran 2018: Variable 'x2' at .1. with POINTER attribute in procedure 's2p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=2), pointer :: x2
+end
+
+subroutine s3p (xn, n) bind(C) ! { dg-error "Pointer character dummy argument 'xn' at .1. must have deferred length as procedure 's3p' is BIND\\(C\\)" }
+                               ! { dg-error "Fortran 2018: Variable 'xn' at .1. with POINTER attribute in procedure 's3p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  integer :: n
+  character(len=n), pointer :: xn
+end
+
+subroutine s4p (xstar) bind(C) ! { dg-error "Pointer character dummy argument 'xstar' at .1. must have deferred length as procedure 's4p' is BIND\\(C\\)" }
+                               ! { dg-error "Fortran 2018: Variable 'xstar' at .1. with POINTER attribute in procedure 's4p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=*), pointer :: xstar
+end
+
+subroutine s5p (xcolon) bind(C) ! { dg-error "Fortran 2018: Deferred-length character dummy argument 'xcolon' at .1. of procedure 's5p' with BIND\\(C\\) attribute" }
+                            ! { dg-error "Fortran 2018: Variable 'xcolon' at .1. with POINTER attribute in procedure 's5p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=:), pointer :: xcolon
+end
+
+! Assumed-shape array, pointer
+
+subroutine a1p (x1) bind(C) ! { dg-error "Pointer character dummy argument 'x1' at .1. must have deferred length as procedure 'a1p' is BIND\\(C\\)" }
+                            ! { dg-error "Fortran 2018: Variable 'x1' at .1. with POINTER attribute in procedure 'a1p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=1), pointer :: x1(:)
+end
+
+subroutine a2p (x2) bind(C) ! { dg-error "Pointer character dummy argument 'x2' at .1. must have deferred length as procedure 'a2p' is BIND\\(C\\)" }
+                            ! { dg-error "Fortran 2018: Variable 'x2' at .1. with POINTER attribute in procedure 'a2p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=2), pointer :: x2(:,:)
+end
+
+subroutine a3p (xn, n) bind(C) ! { dg-error "Pointer character dummy argument 'xn' at .1. must have deferred length as procedure 'a3p' is BIND\\(C\\)" }
+                               ! { dg-error "Fortran 2018: Variable 'xn' at .1. with POINTER attribute in procedure 'a3p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  integer :: n
+  character(len=n), pointer :: xn(:,:,:)
+end
+
+subroutine a4p (xstar) bind(C) ! { dg-error "Pointer character dummy argument 'xstar' at .1. must have deferred length as procedure 'a4p' is BIND\\(C\\)" }
+                               ! { dg-error "Fortran 2018: Variable 'xstar' at .1. with POINTER attribute in procedure 'a4p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=*), pointer :: xstar(:,:,:,:)
+end
+
+subroutine a5p (xcolon) bind(C) ! { dg-error "Fortran 2018: Deferred-length character dummy argument 'xcolon' at .1. of procedure 'a5p' with BIND\\(C\\) attribute" }
+                                ! { dg-error "Fortran 2018: Variable 'xcolon' at .1. with POINTER attribute in procedure 'a5p' with BIND\\(C\\)" "" { target *-*-* } .-1 }
+  character(len=:), pointer :: xcolon(:)
+end
+
+! Assumed-rank array, pointer
+
+subroutine a1pr (x1) bind(C) ! { dg-error "Symbol 'x1' at .1. has no IMPLICIT type" }
+  character(len=1), pointer :: x1(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a2pr (x2) bind(C) ! { dg-error "Symbol 'x2' at .1. has no IMPLICIT type" }
+  character(len=2), pointer :: x2(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a3pr (xn, n) bind(C) ! { dg-error "Symbol 'xn' at .1. has no IMPLICIT type" }
+  integer :: n
+  character(len=n), pointer :: xn(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a4pr (xstar) bind(C) ! { dg-error "Symbol 'xstar' at .1. has no IMPLICIT type" }
+  character(len=*), pointer :: xstar(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
+
+subroutine a5pr (xcolon) bind(C) ! { dg-error "Symbol 'xcolon' at .1. has no IMPLICIT type" }
+  character(len=:), pointer :: xcolon(..) ! { dg-error "Fortran 2018: Assumed-rank array at .1." }
+end
diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_8.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_8.f90
new file mode 100644 (file)
index 0000000..1d566c0
--- /dev/null
@@ -0,0 +1,249 @@
+! { dg-do compile }
+! { dg-additional-options "-fimplicit-none" }
+
+! F2018 only permittes len=*, len=: or len=<const> as dummy argument
+! but not len=<non-const-expr>
+! Additionally, for allocatable/pointer, len=: is required.
+
+! Scalar, nonallocatable/nonpointer
+
+subroutine val_s1(x1) bind(C)
+  character(len=1), value :: x1
+end
+
+subroutine val_s2(x2) bind(C) ! { dg-error "Character dummy argument 'x2' at .1. must be of length 1 as it has the VALUE attribute" }
+  character(len=2), value :: x2
+end
+
+subroutine s1 (x1) bind(C)
+  character(len=1) :: x1
+end
+
+subroutine s2 (x2) bind(C)
+  character(len=2) :: x2
+end
+
+subroutine s3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 's3' has the BIND\\(C\\) attribute" }
+  integer :: n
+  character(len=n) :: xn
+end
+
+subroutine s4 (xstar) bind(C) ! { dg-error "Sorry, character dummy argument 'xstar' at .1. with assumed length is not yet supported for procedure 's4' with BIND\\(C\\) attribute" }
+  character(len=*) :: xstar
+end
+
+! Assumed-shape array, nonallocatable/nonpointer
+
+subroutine as1 (x1) bind(C)
+  character(len=1) :: x1(:)
+end
+
+subroutine as2 (x2) bind(C)
+  character(len=2) :: x2(:,:)
+end
+
+subroutine as3 (xn, n) bind(C)
+  integer :: n
+  character(len=n) :: xn(:,:,:)
+end
+
+subroutine as4 (xstar) bind(C)
+  character(len=*) :: xstar(:,:,:,:)
+end
+
+! Assumed-rank array, nonallocatable/nonpointer
+
+subroutine ar1 (x1) bind(C)
+  character(len=1) :: x1(..)
+end
+
+subroutine ar2 (x2) bind(C)
+  character(len=2) :: x2(..)
+end
+
+subroutine ar3 (xn, n) bind(C)
+  integer :: n
+  character(len=n) :: xn(..)
+end
+
+subroutine ar4 (xstar) bind(C)
+  character(len=*) :: xstar(..)
+end
+
+! Assumed-size array, nonallocatable/nonpointer
+
+subroutine az1 (x1) bind(C)
+  character(len=1) :: x1(*)
+end
+
+subroutine az2 (x2) bind(C)
+  character(len=2) :: x2(*)
+end
+
+subroutine az3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 'az3' has the BIND\\(C\\) attribute" }
+  integer :: n
+  character(len=n) :: xn(*)
+end
+
+subroutine az4 (xstar) bind(C)  ! { dg-error "Sorry, character dummy argument 'xstar' at .1. with assumed length is not yet supported for procedure 'az4' with BIND\\(C\\) attribute" }
+  character(len=*) :: xstar(*)
+end
+
+! Explicit-size array, nonallocatable/nonpointer
+
+subroutine ae1 (x1) bind(C)
+  character(len=1) :: x1(5)
+end
+
+subroutine ae2 (x2) bind(C)
+  character(len=2) :: x2(7)
+end
+
+subroutine ae3 (xn, n) bind(C) ! { dg-error "Character dummy argument 'xn' at .1. must be of constant length or assumed length, unless it has assumed shape or assumed rank, as procedure 'ae3' has the BIND\\(C\\) attribute" }
+  integer :: n
+  character(len=n) :: xn(9)
+end
+
+subroutine ae4 (xstar) bind(C) ! { dg-error "Sorry, character dummy argument 'xstar' at .1. with assumed length is not yet supported for procedure 'ae4' with BIND\\(C\\) attribute" }
+  character(len=*) :: xstar(3)
+end
+
+! ALLOCATABLE
+! Scalar, allocatable
+
+subroutine s1a (x1) bind(C) ! { dg-error "Allocatable character dummy argument 'x1' at .1. must have deferred length as procedure 's1a' is BIND\\(C\\)" }
+  character(len=1), allocatable :: x1
+end
+
+subroutine s2a (x2) bind(C) ! { dg-error "Allocatable character dummy argument 'x2' at .1. must have deferred length as procedure 's2a' is BIND\\(C\\)" }
+  character(len=2), allocatable :: x2
+end
+
+subroutine s3a (xn, n) bind(C) ! { dg-error "Allocatable character dummy argument 'xn' at .1. must have deferred length as procedure 's3a' is BIND\\(C\\)" }
+  integer :: n
+  character(len=n), allocatable :: xn
+end
+
+subroutine s4a (xstar) bind(C) ! { dg-error "Allocatable character dummy argument 'xstar' at .1. must have deferred length as procedure 's4a' is BIND\\(C\\)" }
+  character(len=*), allocatable :: xstar
+end
+
+subroutine s5a (xcolon) bind(C) ! { dg-error "Sorry, deferred-length scalar character dummy argument 'xcolon' at .1. of procedure 's5a' with BIND\\(C\\) not yet supported" }
+  character(len=:), allocatable :: xcolon
+end
+
+! Assumed-shape array, allocatable
+
+subroutine a1a (x1) bind(C) ! { dg-error "Allocatable character dummy argument 'x1' at .1. must have deferred length as procedure 'a1a' is BIND\\(C\\)" }
+  character(len=1), allocatable :: x1(:)
+end
+
+subroutine a2a (x2) bind(C) ! { dg-error "Allocatable character dummy argument 'x2' at .1. must have deferred length as procedure 'a2a' is BIND\\(C\\)" }
+  character(len=2), allocatable :: x2(:,:)
+end
+
+subroutine a3a (xn, n) bind(C) ! { dg-error "Allocatable character dummy argument 'xn' at .1. must have deferred length as procedure 'a3a' is BIND\\(C\\)" }
+  integer :: n
+  character(len=n), allocatable :: xn(:,:,:)
+end
+
+subroutine a4a (xstar) bind(C) ! { dg-error "Allocatable character dummy argument 'xstar' at .1. must have deferred length as procedure 'a4a' is BIND\\(C\\)" }
+  character(len=*), allocatable :: xstar(:,:,:,:)
+end
+
+subroutine a5a (xcolon) bind(C)
+  character(len=:), allocatable :: xcolon(:)
+end
+
+! Assumed-rank array, allocatable
+
+subroutine a1ar (x1) bind(C) ! { dg-error "Allocatable character dummy argument 'x1' at .1. must have deferred length as procedure 'a1ar' is BIND\\(C\\)" }
+  character(len=1), allocatable :: x1(..)
+end
+
+subroutine a2ar (x2) bind(C) ! { dg-error "Allocatable character dummy argument 'x2' at .1. must have deferred length as procedure 'a2ar' is BIND\\(C\\)" }
+  character(len=2), allocatable :: x2(..)
+end
+
+subroutine a3ar (xn, n) bind(C) ! { dg-error "Allocatable character dummy argument 'xn' at .1. must have deferred length as procedure 'a3ar' is BIND\\(C\\)" }
+  integer :: n
+  character(len=n), allocatable :: xn(..)
+end
+
+subroutine a4ar (xstar) bind(C) ! { dg-error "Allocatable character dummy argument 'xstar' at .1. must have deferred length as procedure 'a4ar' is BIND\\(C\\)" }
+  character(len=*), allocatable :: xstar(..)
+end
+
+subroutine a5ar (xcolon) bind(C)
+  character(len=:), allocatable :: xcolon(..)
+end
+
+! POINTER
+! Scalar, pointer
+
+subroutine s1p (x1) bind(C) ! { dg-error "Pointer character dummy argument 'x1' at .1. must have deferred length as procedure 's1p' is BIND\\(C\\)" }
+  character(len=1), pointer :: x1
+end
+
+subroutine s2p (x2) bind(C) ! { dg-error "Pointer character dummy argument 'x2' at .1. must have deferred length as procedure 's2p' is BIND\\(C\\)" }
+  character(len=2), pointer :: x2
+end
+
+subroutine s3p (xn, n) bind(C) ! { dg-error "Pointer character dummy argument 'xn' at .1. must have deferred length as procedure 's3p' is BIND\\(C\\)" }
+  integer :: n
+  character(len=n), pointer :: xn
+end
+
+subroutine s4p (xstar) bind(C) ! { dg-error "Pointer character dummy argument 'xstar' at .1. must have deferred length as procedure 's4p' is BIND\\(C\\)" }
+  character(len=*), pointer :: xstar
+end
+
+subroutine s5p (xcolon) bind(C) ! { dg-error "Sorry, deferred-length scalar character dummy argument 'xcolon' at .1. of procedure 's5p' with BIND\\(C\\) not yet supported" }
+  character(len=:), pointer :: xcolon
+end
+
+! Assumed-shape array, pointer
+
+subroutine a1p (x1) bind(C) ! { dg-error "Pointer character dummy argument 'x1' at .1. must have deferred length as procedure 'a1p' is BIND\\(C\\)" }
+  character(len=1), pointer :: x1(:)
+end
+
+subroutine a2p (x2) bind(C) ! { dg-error "Pointer character dummy argument 'x2' at .1. must have deferred length as procedure 'a2p' is BIND\\(C\\)" }
+  character(len=2), pointer :: x2(:,:)
+end
+
+subroutine a3p (xn, n) bind(C) ! { dg-error "Pointer character dummy argument 'xn' at .1. must have deferred length as procedure 'a3p' is BIND\\(C\\)" }
+  integer :: n
+  character(len=n), pointer :: xn(:,:,:)
+end
+
+subroutine a4p (xstar) bind(C) ! { dg-error "Pointer character dummy argument 'xstar' at .1. must have deferred length as procedure 'a4p' is BIND\\(C\\)" }
+  character(len=*), pointer :: xstar(:,:,:,:)
+end
+
+subroutine a5p (xcolon) bind(C)
+  character(len=:), pointer :: xcolon(:)
+end
+
+! Assumed-rank array, pointer
+
+subroutine a1pr (x1) bind(C)  ! { dg-error "Pointer character dummy argument 'x1' at .1. must have deferred length as procedure 'a1pr' is BIND\\(C\\)" }
+  character(len=1), pointer :: x1(..)
+end
+
+subroutine a2pr (x2) bind(C) ! { dg-error "Pointer character dummy argument 'x2' at .1. must have deferred length as procedure 'a2pr' is BIND\\(C\\)" }
+  character(len=2), pointer :: x2(..)
+end
+
+subroutine a3pr (xn, n) bind(C) ! { dg-error "Pointer character dummy argument 'xn' at .1. must have deferred length as procedure 'a3pr' is BIND\\(C\\)" }
+  integer :: n
+  character(len=n), pointer :: xn(..)
+end
+
+subroutine a4pr (xstar) bind(C) ! { dg-error "Pointer character dummy argument 'xstar' at .1. must have deferred length as procedure 'a4pr' is BIND\\(C\\)" }
+  character(len=*), pointer :: xstar(..)
+end
+
+subroutine a5pr (xcolon) bind(C)
+  character(len=:), pointer :: xcolon(..)
+end
diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_9.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_9.f90
new file mode 100644 (file)
index 0000000..d31862c
--- /dev/null
@@ -0,0 +1,188 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+
+! F2018  - examples without array descriptor
+
+
+module m
+  use iso_c_binding, only: c_char
+  implicit none (type, external)
+
+contains
+
+! Scalar, nonallocatable/nonpointer
+subroutine s1 (x1) bind(C)
+  character(kind=c_char, len=1) :: x1
+  if (len (x1) /= 1) stop
+  if (x1 /= 'Z') stop
+  x1 = 'A'
+end
+
+subroutine s2 (x2) bind(C)
+  character(kind=c_char, len=2) :: x2
+  if (len (x2) /= 2) stop
+  if (x2 /= '42') stop
+  x2 = '64'
+end
+
+! Assumed-size array, nonallocatable/nonpointer
+
+subroutine az1 (x1) bind(C)
+  character(kind=c_char, len=1) :: x1(*)
+  if (len(x1) /= 1) stop  
+  if (any (x1(:6) /= ['g', &
+                      'd', &
+                      'f', &
+                      's', &
+                      '3', &
+                      '5'])) stop 1
+  x1(:6) = ['1', &
+            'h', &
+            'f', &
+            '3', &
+            '4', &
+            'h']
+end
+
+subroutine az2 (x2) bind(C)
+  character(kind=c_char, len=2) :: x2(*)
+  if (len(x2) /= 2) stop  
+  if (any (x2(:6) /= ['ab', &
+                      'fd', &
+                      'D4', &
+                      '54', &
+                      'ga', &
+                      'hg'])) stop
+  x2(:6) = ['ab', &
+            'hd', &
+            'fj', &
+            'a4', &
+            '4a', &
+            'hf']
+end
+
+! Explicit-size array, nonallocatable/nonpointer
+
+subroutine ae1 (x1) bind(C)
+  character(kind=c_char, len=1) :: x1(6)
+  if (size(x1) /= 6) stop
+  if (len(x1) /= 1) stop  
+  if (any (x1 /= ['g', &
+                  'd', &
+                  'f', &
+                  's', &
+                  '3', &
+                  '5'])) stop 1
+  x1 = ['1', &
+        'h', &
+        'f', &
+        '3', &
+        '4', &
+        'h']
+end
+
+subroutine ae2 (x2) bind(C)
+  character(kind=c_char, len=2) :: x2(6)
+  if (size(x2) /= 6) stop
+  if (len(x2) /= 2) stop  
+  if (any (x2 /= ['ab', &
+                  'fd', &
+                  'D4', &
+                  '54', &
+                  'ga', &
+                  'hg'])) stop
+  x2 = ['ab', &
+        'hd', &
+        'fj', &
+        'a4', &
+        '4a', &
+        'hf']
+end
+
+end module m
+
+program main
+  use m
+  implicit none (type, external)
+  character(kind=c_char, len=1) :: str1
+  character(kind=c_char, len=2) :: str2
+
+  character(kind=c_char, len=1) :: str1a6(6)
+  character(kind=c_char, len=2) :: str2a6(6)
+
+  ! Scalar - no array descriptor
+
+  str1 = 'Z'
+  call s1 (str1)
+  if (str1 /= 'A') stop
+
+  str2 = '42'
+  call s2 (str2)
+  if (str2 /= '64') stop
+
+  ! assumed size - without array descriptor
+
+  str1a6 = ['g', &
+            'd', &
+            'f', &
+            's', &
+            '3', &
+            '5']
+  call az1 (str1a6)
+  if (any (str1a6 /= ['1', &
+                      'h', &
+                      'f', &
+                      '3', &
+                      '4', &
+                      'h'])) stop
+  str2a6 = ['ab', &
+            'fd', &
+            'D4', &
+            '54', &
+            'ga', &
+            'hg']
+  call az2 (str2a6)
+  if (any (str2a6 /= ['ab', &
+                      'hd', &
+                      'fj', &
+                      'a4', &
+                      '4a', &
+                      'hf'])) stop
+  ! explicit size - without array descriptor
+
+  str1a6 = ['g', &
+            'd', &
+            'f', &
+            's', &
+            '3', &
+            '5']
+  call ae1 (str1a6)
+  if (any (str1a6 /= ['1', &
+                      'h', &
+                      'f', &
+                      '3', &
+                      '4', &
+                      'h'])) stop
+  str2a6 = ['ab', &
+            'fd', &
+            'D4', &
+            '54', &
+            'ga', &
+            'hg']
+  call ae2 (str2a6)
+  if (any (str2a6 /= ['ab', &
+                      'hd', &
+                      'fj', &
+                      'a4', &
+                      '4a', &
+                      'hf'])) stop
+end
+
+! All argument shall be passed without descriptor
+! { dg-final { scan-tree-dump-not "dtype" "original" } }
+! { dg-final { scan-tree-dump-times "void s1 \\(character\\(kind=1\\)\\\[1:1\\\] & restrict x1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void s2 \\(character\\(kind=1\\)\\\[1:2\\\] & restrict x2\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void az1 \\(character\\(kind=1\\)\\\[0:\\\]\\\[1:1\\\] \\* restrict x1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void az2 \\(character\\(kind=1\\)\\\[0:\\\]\\\[1:2\\\] \\* restrict x2\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void ae1 \\(character\\(kind=1\\)\\\[6\\\]\\\[1:1\\\] \\* restrict x1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "void ae2 \\(character\\(kind=1\\)\\\[6\\\]\\\[1:2\\\] \\* restrict x2\\)" 1 "original" } }
index ebf9a24..abe5cb7 100644 (file)
@@ -4,7 +4,7 @@
 !
 ! Contributed by Thomas Koenig  <tkoenig@gcc.gnu.org>
 !
-subroutine bar(c,d) BIND(C) ! { dg-error "must be length 1" }
+subroutine bar(c,d) BIND(C) ! { dg-error "character dummy argument 'c' at .1. with assumed length is not yet supported for procedure 'bar' with BIND\\(C\\) attribute" }
   character (len=*) c
   character (len=2) d
 end
index 297b75a..bf9bd8c 100644 (file)
@@ -1,20 +1,20 @@
 ! { dg-do compile }
-! { dg-options "-std=f2008" }
+! { dg-options "-std=f2003" }
 !
 ! PR fortran/32599
 ! Verifies that character string arguments to a bind(c) procedure have length
-! 1, or no len is specified. Note that the C interop extensions in F2018 allow
+! 1, or no len is specified. Note that the C interop extensions in F2008 allow
 ! string arguments of length greater than one to be passed to a C descriptor.
 !
 module pr32599
   interface
-     subroutine destroy(path) BIND(C) ! { dg-error "must be length 1" }
+     subroutine destroy(path) BIND(C) ! { dg-error "Fortran 2018: Assumed-length character dummy argument 'path' at .1. of procedure .destroy. with BIND\\(C\\) attribute" }
        use iso_c_binding
        implicit none
        character(len=*,kind=c_char), intent(IN) :: path
      end subroutine destroy
 
-     subroutine create(path) BIND(C) ! { dg-error "must be length 1" }
+     subroutine create(path) BIND(C) ! { dg-error "Fortran 2008: Character dummy argument 'path' at .1. with length greater than 1 for procedure 'create' with BIND\\(C\\) attribute" }
        use iso_c_binding
        implicit none
        character(len=5,kind=c_char), intent(IN) :: path