Patchwork [Fortran] PR 47569 - fix ICE (regression) and fix diagnostic

login
register
mail settings
Submitter Tobias Burnus
Date Feb. 11, 2011, 11:26 p.m.
Message ID <4D55C5C1.3000601@net-b.de>
Download mbox | patch
Permalink /patch/82853/
State New
Headers show

Comments

Tobias Burnus - Feb. 11, 2011, 11:26 p.m.
PR 47569 is about a 4.3/4.4/4.5/4.6 regression where 
"component%substring(1:2)" gave an ICE. Looking closer at the issue, I 
saw that the checks were a bit incomplete and inconsistent. I hope that 
with the patch the diagnostic is now correct.

 From the standards:

F97: "If the actual argument is scalar, the corresponding dummy argument 
shall be scalar unless the actual argument is an element of an array 
that is not an assumed-shape or pointer array, or a substring of such an 
element."

F2003: "If the actual argument is scalar, the corresponding dummy 
argument shall be scalar unless the actual argument is of type default 
character, of type character with the C character kind (15.1), or is an 
element or substring of an element of an array that is not an 
assumed-shape or pointer array."

F2008 quote ("12.5.2.4 Ordinary dummy variables"):
"If the actual argument is a noncoindexed scalar, the corresponding dummy
argument shall be scalar unless the actual argument is default character, of
type character with the C character kind (15.2.2), or is an element or
substring of an element of an array that is not an assumed-shape, 
pointer, or
polymorphic array."

(The coindex/polymorphism is checked earlier in that function.)

Build and regtested on x86-64-linux.
OK for the trunk? Should this be backported? If yes, to which versions?*

Tobias

* The issue was reported for a real-world code using GCC 4.4.4. While 
passing a scalar actual to an array dummy is common in pre-Fortran-90, I 
think doing so in F90+ code happens more rarely - but as the PR shows, 
it happens.
Mikael Morin - Feb. 12, 2011, 8:54 p.m.
On Saturday 12 February 2011 00:26:57 Tobias Burnus wrote:
> PR 47569 is about a 4.3/4.4/4.5/4.6 regression where
> "component%substring(1:2)" gave an ICE. Looking closer at the issue, I
> saw that the checks were a bit incomplete and inconsistent. I hope that
> with the patch the diagnostic is now correct.
> 
>  From the standards:
> 
> F97: "If the actual argument is scalar, the corresponding dummy argument
> shall be scalar unless the actual argument is an element of an array
> that is not an assumed-shape or pointer array, or a substring of such an
> element."
> 
> F2003: "If the actual argument is scalar, the corresponding dummy
> argument shall be scalar unless the actual argument is of type default
> character, of type character with the C character kind (15.1), or is an
> element or substring of an element of an array that is not an
> assumed-shape or pointer array."
> 
> F2008 quote ("12.5.2.4 Ordinary dummy variables"):
> "If the actual argument is a noncoindexed scalar, the corresponding dummy
> argument shall be scalar unless the actual argument is default character,
> of type character with the C character kind (15.2.2), 
If I understand this correctly, anything of default character kind type is 
allowed. Thus...

