typespec in forall and implied-do

typespec in forall and implied-do

[Harald Anlauf]

Steve,

for unknown reasons I cannot reply to your mail on gmane,
so trying directly via mailing list.

I tried your patch, and it works on the supplied testcases.

However, there is a scoping issue for the declaration of the
index variable, as can be seen by the following variation:

program foo
  use iso_fortran_env, only : k => real_kinds
  implicit none
  integer, parameter :: n = size(k)
  integer(8) :: i
!!$  integer, parameter :: &
!!$       &  p(n) = [(precision(real(1.,k(i))), integer :: i = 1, n)]
  integer, parameter :: &
       &  q(n) = [(kind(i), integer(2) :: i = 1, n)]
  integer, parameter :: &
       &  r(n) = [(storage_size(i), integer(1) :: i = 1, n)]
!!$  print *, p
  print *, q
  print *, r
end program foo

After your patch, gfortran prints:

           8           8           8           8
          64          64          64          64

This suggests that the integer kind is taken from the host decl,
which is kind=8, and not the local one (2 or 1).

Crayftn (which chokes on your original testcase):

 3*2
 3*8

This is what I expect.

Intel doesn't accept storage_size() here, which is a bug.
Commenting the uses of array r, I then get:

           2           2           2

At least this agrees with Cray.

Can you have another look at this?

Thanks so far for you patch!

Harald

Re: typespec in forall and implied-do

[Steve Kargl]

On Sun, Nov 20, 2022 at 10:28:40PM +0100, Harald Anlauf via Fortran wrote:
> Steve,
> 
> for unknown reasons I cannot reply to your mail on gmane,
> so trying directly via mailing list.
> 
> I tried your patch, and it works on the supplied testcases.
> 
> However, there is a scoping issue for the declaration of the
> index variable, as can be seen by the following variation:
> 
> program foo
>   use iso_fortran_env, only : k => real_kinds
>   implicit none
>   integer, parameter :: n = size(k)
>   integer(8) :: i
> !!$  integer, parameter :: &
> !!$       &  p(n) = [(precision(real(1.,k(i))), integer :: i = 1, n)]
>   integer, parameter :: &
>        &  q(n) = [(kind(i), integer(2) :: i = 1, n)]
>   integer, parameter :: &
>        &  r(n) = [(storage_size(i), integer(1) :: i = 1, n)]
> !!$  print *, p
>   print *, q
>   print *, r
> end program foo
> 
> After your patch, gfortran prints:
> 
>            8           8           8           8
>           64          64          64          64
> 
> This suggests that the integer kind is taken from the host decl,
> which is kind=8, and not the local one (2 or 1).
> 
> Crayftn (which chokes on your original testcase):
> 
>  3*2
>  3*8
> 
> This is what I expect.
> 
> Intel doesn't accept storage_size() here, which is a bug.
> Commenting the uses of array r, I then get:
> 
>            2           2           2
> 
> At least this agrees with Cray.
> 
> Can you have another look at this?
> 

Unfortunately, gfortran does not define a namespace for an implied-do
index and uses a kludge by adding the attr.implied_index attribute to
the symbol.  Unfortunately**2, gfortran uses gfc_match_iterator for 
all places that 'i = start, stop [,step]' and there is no way to know
if what is being parsed.  With the introduction of an optional typespec,
there is no easy way to deal with it in a clean way.  Things get messy
quickly when trying to deal with implicit typing and explicitly typed
symbols.  So, if the implied-do index has previously been typed such as

    integer(8) i
    print *, (i, integer(2) i=1, 3)

the integer(2) is ignored.  That's this part of the gfc_match_iterator
diff

+  if (seen_ts && var->ts.type == BT_UNKNOWN)
+    {
+      var->ts.type = ts.type;
+      var->ts.kind = ts.kind;
+      var->symtree->n.sym->ts.type = ts.type;
+      var->symtree->n.sym->ts.kind = ts.kind;
+    }

Perhaps, a better way would be to simply create a shadow symbol
if a typespec appears in an iterator 

    print *, (i, integer i=1,3)

would become 

    print *, (_i, integer _i=1,3)

The issue is then that implied-do object list needs to be walked
and all occurrence of i must be replaced with _i.

-- 
Steve

Re: typespec in forall and implied-do

[Steve Kargl]

On Sun, Nov 20, 2022 at 10:28:40PM +0100, Harald Anlauf via Fortran wrote:
> 
> for unknown reasons I cannot reply to your mail on gmane,
> so trying directly via mailing list.
> 

I forgot to address this.  I updated my OS on Thursday afternoon,
and when I rebooted, sendmail failed to start.  It took me until
noon-ish on Friday to restore the ability to use sendmail.  Perhaps,
the gmane mails were rejected while I was off-line.

-- 
Steve

Re: typespec in forall and implied-do

[Harald Anlauf]

Minor addition:

program foo
  implicit none
  real(8) :: i
  integer, parameter :: q(*) = [(kind(i), integer :: i = 1, 3)]
  print *, q
end program foo

This prints

           8           8           8

