Re: [patch, fortran] Fix PR 92004, restore Lapack compilation

2019-10-14 Thread Thomas Koenig

Committed, with that nitch, r276972.


OK with a minor nit. — Thanks for the patch.


Thanks a lot for the review!

Regards

Thomas


Re: [patch, fortran] Fix PR 92004, restore Lapack compilation

2019-10-14 Thread Tobias Burnus

Hi,

On 10/13/19 5:41 PM, Thomas Koenig wrote:

OK, so here's the update. There was a problem with uninitialized
variables, which for some reason was not detected on compilation.

OK for trunk?


OK with a minor nit. — Thanks for the patch.


unsigned int do_not_warn : 1;
+
+  /* Set this if the expression came from expanding an array constructor.  */
+
+  unsigned int from_constructor : 1;



The most other items in the file have no empty line between comment and 
the bit-set entry. For consistency, can you remove that line?


Thanks,

Tobias



Re: [patch, fortran] Fix PR 92004, restore Lapack compilation

2019-10-13 Thread Thomas Koenig

OK, so here's the update. There was a problem with uninitialized
variables, which for some reason was not detected on compilation.

OK for trunk?

2019-10-13  Thomas Koenig  

PR fortran/92004
* array.c (expand_constructor): Set from_constructor on
expression.
* gfortran.h (gfc_symbol): Add maybe_array.
(gfc_expr): Add from_constructor.
* interface.c (maybe_dummy_array_arg): New function.
(compare_parameter): If the formal argument is generated from a
call, check the conditions where an array element could be
passed to an array.  Adjust error message for assumed-shape
or pointer array.  Use correct language for assumed shaped arrays.
(gfc_get_formal_from_actual_arglist): Set maybe_array on the
symbol if the actual argument is an array element fulfilling
the conditions of 15.5.2.4.

2019-10-13  Thomas Koenig  

PR fortran/92004
* gfortran.dg/argument_checking_24.f90: New test.
* gfortran.dg/abstract_type_6.f90: Add error message.
* gfortran.dg/argument_checking_11.f90: Correct wording
in error message.
* gfortran.dg/argumeent_checking_13.f90: Likewise.
* gfortran.dg/interface_40.f90: Add error message.

Index: fortran/array.c
===
--- fortran/array.c	(Revision 276506)
+++ fortran/array.c	(Arbeitskopie)
@@ -1763,6 +1763,7 @@ expand_constructor (gfc_constructor_base base)
 	  gfc_free_expr (e);
 	  return false;
 	}
+  e->from_constructor = 1;
   current_expand.offset = >offset;
   current_expand.repeat = >repeat;
   current_expand.component = c->n.component;
Index: fortran/gfortran.h
===
--- fortran/gfortran.h	(Revision 276506)
+++ fortran/gfortran.h	(Arbeitskopie)
@@ -1614,6 +1614,9 @@ typedef struct gfc_symbol
   /* Set if a previous error or warning has occurred and no other
  should be reported.  */
   unsigned error:1;
+  /* Set if the dummy argument of a procedure could be an array despite
+ being called with a scalar actual argument. */
+  unsigned maybe_array:1;
 
   int refs;
   struct gfc_namespace *ns;	/* namespace containing this symbol */
@@ -2194,6 +2197,11 @@ typedef struct gfc_expr
   /* Set this if no warning should be given somewhere in a lower level.  */
 
   unsigned int do_not_warn : 1;