> or is an element or
> substring of an element of an array that is not an assumed-shape,
> pointer, or
> polymorphic array."
> 
>
> 
> diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
> index 1e5df61..b555c3d 100644
> --- a/gcc/fortran/interface.c
> +++ b/gcc/fortran/interface.c
> @@ -1461,7 +1461,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr 
*actual,
>                    int ranks_must_agree, int is_elemental, locus *where)
>  {
>    gfc_ref *ref;
> -  bool rank_check;
> +  bool rank_check, is_pointer;
>  
>    /* If the formal arg has type BT_VOID, it's to one of the iso_c_binding
>       procs c_f_pointer or c_f_procpointer, and we need to accept most
> @@ -1672,23 +1672,58 @@ compare_parameter (gfc_symbol *formal, gfc_expr 
*actual,
>      return 1;
>  
>    /* At this point, we are considering a scalar passed to an array.   This
> -     is valid (cf. F95 12.4.1.1; F2003 12.4.1.2),
> +     is valid (cf. F95 12.4.1.1, F2003 12.4.1.2, and F2008 12.5.2.4),
>       - if the actual argument is (a substring of) an element of a
> -       non-assumed-shape/non-pointer array;
> -     - (F2003) if the actual argument is of type character.  */
> +       non-assumed-shape/non-pointer/non-polymorphic array;
> +     - (F2003) if the actual argument is of type character of 
default/c_char
> +       kind.  */

... one could/should return early here for default (or C_CHAR) kind characters 
?
That would mean some lines previously marked as "! Valid F2003" in the 
testsuite could/should remain so. 

> +
> +  is_pointer = actual->expr_type == EXPR_VARIABLE
> +              ? actual->symtree->n.sym->attr.pointer : false;
>  
>    for (ref = actual->ref; ref; ref = ref->next)
> -    if (ref->type == REF_ARRAY && ref->u.ar.type == AR_ELEMENT
> -       && ref->u.ar.dimen > 0)
> -      break;
> +    {
> +      if (ref->type == REF_COMPONENT)
> +       is_pointer = ref->u.c.component->attr.pointer;
> +      else if (ref->type == REF_ARRAY && ref->u.ar.type == AR_ELEMENT
> +              && ref->u.ar.dimen > 0
> +              && (!ref->next 
> +                  || (ref->next->type == REF_SUBSTRING && !ref->next-
>next)))
> +        break;
> +    }
> +
> +  if (actual->expr_type != EXPR_NULL
> +      && (is_pointer || (ref && ref->u.ar.as->type == AS_ASSUMED_SHAPE)))
> +    {
> +      if (where)
> +       gfc_error ("Scalar pointer or element of assumed-shaped or pointer "
> +                  "array passed to array dummy argument '%s' at %L",
> +                  formal->name, &actual->where);
> +      return 0;
> +    }
> +
> +  if (actual->ts.type == BT_CLASS && actual->expr_type != EXPR_NULL)
> +    {
> +      if (where)
> +       gfc_error ("Polymorphic scalar passed to array dummy argument '%s' "
> +                  "at %L", formal->name, &actual->where);
> +      return 0;
> +    }
>  
> -  /* Not an array element.  */
> -  if (formal->ts.type == BT_CHARACTER
> -      && (ref == NULL
> -          || (actual->expr_type == EXPR_VARIABLE
> -             && (actual->symtree->n.sym->as->type == AS_ASSUMED_SHAPE
> -                 || actual->symtree->n.sym->attr.pointer))))
> +  if (formal->ts.type == BT_CHARACTER && actual->expr_type != EXPR_NULL && 
!ref)
>      {
> +      if (formal->ts.kind == 4 && where
> +         && (gfc_option.allow_std & GFC_STD_GNU) == 0)
> +       {
> +         gfc_error ("Extension: Scalar ISO-10646 CHARACTER actual argument 
"
> +                    "with array dummy argument '%s' at %L",
> +                    formal->name, &actual->where);
> +         return 0;
> +       }
> +
> +      if (formal->ts.kind == 4 && (gfc_option.allow_std & GFC_STD_GNU) == 
0)
> +       return 0;
- I find it clearer to have the conditions merged and the error under a "if 
(where)" like you did elsewhere. 
- Is there a reason not to use gfc_notify_std ?
- Also, I think the error message above could be interpreted as if the problem 
is the presence of non-ascii characters in the actual argument. So I would 
preferably stick to the standard wording (non either default or C kind 
character actual argument) even if it doesn't sound great.
- Last but not least, shouldn't actual->ts.kind be tested instead of formal-
>ts.kind ?

> +
>        if (where && (gfc_option.allow_std & GFC_STD_F2003) == 0)
>         {
>           gfc_error ("Fortran 2003: Scalar CHARACTER actual argument with "
> @@ -1709,17 +1744,6 @@ compare_parameter (gfc_symbol *formal, gfc_expr 
*actual,
>        return 0;
>      }
>  
> -  if (actual->expr_type == EXPR_VARIABLE
> -      && actual->symtree->n.sym->as
> -      && (actual->symtree->n.sym->as->type == AS_ASSUMED_SHAPE
> -         || actual->symtree->n.sym->attr.pointer))
> -    {
> -      if (where)
> -       gfc_error ("Element of assumed-shaped array passed to dummy "
> -                  "argument '%s' at %L", formal->name, &actual->where);
> -      return 0;
> -    }
> -
>    return 1;
>  }
>  

The rest (pointer, class and assumed shape) seem properly handled. 

Mikael

Patch

2011-02-11  Tobias Burnus  <burnus@net-b.de>

	PR fortran/47569
	* interface.c (compare_parameter): Avoid ICE with
	character components.

2011-02-11  Tobias Burnus  <burnus@net-b.de>

	* gfortran.dg/argument_checking_11.f90: Update dg-error.
	* gfortran.dg/argument_checking_12.f90: Update dg-error.
	* gfortran.dg/argument_checking_13.f90: Update dg-error.
	* gfortran.dg/argument_checking_17.f90: New.
	* gfortran.dg/argument_checking_18.f90: New.

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 1e5df61..b555c3d 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1461,7 +1461,7 @@  compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 		   int ranks_must_agree, int is_elemental, locus *where)
 {
   gfc_ref *ref;
-  bool rank_check;
+  bool rank_check, is_pointer;
 
   /* If the formal arg has type BT_VOID, it's to one of the iso_c_binding
      procs c_f_pointer or c_f_procpointer, and we need to accept most
@@ -1672,23 +1672,58 @@  compare_parameter (gfc_symbol *formal, gfc_expr *actual,
     return 1;
 
   /* At this point, we are considering a scalar passed to an array.   This
-     is valid (cf. F95 12.4.1.1; F2003 12.4.1.2),
+     is valid (cf. F95 12.4.1.1, F2003 12.4.1.2, and F2008 12.5.2.4),
      - if the actual argument is (a substring of) an element of a
-       non-assumed-shape/non-pointer array;
-     - (F2003) if the actual argument is of type character.  */
+       non-assumed-shape/non-pointer/non-polymorphic array;
+     - (F2003) if the actual argument is of type character of default/c_char
+       kind.  */
+
+  is_pointer = actual->expr_type == EXPR_VARIABLE
+	       ? actual->symtree->n.sym->attr.pointer : false;
 
   for (ref = actual->ref; ref; ref = ref->next)
-    if (ref->type == REF_ARRAY && ref->u.ar.type == AR_ELEMENT
-	&& ref->u.ar.dimen > 0)
-      break;
+    {
+      if (ref->type == REF_COMPONENT)
+	is_pointer = ref->u.c.component->attr.pointer;
+      else if (ref->type == REF_ARRAY && ref->u.ar.type == AR_ELEMENT
+	       && ref->u.ar.dimen > 0
+	       && (!ref->next 
+		   || (ref->next->type == REF_SUBSTRING && !ref->next->next)))
+        break;
+    }
+
+  if (actual->expr_type != EXPR_NULL
+      && (is_pointer || (ref && ref->u.ar.as->type == AS_ASSUMED_SHAPE)))
+    {
+      if (where)
+	gfc_error ("Scalar pointer or element of assumed-shaped or pointer "
+		   "array passed to array dummy argument '%s' at %L",
+		   formal->name, &actual->where);
+      return 0;
+    }
+
+  if (actual->ts.type == BT_CLASS && actual->expr_type != EXPR_NULL)
+    {
+      if (where)
+	gfc_error ("Polymorphic scalar passed to array dummy argument '%s' "
+		   "at %L", formal->name, &actual->where);
+      return 0;
+    }
 
-  /* Not an array element.  */
-  if (formal->ts.type == BT_CHARACTER
-      && (ref == NULL
-          || (actual->expr_type == EXPR_VARIABLE
-	      && (actual->symtree->n.sym->as->type == AS_ASSUMED_SHAPE
-		  || actual->symtree->n.sym->attr.pointer))))
+  if (formal->ts.type == BT_CHARACTER && actual->expr_type != EXPR_NULL && !ref)
     {
+      if (formal->ts.kind == 4 && where
+	  && (gfc_option.allow_std & GFC_STD_GNU) == 0)
+	{
+	  gfc_error ("Extension: Scalar ISO-10646 CHARACTER actual argument "
+		     "with array dummy argument '%s' at %L",
+		     formal->name, &actual->where);
+	  return 0;
+	}
+
+      if (formal->ts.kind == 4 && (gfc_option.allow_std & GFC_STD_GNU) == 0)
+	return 0;
+
       if (where && (gfc_option.allow_std & GFC_STD_F2003) == 0)
 	{
 	  gfc_error ("Fortran 2003: Scalar CHARACTER actual argument with "
@@ -1709,17 +1744,6 @@  compare_parameter (gfc_symbol *formal, gfc_expr *actual,
       return 0;
     }
 
-  if (actual->expr_type == EXPR_VARIABLE
-      && actual->symtree->n.sym->as
-      && (actual->symtree->n.sym->as->type == AS_ASSUMED_SHAPE
-	  || actual->symtree->n.sym->attr.pointer))
-    {
-      if (where)
-	gfc_error ("Element of assumed-shaped array passed to dummy "
-		   "argument '%s' at %L", formal->name, &actual->where);
-      return 0;
-    }
-
   return 1;
 }
 
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_11.f90 b/gcc/testsuite/gfortran.dg/argument_checking_11.f90
index 7c70c37..73a38f5 100644
--- a/gcc/testsuite/gfortran.dg/argument_checking_11.f90
+++ b/gcc/testsuite/gfortran.dg/argument_checking_11.f90
@@ -2,6 +2,7 @@ 
 ! { dg-options "-std=f95 -fmax-errors=100" }
 !
 ! PR fortran/34665
+! Small update for PR fortran/47569
 !
 ! Test argument checking
 !
@@ -29,8 +30,8 @@  SUBROUTINE test1(a,b,c,d,e)
  call as_size( (c) ) ! { dg-error "The upper bound in the last dimension must appear in the reference to the assumed size array" }
  call as_size( (d) )
  call as_size( (e) ) ! { dg-error "Rank mismatch" }
- call as_size(a(1)) ! { dg-error "Element of assumed-shaped" }
- call as_size(b(1)) ! { dg-error "Element of assumed-shaped" }
+ call as_size(a(1)) ! { dg-error "element of assumed-shaped" }
+ call as_size(b(1)) ! { dg-error "element of assumed-shaped" }
  call as_size(c(1))
  call as_size(d(1))
  call as_size( (a(1)) ) ! { dg-error "Rank mismatch" }
@@ -89,14 +90,14 @@  SUBROUTINE test1(a,b,c,d,e)
  call as_expl( (c) ) ! { dg-error "The upper bound in the last dimension must appear in the reference to the assumed size array" }
  call as_expl( (d) )
  call as_expl( (e) ) ! { dg-error "Rank mismatch" }
- call as_expl(a(1)) ! { dg-error "Element of assumed-shaped" }
- call as_expl(b(1)) ! { dg-error "Element of assumed-shaped" }
+ call as_expl(a(1)) ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
+ call as_expl(b(1)) ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
  call as_expl(c(1))
  call as_expl(d(1))
  call as_expl( (a(1)) ) ! { dg-error "Rank mismatch" }
  call as_expl( (b(1)) ) ! { dg-error "Rank mismatch" }
  call as_expl( (c(1)) ) ! { dg-error "Rank mismatch" }
- call as_expl( (d(1)) )  ! { dg-error "Rank mismatch" }
+ call as_expl( (d(1)) ) ! { dg-error "Rank mismatch" }
  call as_expl(a(1:3))
  call as_expl(b(1:3))
  call as_expl(c(1:3))
@@ -141,8 +142,8 @@  SUBROUTINE test2(a,b,c,d,e)
  call cas_size(e//"a") ! { dg-error "Fortran 2003: Scalar CHARACTER" }
  call cas_size(("abc")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
  call cas_size( ((/"abc"/)) )
- call cas_size(a(1)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
- call cas_size(b(1)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size(a(1)) ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
+ call cas_size(b(1)) ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
  call cas_size(c(1)) ! OK in F95
  call cas_size(d(1)) ! OK in F95
  call cas_size((a(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" } 
@@ -235,8 +236,8 @@  SUBROUTINE test2(a,b,c,d,e)
  call cas_expl(e//"a") ! { dg-error "Fortran 2003: Scalar CHARACTER" }
  call cas_expl(("abc")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
  call cas_expl(((/"a","b","c"/)))
- call cas_expl(a(1)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
- call cas_expl(b(1)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl(a(1)) ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
+ call cas_expl(b(1)) ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
  call cas_expl(c(1)) ! OK in F95
  call cas_expl(d(1)) ! OK in F95
  call cas_expl((a(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_12.f90 b/gcc/testsuite/gfortran.dg/argument_checking_12.f90
index dc5b526..8857095 100644
--- a/gcc/testsuite/gfortran.dg/argument_checking_12.f90
+++ b/gcc/testsuite/gfortran.dg/argument_checking_12.f90
@@ -2,6 +2,7 @@ 
 ! { dg-options "-std=f2003" }
 !
 ! PR fortran/34665
+! Small update for PR fortran/47569
 !
 ! Test argument checking
 !
@@ -18,8 +19,8 @@  SUBROUTINE test2(a,b,c,d,e)
  call cas_size("abc") 
  call cas_size(e//"a") 
  call cas_size(("abc")) 
- call cas_size(a(1)) 
- call cas_size(b(1)) 
+ call cas_size(a(1))  ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array passed to array dummy argument" }
+ call cas_size(b(1))  ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array passed to array dummy argument" }
  call cas_size((a(1)//"a")) 
  call cas_size((b(1)//"a")) 
  call cas_size((c(1)//"a")) 
@@ -36,8 +37,8 @@  SUBROUTINE test2(a,b,c,d,e)
  call cas_expl("abc") 
  call cas_expl(e//"a") 
  call cas_expl(("abc")) 
- call cas_expl(a(1)) 
- call cas_expl(b(1)) 
+ call cas_expl(a(1))   ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array passed to array dummy argument" }
+ call cas_expl(b(1))   ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array passed to array dummy argument" }
  call cas_expl((a(1)//"a")) 
  call cas_expl((b(1)//"a")) 
  call cas_expl((c(1)//"a")) 
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_13.f90 b/gcc/testsuite/gfortran.dg/argument_checking_13.f90
index ae3fd22..f69a5c4 100644
--- a/gcc/testsuite/gfortran.dg/argument_checking_13.f90
+++ b/gcc/testsuite/gfortran.dg/argument_checking_13.f90
@@ -1,6 +1,7 @@ 
 ! { dg-do compile }
 !
 ! PR fortran/34796
+! Modified for PR fortran/47569
 !
 ! Argument checks:
 ! - elements of deferred-shape arrays (= non-dummies) are allowed
@@ -26,9 +27,9 @@  real, pointer :: pointer_dummy(:,:,:)
 real, allocatable :: deferred(:,:,:)
 real, pointer     :: ptr(:,:,:)
 call rlv1(deferred(1,1,1))         ! valid since contiguous
-call rlv1(ptr(1,1,1))              ! { dg-error "Element of assumed-shaped array" }
-call rlv1(assumed_sh_dummy(1,1,1)) ! { dg-error "Element of assumed-shaped array" }
-call rlv1(pointer_dummy(1,1,1))    ! { dg-error "Element of assumed-shaped array" }
+call rlv1(ptr(1,1,1))              ! { dg-error "element of assumed-shaped or pointer array" }
+call rlv1(assumed_sh_dummy(1,1,1)) ! { dg-error "element of assumed-shaped or pointer array" }
+call rlv1(pointer_dummy(1,1,1))    ! { dg-error "element of assumed-shaped or pointer array" }
 end
 
 subroutine test2(assumed_sh_dummy, pointer_dummy)
@@ -45,17 +46,13 @@  character(3), pointer :: pointer_dummy(:,:,:)
 character(3), allocatable :: deferred(:,:,:)
 character(3), pointer     :: ptr(:,:,:)
 call rlv2(deferred(1,1,1))         ! Valid since contiguous
-call rlv2(ptr(1,1,1))              ! Valid F2003
-call rlv2(assumed_sh_dummy(1,1,1)) ! Valid F2003
-call rlv2(pointer_dummy(1,1,1))    ! Valid F2003
+call rlv2(ptr(1,1,1))              ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
+call rlv2(assumed_sh_dummy(1,1,1)) ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
+call rlv2(pointer_dummy(1,1,1))    ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
 
-! The following is kind of ok: The memory access it valid
-! We warn nonetheless as the result is not what is intented
-! and also formally wrong.
-! Using (1:string_length) would be ok.
-call rlv2(ptr(1,1,1)(1:1))              ! { dg-warning "contains too few elements" }
-call rlv2(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-warning "contains too few elements" }
-call rlv2(pointer_dummy(1,1,1)(1:3))    ! Valid F2003
+call rlv2(ptr(1,1,1)(1:1))              ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
+call rlv2(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
+call rlv2(pointer_dummy(1,1,1)(1:3))    ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
 end
 
 subroutine test3(assumed_sh_dummy, pointer_dummy)
@@ -72,12 +69,12 @@  character(2), pointer :: pointer_dummy(:,:,:)
 character(2), allocatable :: deferred(:,:,:)
 character(2), pointer     :: ptr(:,:,:)
 call rlv3(deferred(1,1,1))         ! Valid since contiguous
-call rlv3(ptr(1,1,1))              ! { dg-warning "contains too few elements" }
-call rlv3(assumed_sh_dummy(1,1,1)) ! { dg-warning "contains too few elements" }
-call rlv3(pointer_dummy(1,1,1))    ! { dg-warning "contains too few elements" }
+call rlv3(ptr(1,1,1))              ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
+call rlv3(assumed_sh_dummy(1,1,1)) ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
+call rlv3(pointer_dummy(1,1,1))    ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
 
 call rlv3(deferred(1,1,1)(1:2))         ! Valid since contiguous
-call rlv3(ptr(1,1,1)(1:2))              ! { dg-warning "contains too few elements" }
-call rlv3(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-warning "contains too few elements" }
-call rlv3(pointer_dummy(1,1,1)(1:2))    ! { dg-warning "contains too few elements" }
+call rlv3(ptr(1,1,1)(1:2))              ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
+call rlv3(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
+call rlv3(pointer_dummy(1,1,1)(1:2))    ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
 end
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_14.f90 b/gcc/testsuite/gfortran.dg/argument_checking_14.f90
index 4c32b25..f5d5825 100644
--- a/gcc/testsuite/gfortran.dg/argument_checking_14.f90
+++ b/gcc/testsuite/gfortran.dg/argument_checking_14.f90
@@ -2,6 +2,7 @@ 
 ! { dg-options "-std=f95" }
 !
 ! PR fortran/34796
+! Modified for PR fortran/47569
 !
 ! This checks for Fortran 2003 extensions.
 !
@@ -15,7 +16,7 @@ 
 !   storage size only the size of the element itself, check for
 !   too short actual arguments.
 !
-subroutine test2(assumed_sh_dummy, pointer_dummy)
+subroutine test2(assumed_sh_dummy, dummy)
 implicit none
 interface
   subroutine rlv2(y)
@@ -23,27 +24,27 @@  interface
   end subroutine rlv2
 end interface
 
-character(3)          :: assumed_sh_dummy(:,:,:)
-character(3), pointer :: pointer_dummy(:,:,:)
+character(3) :: assumed_sh_dummy(:,:,:)
+character(3) :: dummy(1,1,1)
 
 character(3), allocatable :: deferred(:,:,:)
-character(3), pointer     :: ptr(:,:,:)
-call rlv2(deferred(1,1,1))         ! Valid since contiguous
-call rlv2(ptr(1,1,1))              ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
-call rlv2(assumed_sh_dummy(1,1,1)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
-call rlv2(pointer_dummy(1,1,1))    ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+character(3) :: local(1,1,1)
+call rlv2(deferred(1,1,1))         ! OK
+call rlv2(local(1,1,1))            ! OK
+call rlv2(assumed_sh_dummy(1,1,1)) ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
+call rlv2(dummy(1,1,1))            ! OK
 
 ! The following is kind of ok: The memory access it valid
 ! We warn nonetheless as the result is not what is intented
 ! and also formally wrong.
 ! Using (1:string_length) would be ok.
 call rlv2(deferred(1,1,1)(1:3))         ! OK
-call rlv2(ptr(1,1,1)(1:1))              ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
-call rlv2(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
-call rlv2(pointer_dummy(1,1,1)(1:3))    ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv2(local(1,1,1)(1:1))            ! OK
+call rlv2(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
+call rlv2(dummy(1,1,1)(1:3))            ! OK
 end
 
-subroutine test3(assumed_sh_dummy, pointer_dummy)
+subroutine test3(assumed_sh_dummy, dummy)
 implicit none
 interface
   subroutine rlv3(y)
@@ -51,18 +52,18 @@  interface
   end subroutine rlv3
 end interface
 
-character(2)          :: assumed_sh_dummy(:,:,:)
-character(2), pointer :: pointer_dummy(:,:,:)
+character(2) :: assumed_sh_dummy(:,:,:)
+character(2) :: dummy(2,2,*)
 
 character(2), allocatable :: deferred(:,:,:)
-character(2), pointer     :: ptr(:,:,:)
+character(2)              :: local(1,1,1), local_scalar
 call rlv3(deferred(1,1,1))         ! Valid since contiguous
-call rlv3(ptr(1,1,1))              ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
-call rlv3(assumed_sh_dummy(1,1,1)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
-call rlv3(pointer_dummy(1,1,1))    ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv3(local_scalar)            ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv3(assumed_sh_dummy(1,1,1)) ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
+call rlv3(dummy(1,1,1))            ! OK
 
 call rlv3(deferred(1,1,1)(1:2))         ! Valid since contiguous
-call rlv3(ptr(1,1,1)(1:2))              ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
-call rlv3(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
-call rlv3(pointer_dummy(1,1,1)(1:2))    ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv3(local_scalar(1:2))            ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv3(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array" }
+call rlv3(dummy(1,1,1)(1:2))            ! OK
 end
--- /dev/null	2011-02-11 19:24:22.591999997 +0100
+++ gcc/gcc/testsuite/gfortran.dg/argument_checking_17.f90	2011-02-01 15:02:42.000000000 +0100
@@ -0,0 +1,26 @@ 
+! { dg-do compile }
+!
+! PR fortran/47569
+!
+! Contributed by Jos de Kloe 
+!
+module teststr
+  implicit none
+  integer, parameter :: GRH_SIZE = 20, NMAX = 41624
+  type strtype
+    integer   :: size
+    character :: mdr(NMAX)
+  end type strtype
+contains
+  subroutine sub2(string,str_size)
+    integer,intent(in)    :: str_size
+    character,intent(out) :: string(str_size)
+    string(:) = 'a'
+  end subroutine sub2
+  subroutine sub1(a)
+    type(strtype),intent(inout) :: a
+    call sub2(a%mdr(GRH_SIZE+1),a%size-GRH_SIZE)
+  end subroutine sub1
+end module teststr
+
+! { dg-final { cleanup-modules "teststr" } }
--- /dev/null	2011-02-11 19:24:22.591999997 +0100
+++ gcc/gcc/testsuite/gfortran.dg/argument_checking_18.f90	2011-02-10 15:59:52.000000000 +0100
@@ -0,0 +1,28 @@ 
+! { dg-do compile }
+!
+! PR fortran/47569
+!
+module m
+type t
+ integer :: i
+end type t
+contains
+subroutine chartest(x,y)
+  character, pointer :: x, y(:)
+  call foo(x)    ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array passed to array dummy" }
+  call foo(y(1)) ! { dg-error "Scalar pointer or element of assumed-shaped or pointer array passed to array dummy" })
+contains
+  subroutine foo(a)
+    character :: a(*)
+  end subroutine
+end subroutine
+! Test disabled due to PR 47680
+!subroutine classtest(x)
+!  class(t) :: x(4)
+!  call foo(x(1)) ! ICE; error "Polymorphic scalar passed to array dummy argument"
+!contains
+!  subroutine foo(a,b)
+!    class(t) :: a(*)
+!  end subroutine
+!end subroutine
+end module m