although it should be all 4's.  So we really need to create a local
namespace or even block to shadow the host's variable.

Crayftn and NAG accept this too, Intel has a problem report on this.

Harald

Re: typespec in forall and implied-do

[Steve Kargl]

On Tue, Nov 22, 2022 at 10:15:39PM +0100, Harald Anlauf via Fortran wrote:
> Minor addition:
> 
> program foo
>   implicit none
>   real(8) :: i
>   integer, parameter :: q(*) = [(kind(i), integer :: i = 1, 3)]
>   print *, q
> end program foo
> 
> This prints
> 
>            8           8           8
> 
> although it should be all 4's.  So we really need to create a local
> namespace or even block to shadow the host's variable.
> 
> Crayftn and NAG accept this too, Intel has a problem report on this.
> 

I'll see if I can make the shadow variable idea work.  For two
lines

   integer, parameter :: q(3) = [(kind(i), integer :: i = 1, 3)]
   integer            :: p(3) = [(kind(i), integer :: i = 1, 3)]

I believe the paths through the compiler differ sufficiently, and
the shado variable might help in keeping the change simple.

-- 
Steve

Re: typespec in forall and implied-do

[Mikael Morin]

Le 21/11/2022 à 19:46, Steve Kargl a écrit :
> On Mon, Nov 21, 2022 at 11:34:07AM +0100, Mikael Morin wrote:
>> Le 21/11/2022 à 00:31, Steve Kargl via Fortran a écrit :
>>>
>>> Unfortunately, gfortran does not define a namespace for an implied-do
>>> index and uses a kludge by adding the attr.implied_index attribute to
>>> the symbol.  Unfortunately**2, gfortran uses gfc_match_iterator for
>>> all places that 'i = start, stop [,step]' and there is no way to know
>>> if what is being parsed.  With the introduction of an optional typespec,
>>> there is no easy way to deal with it in a clean way.  Things get messy
>>> quickly when trying to deal with implicit typing and explicitly typed
>>> symbols.  So, if the implied-do index has previously been typed such as
>>>
>>>       integer(8) i
>>>       print *, (i, integer(2) i=1, 3)
>>>
>>> the integer(2) is ignored.  That's this part of the gfc_match_iterator
>>> diff
>>>
>>> +  if (seen_ts && var->ts.type == BT_UNKNOWN)
>>> +    {
>>> +      var->ts.type = ts.type;
>>> +      var->ts.kind = ts.kind;
>>> +      var->symtree->n.sym->ts.type = ts.type;
>>> +      var->symtree->n.sym->ts.kind = ts.kind;
>>> +    }
>>>
>>> Perhaps, a better way would be to simply create a shadow symbol
>>> if a typespec appears in an iterator
>>>
>>>       print *, (i, integer i=1,3)
>>>
>>> would become
>>>
>>>       print *, (_i, integer _i=1,3)
>>>
>>> The issue is then that implied-do object list needs to be walked
>>> and all occurrence of i must be replaced with _i.
>>>
>> Or maybe a namespace could be created if seen_ts is true?
> 
> Yes, I thought about creating a new namespace, but I don't
> have too much experience on how to deal with them.  Even
> with a new namespace, we have to deal with an implied-do
> loop in an initialization expression.  At the moment,
> gfc_reduce_init_expr() does recognize some (all?) implied-do
> loops.
> 
> This is legal code, which uses implicit typing.  Here,
> I get an integer type, but gfc_reduce_init_expr() rejects
> the construct.
> 
> program foo
>     use iso_fortran_env, only : k => real_kinds
>     integer, parameter :: n = size(k)
>     integer, parameter ::p(n) = [(digits(real(1.,k(i))),i = 1,n)]
>     print '(*(I0,X))', p
> end program foo
> 
> % gfortran -o z a.f90
> a.f90:6:30:
> 
>      6 |    &  p(n) = [(digits(real(1.,k(i))),  i = 1, n)]
>        |                              1
> Error: Invalid kind for REAL at (1)
> 
I have looked at it, it is a tricky bug.

The first step of gfc_check_init_expr, way before trying to expand the 
array constructor, is to resolve it.  Resolution of the array 
constructor needs resolution of the ac-value expression, which needs 
resolution of the real(...) expression.  Resolution of that expression 
calls gfc_check_real, which checks that the KIND argument is a valid 
kind, which means among other things being constant, and being able to 
extract its value to check it against the list of defined kinds for the 
platform.  And we can't extract its value before the expansion of the 
array constructor, so the error is emitted, which prevents array 
constructor expansion later on.

So it's a kind of chicken and egg problem.
Right now, I don't see any solution (except simply removing the error).

Re: typespec in forall and implied-do

[Mikael Morin]