+
+  /* Set this if the expression came from expanding an array constructor.  */
+
+  unsigned int from_constructor : 1;
+
   /* If an expression comes from a Hollerith constant or compile-time
  evaluation of a transfer statement, it may have a prescribed target-
  memory representation, and these cannot always be backformed from
Index: fortran/interface.c
===
--- fortran/interface.c	(Revision 276506)
+++ fortran/interface.c	(Arbeitskopie)
@@ -2229,6 +2229,67 @@ argument_rank_mismatch (const char *name, locus *w
 }
 
 
+/* Under certain conditions, a scalar actual argument can be passed
+   to an array dummy argument - see F2018, 15.5.2.4, paragraph 14.
+   This function returns true for these conditions so that an error
+   or warning for this can be suppressed later.  Always return false
+   for expressions with rank > 0.  */
+
+bool
+maybe_dummy_array_arg (gfc_expr *e)
+{
+  gfc_symbol *s;
+  gfc_ref *ref;
+  bool array_pointer = false;
+  bool assumed_shape = false;
+  bool scalar_ref = true;
+
+  if (e->rank > 0)
+return false;
+
+  if (e->ts.type == BT_CHARACTER && e->ts.kind == 1)
+return true;
+
+  /* If this comes from a constructor, it has been an array element
+ originally.  */
+
+  if (e->expr_type == EXPR_CONSTANT)
+return e->from_constructor;
+
+  if (e->expr_type != EXPR_VARIABLE)
+return false;
+
+  s = e->symtree->n.sym;
+
+  if (s->attr.dimension)
+{
+  scalar_ref = false;
+  array_pointer = s->attr.pointer;
+}
+
+  if (s->as && s->as->type == AS_ASSUMED_SHAPE)
+assumed_shape = true;
+
+  for (ref=e->ref; ref; ref=ref->next)
+{
+  if (ref->type == REF_COMPONENT)
+	{
+	  symbol_attribute *attr;
+	  attr = >u.c.component->attr;
+	  if (attr->dimension)
+	{
+	  array_pointer = attr->pointer;
+	  assumed_shape = false;
+	  scalar_ref = false;
+	}
+	  else
+	scalar_ref = true;
+	}
+}
+
+  return !(scalar_ref || array_pointer || assumed_shape);
+}
+
 /* Given a symbol of a formal argument list and an expression, see if
the two are compatible as arguments.  Returns true if
compatible, false if not compatible.  */
@@ -2544,7 +2605,9 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
   || (actual->rank == 0 && formal->attr.dimension
 	  && gfc_is_coindexed (actual)))
 {
-  if (where)
+  if (where 
+	  && (!formal->attr.artificial || (!formal->maybe_array
+	   && !maybe_dummy_array_arg (actual
 	{
 	  locus 

Re: [patch, fortran] Fix PR 92004, restore Lapack compilation

2019-10-13 Thread Thomas Koenig

Hm, my trunk is doing strange things (debugging not working),
and I think I have found an additional problem.  I'll need some
time to work this out, and will resubmit.

Regards

Thomas


Re: [patch, fortran] Fix PR 92004, restore Lapack compilation

2019-10-12 Thread Thomas Koenig

Hi,

I think I have resolved all the issues (see attached patch and test
case).

Basically, the patch now walks through the refs and looks at the
latest thing that could be an array or a scalar.

Regarding CLASS in argument lists without an explicit interface:
I think that this is disallowed because an explicit interface
is required for a polymorphic dummy argument, and I see no
way of passing a polymorphic argument to a procedure without
having a polymorphic argument as a dummy argument.

While I was at it, I also changed some language to match the
language of the standard more closely.

As you can see in the test case, I tried to cover all relevant
cases.

Regression-tested. OK for trunk?

Regards

Thomas

2019-10-12  Thomas Koenig  

PR fortran/92004
* array.c (expand_constructor): Set from_constructor on
expression.
* gfortran.h (gfc_symbol): Add maybe_array.
(gfc_expr): Add from_constructor.
* interface.c (maybe_dummy_array_arg): New function.
(compare_parameter): If the formal argument is generated from a
call, check the conditions where an array element could be
passed to an array.  Adjust error message for assumed-shape
or pointer array.  Use correct language for assumed shaped arrays.
(gfc_get_formal_from_actual_arglist): Set maybe_array on the
symbol if the actual argument is an array element fulfilling
the conditions of 15.5.2.4.

2019-10-12  Thomas Koenig  

PR fortran/92004
* gfortran.dg/argument_checking_24.f90: New test.
* gfortran.dg/abstract_type_6.f90: Add error message.
* gfortran.dg/argument_checking_11.f90: Correct wording
in error message.
* gfortran.dg/argumeent_checking_13.f90: Likewise.
* gfortran.dg/interface_40.f90: Add error message.
Index: fortran/array.c
===
--- fortran/array.c	(Revision 276506)
+++ fortran/array.c	(Arbeitskopie)
@@ -1763,6 +1763,7 @@ expand_constructor (gfc_constructor_base base)
 	  gfc_free_expr (e);
 	  return false;
 	}
+  e->from_constructor = 1;
   current_expand.offset = >offset;
   current_expand.repeat = >repeat;
   current_expand.component = c->n.component;
Index: fortran/gfortran.h
===
--- fortran/gfortran.h	(Revision 276506)
+++ fortran/gfortran.h	(Arbeitskopie)
@@ -1614,6 +1614,9 @@ typedef struct gfc_symbol
   /* Set if a previous error or warning has occurred and no other
  should be reported.  */
   unsigned error:1;
+  /* Set if the dummy argument of a procedure could be an array despite
+ being called with a scalar actual argument. */
+  unsigned maybe_array:1;
 
   int refs;
   struct gfc_namespace *ns;	/* namespace containing this symbol */
@@ -2194,6 +2197,11 @@ typedef struct gfc_expr
   /* Set this if no warning should be given somewhere in a lower level.  */
 
   unsigned int do_not_warn : 1;
+
+  /* Set this if the expression came from expanding an array constructor.  */
+
+  unsigned int from_constructor : 1;
+
   /* If an expression comes from a Hollerith constant or compile-time
  evaluation of a transfer statement, it may have a prescribed target-
  memory representation, and these cannot always be backformed from
Index: fortran/interface.c
===
--- fortran/interface.c	(Revision 276506)
+++ fortran/interface.c	(Arbeitskopie)
@@ -2229,6 +2229,64 @@ argument_rank_mismatch (const char *name, locus *w
 }
 
 
+/* Under certain conditions, a scalar actual argument can be passed
+   to an array dummy argument - see F2018, 15.5.2.4, paragraph 14.
+   This function returns true for these conditions so that an error
+   or warning for this can be suppressed later.  Always return false
+   for expressions with rank > 0.  */
+
+bool
+maybe_dummy_array_arg (gfc_expr *e)
+{
+  gfc_symbol *s;
+  gfc_ref *ref;
+  bool array_pointer, assumed_shape, scalar_ref;
+
+  if (e->rank > 0)
+return false;
+
+  if (e->ts.type == BT_CHARACTER && e->ts.kind == 1)
+return true;
+
+  /* If this comes from a constructor, it has been an array element
+ originally.  */
+
+  if (e->expr_type == EXPR_CONSTANT)
+return e->from_constructor;
+
+  if (e->expr_type != EXPR_VARIABLE)
+return false;
+
+  s = e->symtree->n.sym;
+
+  if (s->attr.dimension)
+array_pointer = s->attr.pointer;
+  else
+scalar_ref = true;
+
+  if (s->as && s->as->type == AS_ASSUMED_SHAPE)
+assumed_shape = true;
+
+  for (ref=e->ref; ref; ref=ref->next)
+{
+  if (ref->type == REF_COMPONENT)
+	{
+	  symbol_attribute *attr;
+	  attr = >u.c.component->attr;
+	  if (attr->dimension)
+	{
+	  array_pointer = attr->pointer;
+	  assumed_shape = false;
+	  scalar_ref = false;
+	}
+	  else
+	scalar_ref = true;
+	}
+}
+
+  return !(scalar_ref || 

Re: [patch, fortran] Fix PR 92004, restore Lapack compilation

2019-10-10 Thread Tobias Burnus

Hi Thomas,

On 10/10/19 12:23 AM, Thomas Koenig wrote:

+  if (s->ts.type == BT_CLASS || s->as->type == AS_ASSUMED_SHAPE
+  || s->attr.pointer)
+    return false;


dt%foo – again, "foo" can be an allocatable of polymorphic type or a 
pointer, but at least, it cannot be of assumed shape.


Really? The paragraph reads […]


What I meant is assumed-shape implies dummy argument. Hence, 
"s->as->type" is a good check.


Whereas for deferred-shape, one had to take care of "dt%allocatable_arg" 
– thus, the s->attr.pointer and the s->ts.type check aren't good.


Technical background for those requirements: pointers and assumed-shape 
arrays can have strides, but if one passes a scalar to an array dummy 
argument, one wants to be reasonably sure that the memory is contiguous.


(Actually, one could permit assumed-shape or pointer with contiguous 
argument. But as one doesn't want to encourage this abuse. The reason 
for permitting character(kind=1) is to call C "char*" functions without 
using ["H", "e", "l", "l", "o", null] instead of "Hello" + null].)




Anyway, here's an update of the patch. OK, or is there still something
missing?


It would be nice to have a ChangeLog item (not as diff).



+ /* Set if an interface to a procedure could actually be to an array
+ although the actual argument is scalar. */
+ unsigned maybe_array:1; 


Actually, I find this sentence hard to parse. Maybe:
"Set if the dummy argument of a procedure could be an array despite
being called with a scalar actual argument."

Or something along this line.



+/* Under certain conditions, a scalar actual argument can be passed
+   to an array dummy argument - see F2018, 15.5.2.4, clause 14.  This
+   functin returns true for these conditions so that an error or

Old patch? Still "functin".


+   warning for this can be suppressed later.  */
+
+bool
+maybe_dummy_array_arg (gfc_expr *e)
+{
+  gfc_symbol *s;
+  gfc_ref *ref;
+  bool last_array_ref;
+
+  if (e->rank > 0)
+return false;


Maybe add a comment "/* Return false as for arrays, the rank always 
needs to be checked. */" or something like that. Otherweise, 
"maybe_dummy_array_arg" + description above the function cause one to 
stumble over this.




+  s = e->symtree->n.sym;
+  if (s->as == NULL)
+return false;


Again, assume  "call foo(dt%array(1))" – I think that's fine but 
rejected by this check as "dt" is a scalar and only "dt%array" is an 
array. – You have have to keep that array spec and then look the the 
last component reference and see at its array spec.



+  if (s->ts.type == BT_CLASS || s->as->type == AS_ASSUMED_SHAPE
+  || s->attr.pointer)
+return false;


Similarly, "class%int_array(1)" is fine – I think you need "e->ts.type" 
instead of "s".


For s->attr.pointer, likewise "ptr%int_array(1)" is fine, hence, 
"gfc_expr_attr (e).pointer" or something like that is needed.


And for the "s->as->type", the following should be valid:

type t
integer :: ia(100)
end type t

type(t), allocatable :: x(:)
allocate(x(1))
call foo(x(1)%ia(5), 100-5)

But while x is assumed-shape


+  last_array_ref = false;
+
+  for (ref=e->ref; ref; ref=ref->next)
+last_array_ref = ref->type == REF_ARRAY;


This rejects too much - you can also have a substring reference at the 
end – and then the arrayness still matters.


character(type=4, len=5) :: str(50)

   call foo(str(1))  ! This makes sense
   call foo(str(1)(3:4))  ! Technically valid, but feels odd


argument_checking_24.f90



I also would prefer to have some more test coverage.

For instance:

type(tt), pointer :: tt_var2
allocate(tt_var2)
call s2(tt_var2%x(1)) ! Valid

subroutine foo3(x)
type(tt) :: tt_var2(:)
call s1(tt_var2%x(1)) ! Valid

call s4(dt%array_var%scalar) ! Invalid


Actually, I wonder whether you code as any effects on strings as at 
least the test for "Element of assumed-shaped or pointer array passed to 
array dummy argument" permits any string and not only 
default-kind/c_char strings. – I am pretty sure that some C-binding test 
case already checks that those are accepted.



Cheers,

Tobias



Re: [patch, fortran] Fix PR 92004, restore Lapack compilation

2019-10-09 Thread Thomas Koenig

Hi Tobias,


function ("o" missing); I think it is not clause 14 but paragraph 14.


Fixed. (That one was easy :-)


+   warning for this can be suppressed later.  */
+
+bool
+maybe_dummy_array_arg (gfc_expr *e)
+{
+  gfc_symbol *s;
+
+  if (e->rank > 0)
+    return false;
+
+  if (e->ts.type == BT_CHARACTER && e->ts.kind == 1)
+    return true;
+
+  if (e->expr_type != EXPR_VARIABLE)
+    return false;


What about PARAMETER? :-)


Good catch.

I found that, by the time the code is reached, an element of a
parameter array is already simplified; so I added a flag during
constructor expansion.




+  s = e->symtree->n.sym;
+  if (s->as == NULL)
+    return false;


This looks wrong. You also want to permit dt%array(1) – but not 
dt(1)%scalar


Fixed.


+  if (s->ts.type == BT_CLASS || s->as->type == AS_ASSUMED_SHAPE
+  || s->attr.pointer)
+    return false;


dt%foo – again, "foo" can be an allocatable of polymorphic type or a 
pointer, but at least, it cannot be of assumed shape.


Really? The paragraph reads

# 14 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 (18.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 last two points do not apply here because they are invalid without
explicit interface).  Unless I have my negatives wrong, the code is
correct (but I have been getting standardese wrong before).

Anyway, here's an update of the patch. OK, or is there still something
missing?  Or how should I interpret that paragraph? :-)

Regards

Thomas
Index: array.c
===
--- array.c	(Revision 276506)
+++ array.c	(Arbeitskopie)
@@ -1763,6 +1763,7 @@ expand_constructor (gfc_constructor_base base)
 	  gfc_free_expr (e);
 	  return false;
 	}
+  e->from_constructor = 1;
   current_expand.offset = >offset;
   current_expand.repeat = >repeat;
   current_expand.component = c->n.component;
Index: gfortran.h
===
--- gfortran.h	(Revision 276506)
+++ gfortran.h	(Arbeitskopie)
@@ -1614,6 +1614,9 @@ typedef struct gfc_symbol
   /* Set if a previous error or warning has occurred and no other
  should be reported.  */
   unsigned error:1;
+  /* Set if an interface to a procedure could actually be to an array
+ although the actual argument is scalar.  */
+  unsigned maybe_array:1;
 
   int refs;
   struct gfc_namespace *ns;	/* namespace containing this symbol */
@@ -2194,6 +2197,11 @@ typedef struct gfc_expr
   /* Set this if no warning should be given somewhere in a lower level.  */
 
   unsigned int do_not_warn : 1;
+
+  /* Set this if the expression came from expanding an array constructor.  */
+
+  unsigned int from_constructor : 1;
+
   /* If an expression comes from a Hollerith constant or compile-time
  evaluation of a transfer statement, it may have a prescribed target-
  memory representation, and these cannot always be backformed from
Index: interface.c
===
--- interface.c	(Revision 276506)
+++ interface.c	(Arbeitskopie)
@@ -2229,6 +2229,46 @@ argument_rank_mismatch (const char *name, locus *w
 }
 
 
+/* Under certain conditions, a scalar actual argument can be passed
+   to an array dummy argument - see F2018, 15.5.2.4, clause 14.  This
+   functin returns true for these conditions so that an error or
+   warning for this can be suppressed later.  */
+
+bool
+maybe_dummy_array_arg (gfc_expr *e)
+{
+  gfc_symbol *s;
+  gfc_ref *ref;
+  bool last_array_ref;
+
+  if (e->rank > 0)
+return false;
+
+  if (e->ts.type == BT_CHARACTER && e->ts.kind == 1)
+return true;
+
+  if (e->expr_type == EXPR_CONSTANT)
+return e->from_constructor;
+
+  if (e->expr_type != EXPR_VARIABLE)
+return false;
+
+  s = e->symtree->n.sym;
+  if (s->as == NULL)
+return false;
+
+  if (s->ts.type == BT_CLASS || s->as->type == AS_ASSUMED_SHAPE
+  || s->attr.pointer)
+return false;
+
+  last_array_ref = false;
+
+  for (ref=e->ref; ref; ref=ref->next)
+last_array_ref = ref->type == REF_ARRAY;
+
+  return last_array_ref;
+}
+
 /* Given a symbol of a formal argument list and an expression, see if
the two are compatible as arguments.  Returns true if
compatible, false if not compatible.  */
@@ -2544,7 +2584,9 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
   || (actual->rank == 0 && formal->attr.dimension
 	  && gfc_is_coindexed (actual)))
 {
-  if (where)
+  if (where 
+	  && (!formal->attr.artificial || (!formal->maybe_array
+	   && !maybe_dummy_array_arg (actual
 	{
 	  locus *where_formal;
 	  if (formal->attr.artificial)
@@ -2594,9 +2636,17 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
   && 

Re: [patch, fortran] Fix PR 92004, restore Lapack compilation

2019-10-08 Thread Tobias Burnus

Hi Thomas,

On 10/6/19 5:26 PM, Thomas Koenig wrote:

+/* Under certain conditions, a scalar actual argument can be passed
+   to an array dummy argument - see F2018, 15.5.2.4, clause 14.  This
+   functin returns true for these conditions so that an error or


function ("o" missing); I think it is not clause 14 but paragraph 14.



+   warning for this can be suppressed later.  */
+
+bool
+maybe_dummy_array_arg (gfc_expr *e)
+{
+  gfc_symbol *s;
+
+  if (e->rank > 0)
+return false;
+
+  if (e->ts.type == BT_CHARACTER && e->ts.kind == 1)
+return true;
+
+  if (e->expr_type != EXPR_VARIABLE)
+return false;


What about PARAMETER? :-)



+  s = e->symtree->n.sym;
+  if (s->as == NULL)
+return false;


This looks wrong. You also want to permit dt%array(1) – but not dt(1)%scalar


+  if (s->ts.type == BT_CLASS || s->as->type == AS_ASSUMED_SHAPE
+  || s->attr.pointer)
+return false;


dt%foo – again, "foo" can be an allocatable of polymorphic type or a 
pointer, but at least, it cannot be of assumed shape.


Otherwise it looks good at a glance.

Tobias




Re: [patch, fortran] Fix PR 92004, restore Lapack compilation

2019-10-06 Thread Thomas Koenig

Am 06.10.19 um 17:26 schrieb Thomas Koenig:

This
also restores Lapack compilation without warning.


Well, up to an error in the testing routines, at least.

TESTING/LIN/sdrvls.f has

  REAL, ALLOCATABLE :: WORK (:)
...

  REAL   RESULT( NTESTS ), WQ

and calls

  CALL SGELS( TRANS, M, N, NRHS, A, LDA,
 $B, LDB, WQ, -1, INFO )

[...]

  CALL SGELS( TRANS, M, N, NRHS, A, LDA, B,
 $LDB, WORK, LWORK, INFO )

so that one really is illegal and should be flagged.


[patch, fortran] Fix PR 92004, restore Lapack compilation

2019-10-06 Thread Thomas Koenig

Hello world,

this patch fixes an overzealous interpretation of F2018 15.5.2.4, where
an idiom of passing an array element to an array was rejected. This
also restores Lapack compilation without warning.

Regression-tested. OK for trunk?

Regards

Thomas

2019-10-06  Thomas Koenig  

PR fortran/92004
* gfortran.h (gfc_symbol): Add maybe_array.
* interface.c (maybe_dummy_array_arg): New function.
(compare_parameter): If the formal argument is generated from a
call, check the conditions where an array element could be
passed to an array.  Adjust error message for assumed-shape
or pointer array.
(gfc_get_formal_from_actual_arglist): Set maybe_array on the
symbol if the actual argument is an array element fulfilling
the conditions of 15.5.2.4.

2019-10-06  Thomas Koenig  

PR fortran/92004
* gfortran.dg/argument_checking_24.f90: New test.
Index: gfortran.h
===
--- gfortran.h	(Revision 276506)
+++ gfortran.h	(Arbeitskopie)
@@ -1614,6 +1614,9 @@ typedef struct gfc_symbol
   /* Set if a previous error or warning has occurred and no other
  should be reported.  */
   unsigned error:1;
+  /* Set if an interface to a procedure could actually be to an array
+ although the actual argument is scalar.  */
+  unsigned maybe_array:1;
 
   int refs;
   struct gfc_namespace *ns;	/* namespace containing this symbol */
Index: interface.c
===
--- interface.c	(Revision 276506)
+++ interface.c	(Arbeitskopie)
@@ -2229,6 +2229,36 @@ argument_rank_mismatch (const char *name, locus *w
 }
 
 
+/* Under certain conditions, a scalar actual argument can be passed
+   to an array dummy argument - see F2018, 15.5.2.4, clause 14.  This
+   functin returns true for these conditions so that an error or
+   warning for this can be suppressed later.  */
+
+bool
+maybe_dummy_array_arg (gfc_expr *e)
+{
+  gfc_symbol *s;
+
+  if (e->rank > 0)
+return false;
+
+  if (e->ts.type == BT_CHARACTER && e->ts.kind == 1)
+return true;
+
+  if (e->expr_type != EXPR_VARIABLE)
+return false;
+
+  s = e->symtree->n.sym;
+  if (s->as == NULL)
+return false;
+
+  if (s->ts.type == BT_CLASS || s->as->type == AS_ASSUMED_SHAPE
+  || s->attr.pointer)
+return false;
+
+  return true;
+}
+
 /* Given a symbol of a formal argument list and an expression, see if
the two are compatible as arguments.  Returns true if
compatible, false if not compatible.  */
@@ -2544,7 +2574,9 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
   || (actual->rank == 0 && formal->attr.dimension
 	  && gfc_is_coindexed (actual)))
 {
-  if (where)
+  if (where 
+	  && (!formal->attr.artificial || (!formal->maybe_array
+	   && !maybe_dummy_array_arg (actual
 	{
 	  locus *where_formal;
 	  if (formal->attr.artificial)
@@ -2594,9 +2626,17 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
   && (is_pointer || ref->u.ar.as->type == AS_ASSUMED_SHAPE))
 {
   if (where)
-	gfc_error ("Element of assumed-shaped or pointer "
-		   "array passed to array dummy argument %qs at %L",
-		   formal->name, >where);
+	{
+	  if (formal->attr.artificial)
+	gfc_error ("Element of assumed-shaped or pointer array "
+		   "as actual argument at %L can not correspond to "
+		   "actual argument at %L ",
+		   >where, >declared_at);
+	  else
+	gfc_error ("Element of assumed-shaped or pointer "
+		   "array passed to array dummy argument %qs at %L",
+		   formal->name, >where);
+	}
   return false;
 }
 
@@ -2625,7 +2665,9 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
 
   if (ref == NULL && actual->expr_type != EXPR_NULL)
 {
-  if (where)
+  if (where 
+	  && (!formal->attr.artificial || (!formal->maybe_array
+	   && !maybe_dummy_array_arg (actual
 	{
 	  locus *where_formal;
 	  if (formal->attr.artificial)
@@ -5228,6 +5270,8 @@ gfc_get_formal_from_actual_arglist (gfc_symbol *sy
 		  s->as->upper[0] = NULL;
 		  s->as->type = AS_ASSUMED_SIZE;
 		}
+	  else
+		s->maybe_array = maybe_dummy_array_arg (a->expr);
 	}
 	  s->attr.dummy = 1;
 	  s->declared_at = a->expr->where;
! { dg-do compile }
! PR 
module x
  implicit none
contains
  subroutine foo(a)
real, dimension(:) :: a
call ext_1(a(1))  ! { dg-error "Rank mismatch" }
call ext_1(a) ! { dg-error "Rank mismatch" }
call ext_2(a) ! { dg-error "Element of assumed-shaped or pointer" }
call ext_2(a(1))  ! { dg-error "Element of assumed-shaped or pointer" }
  end subroutine foo

  subroutine bar(a)
real, dimension(*) :: a
! None of the ones below should issue an error.
call ext_3 (a)
call ext_3 (a(1))
call ext_4 (a(1))
call ext_4 (a)
  end subroutine bar
end module x