Le 27/11/2022 à 20:17, Mikael Morin a écrit :
> Le 21/11/2022 à 19:46, Steve Kargl a écrit :
>> On Mon, Nov 21, 2022 at 11:34:07AM +0100, Mikael Morin wrote:
>>> Le 21/11/2022 à 00:31, Steve Kargl via Fortran a écrit :
>>>>
>>>> Unfortunately, gfortran does not define a namespace for an implied-do
>>>> index and uses a kludge by adding the attr.implied_index attribute to
>>>> the symbol.  Unfortunately**2, gfortran uses gfc_match_iterator for
>>>> all places that 'i = start, stop [,step]' and there is no way to know
>>>> if what is being parsed.  With the introduction of an optional 
>>>> typespec,
>>>> there is no easy way to deal with it in a clean way.  Things get messy
>>>> quickly when trying to deal with implicit typing and explicitly typed
>>>> symbols.  So, if the implied-do index has previously been typed such as
>>>>
>>>>       integer(8) i
>>>>       print *, (i, integer(2) i=1, 3)
>>>>
>>>> the integer(2) is ignored.  That's this part of the gfc_match_iterator
>>>> diff
>>>>
>>>> +  if (seen_ts && var->ts.type == BT_UNKNOWN)
>>>> +    {
>>>> +      var->ts.type = ts.type;
>>>> +      var->ts.kind = ts.kind;
>>>> +      var->symtree->n.sym->ts.type = ts.type;
>>>> +      var->symtree->n.sym->ts.kind = ts.kind;
>>>> +    }
>>>>
>>>> Perhaps, a better way would be to simply create a shadow symbol
>>>> if a typespec appears in an iterator
>>>>
>>>>       print *, (i, integer i=1,3)
>>>>
>>>> would become
>>>>
>>>>       print *, (_i, integer _i=1,3)
>>>>
>>>> The issue is then that implied-do object list needs to be walked
>>>> and all occurrence of i must be replaced with _i.
>>>>
>>> Or maybe a namespace could be created if seen_ts is true?
>>
>> Yes, I thought about creating a new namespace, but I don't
>> have too much experience on how to deal with them.  Even
>> with a new namespace, we have to deal with an implied-do
>> loop in an initialization expression.  At the moment,
>> gfc_reduce_init_expr() does recognize some (all?) implied-do
>> loops.
>>
>> This is legal code, which uses implicit typing.  Here,
>> I get an integer type, but gfc_reduce_init_expr() rejects
>> the construct.
>>
>> program foo
>>     use iso_fortran_env, only : k => real_kinds
>>     integer, parameter :: n = size(k)
>>     integer, parameter ::p(n) = [(digits(real(1.,k(i))),i = 1,n)]
>>     print '(*(I0,X))', p
>> end program foo
>>
>> % gfortran -o z a.f90
>> a.f90:6:30:
>>
>>      6 |    &  p(n) = [(digits(real(1.,k(i))),  i = 1, n)]
>>        |                              1
>> Error: Invalid kind for REAL at (1)
>>
> I have looked at it, it is a tricky bug.
> 
> The first step of gfc_check_init_expr, way before trying to expand the 
> array constructor, is to resolve it.  Resolution of the array 
> constructor needs resolution of the ac-value expression, which needs 
> resolution of the real(...) expression.  Resolution of that expression 
> calls gfc_check_real, which checks that the KIND argument is a valid 
> kind, which means among other things being constant, and being able to 
> extract its value to check it against the list of defined kinds for the 
> platform.  And we can't extract its value before the expansion of the 
> array constructor, so the error is emitted, which prevents array 
> constructor expansion later on.
> 
> So it's a kind of chicken and egg problem.
> Right now, I don't see any solution (except simply removing the error).

With the following patch, no error is reported in case of failure of 
gfc_extract_int.  As the constantness and type checks have been 
redundantly checked in kind_check before the call to gfc_extract_int, we 
only miss to report an error if the value doesn't fit on a host int.  I 
think it's an acceptable loss.

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 91d87a1b2c1..a8edeebe9cd 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -654,12 +654,14 @@ kind_check (gfc_expr *k, int n, bt type)
        return false;
      }

-  if (gfc_extract_int (k, &kind)
-      || gfc_validate_kind (type, kind, true) < 0)
+  if (!gfc_extract_int (k, &kind))
      {
-      gfc_error ("Invalid kind for %s at %L", gfc_basic_typename (type),
-		 &k->where);
-      return false;
+      if (gfc_validate_kind (type, kind, true) < 0)
+	{
+	  gfc_error ("Invalid kind for %s at %L", gfc_basic_typename (type),
+		     &k->where);
+	  return false;
+	}
      }

    return true;


This avoids emitting the error you were facing.
Unfortunately, the same error is caught later at a different place.

test.f90:4:48:

     4 |    integer, parameter ::p(n) = [(digits(real(1.,k(i))),i = 1,n)]
       |                                                1
Error: KIND parameter of REAL at (1) must be an initialization expression

Re: typespec in forall and implied-do

[Steve Kargl]

On Tue, Nov 15, 2022 at 05:13:19PM -0800, Steve Kargl via Fortran wrote:
> F2008 introduced the inclusion of a typespec in a forall
> statement, and thn F2018 a typespec was allowed in an
> implied-do.  There may even be a few bug reports.

New patch and two test cases (don't know how add testcases under git).


Fixes pr78219 for forall.  I thought, but cannot find, there is a PR
about implied-do. 

* fortran/decl.cc: Place current_attr in global namespace. Needed ...
* fortran/expr.cc (gfc_reduce_init_expr): ... here. Handle an implied-do
  loop in an initialization expression whre a type-spec has been given.
* fortran/match.cc (gfc_match_iterator):  Match optional type-spec in
  implied-do.
* fortran/match.cc  (match_forall_header): Match optional type-spec in
  forall-control-header.

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 0f9b2ced4c2..068eb6c4113 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -52,7 +52,7 @@ static int old_char_selector;
 
 static gfc_typespec current_ts;
 
-static symbol_attribute current_attr;
+symbol_attribute current_attr;
 static gfc_array_spec *current_as;
 static int colon_seen;
 static int attr_seen;
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 69d0b57c688..899c76f8cde 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -3162,12 +3162,34 @@ gfc_check_init_expr (gfc_expr *e)
 bool
 gfc_reduce_init_expr (gfc_expr *expr)
 {
+  extern symbol_attribute current_attr;
   bool t;
 
   gfc_init_expr_flag = true;
+
+  /* This block is need to reduce an initialization expression with an
+     implied-do loop where a type-spec is include, e.g.,
+
+     integer, parameter :: &
+     &  p(n) = [(precision(real(1.,k(i))), integer :: i = 1, n)]  */
+  if (expr
+      && expr->expr_type == EXPR_ARRAY
+      && expr->ts.type == BT_UNKNOWN
+      && current_attr.flavor == FL_PARAMETER 
+      && gfc_current_ns->seen_implicit_none == 1)
+    {
+      gfc_simplify_expr (expr, 1);
+      gfc_resolve_expr (expr);
+      if (!gfc_check_constructor_type (expr))
+	return false;
+      if (!gfc_expand_constructor (expr, true))
+	return false;
+    }
+
   t = gfc_resolve_expr (expr);
   if (t)
     t = gfc_check_init_expr (expr);
+
   gfc_init_expr_flag = false;
 
   if (!t || !expr)
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 8b8b6e79c8b..3fd2a80caad 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -968,9 +968,39 @@ gfc_match_iterator (gfc_iterator *iter, int init_flag)
   gfc_expr *var, *e1, *e2, *e3;
   locus start;
   match m;
+  gfc_typespec ts;
+  bool seen_ts;
 
   e1 = e2 = e3 = NULL;
 
+  /* Match an optional "integer ::" type-spec. */
+  start = gfc_current_locus;
+  seen_ts = false;
+  gfc_clear_ts (&ts);
+  m = gfc_match_type_spec (&ts);
+  if (m == MATCH_YES)
+    {
+      seen_ts = (gfc_match (" ::") == MATCH_YES);
+
+      if (seen_ts)
+	{
+	  if (!gfc_notify_std (GFC_STD_F2018, "Optional type-spec "
+			       "included in implied-do loop at %C"))
+	    goto cleanup;
+
+	  if (ts.type != BT_INTEGER)
+	    {
+	      gfc_error ("Type in type-spec at %C shall be INTEGER");
+	      goto cleanup;
+	    }
+	}
+    }
+  else if (m == MATCH_ERROR)
+    goto cleanup;
+
+  if (!seen_ts)
+    gfc_current_locus = start;
+
   /* Match the start of an iterator without affecting the symbol table.  */
 
   start = gfc_current_locus;
@@ -984,6 +1014,14 @@ gfc_match_iterator (gfc_iterator *iter, int init_flag)
   if (m != MATCH_YES)
     return MATCH_NO;
 
+  if (seen_ts && var->ts.type == BT_UNKNOWN)
+    {
+      var->ts.type = ts.type;
+      var->ts.kind = ts.kind;
+      var->symtree->n.sym->ts.type = ts.type;
+      var->symtree->n.sym->ts.kind = ts.kind;
+    }
+
   if (var->symtree->n.sym->attr.dimension)
     {
       gfc_error ("Loop variable at %C cannot be an array");
@@ -2396,6 +2434,9 @@ match_forall_header (gfc_forall_iterator **phead, gfc_expr **mask)
   gfc_forall_iterator *head, *tail, *new_iter;
   gfc_expr *msk;
   match m;
+  locus start;
+  gfc_typespec ts;
+  bool seen_ts;
 
   gfc_gobble_whitespace ();
 
@@ -2405,12 +2446,48 @@ match_forall_header (gfc_forall_iterator **phead, gfc_expr **mask)
   if (gfc_match_char ('(') != MATCH_YES)
     return MATCH_NO;
 
+  /* Match an optional "integer ::" type-spec. */
+  start = gfc_current_locus;
+  seen_ts = false;
+  gfc_clear_ts (&ts);
+  m = gfc_match_type_spec (&ts);
+  if (m == MATCH_YES)
+    {
+      seen_ts = (gfc_match (" ::") == MATCH_YES);
+
+      if (seen_ts)
+	{
+	  if (!gfc_notify_std (GFC_STD_F2008, "Optional type-spec "
+			       "included in FORALL at %C"))
+	    goto cleanup;
+
+	  if (ts.type != BT_INTEGER)
+	    {
+	      gfc_error ("Type in type-spec at %C shall be INTEGER");
+	      goto cleanup;
+	    }
+	}
+    }
+  else if (m == MATCH_ERROR)
+    goto cleanup;
+
+  if (!seen_ts)
+    gfc_current_locus = start;
+
   m = match_forall_iterator (&new_iter);
   if (m == MATCH_ERROR)
     goto cleanup;
   if (m == MATCH_NO)
     goto syntax;
 
+  if (seen_ts && new_iter->var->ts.type == BT_UNKNOWN)
+    {
+      new_iter->var->ts.type = ts.type;
+      new_iter->var->ts.kind = ts.kind;
+      new_iter->var->symtree->n.sym->ts.type = ts.type;
+      new_iter->var->symtree->n.sym->ts.kind = ts.kind;
+    }
+
   head = tail = new_iter;
 
   for (;;)

% cat ~/gcc/gccx/gcc/testsuite/gfortran.dg/implied_do_index.f90  
! { dg-do run }
program foo
   use iso_fortran_env, only : k => real_kinds
   implicit none
   integer, parameter :: n = size(k)
   integer, parameter :: &
   &  p(n) = [(precision(real(1.,k(i))), integer :: i = 1, n)]
   if (p(1) /= 6 .or. p(2) /= 15) stop 1
end program foo

% cat ~/gcc/gccx/gcc/testsuite/gfortran.dg/forall_index.f90
! { dg-do run }
! 
program foo

   implicit none

   integer, parameter :: n = 9
   integer a(n,n), b(n), j

   b = [(k, integer :: k = 1, n)]
   if (any(b /= [1, 2, 3, 4, 5, 6, 7, 8, 9])) stop 1
 
   a = 0
   forall (integer :: i = 1:n) a(i,i) = b(i)
   do j = 1, n
      if (a(j,j) /= b(j)) stop j
   end do

   call bar

   contains

      subroutine bar
         character(len=*), parameter :: &
         &  out = " 1.00  1.41  1.73  2.00  2.24  2.45  2.65  2.83  3.00"
         character(len=80) str
         real x(n)
         x = [(sqrt(real(p)), integer :: p = 1, n)]
         write(str,'(*(F5.2,1X))') x
         if (trim(str) /= out) stop 42
      end subroutine bar

   end program foo

-- 
Steve

Re: typespec in forall and implied-do

[Steve Kargl]

On Wed, Nov 16, 2022 at 04:47:50PM -0800, Steve Kargl via Fortran wrote:
> On Wed, Nov 16, 2022 at 04:32:39PM -0800, Steve Kargl via Fortran wrote:
> > On Wed, Nov 16, 2022 at 01:30:07PM -0800, Steve Kargl via Fortran wrote:
> > > On Tue, Nov 15, 2022 at 05:13:19PM -0800, Steve Kargl via Fortran wrote:
> > > > F2008 introduced the inclusion of a typespec in a forall
> > > > statement, and thn F2018 a typespec was allowed in an
> > > > implied-do.  There may even be a few bug reports.
> > > > 
> > > 
> > > New patch.  This one handles the example of an implied-do
> > > loop in an initialization expression (see patch for expr.cc).  
> > > 
> > 
> > Seems to cause regressions.
> > 
> 
> It seems that the patch to expr.cc allows the implied-do-index
> to escape into the namespace of scoping unit that contains
> the implied-do loop.
> 

If I restrict the expr.cc patch to only kick-in when
gfc_current_ns->seen_implicit_none == 1, then there
are only 11 regression.  Perhaps, this should be committed?

-- 
Steve

Re: typespec in forall and implied-do

[Steve Kargl]

On Wed, Nov 16, 2022 at 04:32:39PM -0800, Steve Kargl via Fortran wrote:
> On Wed, Nov 16, 2022 at 01:30:07PM -0800, Steve Kargl via Fortran wrote:
> > On Tue, Nov 15, 2022 at 05:13:19PM -0800, Steve Kargl via Fortran wrote:
> > > F2008 introduced the inclusion of a typespec in a forall
> > > statement, and thn F2018 a typespec was allowed in an
> > > implied-do.  There may even be a few bug reports.
> > > 
> > 
> > New patch.  This one handles the example of an implied-do
> > loop in an initialization expression (see patch for expr.cc).  
> > 
> 
> Seems to cause regressions.
> 

It seems that the patch to expr.cc allows the implied-do-index
to escape into the namespace of scoping unit that contains
the implied-do loop.

-- 
Steve

Re: typespec in forall and implied-do

[Steve Kargl]

On Wed, Nov 16, 2022 at 01:30:07PM -0800, Steve Kargl via Fortran wrote:
> On Tue, Nov 15, 2022 at 05:13:19PM -0800, Steve Kargl via Fortran wrote:
> > F2008 introduced the inclusion of a typespec in a forall
> > statement, and thn F2018 a typespec was allowed in an
> > implied-do.  There may even be a few bug reports.
> > 
> 
> New patch.  This one handles the example of an implied-do
> loop in an initialization expression (see patch for expr.cc).  
> 

Seems to cause regressions.

-- 
Steve

Re: typespec in forall and implied-do

[Steve Kargl]

On Tue, Nov 15, 2022 at 05:13:19PM -0800, Steve Kargl via Fortran wrote:
> F2008 introduced the inclusion of a typespec in a forall
> statement, and thn F2018 a typespec was allowed in an
> implied-do.  There may even be a few bug reports.
> 

New patch.  This one handles the example of an implied-do
loop in an initialization expression (see patch for expr.cc).  


diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 69d0b57c688..90bd8d7251d 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -3165,9 +3165,20 @@ gfc_reduce_init_expr (gfc_expr *expr)
   bool t;
 
   gfc_init_expr_flag = true;
+
+  if (expr->expr_type == EXPR_ARRAY && expr->ts.type == BT_UNKNOWN)
+    {
+      gfc_simplify_expr (expr, 1);
+      if (!gfc_check_constructor_type (expr))
+	return false;
+      if (!gfc_expand_constructor (expr, true))
+	return false;
+    }
+
   t = gfc_resolve_expr (expr);
   if (t)
     t = gfc_check_init_expr (expr);
+
   gfc_init_expr_flag = false;
 
   if (!t || !expr)
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 8b8b6e79c8b..3fd2a80caad 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -968,9 +968,39 @@ gfc_match_iterator (gfc_iterator *iter, int init_flag)
   gfc_expr *var, *e1, *e2, *e3;
   locus start;
   match m;
+  gfc_typespec ts;
+  bool seen_ts;
 
   e1 = e2 = e3 = NULL;
 
+  /* Match an optional "integer ::" type-spec. */
+  start = gfc_current_locus;
+  seen_ts = false;
+  gfc_clear_ts (&ts);
+  m = gfc_match_type_spec (&ts);
+  if (m == MATCH_YES)
+    {
+      seen_ts = (gfc_match (" ::") == MATCH_YES);
+
+      if (seen_ts)
+	{
+	  if (!gfc_notify_std (GFC_STD_F2018, "Optional type-spec "
+			       "included in implied-do loop at %C"))
+	    goto cleanup;
+
+	  if (ts.type != BT_INTEGER)
+	    {
+	      gfc_error ("Type in type-spec at %C shall be INTEGER");
+	      goto cleanup;
+	    }
+	}
+    }
+  else if (m == MATCH_ERROR)
+    goto cleanup;
+
+  if (!seen_ts)
+    gfc_current_locus = start;
+
   /* Match the start of an iterator without affecting the symbol table.  */
 
   start = gfc_current_locus;
@@ -984,6 +1014,14 @@ gfc_match_iterator (gfc_iterator *iter, int init_flag)
   if (m != MATCH_YES)
     return MATCH_NO;
 
+  if (seen_ts && var->ts.type == BT_UNKNOWN)
+    {
+      var->ts.type = ts.type;
+      var->ts.kind = ts.kind;
+      var->symtree->n.sym->ts.type = ts.type;
+      var->symtree->n.sym->ts.kind = ts.kind;
+    }
+
   if (var->symtree->n.sym->attr.dimension)
     {
       gfc_error ("Loop variable at %C cannot be an array");
@@ -2396,6 +2434,9 @@ match_forall_header (gfc_forall_iterator **phead, gfc_expr **mask)
   gfc_forall_iterator *head, *tail, *new_iter;
   gfc_expr *msk;
   match m;
+  locus start;
+  gfc_typespec ts;
+  bool seen_ts;
 
   gfc_gobble_whitespace ();
 
@@ -2405,12 +2446,48 @@ match_forall_header (gfc_forall_iterator **phead, gfc_expr **mask)
   if (gfc_match_char ('(') != MATCH_YES)
     return MATCH_NO;
 
+  /* Match an optional "integer ::" type-spec. */
+  start = gfc_current_locus;
+  seen_ts = false;
+  gfc_clear_ts (&ts);
+  m = gfc_match_type_spec (&ts);
+  if (m == MATCH_YES)
+    {
+      seen_ts = (gfc_match (" ::") == MATCH_YES);
+
+      if (seen_ts)
+	{
+	  if (!gfc_notify_std (GFC_STD_F2008, "Optional type-spec "
+			       "included in FORALL at %C"))
+	    goto cleanup;
+
+	  if (ts.type != BT_INTEGER)
+	    {
+	      gfc_error ("Type in type-spec at %C shall be INTEGER");
+	      goto cleanup;
+	    }
+	}
+    }
+  else if (m == MATCH_ERROR)
+    goto cleanup;
+
+  if (!seen_ts)
+    gfc_current_locus = start;
+
   m = match_forall_iterator (&new_iter);
   if (m == MATCH_ERROR)
     goto cleanup;
   if (m == MATCH_NO)
     goto syntax;
 
+  if (seen_ts && new_iter->var->ts.type == BT_UNKNOWN)
+    {
+      new_iter->var->ts.type = ts.type;
+      new_iter->var->ts.kind = ts.kind;
+      new_iter->var->symtree->n.sym->ts.type = ts.type;
+      new_iter->var->symtree->n.sym->ts.kind = ts.kind;
+    }
+
   head = tail = new_iter;
 
   for (;;)

-- 
Steve

Re: typespec in forall and implied-do

[Steve Kargl]

On Tue, Nov 15, 2022 at 06:31:16PM -0800, Steve Kargl via Fortran wrote:
> On Tue, Nov 15, 2022 at 05:13:19PM -0800, Steve Kargl via Fortran wrote:
> > F2008 introduced the inclusion of a typespec in a forall
> > statement, and thn F2018 a typespec was allowed in an
> > implied-do.  There may even be a few bug reports.
> > 
> 
> Forgot to ask.  Anyone know how namespaces work with
> initialization expressions in gfortran?  This code
> should compile
> 
>    program foo
>    use iso_fortran_env, only : k => real_kinds
>    implicit none
>    integer, parameter :: n = size(k)
>    integer, parameter :: &
>    &  p(n) = [(precision(real(1.,k(i))), integer :: i = 1, n)]
>    print '(*(I0,X))', p
>    end program foo
>    
> 
> The first occurence of 'i' in the expression for 'p(n)'
> is either thought to be in a different namespace, or
> an implied-do loop cannot be used in an initialization 
> expression.

After spending to much time on this, I found that decl.cc:3044-50

	  m = gfc_match_init_expr (&initializer);
	  if (m == MATCH_NO)
	    {
	      gfc_error ("Expected an initialization expression at %C");
	      m = MATCH_ERROR;
	    }

results in m == MATCH_ERROR.  First, I would expect the "if" 
condition to include the m == MATCH_ERROR to generate an
error message.  Second, an implied-do loop can appear in
an initialization expression.  So, gfortran is not handling 
this correctly.  Now, if one goes to expr.cc:gfc_match_init_expr,
gfortran matches the RHS expression, but gfc_reduce_init_expr()
fails to expand the array constructor.
-- 
Steve

Re: typespec in forall and implied-do

[Steve Kargl]

On Tue, Nov 15, 2022 at 05:13:19PM -0800, Steve Kargl via Fortran wrote:
> 
> This patch allows the above to compile and execute.
> It has only had some light testing, and I do not know
> if nested forall and implied-do loops do work.  Feel
> free to commit as I cannot.
> 

Appears to work for nested forall (at least in the execution
part of a subprogram).

! From Section 6.9 of MR&C
program foo

   implicit none

   integer, parameter :: n = 9
   integer i, j
   integer k
   integer a(n,n), b(n,n)

   a = reshape([(i,i=1,n**2)], [n,n])
   do k = 1, 9
      print '(*(I3))', a(k,:)
   end do
   print *

   b = a

   forall (i = 1:n-1)
      forall (j = i+1:n)
         a(i,j) = a(j,i) ! a is a rank-2 array
      end forall
   end forall
   do k = 1, 9
      print '(*(I3))', a(k,:)
   end do
   print *

   a = b

   forall (integer :: ii = 1:n-1)
      forall (integer :: jj = ii+1:n)
         a(ii,jj) = a(jj,ii) ! a is a rank-2 array
      end forall
   end forall
   do k = 1, 9
      print '(*(I3))', a(k,:)
   end do
   print *

end program foo

-- 
Steve

Re: typespec in forall and implied-do

[Steve Kargl]

On Tue, Nov 15, 2022 at 05:13:19PM -0800, Steve Kargl via Fortran wrote:
> 
> This patch allows the above to compile and execute.
> It has only had some light testing, and I do not know
> if nested forall and implied-do loops do work.  Feel
> free to commit as I cannot.

For nested implied-do loops, the patch appears to do
the right thing on

   program foo

      implicit none

      integer, parameter :: m = 4, n = 3
      integer k, x(m*n)

      print '(*(I0,1X))', [(i, (i*j, integer :: j=1, n), integer :: i=1, m)]
      x = [((i*j, integer :: j=1, n), integer :: i=1, m)]
      print '(*(I0,1X))', x

   end program foo

-- 
Steve

Re: typespec in forall and implied-do

[Steve Kargl]

On Tue, Nov 15, 2022 at 05:13:19PM -0800, Steve Kargl via Fortran wrote:
> F2008 introduced the inclusion of a typespec in a forall
> statement, and thn F2018 a typespec was allowed in an
> implied-do.  There may even be a few bug reports.
> 

Forgot to ask.  Anyone know how namespaces work with
initialization expressions in gfortran?  This code
should compile

   program foo
   use iso_fortran_env, only : k => real_kinds
   implicit none
   integer, parameter :: n = size(k)
   integer, parameter :: &
   &  p(n) = [(precision(real(1.,k(i))), integer :: i = 1, n)]
   print '(*(I0,X))', p
   end program foo
   

The first occurence of 'i' in the expression for 'p(n)'
is either thought to be in a different namespace, or
an implied-do loop cannot be used in an initialization 
expression.

-- 
Steve

typespec in forall and implied-do

[Steve Kargl]

F2008 introduced the inclusion of a typespec in a forall
statement, and thn F2018 a typespec was allowed in an
implied-do.  There may even be a few bug reports.

Consider,

   program foo

      implicit none

      integer, parameter :: n = 9
      integer a(n,n), b(n), j

      b = [(k, integer :: k = 1, n)] 
      if (any(b /= [1, 2, 3, 4, 5, 6, 7, 8, 9])) stop 1
 
      a = 0
      forall (integer :: i = 1:n) a(i,i) = b(i)
      do j = 1, n
         if (a(j,j) /= b(j)) stop j
      end do

      call bar

      contains

         subroutine bar
            real x(n)
            x = [(sqrt(real(p)), integer :: p = 1, n)]
            print '(*(F8.2,1X))', x
         end subroutine bar

   end program foo

This patch allows the above to compile and execute.
It has only had some light testing, and I do not know
if nested forall and implied-do loops do work.  Feel
free to commit as I cannot.

diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 8b8b6e79c8b..3fd2a80caad 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -968,9 +968,39 @@ gfc_match_iterator (gfc_iterator *iter, int init_flag)
   gfc_expr *var, *e1, *e2, *e3;
   locus start;
   match m;
+  gfc_typespec ts;
+  bool seen_ts;
 
   e1 = e2 = e3 = NULL;
 
+  /* Match an optional "integer ::" type-spec. */
+  start = gfc_current_locus;
+  seen_ts = false;
+  gfc_clear_ts (&ts);
+  m = gfc_match_type_spec (&ts);
+  if (m == MATCH_YES)
+    {
+      seen_ts = (gfc_match (" ::") == MATCH_YES);
+
+      if (seen_ts)
+	{
+	  if (!gfc_notify_std (GFC_STD_F2018, "Optional type-spec "
+			       "included in implied-do loop at %C"))
+	    goto cleanup;
+
+	  if (ts.type != BT_INTEGER)
+	    {
+	      gfc_error ("Type in type-spec at %C shall be INTEGER");
+	      goto cleanup;
+	    }
+	}
+    }
+  else if (m == MATCH_ERROR)
+    goto cleanup;
+
+  if (!seen_ts)
+    gfc_current_locus = start;
+
   /* Match the start of an iterator without affecting the symbol table.  */
 
   start = gfc_current_locus;
@@ -984,6 +1014,14 @@ gfc_match_iterator (gfc_iterator *iter, int init_flag)
   if (m != MATCH_YES)
     return MATCH_NO;
 
+  if (seen_ts && var->ts.type == BT_UNKNOWN)
+    {
+      var->ts.type = ts.type;
+      var->ts.kind = ts.kind;
+      var->symtree->n.sym->ts.type = ts.type;
+      var->symtree->n.sym->ts.kind = ts.kind;
+    }
+
   if (var->symtree->n.sym->attr.dimension)
     {
       gfc_error ("Loop variable at %C cannot be an array");
@@ -2396,6 +2434,9 @@ match_forall_header (gfc_forall_iterator **phead, gfc_expr **mask)
   gfc_forall_iterator *head, *tail, *new_iter;
   gfc_expr *msk;
   match m;
+  locus start;
+  gfc_typespec ts;
+  bool seen_ts;
 
   gfc_gobble_whitespace ();
 
@@ -2405,12 +2446,48 @@ match_forall_header (gfc_forall_iterator **phead, gfc_expr **mask)
   if (gfc_match_char ('(') != MATCH_YES)
     return MATCH_NO;
 
+  /* Match an optional "integer ::" type-spec. */
+  start = gfc_current_locus;
+  seen_ts = false;
+  gfc_clear_ts (&ts);
+  m = gfc_match_type_spec (&ts);
+  if (m == MATCH_YES)
+    {
+      seen_ts = (gfc_match (" ::") == MATCH_YES);
+
+      if (seen_ts)
+	{
+	  if (!gfc_notify_std (GFC_STD_F2008, "Optional type-spec "
+			       "included in FORALL at %C"))
+	    goto cleanup;
+
+	  if (ts.type != BT_INTEGER)
+	    {
+	      gfc_error ("Type in type-spec at %C shall be INTEGER");
+	      goto cleanup;
+	    }
+	}
+    }
+  else if (m == MATCH_ERROR)
+    goto cleanup;
+
+  if (!seen_ts)
+    gfc_current_locus = start;
+
   m = match_forall_iterator (&new_iter);
   if (m == MATCH_ERROR)
     goto cleanup;
   if (m == MATCH_NO)
     goto syntax;
 
+  if (seen_ts && new_iter->var->ts.type == BT_UNKNOWN)
+    {
+      new_iter->var->ts.type = ts.type;
+      new_iter->var->ts.kind = ts.kind;
+      new_iter->var->symtree->n.sym->ts.type = ts.type;
+      new_iter->var->symtree->n.sym->ts.kind = ts.kind;
+    }
+
   head = tail = new_iter;
 
   for (;;)