[PATCH, committed] Fortran: avoid NULL pointer dereference on bad EQUIVALENCEs [PR107559]

2022-11-09 Thread Harald Anlauf via Gcc-patches
Dear all,

I've committed an obvious patch for NULL pointer dereferences
that could occur when checking EQUIVALENCEs.  See also attached.

Testcase by Gerhard.

Regtested on x86_64-pc-linux-gnu.

Pushed: https://gcc.gnu.org/g:e505f7493bed1395d121d2f53137ec11706fa42e

Thanks,
Harald

From e505f7493bed1395d121d2f53137ec11706fa42e Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Wed, 9 Nov 2022 21:05:28 +0100
Subject: [PATCH] Fortran: avoid NULL pointer dereference on bad EQUIVALENCEs
 [PR107559]

gcc/fortran/ChangeLog:

	PR fortran/107559
	* resolve.cc (resolve_equivalence): Avoid NULL pointer dereference
	while emitting diagnostics for bad EQUIVALENCEs.

gcc/testsuite/ChangeLog:

	PR fortran/107559
	* gfortran.dg/pr107559.f90: New test.
---
 gcc/fortran/resolve.cc |  2 ++
 gcc/testsuite/gfortran.dg/pr107559.f90 | 11 +++
 2 files changed, 13 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/pr107559.f90

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 9202e2f10ad..5ff1cd070ac 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -17218,6 +17218,7 @@ resolve_equivalence (gfc_equiv *eq)
 	"statement at %L with different type objects";
   if ((object ==2
 	   && last_eq_type == SEQ_MIXED
+	   && last_where
 	   && !gfc_notify_std (GFC_STD_GNU, msg, first_sym->name, last_where))
 	  || (eq_type == SEQ_MIXED
 	  && !gfc_notify_std (GFC_STD_GNU, msg, sym->name, &e->where)))
@@ -17227,6 +17228,7 @@ resolve_equivalence (gfc_equiv *eq)
 	"statement at %L with objects of different type";
   if ((object ==2
 	   && last_eq_type == SEQ_NONDEFAULT
+	   && last_where
 	   && !gfc_notify_std (GFC_STD_GNU, msg, first_sym->name, last_where))
 	  || (eq_type == SEQ_NONDEFAULT
 	  && !gfc_notify_std (GFC_STD_GNU, msg, sym->name, &e->where)))
diff --git a/gcc/testsuite/gfortran.dg/pr107559.f90 b/gcc/testsuite/gfortran.dg/pr107559.f90
new file mode 100644
index 000..714e236df50
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr107559.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! PR fortran/107559 - ICE in resolve_equivalence
+! Contributed by G.Steinmetz
+
+module m
+  implicit none
+  integer, protected :: a ! { dg-error "Fortran 2003: PROTECTED attribute" }
+  integer :: b
+  equivalence (a, b)  ! { dg-error "has no IMPLICIT type" }
+end
--
2.35.3



Re: [PATCH, v3] Fortran: ordering of hidden procedure arguments [PR107441]

2022-11-08 Thread Harald Anlauf via Gcc-patches

Hi Mikael,

Am 08.11.22 um 11:32 schrieb Mikael Morin:

this is mostly good.
There is one last corner case that is not properly handled:


diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 63515b9072a..94988b8690e 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc

(...)

@@ -2619,6 +2620,15 @@ create_function_arglist (gfc_symbol * sym)
 if (f->sym != NULL)    /* Ignore alternate returns.  */
   hidden_typelist = TREE_CHAIN (hidden_typelist);

+  /* Advance hidden_typelist over optional+value argument presence
flags.  */
+  optval_typelist = hidden_typelist;
+  for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
+    if (f->sym != NULL
+    && f->sym->attr.optional && f->sym->attr.value
+    && !f->sym->attr.dimension && f->sym->ts.type != BT_CLASS
+    && !gfc_bt_struct (f->sym->ts.type))
+  hidden_typelist = TREE_CHAIN (hidden_typelist);
+


This new loop copies the condition guarding the handling of optional
value presence arguments, except that the condition is in an "else if",
and the complement of the condition in the corresponding "if" is
missing, to have strictly the same conditions.


I know, and I left that intentionally, as it is related to
PR107444, assuming that it doesn't lead to a new ICE.  Bad idea.


Admittedly, it only makes a difference for character optional value
arguments, which are hardly working.  At least they work as long as one
doesn't try to query their presence.  Below is a case regressing with
your patch.



With that fixed, I think it's good for mainline.
Thanks for your patience.


! { dg-do compile }
!
! PR fortran/107441
! Check that procedure types and procedure decls match when the procedure
! has both character-typed and character-typed optional value args.
!
! Contributed by M.Morin

program p
   interface
     subroutine i(c, o)
   character(*) :: c
   character(3), optional, value :: o
     end subroutine i
   end interface
   procedure(i), pointer :: pp
   pp => s
   call pp("abcd", "xyz")
contains
   subroutine s(c, o)
     character(*) :: c
     character(3), optional, value :: o
     if (o /= "xyz") stop 1
     if (c /= "abcd") stop 2
   end subroutine s
end program p


Well, that testcase may compile with 12-branch, but it gives
wrong code.  Furthermore, it is arguably invalid, as you are
currently unable to check the presence of the optional argument
due to PR107444.  I am therefore reluctant to have that testcase
now.

To fix that, we may have to bite the bullet and break the
documented ABI, or rather update it, as character,value,optional
is broken in all current gfortran versions, and the documentation
is not completely consistent.  I had planned to do this with the
fix for PR107444, which want to keep separate from the current
patch for good reasons.

I have modified my patch so that your testcase above compiles
and runs.  But as explained, I don't want to add it now.

Regtested again.  What do you think?

Thanks,
Harald

From 8694d1d2cbd19b5148b5d1d891b182cc3e718f40 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Fri, 28 Oct 2022 21:58:08 +0200
Subject: [PATCH] Fortran: ordering of hidden procedure arguments [PR107441]

The gfortran argument passing conventions specify a certain order for
procedure arguments that should be followed consequently: the hidden
presence status flags of optional+value scalar arguments of intrinsic type
shall come before the hidden character length, coarray token and offset.
Clarify that in the documentation.

gcc/fortran/ChangeLog:

	PR fortran/107441
	* gfortran.texi (Argument passing conventions): Clarify the gfortran
	argument passing conventions with regard to OPTIONAL dummy arguments
	of intrinsic type.
	* trans-decl.cc (create_function_arglist): Adjust the ordering of
	automatically generated hidden procedure arguments to match the
	documented ABI for gfortran.
	* trans-types.cc (gfc_get_function_type): Separate hidden parameters
	so that the presence flag for optional+value arguments come before
	string length, coarray token and offset, as required.

gcc/testsuite/ChangeLog:

	PR fortran/107441
	* gfortran.dg/coarray/pr107441-caf.f90: New test.
	* gfortran.dg/optional_absent_6.f90: New test.
	* gfortran.dg/optional_absent_7.f90: New test.
---
 gcc/fortran/gfortran.texi |  3 +-
 gcc/fortran/trans-decl.cc | 31 +++---
 gcc/fortran/trans-types.cc| 25 
 .../gfortran.dg/coarray/pr107441-caf.f90  | 27 +
 .../gfortran.dg/optional_absent_6.f90 | 60 +++
 .../gfortran.dg/optional_absent_7.f90 | 31 ++
 6 files changed, 157 insertions(+), 20 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90
 create mode 100644 gcc/testsuite/gfortran.dg/optional_abse

[PATCH, v3] Fortran: ordering of hidden procedure arguments [PR107441]

2022-11-07 Thread Harald Anlauf via Gcc-patches

Dear all,

Am 04.11.22 um 10:53 schrieb Mikael Morin:

Le 03/11/2022 à 23:03, Harald Anlauf a écrit :

I've spent some time not only staring at create_function_arglist,
but trying several variations handling the declared hidden parms,
and applying the necessary adjustments to gfc_get_function_type.
(Managing linked trees is not the issue, just understanding them.)
I've been unable to get the declarations in sync, and would need
help how to debug the mess I've created.  Dropping my patch for
the time being.


If you want, we can meet on IRC somewhen (tonight?).


armed with the new knowledge, I could now understand what
(more or less) trivially went wrong with my previous patch.

The attached patch remedies that: gfc_get_function_type() now
properly separates the types of the hidden parameters so that
optional+value comes before string length and caf stuff,
while in create_function_arglist we simply need to split
the walking over the typelists so that the optional+value
stuff, which is basically just booleans, is done separately
from the other parts.

Looking at the tree-dumps, the function decls now seem to be
fine at least for the given testcases.  I've adjusted one of
the testcases to validate this.

Regtests fine on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

From 7ba433c9c22e206532a9abcad8ff1b22d3f77b3a Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Fri, 28 Oct 2022 21:58:08 +0200
Subject: [PATCH] Fortran: ordering of hidden procedure arguments [PR107441]

The gfortran ABI specifies the order of given and hidden procedure arguments,
where the hidden presence status flags of optional+value scalar arguments
shall come before character length, coarray token and offset.

gcc/fortran/ChangeLog:

	PR fortran/107441
	* trans-decl.cc (create_function_arglist): Adjust the ordering of
	automatically generated hidden procedure arguments to match the
	documented ABI for gfortran.
	* trans-types.cc (gfc_get_function_type): Separate hidden parameters
	so that the presence flag for optional+value arguments come before
	string length, coarray token and offset, as required.

gcc/testsuite/ChangeLog:

	PR fortran/107441
	* gfortran.dg/coarray/pr107441-caf.f90: New test.
	* gfortran.dg/optional_absent_6.f90: New test.
	* gfortran.dg/optional_absent_7.f90: New test.
---
 gcc/fortran/trans-decl.cc | 23 +--
 gcc/fortran/trans-types.cc| 11 +++-
 .../gfortran.dg/coarray/pr107441-caf.f90  | 27 +
 .../gfortran.dg/optional_absent_6.f90 | 60 +++
 .../gfortran.dg/optional_absent_7.f90 | 31 ++
 5 files changed, 145 insertions(+), 7 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90
 create mode 100644 gcc/testsuite/gfortran.dg/optional_absent_6.f90
 create mode 100644 gcc/testsuite/gfortran.dg/optional_absent_7.f90

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 63515b9072a..94988b8690e 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -2507,8 +2507,8 @@ create_function_arglist (gfc_symbol * sym)
 {
   tree fndecl;
   gfc_formal_arglist *f;
-  tree typelist, hidden_typelist;
-  tree arglist, hidden_arglist;
+  tree typelist, hidden_typelist, optval_typelist;
+  tree arglist, hidden_arglist, optval_arglist;
   tree type;
   tree parm;
 
@@ -2518,6 +2518,7 @@ create_function_arglist (gfc_symbol * sym)
  the new FUNCTION_DECL node.  */
   arglist = NULL_TREE;
   hidden_arglist = NULL_TREE;
+  optval_arglist = NULL_TREE;
   typelist = TYPE_ARG_TYPES (TREE_TYPE (fndecl));
 
   if (sym->attr.entry_master)
@@ -2619,6 +2620,15 @@ create_function_arglist (gfc_symbol * sym)
 if (f->sym != NULL)	/* Ignore alternate returns.  */
   hidden_typelist = TREE_CHAIN (hidden_typelist);
 
+  /* Advance hidden_typelist over optional+value argument presence flags.  */
+  optval_typelist = hidden_typelist;
+  for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
+if (f->sym != NULL
+	&& f->sym->attr.optional && f->sym->attr.value
+	&& !f->sym->attr.dimension && f->sym->ts.type != BT_CLASS
+	&& !gfc_bt_struct (f->sym->ts.type))
+  hidden_typelist = TREE_CHAIN (hidden_typelist);
+
   for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
 {
   char name[GFC_MAX_SYMBOL_LEN + 2];
@@ -2712,14 +2722,16 @@ create_function_arglist (gfc_symbol * sym)
 			PARM_DECL, get_identifier (name),
 			boolean_type_node);
 
-  hidden_arglist = chainon (hidden_arglist, tmp);
+	  optval_arglist = chainon (optval_arglist, tmp);
   DECL_CONTEXT (tmp) = fndecl;
   DECL_ARTIFICIAL (tmp) = 1;
   DECL_ARG_TYPE (tmp) = boolean_type_node;
   TREE_READONLY (tmp) = 1;
   gfc_finish_decl (tmp);
 
-	  hidden_typelist = TREE_CHAIN (hidden_typelist);
+	  /* The presence flag must be boolean.  */
+	  gcc_asse

Re: [PATCH, v2] Fortran: ordering of hidden procedure arguments [PR107441]

2022-11-03 Thread Harald Anlauf via Gcc-patches

Am 03.11.22 um 11:06 schrieb Mikael Morin:

Le 02/11/2022 à 22:19, Harald Anlauf via Fortran a écrit :

Am 02.11.22 um 18:20 schrieb Mikael Morin:

Unfortunately no, the coarray case works, but the other problem remains.
The type problem is not visible in the definition of S, it is in the
declaration of S's prototype in P.

S is defined as:

void s (character(kind=1)[1:_c] & restrict c, integer(kind=4) o,
logical(kind=1) _o, integer(kind=8) _c)
{
...
}

but P has:

void p ()
{
   static void s (character(kind=1)[1:] & restrict, integer(kind=4),
integer(kind=8), logical(kind=1));
   void (*) (character(kind=1)[1:] & restrict, integer(kind=4),
integer(kind=8), logical(kind=1)) pp;

   pp = s;
...
}


Right, now I see it too.  Simplified case:

program p
   call s ("abcd")
contains
   subroutine s(c, o)
 character(*) :: c
 integer, optional, value :: o
   end subroutine s
end

I do see what needs to be done in gfc_get_function_type, which seems
in fact very simple.  But I get really lost in create_function_arglist
when trying to get the typelist right.

One thing is I really don't understand how the (hidden_)typelist is
managed here.  How does that macro TREE_CHAIN work?  Can we somehow
chain two typelists the same way we chain arguments?


TREE_CHAIN is just a linked list "next" pointer like there is in the
fortran frontend a "next" pointer in gfc_ref or gfc_actual_arglist
structures.
Yes, we can chain typelists; the implementation of chainon in tree.cc is
just TREE_CHAIN appending under the hood.


(Failing that, I tried to split the loop over the dummy arguments in
create_function_arglist into two passes, one for the optional+value
variant, and one for the rest.  It turned out to be a bad idea...)


Not necessarily a bad idea, but one has to be careful to keep linked
lists synchronized with argument walking.

The most simple, I think, is to move the hidden_typelist advancement for
optional, value presence arguments from the main loop to a preliminary
loop.

I hope it helps.



I've spent some time not only staring at create_function_arglist,
but trying several variations handling the declared hidden parms,
and applying the necessary adjustments to gfc_get_function_type.
(Managing linked trees is not the issue, just understanding them.)
I've been unable to get the declarations in sync, and would need
help how to debug the mess I've created.  Dropping my patch for
the time being.




Re: [PATCH, v2] Fortran: ordering of hidden procedure arguments [PR107441]

2022-11-02 Thread Harald Anlauf via Gcc-patches

Am 02.11.22 um 18:20 schrieb Mikael Morin:

Unfortunately no, the coarray case works, but the other problem remains.
The type problem is not visible in the definition of S, it is in the
declaration of S's prototype in P.

S is defined as:

void s (character(kind=1)[1:_c] & restrict c, integer(kind=4) o,
logical(kind=1) _o, integer(kind=8) _c)
{
...
}

but P has:

void p ()
{
   static void s (character(kind=1)[1:] & restrict, integer(kind=4),
integer(kind=8), logical(kind=1));
   void (*) (character(kind=1)[1:] & restrict, integer(kind=4),
integer(kind=8), logical(kind=1)) pp;

   pp = s;
...
}


Right, now I see it too.  Simplified case:

program p
  call s ("abcd")
contains
  subroutine s(c, o)
character(*) :: c
integer, optional, value :: o
  end subroutine s
end

I do see what needs to be done in gfc_get_function_type, which seems
in fact very simple.  But I get really lost in create_function_arglist
when trying to get the typelist right.

One thing is I really don't understand how the (hidden_)typelist is
managed here.  How does that macro TREE_CHAIN work?  Can we somehow
chain two typelists the same way we chain arguments?

(Failing that, I tried to split the loop over the dummy arguments in
create_function_arglist into two passes, one for the optional+value
variant, and one for the rest.  It turned out to be a bad idea...)

Harald



Re: [PATCH, v2] Fortran: ordering of hidden procedure arguments [PR107441]

2022-10-31 Thread Harald Anlauf via Gcc-patches

Hi Mikael,

thanks a lot, your testcases broke my initial (and incorrect) patch
in multiple ways.  I understand now that the right solution is much
simpler and smaller.

I've added your testcases, see attached, with a simple scan of the
dump for the generated order of hidden arguments in the function decl
for the last testcase.

Regtested again on x86_64-pc-linux-gnu.  OK now?

Thanks,
Harald


Am 31.10.22 um 10:57 schrieb Mikael Morin:

Le 30/10/2022 à 22:25, Mikael Morin a écrit :

Le 30/10/2022 à 20:23, Mikael Morin a écrit :

Another probable issue is your change to create_function_arglist
changes arglist/hidden_arglist without also changing
typelist/hidden_typelist accordingly.  I think a change to
gfc_get_function_type is also necessary: as the function decl is
changed, the decl type need to be changed as well.

I will see whether I can manage to exhibit testcases for these issues.


Here is a test for the type vs decl mismatch.

! { dg-do run }
!
! PR fortran/107441
! Check that procedure types and procedure decls match when the procedure
! has both chaacter-typed and optional value args.

program p
   interface
 subroutine i(c, o)
   character(*) :: c
   integer, optional, value :: o
 end subroutine i
   end interface
   procedure(i), pointer :: pp

A pointer initialization is missing here:
     pp => s

   call pp("abcd")
contains
   subroutine s(c, o)
 character(*) :: c
 integer, optional, value :: o
 if (present(o)) stop 1
 if (len(c) /= 4) stop 2
 if (c /= "abcd") stop 3
   end subroutine s
end program p



With the additional initialization, the test passes, so it's not very
useful.  The type mismatch is visible in the dump though, so maybe a
dump match can be used.

From 705628c89faa1135ed9a446b84e831bbead6095a Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Fri, 28 Oct 2022 21:58:08 +0200
Subject: [PATCH] Fortran: ordering of hidden procedure arguments [PR107441]

gcc/fortran/ChangeLog:

	PR fortran/107441
	* trans-decl.cc (create_function_arglist): Adjust the ordering of
	automatically generated hidden procedure arguments to match the
	documented ABI for gfortran.  The present status for optional+value
	arguments is passed before character length and coarray token and
	offset.

gcc/testsuite/ChangeLog:

	PR fortran/107441
* gfortran.dg/coarray/pr107441-caf.f90: New test.
	* gfortran.dg/optional_absent_6.f90: New test.
	* gfortran.dg/optional_absent_7.f90: New test.
---
 gcc/fortran/trans-decl.cc |  8 ++-
 .../gfortran.dg/coarray/pr107441-caf.f90  | 27 +
 .../gfortran.dg/optional_absent_6.f90 | 60 +++
 .../gfortran.dg/optional_absent_7.f90 | 30 ++
 4 files changed, 123 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90
 create mode 100644 gcc/testsuite/gfortran.dg/optional_absent_6.f90
 create mode 100644 gcc/testsuite/gfortran.dg/optional_absent_7.f90

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 63515b9072a..64b35f054e5 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -2508,7 +2508,7 @@ create_function_arglist (gfc_symbol * sym)
   tree fndecl;
   gfc_formal_arglist *f;
   tree typelist, hidden_typelist;
-  tree arglist, hidden_arglist;
+  tree arglist, hidden_arglist, optval_arglist;
   tree type;
   tree parm;
 
@@ -2518,6 +2518,7 @@ create_function_arglist (gfc_symbol * sym)
  the new FUNCTION_DECL node.  */
   arglist = NULL_TREE;
   hidden_arglist = NULL_TREE;
+  optval_arglist = NULL_TREE;
   typelist = TYPE_ARG_TYPES (TREE_TYPE (fndecl));
 
   if (sym->attr.entry_master)
@@ -2712,7 +2713,7 @@ create_function_arglist (gfc_symbol * sym)
 			PARM_DECL, get_identifier (name),
 			boolean_type_node);
 
-  hidden_arglist = chainon (hidden_arglist, tmp);
+	  optval_arglist = chainon (optval_arglist, tmp);
   DECL_CONTEXT (tmp) = fndecl;
   DECL_ARTIFICIAL (tmp) = 1;
   DECL_ARG_TYPE (tmp) = boolean_type_node;
@@ -2863,6 +2864,9 @@ create_function_arglist (gfc_symbol * sym)
   typelist = TREE_CHAIN (typelist);
 }
 
+  /* Add hidden present status for optional+value arguments.  */
+  arglist = chainon (arglist, optval_arglist);
+
   /* Add the hidden string length parameters, unless the procedure
  is bind(C).  */
   if (!sym->attr.is_bind_c)
diff --git a/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90 b/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90
new file mode 100644
index 000..23b2242e217
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+!
+! PR fortran/107441
+! Check that with -fcoarray=lib, coarray metadata arguments are passed
+! in the right order to procedures.
+!
+! Contributed by M.Morin
+
+program p
+  integer :: ci[*]
+  ci = 17
+  call s(1, ci, "abcd")
+contains
+  subroutine s(ra

[PATCH] Fortran: ordering of hidden procedure arguments [PR107441]

2022-10-28 Thread Harald Anlauf via Gcc-patches
Dear all,

the passing of procedure arguments in Fortran sometimes requires
ancillary parameters that are "hidden".  Examples are string length
and the presence status of scalar variables with optional+value
attribute.

The gfortran ABI is actually documented:

https://gcc.gnu.org/onlinedocs/gfortran/Argument-passing-conventions.html

The reporter found that there was a discrepancy between the
caller and the callee.  This is corrected by the attached patch.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

From b7646403557eca19612c81437f381d4b4dcd51c8 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Fri, 28 Oct 2022 21:58:08 +0200
Subject: [PATCH] Fortran: ordering of hidden procedure arguments [PR107441]

gcc/fortran/ChangeLog:

	PR fortran/107441
	* trans-decl.cc (create_function_arglist): Adjust the ordering of
	automatically generated hidden procedure arguments to match the
	documented ABI for gfortran.

gcc/testsuite/ChangeLog:

	PR fortran/107441
	* gfortran.dg/optional_absent_6.f90: New test.
---
 gcc/fortran/trans-decl.cc | 15 +++--
 .../gfortran.dg/optional_absent_6.f90 | 60 +++
 2 files changed, 71 insertions(+), 4 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/optional_absent_6.f90

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 63515b9072a..18842fe2c4b 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -2508,7 +2508,7 @@ create_function_arglist (gfc_symbol * sym)
   tree fndecl;
   gfc_formal_arglist *f;
   tree typelist, hidden_typelist;
-  tree arglist, hidden_arglist;
+  tree arglist, hidden_arglist, optional_arglist, strlen_arglist;
   tree type;
   tree parm;

@@ -2518,6 +2518,7 @@ create_function_arglist (gfc_symbol * sym)
  the new FUNCTION_DECL node.  */
   arglist = NULL_TREE;
   hidden_arglist = NULL_TREE;
+  strlen_arglist = optional_arglist = NULL_TREE;
   typelist = TYPE_ARG_TYPES (TREE_TYPE (fndecl));

   if (sym->attr.entry_master)
@@ -2644,7 +2645,7 @@ create_function_arglist (gfc_symbol * sym)
 	  length = build_decl (input_location,
 			   PARM_DECL, get_identifier (name), len_type);

-	  hidden_arglist = chainon (hidden_arglist, length);
+	  strlen_arglist = chainon (strlen_arglist, length);
 	  DECL_CONTEXT (length) = fndecl;
 	  DECL_ARTIFICIAL (length) = 1;
 	  DECL_ARG_TYPE (length) = len_type;
@@ -2712,7 +2713,7 @@ create_function_arglist (gfc_symbol * sym)
 			PARM_DECL, get_identifier (name),
 			boolean_type_node);

-  hidden_arglist = chainon (hidden_arglist, tmp);
+	  optional_arglist = chainon (optional_arglist, tmp);
   DECL_CONTEXT (tmp) = fndecl;
   DECL_ARTIFICIAL (tmp) = 1;
   DECL_ARG_TYPE (tmp) = boolean_type_node;
@@ -2863,10 +2864,16 @@ create_function_arglist (gfc_symbol * sym)
   typelist = TREE_CHAIN (typelist);
 }

+  /* Add hidden present status for optional+value arguments.  */
+  arglist = chainon (arglist, optional_arglist);
+
   /* Add the hidden string length parameters, unless the procedure
  is bind(C).  */
   if (!sym->attr.is_bind_c)
-arglist = chainon (arglist, hidden_arglist);
+arglist = chainon (arglist, strlen_arglist);
+
+  /* Add hidden extra arguments for the gfortran library.  */
+  arglist = chainon (arglist, hidden_arglist);

   gcc_assert (hidden_typelist == NULL_TREE
   || TREE_VALUE (hidden_typelist) == void_type_node);
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_6.f90 b/gcc/testsuite/gfortran.dg/optional_absent_6.f90
new file mode 100644
index 000..b8abb06980a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_6.f90
@@ -0,0 +1,60 @@
+! { dg-do run }
+! PR fortran/107441
+!
+! Test VALUE + OPTIONAL for integer/real/...
+! in the presence of non-optional character dummies
+
+program bugdemo
+  implicit none
+  character :: s = 'a'
+  integer   :: t
+
+  t = testoptional(s)
+  call test2 (s)
+  call test3 (s)
+  call test4 (w='123',x=42)
+
+contains
+
+  function testoptional (w, x) result(t)
+character, intent(in)  :: w
+integer,   intent(in), value, optional :: x
+integer :: t
+print *, 'present(x) is', present(x)
+t = 0
+if (present (x)) stop 1
+  end function testoptional
+
+  subroutine test2 (w, x)
+character, intent(in)  :: w
+integer,   intent(in), value, optional :: x
+print*, 'present(x) is', present(x)
+if (present (x)) stop 2
+  end subroutine test2
+
+  subroutine test3 (w, x)
+character, intent(in),optional :: w
+integer,   intent(in), value, optional :: x
+print *, 'present(w) is', present(w)
+print *, 'present(x) is', present(x)
+if (.not. present (w)) stop 3
+if (present (x)) stop 4
+  end subroutine test3
+
+  subroutine test4 (r, w, x)
+real, value, optional :: r
+charact

[PATCH] Fortran: BOZ literal constants are not compatible to any type [PR103413]

2022-10-26 Thread Harald Anlauf via Gcc-patches
Dear all,

a BOZ as source-expression in an ALLOCATE statement could lead
to an ICE when the allocate-object was a CLASS variable.
Since a BOZ has no type, we can handle it as type incompatible
with any type.  This is also what the Cray compiler does for
the code in the testcase.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

The PR is marked as a 10/11/12/13 regression, so OK for backports?

Thanks,
Harald

From 986bf9cc5abc51598609b16edc9242a87244571b Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Wed, 26 Oct 2022 21:00:44 +0200
Subject: [PATCH] Fortran: BOZ literal constants are not compatible to any type
 [PR103413]

gcc/fortran/ChangeLog:

	PR fortran/103413
	* symbol.cc (gfc_type_compatible): A boz-literal-constant has no type
	and thus is not considered compatible to any type.

gcc/testsuite/ChangeLog:

	PR fortran/103413
	* gfortran.dg/illegal_boz_arg_4.f90: New test.
---
 gcc/fortran/symbol.cc   |  4 
 gcc/testsuite/gfortran.dg/illegal_boz_arg_4.f90 | 13 +
 2 files changed, 17 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/illegal_boz_arg_4.f90

diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 6050359d521..49fb37864bd 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -5139,6 +5139,10 @@ gfc_type_compatible (gfc_typespec *ts1, gfc_typespec *ts2)
   bool is_union1 = (ts1->type == BT_UNION);
   bool is_union2 = (ts2->type == BT_UNION);

+  /* A boz-literal-constant has no type.  */
+  if (ts1->type == BT_BOZ || ts2->type == BT_BOZ)
+return false;
+
   if (is_class1
   && ts1->u.derived->components
   && ((ts1->u.derived->attr.is_class
diff --git a/gcc/testsuite/gfortran.dg/illegal_boz_arg_4.f90 b/gcc/testsuite/gfortran.dg/illegal_boz_arg_4.f90
new file mode 100644
index 000..856cfa9211f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/illegal_boz_arg_4.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-std=f2018" }
+! PR fortran/103413
+! Contributed by G.Steinmetz
+
+program p
+  type t
+ class(*), allocatable :: a
+  end type
+  type(t) :: x
+  allocate (x%a, source=z'1') ! { dg-error "type incompatible" }
+  allocate (x%a, mold=z'1')   ! { dg-error "type incompatible" }
+end
--
2.35.3



Re: Proxy ping [PATCH] Fortran: Add missing TKR initialization to class variables [PR100097, PR100098]

2022-10-21 Thread Harald Anlauf via Gcc-patches

Hi Mikael,

Am 21.10.22 um 13:13 schrieb Mikael Morin:

Le 18/10/2022 à 22:48, Harald Anlauf via Fortran a écrit :

I intended to add the updated patch but forgot, so here it is...

Am 18.10.22 um 22:41 schrieb Harald Anlauf via Fortran:

Dear all,

Jose posted a patch here that was never reviewed:

   https://gcc.gnu.org/pipermail/fortran/2021-April/055933.html

I could not find any issues with his patch, it works as advertised
and fixes the reported problem.

As his testcases did not reliably fail without the patch but rather
randomly due to the uninitialized descriptor, I added a check of
the tree-dumps to verify that the TKR initializer is generated.

Does anybody else have any comments?

Regtested on x86_64-pc-linux-gnu.  OK for mainline?


Looks good but please check the initialization of rank instead of
elem_len in the dump patterns (elem_len actually doesn't matter).
OK with that change.


You're right, this is what I should have done in the first place.

Pushed: https://gcc.gnu.org/g:4cfdaeb2755121ac1069f09898def56469b0fb51
See also attached.


Thanks.



Thanks,
Harald
From 4cfdaeb2755121ac1069f09898def56469b0fb51 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?=
 
Date: Tue, 18 Oct 2022 22:29:59 +0200
Subject: [PATCH] Fortran: Add missing TKR initialization to class variables
 [PR100097, PR100098]

gcc/fortran/ChangeLog:

	PR fortran/100097
	PR fortran/100098
	* trans-array.cc (gfc_trans_class_array): New function to
	initialize class descriptor's TKR information.
	* trans-array.h (gfc_trans_class_array): Add function prototype.
	* trans-decl.cc (gfc_trans_deferred_vars): Add calls to the new
	function for both pointers and allocatables.

gcc/testsuite/ChangeLog:

	PR fortran/100097
	PR fortran/100098
	* gfortran.dg/PR100097.f90: New test.
	* gfortran.dg/PR100098.f90: New test.
---
 gcc/fortran/trans-array.cc | 46 ++
 gcc/fortran/trans-array.h  |  2 ++
 gcc/fortran/trans-decl.cc  |  6 +++-
 gcc/testsuite/gfortran.dg/PR100097.f90 | 41 +++
 gcc/testsuite/gfortran.dg/PR100098.f90 | 45 +
 5 files changed, 139 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/PR100097.f90
 create mode 100644 gcc/testsuite/gfortran.dg/PR100098.f90

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 795ce14af08..514cb057afb 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -11125,6 +11125,52 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
 }
 
 
+/* Initialize class descriptor's TKR infomation.  */
+
+void
+gfc_trans_class_array (gfc_symbol * sym, gfc_wrapped_block * block)
+{
+  tree type, etype;
+  tree tmp;
+  tree descriptor;
+  stmtblock_t init;
+  locus loc;
+  int rank;
+
+  /* Make sure the frontend gets these right.  */
+  gcc_assert (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
+	  && (CLASS_DATA (sym)->attr.class_pointer
+		  || CLASS_DATA (sym)->attr.allocatable));
+
+  gcc_assert (VAR_P (sym->backend_decl)
+	  || TREE_CODE (sym->backend_decl) == PARM_DECL);
+
+  if (sym->attr.dummy)
+return;
+
+  descriptor = gfc_class_data_get (sym->backend_decl);
+  type = TREE_TYPE (descriptor);
+
+  if (type == NULL || !GFC_DESCRIPTOR_TYPE_P (type))
+return;
+
+  gfc_save_backend_locus (&loc);
+  gfc_set_backend_locus (&sym->declared_at);
+  gfc_init_block (&init);
+
+  rank = CLASS_DATA (sym)->as ? (CLASS_DATA (sym)->as->rank) : (0);
+  gcc_assert (rank>=0);
+  tmp = gfc_conv_descriptor_dtype (descriptor);
+  etype = gfc_get_element_type (type);
+  tmp = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (tmp), tmp,
+			 gfc_get_dtype_rank_type (rank, etype));
+  gfc_add_expr_to_block (&init, tmp);
+
+  gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
+  gfc_restore_backend_locus (&loc);
+}
+
+
 /* NULLIFY an allocatable/pointer array on function entry, free it on exit.
Do likewise, recursively if necessary, with the allocatable components of
derived types.  This function is also called for assumed-rank arrays, which
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 04fee617590..cd2b3d9f2f0 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -69,6 +69,8 @@ tree gfc_check_pdt_dummy (gfc_symbol *, tree, int, gfc_actual_arglist *);
 
 tree gfc_alloc_allocatable_for_assignment (gfc_loopinfo*, gfc_expr*, gfc_expr*);
 
+/* Add initialization for class descriptors  */
+void gfc_trans_class_array (gfc_symbol *, gfc_wrapped_block *);
 /* Add initialization for deferred arrays.  */
 void gfc_trans_deferred_array (gfc_symbol *, gfc_wrapped_block *);
 /* Generate an initializer for a static pointer or allocatable array.  */
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 4b570c3551a..63515

[PATCH] Fortran: error recovery with references of bad array constructors [PR105633]

2022-10-19 Thread Harald Anlauf via Gcc-patches
Dear Fortranners,

here's another patch that improves error receovery with references
of bad array constructors leading to an ICE after a NULL pointer
dereference.

Original patch by Steve, which I amended with a logic cleanup.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

From 0da12c71a6ccbefa1456be5759974a4b450c78e6 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Wed, 19 Oct 2022 22:37:56 +0200
Subject: [PATCH] Fortran: error recovery with references of bad array
 constructors [PR105633]

gcc/fortran/ChangeLog:

	PR fortran/105633
	* expr.cc (find_array_section): Move check for NULL pointers so
	that both subscript triplets and vector subscripts are covered.

gcc/testsuite/ChangeLog:

	PR fortran/105633
	* gfortran.dg/pr105633.f90: New test.

Co-authored-by: Steven G. Kargl 
---
 gcc/fortran/expr.cc| 10 +++---
 gcc/testsuite/gfortran.dg/pr105633.f90 |  8 
 2 files changed, 15 insertions(+), 3 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr105633.f90

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 290ddf360c8..69d0b57c688 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -1552,6 +1552,12 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
   lower = ref->u.ar.as->lower[d];
   upper = ref->u.ar.as->upper[d];

+  if (!lower || !upper)
+	{
+	  t = false;
+	  goto cleanup;
+	}
+
   if (ref->u.ar.dimen_type[d] == DIMEN_VECTOR)  /* Vector subscript.  */
 	{
 	  gfc_constructor *ci;
@@ -1594,9 +1600,7 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
 	{
 	  if ((begin && begin->expr_type != EXPR_CONSTANT)
 	  || (finish && finish->expr_type != EXPR_CONSTANT)
-	  || (step && step->expr_type != EXPR_CONSTANT)
-	  || !lower
-	  || !upper)
+	  || (step && step->expr_type != EXPR_CONSTANT))
 	{
 	  t = false;
 	  goto cleanup;
diff --git a/gcc/testsuite/gfortran.dg/pr105633.f90 b/gcc/testsuite/gfortran.dg/pr105633.f90
new file mode 100644
index 000..f2dbc5e742a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr105633.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! PR fortran/105633 - ICE in find_array_section
+! Contributed by G.Steinmetz
+
+program p
+  integer, parameter :: a(:) = [1,2] ! { dg-error "deferred shape" }
+  print *, [a([1,2])]
+end
--
2.35.3



Re: Proxy ping [PATCH] Fortran: Add missing TKR initialization to class variables [PR100097, PR100098]

2022-10-18 Thread Harald Anlauf via Gcc-patches

I intended to add the updated patch but forgot, so here it is...

Am 18.10.22 um 22:41 schrieb Harald Anlauf via Fortran:

Dear all,

Jose posted a patch here that was never reviewed:

   https://gcc.gnu.org/pipermail/fortran/2021-April/055933.html

I could not find any issues with his patch, it works as advertised
and fixes the reported problem.

As his testcases did not reliably fail without the patch but rather
randomly due to the uninitialized descriptor, I added a check of
the tree-dumps to verify that the TKR initializer is generated.

Does anybody else have any comments?

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald



From 8d364acf33f27262ef5929a3c8d504ed6df0f943 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?=
 
Date: Tue, 18 Oct 2022 22:29:59 +0200
Subject: [PATCH] Fortran: Add missing TKR initialization to class variables
 [PR100097, PR100098]

gcc/fortran/ChangeLog:

	PR fortran/100097
	PR fortran/100098
	* trans-array.cc (gfc_trans_class_array): New function to
	initialize class descriptor's TKR information.
	* trans-array.h (gfc_trans_class_array): Add function prototype.
	* trans-decl.cc (gfc_trans_deferred_vars): Add calls to the new
	function for both pointers and allocatables.

gcc/testsuite/ChangeLog:

	PR fortran/100097
	PR fortran/100098
	* gfortran.dg/PR100097.f90: New test.
	* gfortran.dg/PR100098.f90: New test.
---
 gcc/fortran/trans-array.cc | 46 ++
 gcc/fortran/trans-array.h  |  2 ++
 gcc/fortran/trans-decl.cc  |  6 +++-
 gcc/testsuite/gfortran.dg/PR100097.f90 | 41 +++
 gcc/testsuite/gfortran.dg/PR100098.f90 | 45 +
 5 files changed, 139 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/PR100097.f90
 create mode 100644 gcc/testsuite/gfortran.dg/PR100098.f90

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 795ce14af08..514cb057afb 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -11125,6 +11125,52 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
 }
 
 
+/* Initialize class descriptor's TKR infomation.  */
+
+void
+gfc_trans_class_array (gfc_symbol * sym, gfc_wrapped_block * block)
+{
+  tree type, etype;
+  tree tmp;
+  tree descriptor;
+  stmtblock_t init;
+  locus loc;
+  int rank;
+
+  /* Make sure the frontend gets these right.  */
+  gcc_assert (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
+	  && (CLASS_DATA (sym)->attr.class_pointer
+		  || CLASS_DATA (sym)->attr.allocatable));
+
+  gcc_assert (VAR_P (sym->backend_decl)
+	  || TREE_CODE (sym->backend_decl) == PARM_DECL);
+
+  if (sym->attr.dummy)
+return;
+
+  descriptor = gfc_class_data_get (sym->backend_decl);
+  type = TREE_TYPE (descriptor);
+
+  if (type == NULL || !GFC_DESCRIPTOR_TYPE_P (type))
+return;
+
+  gfc_save_backend_locus (&loc);
+  gfc_set_backend_locus (&sym->declared_at);
+  gfc_init_block (&init);
+
+  rank = CLASS_DATA (sym)->as ? (CLASS_DATA (sym)->as->rank) : (0);
+  gcc_assert (rank>=0);
+  tmp = gfc_conv_descriptor_dtype (descriptor);
+  etype = gfc_get_element_type (type);
+  tmp = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (tmp), tmp,
+			 gfc_get_dtype_rank_type (rank, etype));
+  gfc_add_expr_to_block (&init, tmp);
+
+  gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
+  gfc_restore_backend_locus (&loc);
+}
+
+
 /* NULLIFY an allocatable/pointer array on function entry, free it on exit.
Do likewise, recursively if necessary, with the allocatable components of
derived types.  This function is also called for assumed-rank arrays, which
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 04fee617590..cd2b3d9f2f0 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -69,6 +69,8 @@ tree gfc_check_pdt_dummy (gfc_symbol *, tree, int, gfc_actual_arglist *);
 
 tree gfc_alloc_allocatable_for_assignment (gfc_loopinfo*, gfc_expr*, gfc_expr*);
 
+/* Add initialization for class descriptors  */
+void gfc_trans_class_array (gfc_symbol *, gfc_wrapped_block *);
 /* Add initialization for deferred arrays.  */
 void gfc_trans_deferred_array (gfc_symbol *, gfc_wrapped_block *);
 /* Generate an initializer for a static pointer or allocatable array.  */
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 4b570c3551a..63515b9072a 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -4835,7 +4835,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
   else if ((!sym->attr.dummy || sym->ts.deferred)
 		&& (sym->ts.type == BT_CLASS
 		&& CLASS_DATA (sym)->attr.class_pointer))
-	continue;
+	gfc_trans_class_array (sym, block);
   else if ((!sym->attr.dummy || sym->ts.deferred)
 		&a

Proxy ping [PATCH] Fortran: Add missing TKR initialization to class variables [PR100097, PR100098]

2022-10-18 Thread Harald Anlauf via Gcc-patches
Dear all,

Jose posted a patch here that was never reviewed:

  https://gcc.gnu.org/pipermail/fortran/2021-April/055933.html

I could not find any issues with his patch, it works as advertised
and fixes the reported problem.

As his testcases did not reliably fail without the patch but rather
randomly due to the uninitialized descriptor, I added a check of
the tree-dumps to verify that the TKR initializer is generated.

Does anybody else have any comments?

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald




[PATCH, committed] Fortran: NULL pointer dereference in gfc_simplify_image_index [PR104330]

2022-10-17 Thread Harald Anlauf via Gcc-patches
Dear all,

I've pushed a very obvious fix for a NULL pointer dereference
on behalf of Steve after regtesting on x86_64-pc-linux-gnu as

https://gcc.gnu.org/g:84807af0ca6dfdb81abb8e925ce32acbcab29868

Thanks,
Harald




Re: [PATCH, v2] Fortran: handle bad array ctors with typespec [PR93483, , PR107216, PR107219]

2022-10-17 Thread Harald Anlauf via Gcc-patches

Hi Mikael,

Am 16.10.22 um 23:17 schrieb Mikael Morin:

Le 15/10/2022 à 22:15, Harald Anlauf via Fortran a écrit :

Dear all,

here is an updated version of the patch that includes suggestions
and comments by Mikael in PR93483.

Basic new features are:
- a new enum value ARITH_NOT_REDUCED to keep track if we encountered
   an expression that was not reduced via reduce_unary/reduce_binary
- a cleanup of the related checking, resulting in more readable
   code.
- a new testcase by Mikael that exhibited a flaw in the first patch
   due to a false resolution of a symbol by premature simplification.

Regtested again.  OK for mainline?


(...)

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 10bb098d136..7b8f0b148bd 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -222,11 +222,12 @@ enum gfc_intrinsic_op
    Assumptions are made about the numbering of the interface_op
enums.  */
 #define GFC_INTRINSIC_OPS GFC_INTRINSIC_END

-/* Arithmetic results.  */
+/* Arithmetic results.  ARITH_NOT_REDUCED is used to keep track of
failed
+   reductions because an erroneous expression was encountered.  */


The expressions are not always erroneous.  They can be, but in the
testcase for example, all the expressions are valid.  They are just
unsupported by the arithmetic evaluation code which works only with
literal constants and arrays of literal constants (and arrays of arrays
etc).

OK with that comment fixed.


you're absolutely right.  I adjusted the comment and the commit
message according to your suggestion.

Pushed as https://gcc.gnu.org/g:d45af5c2eb1ba1e48449d8f3c5b4e3994a956f92

Thanks,
Harald


Thanks.





Re: [Patch] Fortran: Fixes for kind=4 characters strings [PR107266]

2022-10-16 Thread Harald Anlauf via Gcc-patches

Hi Tobias,

the patch LGTM.

Regarding testcase char4_decl-2.f90, I played a little and found that
one could in addition check the storage_size of aa, pp in the main and
compare with storage_size (4_'foo') etc.  Without your patch the
storage sizes look odd.  (Strictly speaking, a comparison like
  if (aa .ne. 4_'foo') stop 123
is not fully sufficient to catch such oddities.)

Thanks,
Harald


Am 14.10.22 um 23:18 schrieb Tobias Burnus:

Long introduction - but the patch is rather simple: Don't use kind=1
as type where kind=4 should be used.

Long introduction + background, feel free to skip.



This popped up for libgomp/testsuite/libgomp.fortran/struct-elem-map-1.f90
which uses kind=4 characters – if Sandra's "Fortran: delinearize
multi-dimensional
array accesses" patch is applied.

Patch: https://gcc.gnu.org/pipermail/gcc-patches/2020-December/562230.html
Used for OG11:
https://gcc.gnu.org/pipermail/gcc-patches/2021-November/584716.html
On the OG12 alias devel/omp/gcc-12 vendor branch, it is used:
https://gcc.gnu.org/g:39a8c371fda6136cf77c74895a00b136409e0ba3

* * *

For mainline, I did not observe a wrong-code issue at runtime, still:

void frobc (character(kind=4)[1:*_a] * & restrict a, ...
...
static void frobc (character(kind=1) * & restrict, ...

feels odd, i.e. having the definition as kind=4 and the declaration as
kind=1.
With the patch, it becomes:

static void frobc (character(kind=4) * & restrict, character(kind=4) *
&, ...

  * * *

For the following, questionable code (→ PR107266), it is even worse:

character(kind=4) function f(x) bind(C)
   character(kind=4), value :: x
end

this gives the following, which has the wrong ABI:

character(kind=1) f (character(kind=1) x)
{
   (void) 0;
}

With the patch, it becomes:
   character(kind=4) f (character(kind=4) x)

  * * *

I think that all only exercises the trans-type.cc patch;
the trans-expr.cc code gets called – as an assert shows,
but I fail to get a dump where this goes wrong.

However, for struct-elem-map-1.f90 with mainline or with
OG12 and the patch:
   #pragma omp target map(tofrom:var.uni2[40 / 20] [len: 20])

while on OG12 without the attached patch:
   #pragma omp target map(tofrom:var.uni2[40 / 5] [len: 5])

where the problem is that TYPE_SIZE_UNIT is wrong. Whether
this only affects OG12 due to the delinearizer patch or
some code on mainline as well, I don't know.

Still, I think it should be fixed ...



OK for mainline?

Tobias
-
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201,
80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer:
Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München;
Registergericht München, HRB 106955




[PATCH] Fortran: check type of operands of logical operations, comparisons [PR107272]

2022-10-16 Thread Harald Anlauf via Gcc-patches
Dear all,

this PR is actually very related to PR107217 that addressed ICEs
with bad array constructors with typespec when used in arithmetic
expressions.  The present patch extends the checking to logical
operations and to comparisons and catches several ICE-on-invalid
as well as a few cases of accepts-invalid.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

From 779baf06888f3adef13c12c468c0a5ef0a45f93e Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Sun, 16 Oct 2022 20:32:27 +0200
Subject: [PATCH] Fortran: check type of operands of logical operations,
 comparisons [PR107272]

gcc/fortran/ChangeLog:

	PR fortran/107272
	* arith.cc (gfc_arith_not): Operand must be of type BT_LOGICAL.
	(gfc_arith_and): Likewise.
	(gfc_arith_or): Likewise.
	(gfc_arith_eqv): Likewise.
	(gfc_arith_neqv): Likewise.
	(gfc_arith_eq): Compare consistency of types of operands.
	(gfc_arith_ne): Likewise.
	(gfc_arith_gt): Likewise.
	(gfc_arith_ge): Likewise.
	(gfc_arith_lt): Likewise.
	(gfc_arith_le): Likewise.

gcc/testsuite/ChangeLog:

	PR fortran/107272
	* gfortran.dg/pr107272.f90: New test.
---
 gcc/fortran/arith.cc   | 33 ++
 gcc/testsuite/gfortran.dg/pr107272.f90 | 21 
 2 files changed, 54 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/pr107272.f90

diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index c8e882badab..fc9224ebc5c 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -422,6 +422,9 @@ gfc_arith_not (gfc_expr *op1, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != BT_LOGICAL)
+return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (BT_LOGICAL, op1->ts.kind, &op1->where);
   result->value.logical = !op1->value.logical;
   *resultp = result;
@@ -435,6 +438,9 @@ gfc_arith_and (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != BT_LOGICAL || op2->ts.type != BT_LOGICAL)
+return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (BT_LOGICAL, gfc_kind_max (op1, op2),
   &op1->where);
   result->value.logical = op1->value.logical && op2->value.logical;
@@ -449,6 +455,9 @@ gfc_arith_or (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != BT_LOGICAL || op2->ts.type != BT_LOGICAL)
+return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (BT_LOGICAL, gfc_kind_max (op1, op2),
   &op1->where);
   result->value.logical = op1->value.logical || op2->value.logical;
@@ -463,6 +472,9 @@ gfc_arith_eqv (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != BT_LOGICAL || op2->ts.type != BT_LOGICAL)
+return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (BT_LOGICAL, gfc_kind_max (op1, op2),
   &op1->where);
   result->value.logical = op1->value.logical == op2->value.logical;
@@ -477,6 +489,9 @@ gfc_arith_neqv (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != BT_LOGICAL || op2->ts.type != BT_LOGICAL)
+return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (BT_LOGICAL, gfc_kind_max (op1, op2),
   &op1->where);
   result->value.logical = op1->value.logical != op2->value.logical;
@@ -1187,6 +1202,9 @@ gfc_arith_eq (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != op2->ts.type)
+return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind,
   &op1->where);
   result->value.logical = (op1->ts.type == BT_COMPLEX)
@@ -1203,6 +1221,9 @@ gfc_arith_ne (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != op2->ts.type)
+return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind,
   &op1->where);
   result->value.logical = (op1->ts.type == BT_COMPLEX)
@@ -1219,6 +1240,9 @@ gfc_arith_gt (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != op2->ts.type)
+return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind,
   &op1->where);
   result->value.logical = (gfc_compare_expr (op1, op2, INTRINSIC_GT) > 0);
@@ -1233,6 +1257,9 @@ gfc_arith_ge (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != op2->ts.type)
+return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind,
   &op1->where);
   result->value.logical = (gfc_compare_expr (op1, op2, INTRINSIC_GE) >= 0);
@@ -1247,6 +1274,9 @@ gfc_arith_lt (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != op2->ts.type)

[PATCH] Fortran: simplify array constructors with typespec [PR93483, PR107216, PR107219]

2022-10-12 Thread Harald Anlauf via Gcc-patches
Dear Fortranners,

this one was really bugging me for quite some time.  We failed to
properly handle (= simplify) expressions using array constructors
with typespec, and with parentheses and unary '+' and '-'
sprinkled here and there.  When there was no typespec, there was
no related problem.

The underlying issue apparently was that we should simplify
elements of the array constructor before attempting the type
conversion.

Thanks to Gerhard, who insisted by submitted many related PRs.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

From ee65197f4d0b0050dc61687b5a77f1afe3bd4a27 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Wed, 12 Oct 2022 21:33:36 +0200
Subject: [PATCH] Fortran: simplify array constructors with typespec [PR93483,
 PR107216, PR107219]

gcc/fortran/ChangeLog:

	PR fortran/93483
	PR fortran/107216
	PR fortran/107219
	* array.cc (walk_array_constructor): If an element of an array
	constructor is an EXPR_OP, try simplification before type conversion.

gcc/testsuite/ChangeLog:

	PR fortran/93483
	PR fortran/107216
	PR fortran/107219
	* gfortran.dg/array_constructor_56.f90: New test.
---
 gcc/fortran/array.cc  |  4 
 .../gfortran.dg/array_constructor_56.f90  | 22 +++
 2 files changed, 26 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_56.f90

diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index bbdb5b392fc..9bec299f160 100644
--- a/gcc/fortran/array.cc
+++ b/gcc/fortran/array.cc
@@ -1205,6 +1205,10 @@ walk_array_constructor (gfc_typespec *ts, gfc_constructor_base head)
   for (c = gfc_constructor_first (head); c; c = gfc_constructor_next (c))
 {
   e = c->expr;
+
+  if (e->expr_type == EXPR_OP)
+	gfc_simplify_expr (e, 0);
+
   if (e->expr_type == EXPR_ARRAY && e->ts.type == BT_UNKNOWN
 	  && !e->ref && e->value.constructor)
 	{
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_56.f90 b/gcc/testsuite/gfortran.dg/array_constructor_56.f90
new file mode 100644
index 000..4701fb36225
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_56.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+!
+! Test the fix for the following:
+! PR fortran/93483
+! PR fortran/107216
+! PR fortran/107219
+!
+! Contributed by G.Steinmetz
+
+program p
+  real, parameter :: r0(*) = +[real :: +(1) ]
+  real, parameter :: r1(*) = +[real :: +[1] ]
+  real, parameter :: r2(*) = -[real :: [(1)]]
+  real, parameter :: r3(*) = +[real :: [-(1)]]
+  real, parameter :: r4(*) = -[real :: [[(1)]]]
+  real, parameter :: r5(*) = -[real :: -[1, 2]]
+  real, parameter :: r6(*) = +[real :: +[1, 2]]
+  real, parameter :: r7(*) =  [real :: 1, 2] * [real :: 1, (2)]
+  real, parameter :: r8(*) =  [real :: 1, (2)] * [real :: 1, 2]
+  real, parameter :: r9(*) = +[real :: 1, 2] * [real :: 1, (2)]
+  real, parameter :: rr(*) = -[real :: 1, (2)] * [real :: 1, 2]
+end
--
2.35.3



[PATCH] Fortran: check types of operands of arithmetic binary operations [PR107217]

2022-10-11 Thread Harald Anlauf via Gcc-patches
Dear all,

we need to check that the operands of arithmetic binary operations
are consistent and of numeric type.

The PR reported an issue for multiplication ("*"), but we better
extend this to the other binary operations.

I chose the following solution:
- consistent types for +,-,*,/, keeping an internal error if any
  unhandled type shows up,
- numeric types for **

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

From a95f251504bcb8ba28b7db1d2b7990631c761e9c Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Tue, 11 Oct 2022 22:08:48 +0200
Subject: [PATCH] Fortran: check types of operands of arithmetic binary
 operations [PR107217]

gcc/fortran/ChangeLog:

	PR fortran/107217
	* arith.cc (gfc_arith_plus): Compare consistency of types of operands.
	(gfc_arith_minus): Likewise.
	(gfc_arith_times): Likewise.
	(gfc_arith_divide): Likewise.
	(arith_power): Check that both operands are of numeric type.

gcc/testsuite/ChangeLog:

	PR fortran/107217
	* gfortran.dg/pr107217.f90: New test.
---
 gcc/fortran/arith.cc   | 15 +++
 gcc/testsuite/gfortran.dg/pr107217.f90 | 18 ++
 2 files changed, 33 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/pr107217.f90

diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index 9e079e42995..14ba931e37f 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -624,6 +624,9 @@ gfc_arith_plus (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
   gfc_expr *result;
   arith rc;

+  if (op1->ts.type != op2->ts.type)
+return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (op1->ts.type, op1->ts.kind, &op1->where);

   switch (op1->ts.type)
@@ -658,6 +661,9 @@ gfc_arith_minus (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
   gfc_expr *result;
   arith rc;

+  if (op1->ts.type != op2->ts.type)
+return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (op1->ts.type, op1->ts.kind, &op1->where);

   switch (op1->ts.type)
@@ -692,6 +698,9 @@ gfc_arith_times (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
   gfc_expr *result;
   arith rc;

+  if (op1->ts.type != op2->ts.type)
+return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (op1->ts.type, op1->ts.kind, &op1->where);

   switch (op1->ts.type)
@@ -727,6 +736,9 @@ gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
   gfc_expr *result;
   arith rc;

+  if (op1->ts.type != op2->ts.type)
+return ARITH_INVALID_TYPE;
+
   rc = ARITH_OK;

   result = gfc_get_constant_expr (op1->ts.type, op1->ts.kind, &op1->where);
@@ -815,6 +827,9 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
   gfc_expr *result;
   arith rc;

+  if (!gfc_numeric_ts (&op1->ts) || !gfc_numeric_ts (&op2->ts))
+return ARITH_INVALID_TYPE;
+
   rc = ARITH_OK;
   result = gfc_get_constant_expr (op1->ts.type, op1->ts.kind, &op1->where);

diff --git a/gcc/testsuite/gfortran.dg/pr107217.f90 b/gcc/testsuite/gfortran.dg/pr107217.f90
new file mode 100644
index 000..9c8492e64f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr107217.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! PR fortran/107217 - ICE in gfc_arith_times
+! Contributed by G.Steinmetz
+
+program p
+  print *, [real :: (['1'])] * 2 ! { dg-error "Cannot convert" }
+  print *, 2 * [real :: (['1'])] ! { dg-error "Cannot convert" }
+  print *, [real :: (['1'])] + 2 ! { dg-error "Cannot convert" }
+  print *, [real :: (['1'])] - 2 ! { dg-error "Cannot convert" }
+  print *, [real :: (['1'])] / 2 ! { dg-error "Cannot convert" }
+  print *, 1 / [real :: (['1'])] ! { dg-error "Cannot convert" }
+  print *, [real :: (['1'])] ** 2 ! { dg-error "Cannot convert" }
+  print *, 2 ** [real :: (['1'])] ! { dg-error "Cannot convert" }
+  print *, 2.0 ** [real :: (.true.)] ! { dg-error "Cannot convert" }
+  print *, [real :: (.true.)] ** 2.0 ! { dg-error "Cannot convert" }
+  print *, [complex :: (['1'])] ** (1.0,2.0) ! { dg-error "Cannot convert" }
+  print *, (1.0,2.0) ** [complex :: (['1'])] ! { dg-error "Cannot convert" }
+end
--
2.35.3



[PATCH] Fortran: check types of source expressions before conversion [PR107215]

2022-10-11 Thread Harald Anlauf via Gcc-patches
Dear all,

this PR is an obvious followup to PR107000, where invalid
types appeared in array constructors and lead to an ICE
either in a conversion or reduction of a unary or binary
expression.

The present PR shows that several other conversions need to
be protected by a check of the type of the source expression.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

From 87dae7eb9d4cc76060d258ba99bc53f62c7130f2 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Tue, 11 Oct 2022 20:37:42 +0200
Subject: [PATCH] Fortran: check types of source expressions before conversion
 [PR107215]

gcc/fortran/ChangeLog:

	PR fortran/107215
	* arith.cc (gfc_int2int): Check validity of type of source expr.
	(gfc_int2real): Likewise.
	(gfc_int2complex): Likewise.
	(gfc_real2int): Likewise.
	(gfc_real2real): Likewise.
	(gfc_complex2int): Likewise.
	(gfc_complex2real): Likewise.
	(gfc_complex2complex): Likewise.
	(gfc_log2log): Likewise.
	(gfc_log2int): Likewise.
	(gfc_int2log): Likewise.

gcc/testsuite/ChangeLog:

	PR fortran/107215
	* gfortran.dg/pr107215.f90: New test.
---
 gcc/fortran/arith.cc   | 33 ++
 gcc/testsuite/gfortran.dg/pr107215.f90 | 17 +
 2 files changed, 50 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/pr107215.f90

diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index 086b1f856b1..9e079e42995 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -2040,6 +2040,9 @@ gfc_int2int (gfc_expr *src, int kind)
   gfc_expr *result;
   arith rc;

+  if (src->ts.type != BT_INTEGER)
+return NULL;
+
   result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);

   mpz_set (result->value.integer, src->value.integer);
@@ -2085,6 +2088,9 @@ gfc_int2real (gfc_expr *src, int kind)
   gfc_expr *result;
   arith rc;

+  if (src->ts.type != BT_INTEGER)
+return NULL;
+
   result = gfc_get_constant_expr (BT_REAL, kind, &src->where);

   mpfr_set_z (result->value.real, src->value.integer, GFC_RND_MODE);
@@ -2116,6 +2122,9 @@ gfc_int2complex (gfc_expr *src, int kind)
   gfc_expr *result;
   arith rc;

+  if (src->ts.type != BT_INTEGER)
+return NULL;
+
   result = gfc_get_constant_expr (BT_COMPLEX, kind, &src->where);

   mpc_set_z (result->value.complex, src->value.integer, GFC_MPC_RND_MODE);
@@ -2150,6 +2159,9 @@ gfc_real2int (gfc_expr *src, int kind)
   arith rc;
   bool did_warn = false;

+  if (src->ts.type != BT_REAL)
+return NULL;
+
   result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);

   gfc_mpfr_to_mpz (result->value.integer, src->value.real, &src->where);
@@ -2196,6 +2208,9 @@ gfc_real2real (gfc_expr *src, int kind)
   arith rc;
   bool did_warn = false;

+  if (src->ts.type != BT_REAL)
+return NULL;
+
   result = gfc_get_constant_expr (BT_REAL, kind, &src->where);

   mpfr_set (result->value.real, src->value.real, GFC_RND_MODE);
@@ -2310,6 +2325,9 @@ gfc_complex2int (gfc_expr *src, int kind)
   arith rc;
   bool did_warn = false;

+  if (src->ts.type != BT_COMPLEX)
+return NULL;
+
   result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);

   gfc_mpfr_to_mpz (result->value.integer, mpc_realref (src->value.complex),
@@ -2372,6 +2390,9 @@ gfc_complex2real (gfc_expr *src, int kind)
   arith rc;
   bool did_warn = false;

+  if (src->ts.type != BT_COMPLEX)
+return NULL;
+
   result = gfc_get_constant_expr (BT_REAL, kind, &src->where);

   mpc_real (result->value.real, src->value.complex, GFC_RND_MODE);
@@ -2439,6 +2460,9 @@ gfc_complex2complex (gfc_expr *src, int kind)
   arith rc;
   bool did_warn = false;

+  if (src->ts.type != BT_COMPLEX)
+return NULL;
+
   result = gfc_get_constant_expr (BT_COMPLEX, kind, &src->where);

   mpc_set (result->value.complex, src->value.complex, GFC_MPC_RND_MODE);
@@ -2504,6 +2528,9 @@ gfc_log2log (gfc_expr *src, int kind)
 {
   gfc_expr *result;

+  if (src->ts.type != BT_LOGICAL)
+return NULL;
+
   result = gfc_get_constant_expr (BT_LOGICAL, kind, &src->where);
   result->value.logical = src->value.logical;

@@ -2518,6 +2545,9 @@ gfc_log2int (gfc_expr *src, int kind)
 {
   gfc_expr *result;

+  if (src->ts.type != BT_LOGICAL)
+return NULL;
+
   result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);
   mpz_set_si (result->value.integer, src->value.logical);

@@ -2532,6 +2562,9 @@ gfc_int2log (gfc_expr *src, int kind)
 {
   gfc_expr *result;

+  if (src->ts.type != BT_INTEGER)
+return NULL;
+
   result = gfc_get_constant_expr (BT_LOGICAL, kind, &src->where);
   result->value.logical = (mpz_cmp_si (src->value.integer, 0) != 0);

diff --git a/gcc/testsuite/gfortran.dg/pr107215.f90 b/gcc/testsuite/gfortran.dg/pr107215.f90
new file mode 100644
index 000..2c2a0ca7502
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr107215.f90
@

[PATCH] Fortran: fix check of polymorphic elements in data transfers [PR100971]

2022-10-09 Thread Harald Anlauf via Gcc-patches
Dear all,

the check of data transfer elements needs to verify that for
polymorphic objects there is a user defined DTIO procedure.
This check worked fine for scalars, but skipped arrays,
leading to an ICE later.

The obvious fix is to allow this check to inspect arrays.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

From 4db0aba8309a2c7e2c7ac95195621dff02e9796c Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Sun, 9 Oct 2022 20:43:32 +0200
Subject: [PATCH] Fortran: fix check of polymorphic elements in data transfers
 [PR100971]

gcc/fortran/ChangeLog:

	PR fortran/100971
	* resolve.cc (resolve_transfer): Extend check for permissibility
	of polymorphic elements in a data transfer to arrays.

gcc/testsuite/ChangeLog:

	PR fortran/100971
	* gfortran.dg/der_io_5.f90: New test.
---
 gcc/fortran/resolve.cc |  5 +
 gcc/testsuite/gfortran.dg/der_io_5.f90 | 17 +
 2 files changed, 22 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/der_io_5.f90

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index d133bc2d034..9202e2f10ad 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -10017,6 +10017,7 @@ resolve_transfer (gfc_code *code)

   if (exp == NULL || (exp->expr_type != EXPR_VARIABLE
 		  && exp->expr_type != EXPR_FUNCTION
+		  && exp->expr_type != EXPR_ARRAY
 		  && exp->expr_type != EXPR_STRUCTURE))
 return;

@@ -10030,6 +10031,7 @@ resolve_transfer (gfc_code *code)

   const gfc_typespec *ts = exp->expr_type == EXPR_STRUCTURE
 			|| exp->expr_type == EXPR_FUNCTION
+			|| exp->expr_type == EXPR_ARRAY
 			 ? &exp->ts : &exp->symtree->n.sym->ts;

   /* Go to actual component transferred.  */
@@ -10128,6 +10130,9 @@ resolve_transfer (gfc_code *code)
   if (exp->expr_type == EXPR_STRUCTURE)
 return;

+  if (exp->expr_type == EXPR_ARRAY)
+return;
+
   sym = exp->symtree->n.sym;

   if (sym->as != NULL && sym->as->type == AS_ASSUMED_SIZE && exp->ref
diff --git a/gcc/testsuite/gfortran.dg/der_io_5.f90 b/gcc/testsuite/gfortran.dg/der_io_5.f90
new file mode 100644
index 000..193916c4a65
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/der_io_5.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! PR fortran/100971 - ICE: Bad IO basetype (7)
+! Contributed by G.Steinmetz
+
+program p
+  implicit none
+  type t
+  end type
+  class(t), allocatable :: a, b(:)
+  type(t)   :: x, y(1)
+  integer   :: i
+  allocate (a,b(1))
+  print *, [a]! { dg-error "Data transfer element at .1. cannot be polymorphic" }
+  print *, [(b(i),i=1,1)] ! { dg-error "Data transfer element at .1. cannot be polymorphic" }
+  print *, [x]
+  print *, [(y(i),i=1,1)]
+end
--
2.35.3



Re: [PATCH, v3] Fortran: error recovery for invalid types in array constructors [PR107000]

2022-10-07 Thread Harald Anlauf via Gcc-patches

Hi Mikael,

Am 07.10.22 um 22:26 schrieb Mikael Morin:

Le 07/10/2022 à 21:47, Mikael Morin a écrit :

Let me have a look.


The attached patch works with your test, I just moved the checks into
the loops.
I'm now checking the patch against the full fortran testsuite.
I'm (finally) fine with that version, what do you think of it?


I'm fine with it.  If it regtests ok, then this should be it.



Re: [PATCH, v2] Fortran: error recovery for invalid types in array constructors [PR107000]

2022-10-07 Thread Harald Anlauf via Gcc-patches

Am 07.10.22 um 10:01 schrieb Mikael Morin:

Le 06/10/2022 à 23:36, Harald Anlauf a écrit :


For example, for this case:

[real :: 2] * [real :: +(.true.)]

First there is a "root" invocation of reduce binary with arguments [real
:: 2] and [real :: +(.true.)]
The root invocation of reduce_binary will call reduce_binary_aa. This is
normal.

Then reduce_binary_aa calls reduce_binary again with arguments 2 and
+(.true.).  And reduce_binary calls again reduce_binary_aa with those
arguments.  This is weird, reduce_binary_aa is supposed to have arrays
for both arguments.


Am I seeing something different from you?  My gdb says
that one argument of reduce_binary is EXPR_CONSTANT,
the other EXPR_OP and BT_UNKNOWN.  Both rank 0.


No, I get the same, and the program goes to reduce_binary_aa with those
arguments; this is the problem.


The same goes for the array vs constant case, reduce_binary_ca (or
reduce_binary_ac) is invoked with two scalars, while if you look at
reduce_binary, you would expect that we only get to reduce_binary_ca
with a scalar constant and an array as arguments.


I think the checks in the three reduce_binary_* functions should be
moved into their respective loops, so that we detect the invalid type
just before these weird recursive calls instead of just after entering
into them.


I think I tried that before, and it didn't work.
There was always one weird case that lead to a bad or
invalid constructor for one of the arrays you want to
look at in the respective loop,  and this is why the
testcase tries to cover everything that I hit then and
there... (hopefully).  So I ended up with the check
before the loop.


I see, I'll have a look.


What do we actually gain with your suggested change?
Moving the check into the loop does not really make
the code more readable to me.  And the recursion is
needed anyway.


I think we gain clarity, consistency.

I try to rephrase again.
 From a high level point of view, to evaluate a binary operator you need
a specific (one for each operator) function to evaluate the scalar vs
scalar case, and three generic (they are common to all the operators)
functions to handle respectively:
  - the scalar vs array case,
  - the array vs scalar case,
  - the array vs array case,
by calling in a loop the scalar specific function.
Here we are only dealing with constants, arrays of constants, arrays of
arrays, etc, all valid cases.

Your patch introduces support for invalid cases, that is invalid values
that can't be reduced to a constant.  This is fine, and it works.
What is weird is that the scalar vs invalid scalar case is caught in the
array vs array function.


OK, that is because reduce_binary dispatches the reduce_binary_*.
We could move the check from reduce_binary_aa to the beginning of
reduce_binary, as with the following change on top of the patch:

diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index 2c57c796270..91e70655ad3 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -1426,10 +1426,6 @@ reduce_binary_aa (arith (*eval) (gfc_expr *,
gfc_expr *, gfc_expr **),
   if (!gfc_check_conformance (op1, op2, _("elemental binary operation")))
 return ARITH_INCOMMENSURATE;

-  if ((op1->expr_type == EXPR_OP && op1->ts.type == BT_UNKNOWN)
-  || (op2->expr_type == EXPR_OP && op2->ts.type == BT_UNKNOWN))
-return ARITH_INVALID_TYPE;
-
   head = gfc_constructor_copy (op1->value.constructor);
   for (c = gfc_constructor_first (head),
d = gfc_constructor_first (op2->value.constructor);
@@ -1467,6 +1463,10 @@ static arith
 reduce_binary (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
   gfc_expr *op1, gfc_expr *op2, gfc_expr **result)
 {
+  if ((op1->expr_type == EXPR_OP && op1->ts.type == BT_UNKNOWN)
+  || (op2->expr_type == EXPR_OP && op2->ts.type == BT_UNKNOWN))
+return ARITH_INVALID_TYPE;
+
   if (op1->expr_type == EXPR_CONSTANT && op2->expr_type == EXPR_CONSTANT)
 return eval (op1, op2, result);

However, we cannot remove the checks from reduce_binary_ac
or reduce_binary_ca, as the lengthy testcase proves...

Do you like the above better?

Cheers,
Harald



Re: [PATCH, v2] Fortran: error recovery for invalid types in array constructors [PR107000]

2022-10-06 Thread Harald Anlauf via Gcc-patches
Hi Mikael,

> Gesendet: Donnerstag, 06. Oktober 2022 um 22:14 Uhr
> Von: "Mikael Morin" 
> An: "Harald Anlauf" 
> Cc: "fortran" , "gcc-patches" 
> Betreff: Re: [PATCH, v2] Fortran: error recovery for invalid types in array 
> constructors [PR107000]
>
> Le 05/10/2022 à 23:40, Harald Anlauf a écrit :
> > 
> >> There is one last thing that I'm dissatisfied with.
> >> The handling of unknown types should be moved to reduce_binary, because
> >> the dispatching in reduce_binary doesn't handle EXPR_OP, so even if
> >> either or both operands are scalar, they are handled by the (array vs
> >> array) reduce_binary_aa function.  That's confusing.
> 
> Thinking about it again, I'm not sure my suggestion is right here.
> > 
> > Do you have an example?
> > 
> No.  Actually, I think it works, but a weird way.
> 
> 
> For example, for this case:
> 
> [real :: 2] * [real :: +(.true.)]
> 
> First there is a "root" invocation of reduce binary with arguments [real 
> :: 2] and [real :: +(.true.)]
> The root invocation of reduce_binary will call reduce_binary_aa. This is 
> normal.
> 
> Then reduce_binary_aa calls reduce_binary again with arguments 2 and 
> +(.true.).  And reduce_binary calls again reduce_binary_aa with those 
> arguments.  This is weird, reduce_binary_aa is supposed to have arrays 
> for both arguments.

Am I seeing something different from you?  My gdb says
that one argument of reduce_binary is EXPR_CONSTANT,
the other EXPR_OP and BT_UNKNOWN.  Both rank 0.

> The same goes for the array vs constant case, reduce_binary_ca (or 
> reduce_binary_ac) is invoked with two scalars, while if you look at 
> reduce_binary, you would expect that we only get to reduce_binary_ca 
> with a scalar constant and an array as arguments.
> 
> 
> I think the checks in the three reduce_binary_* functions should be 
> moved into their respective loops, so that we detect the invalid type 
> just before these weird recursive calls instead of just after entering 
> into them.

I think I tried that before, and it didn't work.
There was always one weird case that lead to a bad or
invalid constructor for one of the arrays you want to
look at in the respective loop,  and this is why the
testcase tries to cover everything that I hit then and
there... (hopefully).  So I ended up with the check
before the loop.

What do we actually gain with your suggested change?
Moving the check into the loop does not really make
the code more readable to me.  And the recursion is
needed anyway.

Cheers,
Harald

> OK with that change.
>


Aw: Re: [PATCH, v2] Fortran: reject procedures and procedure pointers as IO element [PR107074]

2022-10-06 Thread Harald Anlauf via Gcc-patches
Hi Mikael,

I definitely agree that we need a temporary for the result of
MERGE(a,a,.true.), I just haven't found out how to do that.

The reason for the bad one-liner was that in gfc_simplify_merge

result = gfc_get_parentheses (result);

actually does have issues, in that the subsequent

  gfc_simplify_expr (result, 1);

seems to fail in interesting cases (as in PR105371).

So that is something to look into...

Cheers,
Harald

> Gesendet: Donnerstag, 06. Oktober 2022 um 22:32 Uhr
> Von: "Mikael Morin" 
> An: "Harald Anlauf" 
> Cc: "gcc-patches" , "fortran" 
> Betreff: Re: [PATCH, v2] Fortran: reject procedures and procedure pointers as 
> IO element [PR107074]
>
> Le 06/10/2022 à 10:37, Mikael Morin a écrit :
> > Le 05/10/2022 à 22:40, Harald Anlauf a écrit :
> >> Hi Mikael,
> >>
> >>> Gesendet: Mittwoch, 05. Oktober 2022 um 12:34 Uhr
> >>> Von: "Mikael Morin" 
> >>> Please move the check to resolve_transfer in resolve.cc.
> >>
> >> I have done this, see attached updated patch.
> >>
> >> Regtests cleanly on x86_64-pc-linux-gnu.
> >>
> >>> Strangely, the patch doesn't seem to fix the problem on the testcase
> >>> here.  There is an outer parenthese expression preventing the condition
> >>> you added from triggering.  Can you double check?
> >>
> >> You are right: I had a one-liner in my worktree from PR105371 that
> >> fixes an issue with gfc_simplify_merge and that seems to help here.
> >> It is now included.
> >>
> > The rest looks good, but I'm not sure about your one-liner.
> > I will try to come with a real test later, but in principle, if you have 
> > a call to FOO(MERGE(A,A,.TRUE.)) you can't simplify it to FOO(A) as 
> > writes to the argument in FOO should not overwrite the content of A. The 
> > dummy should be associated with a temporary value, not to A.
> > 
> Here is a test that your patch breaks.
> Admittedly it's rejected if A has the INTENT(INOUT) attribute, but 
> without it, I think it's allowed.
> 
> program p
>integer :: b
>b = 1
>call foo(merge(b,b,.true.))
>if (b /= 1) stop 1
> contains
>subroutine foo(a)
>  integer :: a
>  if (a == 1) a = 42
>end subroutine foo
> end program p
> 
>


Re: [PATCH, v2] Fortran: error recovery for invalid types in array constructors [PR107000]

2022-10-05 Thread Harald Anlauf via Gcc-patches
Hi Mikael,

> Gesendet: Mittwoch, 05. Oktober 2022 um 11:23 Uhr
> Von: "Mikael Morin" 
> An: "Harald Anlauf" , "fortran" , 
> "gcc-patches" 
> Betreff: Re: [PATCH] Fortran: error recovery for invalid types in array 
> constructors [PR107000]

> The following does.
>
>
> diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
> index e6e35ef3c42..2c57c796270 100644
> --- a/gcc/fortran/arith.cc
> +++ b/gcc/fortran/arith.cc
> @@ -1443,7 +1443,7 @@ reduce_binary_aa (arith (*eval) (gfc_expr *,
> gfc_expr *, gfc_expr **),
>  gfc_replace_expr (c->expr, r);
>   }
>
> -  if (c || d)
> +  if (rc == ARITH_OK && (c || d))
>   rc = ARITH_INCOMMENSURATE;
>
> if (rc != ARITH_OK)

that's great!  It fixes several rather weird cases.  (There is at least
another PR on the incommensurate arrays, but we should not attempt to
fix everything today.)

> There is one last thing that I'm dissatisfied with.
> The handling of unknown types should be moved to reduce_binary, because
> the dispatching in reduce_binary doesn't handle EXPR_OP, so even if
> either or both operands are scalar, they are handled by the (array vs
> array) reduce_binary_aa function.  That's confusing.

Do you have an example?

Anyway, please find attached an updated patch that incorporates your
two changes and regtests fine on x86_64-pc-linux-gnu.

Even if you disagree, I think this is really a significant step
forwards... (error-recovery wise).

OK for mainline?

Thanks,
Harald

From 1b40214b2b538ec176ff6c118770e6e1cc8796ae Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Tue, 4 Oct 2022 23:04:06 +0200
Subject: [PATCH] Fortran: error recovery for invalid types in array
 constructors [PR107000]

gcc/fortran/ChangeLog:

	PR fortran/107000
	* arith.cc (gfc_arith_error): Define error message for
	ARITH_INVALID_TYPE.
	(reduce_unary): Catch arithmetic expressions with invalid type.
	(reduce_binary_ac): Likewise.
	(reduce_binary_ca): Likewise.
	(reduce_binary_aa): Likewise.
	(eval_intrinsic): Likewise.
	(gfc_real2complex): Source expression must be of type REAL.
	* gfortran.h (enum arith): Add ARITH_INVALID_TYPE.

gcc/testsuite/ChangeLog:

	PR fortran/107000
	* gfortran.dg/pr107000.f90: New test.

Co-authored-by: Mikael Morin 
---
 gcc/fortran/arith.cc   | 23 +++-
 gcc/fortran/gfortran.h |  2 +-
 gcc/testsuite/gfortran.dg/pr107000.f90 | 50 ++
 3 files changed, 73 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr107000.f90

diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index d57059a375f..2c57c796270 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -118,6 +118,9 @@ gfc_arith_error (arith code)
 case ARITH_WRONGCONCAT:
   p = G_("Illegal type in character concatenation at %L");
   break;
+case ARITH_INVALID_TYPE:
+  p = G_("Invalid type in arithmetic operation at %L");
+  break;

 default:
   gfc_internal_error ("gfc_arith_error(): Bad error code");
@@ -1261,6 +1264,9 @@ reduce_unary (arith (*eval) (gfc_expr *, gfc_expr **), gfc_expr *op,
   gfc_expr *r;
   arith rc;

+  if (op->expr_type == EXPR_OP && op->ts.type == BT_UNKNOWN)
+return ARITH_INVALID_TYPE;
+
   if (op->expr_type == EXPR_CONSTANT)
 return eval (op, result);

@@ -1302,6 +1308,9 @@ reduce_binary_ac (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
   gfc_expr *r;
   arith rc = ARITH_OK;

+  if (op1->expr_type == EXPR_OP && op1->ts.type == BT_UNKNOWN)
+return ARITH_INVALID_TYPE;
+
   head = gfc_constructor_copy (op1->value.constructor);
   for (c = gfc_constructor_first (head); c; c = gfc_constructor_next (c))
 {
@@ -1354,6 +1363,9 @@ reduce_binary_ca (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
   gfc_expr *r;
   arith rc = ARITH_OK;

+  if (op2->expr_type == EXPR_OP && op2->ts.type == BT_UNKNOWN)
+return ARITH_INVALID_TYPE;
+
   head = gfc_constructor_copy (op2->value.constructor);
   for (c = gfc_constructor_first (head); c; c = gfc_constructor_next (c))
 {
@@ -1414,6 +1426,10 @@ reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
   if (!gfc_check_conformance (op1, op2, _("elemental binary operation")))
 return ARITH_INCOMMENSURATE;

+  if ((op1->expr_type == EXPR_OP && op1->ts.type == BT_UNKNOWN)
+  || (op2->expr_type == EXPR_OP && op2->ts.type == BT_UNKNOWN))
+return ARITH_INVALID_TYPE;
+
   head = gfc_constructor_copy (op1->value.constructor);
   for (c = gfc_constructor_first (head),
d = gfc_constructor_first (op2->value.constructor);
@@ -1427,7 +1443,7 @@ reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
 	gfc_replace_expr (c->expr, r);
   

Re: [PATCH, v2] Fortran: reject procedures and procedure pointers as IO element [PR107074]

2022-10-05 Thread Harald Anlauf via Gcc-patches
Hi Mikael,

> Gesendet: Mittwoch, 05. Oktober 2022 um 12:34 Uhr
> Von: "Mikael Morin" 
> Please move the check to resolve_transfer in resolve.cc.

I have done this, see attached updated patch.

Regtests cleanly on x86_64-pc-linux-gnu.

> Strangely, the patch doesn't seem to fix the problem on the testcase
> here.  There is an outer parenthese expression preventing the condition
> you added from triggering.  Can you double check?

You are right: I had a one-liner in my worktree from PR105371 that
fixes an issue with gfc_simplify_merge and that seems to help here.
It is now included.

> If we take the standard to the letter, only output items are forbidden,
> so a check is missing for writing context.  I don't know how it can work
> for input items though, so maybe not worth it.  In any case, the error
> shouldn't mention output items in reading context.
>
> Here is a variant of the testcase with procedure pointer components,
> that fails differently but can probably be caught as well.
>
> program p
>implicit none
>type :: t
>  procedure(f), pointer, nopass :: b
>end type t
>type(t) :: a
>
>interface
>  real function f()
>  end function f
>end interface
>
>print *, merge (a%b, a%b, .true.)
> end

I hadn't thought about this, and found a solution that also fixes this
one.  Great example!  This is now an additional test.

OK for mainline?

And thanks for your comments!

Harald

From 70cba7da18023282546b9a5d80e976fc3744d732 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Wed, 5 Oct 2022 22:25:14 +0200
Subject: [PATCH] Fortran: reject procedures and procedure pointers as IO
 element [PR107074]

gcc/fortran/ChangeLog:

	PR fortran/107074
	* resolve.cc (resolve_transfer): A procedure, type-bound procedure
	or a procedure pointer cannot be an element of an IO list.
	* simplify.cc (gfc_simplify_merge): Do not try to reset array lower
	bound for scalars.

gcc/testsuite/ChangeLog:

	PR fortran/107074
	* gfortran.dg/pr107074.f90: New test.
	* gfortran.dg/pr107074b.f90: New test.
---
 gcc/fortran/resolve.cc  | 31 +
 gcc/fortran/simplify.cc |  3 ++-
 gcc/testsuite/gfortran.dg/pr107074.f90  | 11 +
 gcc/testsuite/gfortran.dg/pr107074b.f90 | 18 ++
 4 files changed, 62 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr107074.f90
 create mode 100644 gcc/testsuite/gfortran.dg/pr107074b.f90

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index d133bc2d034..d9d101775f6 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -10137,6 +10137,37 @@ resolve_transfer (gfc_code *code)
 		 "an assumed-size array", &code->loc);
   return;
 }
+
+  /* Check for procedures and procedure pointers.  Fortran 2018 has:
+
+ C1233 (R1217) An expression that is an output-item shall not have a
+ value that is a procedure pointer.
+
+ There does not appear any reason to allow procedure pointers for
+ input, so we disallow them generally, and we reject procedures.  */
+
+  if (exp->expr_type == EXPR_VARIABLE)
+{
+  /* Check for type-bound procedures.  */
+  for (ref = exp->ref; ref; ref = ref->next)
+	if (ref->type == REF_COMPONENT
+	&& ref->u.c.component->attr.flavor == FL_PROCEDURE)
+	  break;
+
+  /* Procedure or procedure pointer?  */
+  if (exp->ts.type == BT_PROCEDURE
+	  || (ref && ref->u.c.component->attr.flavor == FL_PROCEDURE))
+	{
+	  if (exp->symtree->n.sym->attr.proc_pointer
+	  || (ref && ref->u.c.component->attr.proc_pointer))
+	gfc_error ("Data transfer element at %L cannot be a procedure "
+		   "pointer", &code->loc);
+	  else
+	gfc_error ("Data transfer element at %L cannot be a procedure",
+		   &code->loc);
+	  return;
+	}
+}
 }


diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 6ac92cf9db8..f0482d349af 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -4915,7 +4915,8 @@ gfc_simplify_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask)
 {
   result = gfc_copy_expr (mask->value.logical ? tsource : fsource);
   /* Parenthesis is needed to get lower bounds of 1.  */
-  result = gfc_get_parentheses (result);
+  if (result->rank)
+	result = gfc_get_parentheses (result);
   gfc_simplify_expr (result, 1);
   return result;
 }
diff --git a/gcc/testsuite/gfortran.dg/pr107074.f90 b/gcc/testsuite/gfortran.dg/pr107074.f90
new file mode 100644
index 000..1363c285912
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr107074.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! PR fortran/107074 - ICE: Bad IO basetype (8)
+! Contributed by G.Steinmetz
+
+program p
+  implicit none
+  i

[PATCH] Fortran: error recovery for invalid types in array constructors [PR107000]

2022-10-04 Thread Harald Anlauf via Gcc-patches
Dear all,

we did not recover well from bad expressions in array constructors,
especially when there was a typespec and a unary '+' or '-', and
when the array constructor was used in an arithmetic expression.

The attached patch introduces an ARITH_INVALID_TYPE that is used
when we try to recover from these errors, and tries to handle
all unary and binary arithmetic expressions.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

From ad892a270c504def2f8f84494d5c7bcba9aef27f Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Tue, 4 Oct 2022 23:04:06 +0200
Subject: [PATCH] Fortran: error recovery for invalid types in array
 constructors [PR107000]

gcc/fortran/ChangeLog:

	PR fortran/107000
	* arith.cc (gfc_arith_error): Define error message for
	ARITH_INVALID_TYPE.
	(reduce_unary): Catch arithmetic expressions with invalid type.
	(reduce_binary_ac): Likewise.
	(reduce_binary_ca): Likewise.
	(reduce_binary_aa): Likewise.
	(gfc_real2complex): Source expression must be of type REAL.
	* gfortran.h (enum arith): Add ARITH_INVALID_TYPE.

gcc/testsuite/ChangeLog:

	PR fortran/107000
	* gfortran.dg/pr107000.f90: New test.
---
 gcc/fortran/arith.cc   | 19 ++
 gcc/fortran/gfortran.h |  2 +-
 gcc/testsuite/gfortran.dg/pr107000.f90 | 50 ++
 3 files changed, 70 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr107000.f90

diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index d57059a375f..e6e35ef3c42 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -118,6 +118,9 @@ gfc_arith_error (arith code)
 case ARITH_WRONGCONCAT:
   p = G_("Illegal type in character concatenation at %L");
   break;
+case ARITH_INVALID_TYPE:
+  p = G_("Invalid type in arithmetic operation at %L");
+  break;

 default:
   gfc_internal_error ("gfc_arith_error(): Bad error code");
@@ -1261,6 +1264,9 @@ reduce_unary (arith (*eval) (gfc_expr *, gfc_expr **), gfc_expr *op,
   gfc_expr *r;
   arith rc;

+  if (op->expr_type == EXPR_OP && op->ts.type == BT_UNKNOWN)
+return ARITH_INVALID_TYPE;
+
   if (op->expr_type == EXPR_CONSTANT)
 return eval (op, result);

@@ -1302,6 +1308,9 @@ reduce_binary_ac (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
   gfc_expr *r;
   arith rc = ARITH_OK;

+  if (op1->expr_type == EXPR_OP && op1->ts.type == BT_UNKNOWN)
+return ARITH_INVALID_TYPE;
+
   head = gfc_constructor_copy (op1->value.constructor);
   for (c = gfc_constructor_first (head); c; c = gfc_constructor_next (c))
 {
@@ -1354,6 +1363,9 @@ reduce_binary_ca (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
   gfc_expr *r;
   arith rc = ARITH_OK;

+  if (op2->expr_type == EXPR_OP && op2->ts.type == BT_UNKNOWN)
+return ARITH_INVALID_TYPE;
+
   head = gfc_constructor_copy (op2->value.constructor);
   for (c = gfc_constructor_first (head); c; c = gfc_constructor_next (c))
 {
@@ -1414,6 +1426,10 @@ reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
   if (!gfc_check_conformance (op1, op2, _("elemental binary operation")))
 return ARITH_INCOMMENSURATE;

+  if ((op1->expr_type == EXPR_OP && op1->ts.type == BT_UNKNOWN)
+  || (op2->expr_type == EXPR_OP && op2->ts.type == BT_UNKNOWN))
+return ARITH_INVALID_TYPE;
+
   head = gfc_constructor_copy (op1->value.constructor);
   for (c = gfc_constructor_first (head),
d = gfc_constructor_first (op2->value.constructor);
@@ -2238,6 +2254,9 @@ gfc_real2complex (gfc_expr *src, int kind)
   arith rc;
   bool did_warn = false;

+  if (src->ts.type != BT_REAL)
+return NULL;
+
   result = gfc_get_constant_expr (BT_COMPLEX, kind, &src->where);

   mpc_set_fr (result->value.complex, src->value.real, GFC_MPC_RND_MODE);
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 4babd77924b..fc0aa51df57 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -226,7 +226,7 @@ enum gfc_intrinsic_op
 enum arith
 { ARITH_OK = 1, ARITH_OVERFLOW, ARITH_UNDERFLOW, ARITH_NAN,
   ARITH_DIV0, ARITH_INCOMMENSURATE, ARITH_ASYMMETRIC, ARITH_PROHIBIT,
-  ARITH_WRONGCONCAT
+  ARITH_WRONGCONCAT, ARITH_INVALID_TYPE
 };

 /* Statements.  */
diff --git a/gcc/testsuite/gfortran.dg/pr107000.f90 b/gcc/testsuite/gfortran.dg/pr107000.f90
new file mode 100644
index 000..c13627f556b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr107000.f90
@@ -0,0 +1,50 @@
+! { dg-do compile }
+! PR fortran/107000 - ICE in gfc_real2complex, reduce_unary, reduce_binary_*
+! Contributed by G.Steinmetz
+
+program p
+  real:: y(1)
+  complex :: x(1)
+  x = (1.0, 2.0) * [real :: -'1'] ! { dg-error "Operand of unary numeric operator" }
+  x = (1.0, 2.0) * [complex :: +'1'] ! { dg-error "Invalid type" }
+  x = [complex :: -

[PATCH] Fortran: reject procedures and procedure pointers as output item [PR107074]

2022-10-04 Thread Harald Anlauf via Gcc-patches
Dear all,

when looking at output item lists we didn't catch procedures
and procedure pointers and ran into a gfc_internal_error().
Such items are not allowed by the Fortran standard, e.g. for
procedure pointers there is

C1233 (R1217) An expression that is an output-item shall not
  have a value that is a procedure pointer.

Attached patch generates an error instead.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

From 3b15fe83830c1e75339114e0241e9d2158393017 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Tue, 4 Oct 2022 21:19:21 +0200
Subject: [PATCH] Fortran: reject procedures and procedure pointers as output
 item [PR107074]

gcc/fortran/ChangeLog:

	PR fortran/107074
	* trans-io.cc (transfer_expr): A procedure or a procedure pointer
	cannot be output items.

gcc/testsuite/ChangeLog:

	PR fortran/107074
	* gfortran.dg/pr107074.f90: New test.
---
 gcc/fortran/trans-io.cc| 14 ++
 gcc/testsuite/gfortran.dg/pr107074.f90 | 11 +++
 2 files changed, 25 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/pr107074.f90

diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index 9f86815388c..c4e1537eed6 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -2430,6 +2430,20 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr,

   break;

+case BT_PROCEDURE:
+  if (code->expr1
+	  && code->expr1->symtree
+	  && code->expr1->symtree->n.sym)
+	{
+	  if (code->expr1->symtree->n.sym->attr.proc_pointer)
+	gfc_error ("Procedure pointer at %C cannot be an output item");
+	  else
+	gfc_error ("Procedure at %C cannot be an output item");
+	  return;
+	}
+  /* If a PROCEDURE item gets through to here, fall through and ICE.  */
+  gcc_fallthrough ();
+
 case_bt_struct:
 case BT_CLASS:
   if (gfc_bt_struct (ts->type) || ts->type == BT_CLASS)
diff --git a/gcc/testsuite/gfortran.dg/pr107074.f90 b/gcc/testsuite/gfortran.dg/pr107074.f90
new file mode 100644
index 000..a09088c2e9d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr107074.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! PR fortran/107074 - ICE: Bad IO basetype (8)
+! Contributed by G.Steinmetz
+
+program p
+  implicit none
+  integer, external:: a
+  procedure(real), pointer :: b
+  print *, merge (a, a, .true.) ! { dg-error "Procedure" }
+  print *, merge (b, b, .true.) ! { dg-error "Procedure pointer" }
+end
--
2.35.3



Re: [PATCH RESEND 1/1] p1689r5: initial support

2022-10-04 Thread Harald Anlauf via Gcc-patches

Am 04.10.22 um 17:12 schrieb Ben Boeckel:

This patch implements support for [P1689R5][] to communicate to a build
system the C++20 module dependencies to build systems so that they may
build `.gcm` files in the proper order.


Is there a reason that you are touching so many frontends?


diff --git a/gcc/fortran/cpp.cc b/gcc/fortran/cpp.cc
index 364bd0d2a85..0b9df9c02cd 100644
--- a/gcc/fortran/cpp.cc
+++ b/gcc/fortran/cpp.cc
@@ -712,7 +712,7 @@ gfc_cpp_done (void)
  FILE *f = fopen (gfc_cpp_option.deps_filename, "w");
  if (f)
{
- cpp_finish (cpp_in, f);
+ cpp_finish (cpp_in, f, NULL);
  fclose (f);
}
  else
@@ -721,7 +721,7 @@ gfc_cpp_done (void)
 xstrerror (errno));
}
else
-   cpp_finish (cpp_in, stdout);
+   cpp_finish (cpp_in, stdout, NULL);
  }

cpp_undef_all (cpp_in);


Couldn't you simply default the third argument of cpp_finish() to NULL?


diff --git a/libcpp/include/cpplib.h b/libcpp/include/cpplib.h
index 2db1e9cbdfb..90787230a9e 100644
--- a/libcpp/include/cpplib.h
+++ b/libcpp/include/cpplib.h
@@ -298,6 +298,9 @@ typedef CPPCHAR_SIGNED_T cppchar_signed_t;
  /* Style of header dependencies to generate.  */
  enum cpp_deps_style { DEPS_NONE = 0, DEPS_USER, DEPS_SYSTEM };

+/* Format of header dependencies to generate.  */
+enum cpp_deps_format { DEPS_FMT_NONE = 0, DEPS_FMT_P1689R5 };
+
  /* The possible normalization levels, from most restrictive to least.  */
  enum cpp_normalize_level {
/* In NFKC.  */
@@ -581,6 +584,9 @@ struct cpp_options
  /* Style of header dependencies to generate.  */
  enum cpp_deps_style style;

+/* Format of header dependencies to generate.  */
+enum cpp_deps_format format;
+
  /* Assume missing files are generated files.  */
  bool missing_files;

@@ -1104,9 +1110,9 @@ extern void cpp_post_options (cpp_reader *);
  extern void cpp_init_iconv (cpp_reader *);

  /* Call this to finish preprocessing.  If you requested dependency
-   generation, pass an open stream to write the information to,
-   otherwise NULL.  It is your responsibility to close the stream.  */
-extern void cpp_finish (cpp_reader *, FILE *deps_stream);
+   generation, pass open stream(s) to write the information to,
+   otherwise NULL.  It is your responsibility to close the stream(s).  */
+extern void cpp_finish (cpp_reader *, FILE *deps_stream, FILE *fdeps_stream);

 ^^^


  /* Call this to release the handle at the end of preprocessing.  Any
 use of the handle after this function returns is invalid.  */





[PATCH] Fortran: error recovery while simplifying intrinsic UNPACK [PR107054]

2022-09-27 Thread Harald Anlauf via Gcc-patches
Dear all,

invalid input may trigger an assert while trying to simplify an
expression involving the intrinsic UNPACK and when the constructor
is lacking sufficient valid elements.  The obvious solution is to
replace the assert by a condition that terminates simplification
in that case.

Report and testcase by Gerhard.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

This is a 10/11/12/13 regression and shall be backported.

Thanks,
Harald

From 80285cdad1fe98c52ebf38f9f66070b2a50191c6 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Tue, 27 Sep 2022 20:54:28 +0200
Subject: [PATCH] Fortran: error recovery while simplifying intrinsic UNPACK
 [PR107054]

gcc/fortran/ChangeLog:

	PR fortran/107054
	* simplify.cc (gfc_simplify_unpack): Replace assert by condition
	that terminates simplification when there are not enough elements
	in the constructor of argument VECTOR.

gcc/testsuite/ChangeLog:

	PR fortran/107054
	* gfortran.dg/pr107054.f90: New test.
---
 gcc/fortran/simplify.cc| 13 ++---
 gcc/testsuite/gfortran.dg/pr107054.f90 | 13 +
 2 files changed, 23 insertions(+), 3 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr107054.f90

diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index c0fbd0ed7c2..6ac92cf9db8 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -8458,9 +8458,16 @@ gfc_simplify_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field)
 {
   if (mask_ctor->expr->value.logical)
 	{
-	  gcc_assert (vector_ctor);
-	  e = gfc_copy_expr (vector_ctor->expr);
-	  vector_ctor = gfc_constructor_next (vector_ctor);
+	  if (vector_ctor)
+	{
+	  e = gfc_copy_expr (vector_ctor->expr);
+	  vector_ctor = gfc_constructor_next (vector_ctor);
+	}
+	  else
+	{
+	  gfc_free_expr (result);
+	  return NULL;
+	}
 	}
   else if (field->expr_type == EXPR_ARRAY)
 	e = gfc_copy_expr (field_ctor->expr);
diff --git a/gcc/testsuite/gfortran.dg/pr107054.f90 b/gcc/testsuite/gfortran.dg/pr107054.f90
new file mode 100644
index 000..bbfe646beba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr107054.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! PR fortran/107054 - ICE in gfc_simplify_unpack
+! Contributed by G.Steinmetz
+
+program p
+  type t
+ integer :: n = 0
+  end type
+  type(t), parameter :: a(4) = t(2)
+  type(t), parameter :: b(4) = reshape(a,[2]) ! { dg-error "Different shape" }
+  type(t), parameter :: c(2) = pack(b,[.false.,.true.,.false.,.true.]) ! { dg-error "Different shape" }
+  type(t), parameter :: d(4) = unpack(c,[.false.,.true.,.false.,.true.],a)
+end
--
2.35.3



Proxy ping [PATCH] Fortran: Fix ICE and wrong code for assumed-rank arrays [PR100029, PR100040]

2022-09-25 Thread Harald Anlauf via Gcc-patches
Dear all,

the patch for these PRs was submitted for review by Jose here:

  https://gcc.gnu.org/pipermail/fortran/2021-April/055924.html

but unfortunately was never reviewed.

I verified that the rebased patch still works on mainline and
x86_64-pc-linux-gnu, and I think that it is fine.  It is also
very simple and clear, but I repost it here to give others a
chance to provide comments.

The commit message needed a small correction to make it acceptable
to "git gcc-verify", but besides some whitespace-like changes and
clarifications this is Jose's patch.

OK for mainline?

Thanks,
Harald

From b3279399bbdd04f48eab82dcc3f2b2aba5a9b0a3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?=
 
Date: Sun, 25 Sep 2022 22:48:55 +0200
Subject: [PATCH] Fortran: Fix ICE and wrong code for assumed-rank arrays
 [PR100029, PR100040]

gcc/fortran/ChangeLog:

	PR fortran/100040
	PR fortran/100029
	* trans-expr.cc (gfc_conv_class_to_class): Add code to have
	assumed-rank arrays recognized as full arrays and fix the type
	of the array assignment.
	(gfc_conv_procedure_call): Change order of code blocks such that
	the free of ALLOCATABLE dummy arguments with INTENT(OUT) occurs
	first.

gcc/testsuite/ChangeLog:

	PR fortran/100029
	* gfortran.dg/PR100029.f90: New test.

	PR fortran/100040
	* gfortran.dg/PR100040.f90: New test.
---
 gcc/fortran/trans-expr.cc  | 48 +++---
 gcc/testsuite/gfortran.dg/PR100029.f90 | 22 
 gcc/testsuite/gfortran.dg/PR100040.f90 | 36 +++
 3 files changed, 85 insertions(+), 21 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/PR100029.f90
 create mode 100644 gcc/testsuite/gfortran.dg/PR100040.f90

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 4f3ae82d39c..1551a2e4df4 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1178,8 +1178,10 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
 return;

   /* Test for FULL_ARRAY.  */
-  if (e->rank == 0 && gfc_expr_attr (e).codimension
-  && gfc_expr_attr (e).dimension)
+  if (e->rank == 0
+  && ((gfc_expr_attr (e).codimension && gfc_expr_attr (e).dimension)
+	  || (class_ts.u.derived->components->as
+	  && class_ts.u.derived->components->as->type == AS_ASSUMED_RANK)))
 full_array = true;
   else
 gfc_is_class_array_ref (e, &full_array);
@@ -1227,8 +1229,12 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
 	  && e->rank != class_ts.u.derived->components->as->rank)
 	{
 	  if (e->rank == 0)
-	gfc_add_modify (&parmse->post, gfc_class_data_get (parmse->expr),
-			gfc_conv_descriptor_data_get (ctree));
+	{
+	  tmp = gfc_class_data_get (parmse->expr);
+	  gfc_add_modify (&parmse->post, tmp,
+			  fold_convert (TREE_TYPE (tmp),
+	 gfc_conv_descriptor_data_get (ctree)));
+	}
 	  else
 	class_array_data_assign (&parmse->post, parmse->expr, ctree, true);
 	}
@@ -6560,23 +6566,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		base_object = build_fold_indirect_ref_loc (input_location,
 			   parmse.expr);

-		  /* A class array element needs converting back to be a
-		 class object, if the formal argument is a class object.  */
-		  if (fsym && fsym->ts.type == BT_CLASS
-			&& e->ts.type == BT_CLASS
-			&& ((CLASS_DATA (fsym)->as
-			 && CLASS_DATA (fsym)->as->type == AS_ASSUMED_RANK)
-			|| CLASS_DATA (e)->attr.dimension))
-		gfc_conv_class_to_class (&parmse, e, fsym->ts, false,
- fsym->attr.intent != INTENT_IN
- && (CLASS_DATA (fsym)->attr.class_pointer
-	 || CLASS_DATA (fsym)->attr.allocatable),
- fsym->attr.optional
- && e->expr_type == EXPR_VARIABLE
- && e->symtree->n.sym->attr.optional,
- CLASS_DATA (fsym)->attr.class_pointer
- || CLASS_DATA (fsym)->attr.allocatable);
-
 		  /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
 		 allocated on entry, it must be deallocated.  */
 		  if (fsym && fsym->attr.intent == INTENT_OUT
@@ -6637,6 +6626,23 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		  gfc_add_expr_to_block (&se->pre, tmp);
 		}

+		  /* A class array element needs converting back to be a
+		 class object, if the formal argument is a class object.  */
+		  if (fsym && fsym->ts.type == BT_CLASS
+			&& e->ts.type == BT_CLASS
+			&& ((CLASS_DATA (fsym)->as
+			 && CLASS_DATA (fsym)->as->type == AS_ASSUMED_RANK)
+			|| CLASS_DATA (e)->attr.dimension))
+		gfc_conv_class_to_class (&parmse, e, fsym->ts, false,
+ fsym->attr.intent != INTENT_IN
+ && (CLASS_DATA (fsym)->attr.class_pointer
+	 || CLASS_DATA (fsym)->attr.allocatable),
+ fsym->attr.optional
+ && e->expr_type == EXPR_VARIABLE
+ && e->symtree->n.sym->attr.optional,
+ CLASS_DATA (fsym)->attr.class_pointer
+ || CLASS_DATA (fsym)->attr.allo

Proxy ping [PATCH] Fortran: Fix automatic reallocation inside select rank [PR100103]

2022-09-21 Thread Harald Anlauf via Gcc-patches
Dear all,

the patch for this PR was submitted for review by Jose here:

  https://gcc.gnu.org/pipermail/fortran/2021-April/055934.html

but unfortunately was never reviewed.

I verified that it works on mainline and x86_64-pc-linux-gnu,
and I think that it is fine.

Although the above mail suggests that there is a dependency
on the fix for another PR with a rather lengthy patch,
it appears that this is no longer the case.  It might be
that the fix for PR100245 (another reallocation issue)
already did the necessary job.

So OK for mainline?

Thanks,
Harald

From 6c93c5058f552f47a3d828d3fb19cca652901299 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?=
 
Date: Wed, 21 Sep 2022 22:55:02 +0200
Subject: [PATCH] Fortran: Fix automatic reallocation inside select rank
 [PR100103]

gcc/fortran/ChangeLog:

	PR fortran/100103
	* trans-array.cc (gfc_is_reallocatable_lhs): Add select rank
	temporary associate names as possible targets of automatic
	reallocation.

gcc/testsuite/ChangeLog:

	PR fortran/100103
	* gfortran.dg/PR100103.f90: New test.
---
 gcc/fortran/trans-array.cc |  4 +-
 gcc/testsuite/gfortran.dg/PR100103.f90 | 76 ++
 2 files changed, 78 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/PR100103.f90

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 05134952db4..795ce14af08 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -10378,7 +10378,7 @@ gfc_is_reallocatable_lhs (gfc_expr *expr)

   /* An allocatable class variable with no reference.  */
   if (sym->ts.type == BT_CLASS
-  && !sym->attr.associate_var
+  && (!sym->attr.associate_var || sym->attr.select_rank_temporary)
   && CLASS_DATA (sym)->attr.allocatable
   && expr->ref
   && ((expr->ref->type == REF_ARRAY && expr->ref->u.ar.type == AR_FULL
@@ -10393,7 +10393,7 @@ gfc_is_reallocatable_lhs (gfc_expr *expr)

   /* An allocatable variable.  */
   if (sym->attr.allocatable
-  && !sym->attr.associate_var
+  && (!sym->attr.associate_var || sym->attr.select_rank_temporary)
   && expr->ref
   && expr->ref->type == REF_ARRAY
   && expr->ref->u.ar.type == AR_FULL)
diff --git a/gcc/testsuite/gfortran.dg/PR100103.f90 b/gcc/testsuite/gfortran.dg/PR100103.f90
new file mode 100644
index 000..21405610a71
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100103.f90
@@ -0,0 +1,76 @@
+! { dg-do run }
+!
+! Test the fix for PR100103
+!
+
+program main_p
+  implicit none
+
+  integer:: i
+  integer, parameter :: n = 11
+
+  type :: foo_t
+integer :: i
+  end type foo_t
+
+  type(foo_t), parameter :: a(*) = [(foo_t(i), i=1,n)]
+
+  type(foo_t),  allocatable :: bar_d(:)
+  class(foo_t), allocatable :: bar_p(:)
+  class(*), allocatable :: bar_u(:)
+
+
+  call foo_d(bar_d)
+  if(.not.allocated(bar_d)) stop 1
+  if(any(bar_d%i/=a%i)) stop 2
+  deallocate(bar_d)
+  call foo_p(bar_p)
+  if(.not.allocated(bar_p)) stop 3
+  if(any(bar_p%i/=a%i)) stop 4
+  deallocate(bar_p)
+  call foo_u(bar_u)
+  if(.not.allocated(bar_u)) stop 5
+  select type(bar_u)
+  type is(foo_t)
+if(any(bar_u%i/=a%i)) stop 6
+  class default
+stop 7
+  end select
+  deallocate(bar_u)
+
+contains
+
+  subroutine foo_d(that)
+type(foo_t), allocatable, intent(out) :: that(..)
+
+select rank(that)
+rank(1)
+  that = a
+rank default
+  stop 8
+end select
+  end subroutine foo_d
+
+  subroutine foo_p(that)
+class(foo_t), allocatable, intent(out) :: that(..)
+
+select rank(that)
+rank(1)
+  that = a
+rank default
+  stop 9
+end select
+  end subroutine foo_p
+
+  subroutine foo_u(that)
+class(*), allocatable, intent(out) :: that(..)
+
+select rank(that)
+rank(1)
+  that = a
+rank default
+  stop 10
+end select
+  end subroutine foo_u
+
+end program main_p
--
2.35.3



Re: [PATCH 09/10] fortran: Support clobbering of variable subreferences [PR88364]

2022-09-21 Thread Harald Anlauf via Gcc-patches

Hi Mikael,

Am 21.09.22 um 20:56 schrieb Mikael Morin:

Le 21/09/2022 à 11:57, Thomas Koenig a écrit :


Hi Harald,


I think I understand much of what is said, but I feel that I do
not really understand what *clobber* means for the different
beasts we are discussing (although I have an impression of what
it means for a scalar object).




More seriously: My understanding of a clobber it is a hint to
the middle end that the value in question will not be used,
and that operations leading to this value can be removed,
unless they are used otherwise.


My understanding is that "clobber" means "overwrite with garbage" for
all the beasts we have been discussing, which translates to nothing in
the final code, but can be used by the optimizers as Thomas said.

This is a bit off-topic but clobbers model registers having their values
changed unpredictably or by ways unknown to the compiler, in the backend
code, or in inline assembly statements.
Here is an excerpt from rtl.texi:

@item (clobber @var{x})
Represents the storing or possible storing of an unpredictable,
undescribed value into @var{x}


ah, I missed that file.  I only found references to assembly,
and references to registers etc. were not really helpful here.

It also says:

> If @var{x} is @code{(mem:BLK (const_int 0))} or
> @code{(mem:BLK (scratch))}, it means that all memory
> locations must be presumed clobbered.  ...

so this goes into the direction I was thinking of.


I Hope it helps.





[PATCH] Fortran: fix ICE in generate_coarray_sym_init [PR82868]

2022-09-21 Thread Harald Anlauf via Gcc-patches
Dear all,

I intend to commit the attached, obvious patch for a NULL pointer
dereference until tomorrow unless there are comments or objections.
We better skip initialization for a symbol which is an associate name.

Regtested on x86_64-pc-linux-gnu.

Thanks,
Harald

From 0259762271b2eb430e058b0bff4d7b11513c48c4 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Wed, 21 Sep 2022 19:55:30 +0200
Subject: [PATCH] Fortran: fix ICE in generate_coarray_sym_init [PR82868]

gcc/fortran/ChangeLog:

	PR fortran/82868
	* trans-decl.cc (generate_coarray_sym_init): Skip symbol
	if attr.associate_var.

gcc/testsuite/ChangeLog:

	PR fortran/82868
	* gfortran.dg/associate_26a.f90: New test.
---
 gcc/fortran/trans-decl.cc   |  1 +
 gcc/testsuite/gfortran.dg/associate_26a.f90 | 15 +++
 2 files changed, 16 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/associate_26a.f90

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 908a4c6d42e..5d16d640322 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -5529,6 +5529,7 @@ generate_coarray_sym_init (gfc_symbol *sym)

   if (sym->attr.dummy || sym->attr.allocatable || !sym->attr.codimension
   || sym->attr.use_assoc || !sym->attr.referenced
+  || sym->attr.associate_var
   || sym->attr.select_type_temporary)
 return;

diff --git a/gcc/testsuite/gfortran.dg/associate_26a.f90 b/gcc/testsuite/gfortran.dg/associate_26a.f90
new file mode 100644
index 000..85aebebd4d8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_26a.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib" }
+!
+! Test the fix for PR78152 and the followup in PR82868
+!
+! Contributed by 
+!
+program co_assoc
+  implicit none
+  integer, parameter :: p = 5
+  real, allocatable :: a(:,:)[:,:]
+  allocate (a(p,p)[2,*])
+  associate (i => a(1:p, 1:p))
+  end associate
+end program co_assoc
--
2.35.3



Re: [PATCH 09/10] fortran: Support clobbering of variable subreferences [PR88364]

2022-09-20 Thread Harald Anlauf via Gcc-patches

Am 19.09.22 um 22:50 schrieb Mikael Morin:

Le 19/09/2022 à 21:46, Harald Anlauf a écrit :

Am 18.09.22 um 22:55 schrieb Mikael Morin:

Le 18/09/2022 à 20:32, Harald Anlauf a écrit :


Assumed shape will be on the easy side,
while assumed size likely needs to be excluded for clobbering.


Isn’t it the converse that is true?
Assumed shape can be non-contiguous so have to be excluded, but assumed
size are contiguous, so valid candidates for clobbering. No?


I really was referring here to *dummies*, as in the following example:

program p
   integer :: a(4)
   a = 1
   call sub (a(1), 2)
   print *, a
contains
   subroutine sub (b, k)
 integer, intent(in)  :: k
 integer, intent(out) :: b(*)
!   integer, intent(out) :: b(k)
 if (k > 2) b(k) = k
   end subroutine sub
end program p

Assumed size (*) is just a contiguous hunk of memory of possibly
unknown size, which can be zero.  So you couldn't set a clobber
for the a(1) actual argument.


Couldn't you clobber A entirely?  If no element of B is initialized in
SUB, well, A has undefined values on return from SUB.  That's how
INTENT(OUT) works.



I think I understand much of what is said, but I feel that I do
not really understand what *clobber* means for the different
beasts we are discussing (although I have an impression of what
it means for a scalar object).



[PATCH, committed] Fortran: error recovery on invalid ARRAY argument to FINDLOC [PR106986]

2022-09-20 Thread Harald Anlauf via Gcc-patches
Dear all,

we ICE'd in the simplification of FINDLOC when the passed
ARRAY argument had an invalid declaration.  The reason was
a reference to array->shape which was NULL.

Obvious solution: then just don't attempt to simplify.

Regtested on x86_64-pc-linux-gnu and pushed to mainline as

https://gcc.gnu.org/g:5976fbf9d5dd9542fcb82eebb2185886fd52d000

The PR is marked as a 10/11/12/13 regression, thus I plan to
backport.

Thanks,
Harald

From 5976fbf9d5dd9542fcb82eebb2185886fd52d000 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Tue, 20 Sep 2022 22:41:48 +0200
Subject: [PATCH] Fortran: error recovery on invalid ARRAY argument to FINDLOC
 [PR106986]

gcc/fortran/ChangeLog:

	PR fortran/106986
	* simplify.cc (gfc_simplify_findloc): Do not try to simplify
	intrinsic FINDLOC when the ARRAY argument has a NULL shape.

gcc/testsuite/ChangeLog:

	PR fortran/106986
	* gfortran.dg/pr106986.f90: New test.
---
 gcc/fortran/simplify.cc| 1 +
 gcc/testsuite/gfortran.dg/pr106986.f90 | 8 
 2 files changed, 9 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/pr106986.f90

diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 140c17721a7..c0fbd0ed7c2 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -5895,6 +5895,7 @@ gfc_simplify_findloc (gfc_expr *array, gfc_expr *value, gfc_expr *dim,
   bool back_val = false;

   if (!is_constant_array_expr (array)
+  || array->shape == NULL
   || !gfc_is_constant_expr (dim))
 return NULL;

diff --git a/gcc/testsuite/gfortran.dg/pr106986.f90 b/gcc/testsuite/gfortran.dg/pr106986.f90
new file mode 100644
index 000..a309b25d181
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr106986.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! PR fortran/106986 - ICE in simplify_findloc_nodim
+! Contributed by G.Steinmetz
+
+program p
+  integer, parameter :: a(:) = [1] ! { dg-error "deferred shape" }
+  print *, findloc (a, 1)
+end
--
2.35.3



[PATCH, committed] Fortran: NULL pointer dereference in invalid simplification [PR106985]

2022-09-20 Thread Harald Anlauf via Gcc-patches
Dear all,

Gerhard found a NULL pointer dereference in a PARAMETER declaration
that referenced the same declared parameter.

Simple & obvious enough, see attached patch.

Regtested on x86_64-pc-linux-gnu, and pushed to mainline:

https://gcc.gnu.org/g:8dbb15bc2d019488240c1e69d93121b0347ac092

Thanks,
Harald

From 8dbb15bc2d019488240c1e69d93121b0347ac092 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Tue, 20 Sep 2022 22:23:43 +0200
Subject: [PATCH] Fortran: NULL pointer dereference in invalid simplification
 [PR106985]

gcc/fortran/ChangeLog:

	PR fortran/106985
	* expr.cc (gfc_simplify_expr): Avoid NULL pointer dereference.

gcc/testsuite/ChangeLog:

	PR fortran/106985
	* gfortran.dg/pr106985.f90: New test.
---
 gcc/fortran/expr.cc| 3 ++-
 gcc/testsuite/gfortran.dg/pr106985.f90 | 8 
 2 files changed, 10 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr106985.f90

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index be94c18c836..290ddf360c8 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -2287,7 +2287,8 @@ gfc_simplify_expr (gfc_expr *p, int type)
 	 initialization expression, or we want a subsection.  */
   if (p->symtree->n.sym->attr.flavor == FL_PARAMETER
 	  && (gfc_init_expr_flag || p->ref
-	  || p->symtree->n.sym->value->expr_type != EXPR_ARRAY))
+	  || (p->symtree->n.sym->value
+		  && p->symtree->n.sym->value->expr_type != EXPR_ARRAY)))
 	{
 	  if (!simplify_parameter_variable (p, type))
 	return false;
diff --git a/gcc/testsuite/gfortran.dg/pr106985.f90 b/gcc/testsuite/gfortran.dg/pr106985.f90
new file mode 100644
index 000..f4ed92577a3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr106985.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! PR fortran/106985 - ICE in gfc_simplify_expr
+! Contributed by G.Steinmetz
+
+program p
+  integer, parameter :: a(2) = 1
+  integer, parameter :: b = a(2) + b ! { dg-error "before its definition is complete" }
+end
--
2.35.3



Re: [Patch] Fortran: F2018 type(*),dimension(*) with scalars [PR104143]

2022-09-20 Thread Harald Anlauf via Gcc-patches

Am 20.09.22 um 13:51 schrieb Tobias Burnus:

In several cases, one just wants to have the address where an object starts
without requiring the detour via 'c_loc' and the (locally) required
'target'
attribute.

In principle,  type(*),dimension(*)  of TS29113 permits this, except that
'dimension(*)' only permits arrays and array elements but not scalars.

Fortran 2018 modified this such that with 'type(*)' also scalars are
permitted.
(See PR for the quotes.)

This patch implements this simple change. Before, implementations like MPI
had to use '!GCC$ attribute NO_ARG_CHECK ::' in addition to
type(*),dimension(*)
to achieve this. In GCC, we do likewise, but that's at least inside the
compiler,
cf. libgomp/openacc{.f90,_lib.h}.

OK for mainline?


LGTM.

Thanks for the patch!



Proxy ping [PATCH] Fortran: Fix function attributes [PR100132]

2022-09-19 Thread Harald Anlauf via Gcc-patches
Dear all,

the following patch was submitted by Jose but never reviewed:

https://gcc.gnu.org/pipermail/fortran/2021-April/055946.html

Before, we didn't set function attributes properly when
passing polymorphic pointers, which could lead to
mis-optimization.

The patch is technically fine and regtests ok, although it
can be shortened slightly, which makes it more readable,
see attached.

When testing the suggested testcase I found that it was
accepted (and working fine) with NAG, but it was rejected
by both Intel and Cray.  This troubled me, but I think
it is standard conforming (F2018:15.5.2.7), while the
error messages issued by Intel

PR100132.f90(61): error #8300: If a dummy argument is allocatable or a pointer, 
and the dummy or its associated actual argument is polymorphic, both dummy and 
actual must be polymorphic with the same declared type or both must be 
unlimited polymorphic.   [S]
call set(s)
-^

and a similar one by Cray, suggest that they refer to
F2018:15.5.2.5, which IMHO does not apply here.
(The text in the error message seems very related to
the reasoning in Note 1 of that subsection).

I'd like to hear (read: read) a second opinion on that.

Thanks,
Harald

From 0b19cfc098554572279c8d19997df4823b426191 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Mon, 19 Sep 2022 22:00:45 +0200
Subject: [PATCH] Fortran: Fix function attributes [PR100132]

gcc/fortran/ChangeLog:

	PR fortran/100132
	* trans-types.cc (create_fn_spec): Fix function attributes when
	passing polymorphic pointers.

gcc/testsuite/ChangeLog:

	PR fortran/100132
	* gfortran.dg/PR100132.f90: New test.
---
 gcc/fortran/trans-types.cc | 15 +-
 gcc/testsuite/gfortran.dg/PR100132.f90 | 75 ++
 2 files changed, 88 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/PR100132.f90

diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 0ea7c74a6f1..c062a5b29d7 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -3054,12 +3054,23 @@ create_fn_spec (gfc_symbol *sym, tree fntype)
   for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
 if (spec_len < sizeof (spec))
   {
-	if (!f->sym || f->sym->attr.pointer || f->sym->attr.target
+	bool is_class = false;
+	bool is_pointer = false;
+
+	if (f->sym)
+	  {
+	is_class = f->sym->ts.type == BT_CLASS && CLASS_DATA (f->sym)
+	  && f->sym->attr.class_ok;
+	is_pointer = is_class ? CLASS_DATA (f->sym)->attr.class_pointer
+  : f->sym->attr.pointer;
+	  }
+
+	if (f->sym == NULL || is_pointer || f->sym->attr.target
 	|| f->sym->attr.external || f->sym->attr.cray_pointer
 	|| (f->sym->ts.type == BT_DERIVED
 		&& (f->sym->ts.u.derived->attr.proc_pointer_comp
 		|| f->sym->ts.u.derived->attr.pointer_comp))
-	|| (f->sym->ts.type == BT_CLASS
+	|| (is_class
 		&& (CLASS_DATA (f->sym)->ts.u.derived->attr.proc_pointer_comp
 		|| CLASS_DATA (f->sym)->ts.u.derived->attr.pointer_comp))
 	|| (f->sym->ts.type == BT_INTEGER && f->sym->ts.is_c_interop))
diff --git a/gcc/testsuite/gfortran.dg/PR100132.f90 b/gcc/testsuite/gfortran.dg/PR100132.f90
new file mode 100644
index 000..78ae6702810
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100132.f90
@@ -0,0 +1,75 @@
+! { dg-do run }
+!
+! Test the fix for PR100132
+!
+
+module main_m
+  implicit none
+
+  private
+
+  public :: &
+foo_t
+
+  public :: &
+set,&
+get
+
+  type :: foo_t
+integer :: i
+  end type foo_t
+
+  type(foo_t), save, pointer :: data => null()
+
+contains
+
+  subroutine set(this)
+class(foo_t), pointer, intent(in) :: this
+
+if(associated(data)) stop 1
+data => this
+  end subroutine set
+
+  subroutine get(this)
+type(foo_t), pointer, intent(out) :: this
+
+if(.not.associated(data)) stop 4
+this => data
+nullify(data)
+  end subroutine get
+
+end module main_m
+
+program main_p
+
+  use :: main_m, only: &
+foo_t, set, get
+
+  implicit none
+
+  integer, parameter :: n = 1000
+
+  type(foo_t), pointer :: ps
+  type(foo_t),  target :: s
+  integer  :: i, j, yay, nay
+
+  yay = 0
+  nay = 0
+  do i = 1, n
+s%i = i
+call set(s)
+call get(ps)
+if(.not.associated(ps)) stop 13
+j = ps%i
+if(i/=j) stop 14
+if(i/=s%i) stop 15
+if(ps%i/=s%i) stop 16
+if(associated(ps, s))then
+  yay = yay + 1
+else
+  nay = nay + 1
+end if
+  end do
+  if((yay/=n).or.(nay/=0)) stop 17
+
+end program main_p
--
2.35.3



Re: [PATCH 09/10] fortran: Support clobbering of variable subreferences [PR88364]

2022-09-19 Thread Harald Anlauf via Gcc-patches

Am 18.09.22 um 22:55 schrieb Mikael Morin:

Le 18/09/2022 à 20:32, Harald Anlauf a écrit :


Assumed shape will be on the easy side,
while assumed size likely needs to be excluded for clobbering.


Isn’t it the converse that is true?
Assumed shape can be non-contiguous so have to be excluded, but assumed 
size are contiguous, so valid candidates for clobbering. No?


I really was referring here to *dummies*, as in the following example:

program p
  integer :: a(4)
  a = 1
  call sub (a(1), 2)
  print *, a
contains
  subroutine sub (b, k)
integer, intent(in)  :: k
integer, intent(out) :: b(*)
!   integer, intent(out) :: b(k)
if (k > 2) b(k) = k
  end subroutine sub
end program p

Assumed size (*) is just a contiguous hunk of memory of possibly
unknown size, which can be zero.  So you couldn't set a clobber
for the a(1) actual argument.


No way, really, arrays are going to be a maze of complexity.


Agreed.






Re: [PATCH 09/10] fortran: Support clobbering of variable subreferences [PR88364]

2022-09-18 Thread Harald Anlauf via Gcc-patches

On 18.09.22 12:23, Thomas Koenig via Gcc-patches wrote:


On 18.09.22 11:10, Mikael Morin wrote:

It is unfortunate as there is some desirable behavior within reach here.


I think some of the desired behavior can still be salvaged.  For
example, for

   subroutine foo(a,n)
     integer :: n
     integer, dimension(n), intent(in) :: n


integer, dimension(n), intent(out) :: a  ! ?


...

   subroutine bar(a)
     integer, intent(out) :: a

...

   integer :: a(3)

   call foo(a,3)
   call foo(a(1),3)

clobbers for the whole array can still be generated, but not for

   call foo(a(2),2)

so one would have to look at the lower bound.

For this case, it would be helpful to clobber a range a(2:), but that
is a wishlist item for the future ;-)

What is unsafe, currently, is

   call bar(a(1))


We'll need a good coverage by testcases for the different handling
required for assumed shape / assumed size / explicit size dummies
to avoid new regressions.  Assumed shape will be on the easy side,
while assumed size likely needs to be excluded for clobbering.

Harald



[PATCH, committed] Fortran: catch NULL pointer dereferences while simplifying PACK [PR106857]

2022-09-15 Thread Harald Anlauf via Gcc-patches
Dear all,

we hit a NULL pointer dereference when trying to simplify PACK
when the MASK argument was present.  The obvious and trivial
solution is to check for NULL pointer dereferences why looking
at the constructor for the ARRAY argument, which we already do
in the case the MASK is not present.

Committed to mainline after regtesting on x86_64-pc-linux-gnu
as commit r13-2691-g2b75d5f533b9d6b39f4055949aff64ed0d22dd24

This is a 10/11/12/13 regression, so I will check if it can
be backported.

Thanks,
Harald

From 2b75d5f533b9d6b39f4055949aff64ed0d22dd24 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Thu, 15 Sep 2022 22:39:24 +0200
Subject: [PATCH] Fortran: catch NULL pointer dereferences while simplifying
 PACK [PR106857]

gcc/fortran/ChangeLog:

	PR fortran/106857
	* simplify.cc (gfc_simplify_pack): Check for NULL pointer dereferences
	while walking through constructors (error recovery).

gcc/testsuite/ChangeLog:

	PR fortran/106857
	* gfortran.dg/pr106857.f90: New test.
---
 gcc/fortran/simplify.cc|  2 +-
 gcc/testsuite/gfortran.dg/pr106857.f90 | 12 
 2 files changed, 13 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr106857.f90

diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index bc178d54891..140c17721a7 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -6431,7 +6431,7 @@ gfc_simplify_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector)
   /* Copy only those elements of ARRAY to RESULT whose
 	 MASK equals .TRUE..  */
   mask_ctor = gfc_constructor_first (mask->value.constructor);
-  while (mask_ctor)
+  while (mask_ctor && array_ctor)
 	{
 	  if (mask_ctor->expr->value.logical)
 	{
diff --git a/gcc/testsuite/gfortran.dg/pr106857.f90 b/gcc/testsuite/gfortran.dg/pr106857.f90
new file mode 100644
index 000..4b0f86a75a6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr106857.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! PR fortran/106857 - ICE in gfc_simplify_pack
+! Contributed by G.Steinmetz
+
+program p
+  type t
+ integer :: n
+  end type
+  type(t), parameter :: a(2,2) = t(1)
+  type(t), parameter :: b(4) = reshape(a, [2])  ! { dg-error "Different shape" }
+  type(t), parameter :: c(2) = pack(b, [.false.,.true.,.false.,.true.]) ! { dg-error "Different shape" }
+end
--
2.35.3



[PATCH, committed] Fortran: error recovery for bad deferred character length assignment [PR104314]

2022-09-15 Thread Harald Anlauf via Gcc-patches
Dear all,

the attached obvious patch fixes an ICE on a NULL pointer
dereference.  We didn't properly check that the types of
expressions are character before referencing the length.

The issue was originally investigated by Steve, so I made
him co-author.

Regtested on x86_64-pc-linux-gnu and pushed to mainline as
commit r13-2690-g7bd4deb2a7c1394550610ab27507d1ed2af817c2

Thanks,
Harald

From 7bd4deb2a7c1394550610ab27507d1ed2af817c2 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Thu, 15 Sep 2022 22:06:53 +0200
Subject: [PATCH] Fortran: error recovery for bad deferred character length
 assignment [PR104314]

gcc/fortran/ChangeLog:

	PR fortran/104314
	* resolve.cc (deferred_op_assign): Do not try to generate temporary
	for deferred character length assignment if types do not agree.

gcc/testsuite/ChangeLog:

	PR fortran/104314
	* gfortran.dg/pr104314.f90: New test.

Co-authored-by: Steven G. Kargl 
---
 gcc/fortran/resolve.cc | 1 +
 gcc/testsuite/gfortran.dg/pr104314.f90 | 9 +
 2 files changed, 10 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/pr104314.f90

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index ca114750f65..ae7ebb624e4 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -11803,6 +11803,7 @@ deferred_op_assign (gfc_code **code, gfc_namespace *ns)

   if (!((*code)->expr1->ts.type == BT_CHARACTER
 	 && (*code)->expr1->ts.deferred && (*code)->expr1->rank
+	 && (*code)->expr2->ts.type == BT_CHARACTER
 	 && (*code)->expr2->expr_type == EXPR_OP))
 return false;

diff --git a/gcc/testsuite/gfortran.dg/pr104314.f90 b/gcc/testsuite/gfortran.dg/pr104314.f90
new file mode 100644
index 000..510ded0b164
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr104314.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR fortran/104314 - ICE in deferred_op_assign
+! Contributed by G.Steinmetz
+
+program p
+  character(:), allocatable :: c(:)
+  c = ['123']
+  c = c == c  ! { dg-error "Cannot convert" }
+end
--
2.35.3



Proxy ping [PATCH] PR fortran/100136 - ICE, regression, using flag -fcheck=pointer

2022-09-04 Thread Harald Anlauf via Gcc-patches
Dear all,

said PR was addressed by Jose in

  https://gcc.gnu.org/pipermail/fortran/2021-April/055949.html

but unfortunately his patch was never reviewed.

IMHO the patch is mostly fine, with one small exception that
it should use POINTER_TYPE_P (TREE_TYPE (tmp)), see PR and
attached adjusted patch.

Regtested on x86_64-pc-linux-gnu.

Since this fixes a 11/12/13 regression on valid code, I'd like
to commit this one on these branches, but would be glad to see
an OK or LGTM from somebody else.  (Jose says he's too busy
currently.)

Thanks,
Harald

From 3ce0b852ddd91151a23baf8301b7aea5cc7d7ea0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?=
 
Date: Sun, 4 Sep 2022 21:53:09 +0200
Subject: [PATCH] Fortran: Fix ICE with -fcheck=pointer [PR100136]

gcc/fortran/ChangeLog:

	PR fortran/100136
	* trans-expr.cc (gfc_conv_procedure_call): Add handling of pointer
	expressions.

gcc/testsuite/ChangeLog:

	PR fortran/100136
	* gfortran.dg/PR100136.f90: New test.
---
 gcc/fortran/trans-expr.cc  |  7 ++---
 gcc/testsuite/gfortran.dg/PR100136.f90 | 39 ++
 2 files changed, 42 insertions(+), 4 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/PR100136.f90

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 13c3e7df45f..7895d034610 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7220,16 +7220,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	  else
 		goto end_pointer_check;

+	  tmp = parmse.expr;
 	  if (fsym && fsym->ts.type == BT_CLASS)
 		{
-		  tmp = build_fold_indirect_ref_loc (input_location,
-		  parmse.expr);
+		  if (POINTER_TYPE_P (TREE_TYPE (tmp)))
+		tmp = build_fold_indirect_ref_loc (input_location, tmp);
 		  tmp = gfc_class_data_get (tmp);
 		  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
 		tmp = gfc_conv_descriptor_data_get (tmp);
 		}
-	  else
-		tmp = parmse.expr;

 	  /* If the argument is passed by value, we need to strip the
 		 INDIRECT_REF.  */
diff --git a/gcc/testsuite/gfortran.dg/PR100136.f90 b/gcc/testsuite/gfortran.dg/PR100136.f90
new file mode 100644
index 000..922af4aecc3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100136.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+! { dg-options "-fcheck=pointer" }
+! { dg-shouldfail "Argument not allocated" }
+! { dg-output "Fortran runtime error: Allocatable actual argument 'c_init2' is not allocated" }
+!
+! Tests fix for PR100136
+!
+! Test cut down from PR58586
+!
+
+module test_pr58586_mod
+  implicit none
+
+  type :: a
+  end type
+
+  type :: c
+ type(a), allocatable :: a
+  end type
+
+contains
+
+  subroutine add_class_c (d)
+class(c), value :: d
+  end subroutine
+
+  class(c) function c_init2()
+allocatable :: c_init2
+  end function
+
+end module test_pr58586_mod
+
+program test_pr58586
+  use test_pr58586_mod
+
+  ! This needs to execute, to see whether the segfault at runtime is resolved
+  call add_class_c(c_init2())
+
+end program
--
2.35.3



Proxy ping [PATCH] Fortran: Fix ICE with automatic reallocation [PR100245]

2022-09-02 Thread Harald Anlauf via Gcc-patches
Dear all,

Jose posted a small patch here that was never reviewed:

  https://gcc.gnu.org/pipermail/fortran/2021-April/055982.html

IMHO the patch is fine and nearly obvious.

I inquired in the PR, and Jose did not object to my handling of
his patch.  So - unless there are objections - I will commit
the patch in the next days in the slightly corrected version as
attached below (with fixed PR typo in commit message ;-).

Regtested on x86_64-pc-linux-gnu.

Thanks,
Harald

From d7e5cca20be4a4ed00705f0d577302819ad97123 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?=
 
Date: Fri, 2 Sep 2022 21:35:22 +0200
Subject: [PATCH] Fortran: Fix ICE with automatic reallocation [PR100245]

gcc/fortran/ChangeLog:

	PR fortran/100245
	* trans-expr.cc (trans_class_assignment): Add if clause to handle
	derived type in the LHS.

gcc/testsuite/ChangeLog:

	PR fortran/100245
	* gfortran.dg/PR100245.f90: New test.
---
 gcc/fortran/trans-expr.cc  |  3 +++
 gcc/testsuite/gfortran.dg/PR100245.f90 | 28 ++
 2 files changed, 31 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/PR100245.f90

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 850007fd2e1..13c3e7df45f 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11436,6 +11436,9 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs,
   class_han = GFC_CLASS_TYPE_P (TREE_TYPE (lse->expr))
 	  ? gfc_class_data_get (lse->expr) : lse->expr;

+  if (!POINTER_TYPE_P (TREE_TYPE (class_han)))
+	class_han = gfc_build_addr_expr (NULL_TREE, class_han);
+
   /* Allocate block.  */
   gfc_init_block (&alloc);
   gfc_allocate_using_malloc (&alloc, class_han, size, NULL_TREE);
diff --git a/gcc/testsuite/gfortran.dg/PR100245.f90 b/gcc/testsuite/gfortran.dg/PR100245.f90
new file mode 100644
index 000..07c1f7b3a1c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100245.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! Test the fix for PR100245
+!
+
+program main_p
+
+  implicit none
+
+  type :: foo_t
+integer :: a
+  end type foo_t
+
+  integer, parameter :: a = 42
+
+  class(foo_t), allocatable :: val
+  class(foo_t), allocatable :: rs1
+  type(foo_t),  allocatable :: rs2
+
+  allocate(val, source=foo_t(42))
+  if (val%a/=a) stop 1
+  rs1 = val
+  if (rs1%a/=a) stop 2
+  rs2 = val
+  if (rs2%a/=a) stop 3
+  deallocate(val, rs1, rs2)
+
+end program main_p
--
2.35.3



[PATCH, committed] Fortran: avoid NULL pointer dereference on invalid DATA constant [PR99349]

2022-09-02 Thread Harald Anlauf via Gcc-patches
Dear all,

I've committed the attached fix for a NULL pointer dereference
as obvious after a discussion with Steve in the PR, and
successful regtesting on x86_64-pc-linux-gnu, as r13-2382.

See also https://gcc.gnu.org/g:b6aa7d45b502c01f8703c8d2cee2690f9aa8e282

Thanks,
Harald

From b6aa7d45b502c01f8703c8d2cee2690f9aa8e282 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Fri, 2 Sep 2022 21:07:26 +0200
Subject: [PATCH] Fortran: avoid NULL pointer dereference on invalid DATA
 constant [PR99349]

gcc/fortran/ChangeLog:

	PR fortran/99349
	* decl.cc (match_data_constant): Avoid NULL pointer dereference.

gcc/testsuite/ChangeLog:

	PR fortran/99349
	* gfortran.dg/pr99349.f90: New test.

Co-authored-by: Steven G. Kargl 
---
 gcc/fortran/decl.cc   | 3 ++-
 gcc/testsuite/gfortran.dg/pr99349.f90 | 9 +
 2 files changed, 11 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr99349.f90

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index b6400514731..0f9b2ced4c2 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -423,7 +423,8 @@ match_data_constant (gfc_expr **result)
 	 data-pointer-initialization compatible (7.5.4.6) with the initial
 	 data target; the data statement object is initially associated
 	 with the target.  */
-  if ((*result)->symtree->n.sym->attr.save
+  if ((*result)->symtree
+	  && (*result)->symtree->n.sym->attr.save
 	  && (*result)->symtree->n.sym->attr.target)
 	return m;
   gfc_free_expr (*result);
diff --git a/gcc/testsuite/gfortran.dg/pr99349.f90 b/gcc/testsuite/gfortran.dg/pr99349.f90
new file mode 100644
index 000..e1f4628af0b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr99349.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR fortran/99349 - ICE in match_data_constant
+! Contributed by G.Steinmetz
+
+function f()
+  logical, parameter :: a((1.)/0) = .true. ! { dg-error "Parameter array" }
+  integer :: b
+  data b /a%kind/ ! { dg-error "Syntax error" }
+end
--
2.35.3



Re: [Patch] OpenMP/Fortran: Permit end-clause on directive

2022-08-29 Thread Harald Anlauf via Gcc-patches

Hi Tobias,

this is not really a review, but:

Am 26.08.22 um 20:21 schrieb Tobias Burnus:

I did run into some issues related to this; those turned out to be
unrelated, but I end ended up implementing this feature.

Side remark: 'omp parallel workshare' seems to actually permit 'nowait'
now, but I guess that's an unintended change due to the
syntax-representation change. Hence, it is now tracked as Spec Issue
3338 and I do not permit it.

OK for mainline?


Regarding testcase nowait-4.f90: it has a part that tests for many
formally correct uses, and a part that tests for many invalid nowait.
Both parts seem to be giving reasonable coverage, so I wonder whether
it would be beneficial to split this one into two subsets.

It makes sense to have fewer but larger testcases in the testsuite,
to keep the time for regtesting at bay, but I'm split here on this
one - and yes, pun intended.

Harald


Tobias
-
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201,
80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer:
Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München;
Registergericht München, HRB 106955




Re: [Patch] Fortran/OpenMP: Fix strictly structured blocks parsing

2022-08-24 Thread Harald Anlauf via Gcc-patches

Hi Tobias,

Am 24.08.22 um 19:47 schrieb Tobias Burnus:

This patch is about error diagnostic + an ICE for invalid code.

[...]

(So far, so good, but then the parsing-code did run into a bug.)

For the blocks, the following applies. OpenMP permits either
* strictly structured blocks (with optional END_ST == 'end target')
  !$omp target
    block
  ...
    end block
  !$omp end target  ! << this line is optional
* loosely structured block
  !$omp target
     ... ! may not start with 'block' (and hence cannot end with 'end
block')
  !$omp end target  ! << required


The parsing issue is in the following code,
which first takes care of the 'strictly':  'end block' + optional 'end
target'
and then of the 'loosely structured' case with just:  'end target':

  else if (block_construct && st == ST_END_BLOCK)
    ...
  st = next_statement ();
  if (st == omp_end_st)
  accept_statement (st);
    ...
  else if (st != omp_end_st)
    {
  unexpected_statement (st);
  st = next_statement ();
    }

The fix is to change the second if condition to:
  else if (st != omp_end_st || (block_construct && st == omp_end_st))

or rather to the following equivalent code:
  else if (st != omp_end_st || block_construct)


LGTM.


OK for mainline and GCC 12?*


Yes for both.

Thanks for the patch!

Harald


Tobias

*strictly structured blocks were added in r12-4592.


-
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201,
80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer:
Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München;
Registergericht München, HRB 106955




[PATCH] Fortran: improve error recovery while simplifying size of bad array [PR103694]

2022-08-23 Thread Harald Anlauf via Gcc-patches
Dear all,

the simplification of the size of an array with a bad decl
should not be successful.  Improve the error recovery for
such a situation.

The patch is nearly obvious.  I therefore intend to commit
it in the next few days unless someone comes up with a
better solution.

Regtested on x86_64-pc-linux-gnu.

The PR is marked as a 12/13 regression.  Will therefore
commit to both.

Thanks,
Harald

From d306c0b171e502e3c87b92b6bc63b532f734e754 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Tue, 23 Aug 2022 22:16:14 +0200
Subject: [PATCH] Fortran: improve error recovery while simplifying size of bad
 array [PR103694]

gcc/fortran/ChangeLog:

	PR fortran/103694
	* simplify.cc (simplify_size): The size expression of an array cannot
	be simplified if an error occurs while resolving the array spec.

gcc/testsuite/ChangeLog:

	PR fortran/103694
	* gfortran.dg/pr103694.f90: New test.
---
 gcc/fortran/simplify.cc|  5 +++--
 gcc/testsuite/gfortran.dg/pr103694.f90 | 11 +++
 2 files changed, 14 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr103694.f90

diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index f992c31e5d7..bc178d54891 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -7536,8 +7536,9 @@ simplify_size (gfc_expr *array, gfc_expr *dim, int k)
 }

   for (ref = array->ref; ref; ref = ref->next)
-if (ref->type == REF_ARRAY && ref->u.ar.as)
-  gfc_resolve_array_spec (ref->u.ar.as, 0);
+if (ref->type == REF_ARRAY && ref->u.ar.as
+	&& !gfc_resolve_array_spec (ref->u.ar.as, 0))
+  return NULL;

   if (dim == NULL)
 {
diff --git a/gcc/testsuite/gfortran.dg/pr103694.f90 b/gcc/testsuite/gfortran.dg/pr103694.f90
new file mode 100644
index 000..3ed8b2088da
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr103694.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! PR fortran/103694 - ICE in gfc_conv_expr_op
+! Contributed by G.Steinmetz
+
+subroutine s
+  type t
+ integer :: a(2)
+  end type
+  type(t) :: x((0.)/0)
+  integer :: n = size(x(1)%a) ! { dg-error "does not reduce to a constant expression" }
+end
--
2.35.3



[PATCH] Fortran: fix simplification of intrinsics IBCLR and IBSET [PR106557]

2022-08-20 Thread Harald Anlauf via Gcc-patches
Dear all,

the simplification of the TRANSFER intrinsic produces a
redundant representation of the result, one in expr->value
and another in expr->representation.string.  This is done
to ensure a safe "round-trip" for nested TRANSFER.

In a subsequent use of this result we either need to make
sure that both parts stay consistent, or drop the latter
part.

The simplifications of IBCLR and IBSET do a gfc_copy_expr
of their argument x and modify only the former part.
Depending on context, either value.integer or
representation.string (if non-NULL) are used later,
leading to surprising results.

A conservative approach to fix this PR is to simply
drop the unneeded representation.string in the
simplification of the intrinsics IBCLR and IBSET,
see attached patch.  (A quick glance did not turn up
other intrinsics affected the same way.)

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

From a540a806cf02d739a408f129738252e73f03e60c Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Sat, 20 Aug 2022 20:36:28 +0200
Subject: [PATCH] Fortran: fix simplification of intrinsics IBCLR and IBSET
 [PR106557]

gcc/fortran/ChangeLog:

	PR fortran/106557
	* simplify.cc (gfc_simplify_ibclr): Ensure consistent results of
	the simplification by dropping a redundant memory representation
	of argument x.
	(gfc_simplify_ibset): Likewise.

gcc/testsuite/ChangeLog:

	PR fortran/106557
	* gfortran.dg/pr106557.f90: New test.
---
 gcc/fortran/simplify.cc| 14 ++
 gcc/testsuite/gfortran.dg/pr106557.f90 | 19 +++
 2 files changed, 33 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/pr106557.f90

diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index fb725994653..f992c31e5d7 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -3380,6 +3380,13 @@ gfc_simplify_ibclr (gfc_expr *x, gfc_expr *y)
   k = gfc_validate_kind (x->ts.type, x->ts.kind, false);

   result = gfc_copy_expr (x);
+  /* Drop any separate memory representation of x to avoid potential
+ inconsistencies in result.  */
+  if (result->representation.string)
+{
+  free (result->representation.string);
+  result->representation.string = NULL;
+}

   convert_mpz_to_unsigned (result->value.integer,
 			   gfc_integer_kinds[k].bit_size);
@@ -3471,6 +3478,13 @@ gfc_simplify_ibset (gfc_expr *x, gfc_expr *y)
   k = gfc_validate_kind (x->ts.type, x->ts.kind, false);

   result = gfc_copy_expr (x);
+  /* Drop any separate memory representation of x to avoid potential
+ inconsistencies in result.  */
+  if (result->representation.string)
+{
+  free (result->representation.string);
+  result->representation.string = NULL;
+}

   convert_mpz_to_unsigned (result->value.integer,
 			   gfc_integer_kinds[k].bit_size);
diff --git a/gcc/testsuite/gfortran.dg/pr106557.f90 b/gcc/testsuite/gfortran.dg/pr106557.f90
new file mode 100644
index 000..d073f3e7186
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr106557.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+! PR fortran/106557 - nesting intrinsics ibset and transfer gives wrong result
+
+program p
+  implicit none
+  character(1) :: s
+
+  write(s,'(i1)') ibset (transfer (0, 0), 0)
+  if (s /= '1') stop 1
+  write(s,'(i1)') ibclr (transfer (1, 0), 0)
+  if (s /= '0') stop 2
+
+  ! These shall be fully resolved at compile time:
+  if (transfer   (ibset (transfer (0, 0), 0), 0) /= 1) stop 3
+  if (transfer   (ibclr (transfer (1, 0), 0), 0) /= 0) stop 4
+end
+
+! { dg-final { scan-tree-dump-times "_gfortran_stop_numeric" 2 "original" } }
--
2.35.3



Re: [PATCH, v2] Fortran: fix invalid rank error in ASSOCIATED when rank is remapped [PR77652]

2022-08-18 Thread Harald Anlauf via Gcc-patches

Hi Mikael, all,

I've just reverted commit 0110cfd5449bae3a772f45ea2e4c5dab5b7a8ccd.
As it seems that commit ca170ed9f8a086ca7e1eec841882b6bed9ec1a3a did
not update bugzilla, I'll add a note to the PR and close it as invalid.

Thanks,
Harald


Am 04.08.22 um 14:03 schrieb Mikael Morin:

Le 30/07/2022 à 12:03, Mikael Morin a écrit :

Le 28/07/2022 à 22:19, Mikael Morin a écrit :

I propose to prepare something tomorrow.



Here you go.


I posted the message the other day.
The mailing list archive are not automatic, so there is no link to the
message (yet?), nor to the thread that follows it.
So I attach below the answer from Malcolm Cohen.
Long story short, he confirms the interpretation from Steve Lionel, and
that the text in the standard needs fixing.
I’m afraid we’ll have to revert.


 Message transféré 
Sujet : [SC22WG5.6416] RE: [ukfortran] Request for interpretation of
compile-time restrictions on ASSOCIATED
Date : Thu, 4 Aug 2022 11:43:16 +0900
De : Malcolm Cohen 
Pour : 'Mikael Morin' , sc22...@open-std.org
Copie à : 'Harald Anlauf' 

Dear Mikael,

Thank you for your query.

I would agree with Steve Lionel that the ranks must be the same (when
POINTER is not assumed-rank), for two reasons.

(1) The result of ASSOCIATED is unambiguously .FALSE. when the shapes of
POINTER and TARGET differ. As the shapes cannot be the same when the ranks
differ seeing as how the number of elements in the shape are not the same,
that means it would always be .FALSE. when the ranks differ. The Fortran
language does not need an extra way to produce the LOGICAL constant .FALSE.

Note that this means that even in the case where POINTER is dimension (2,1)
and TARGET is dimension (1,2), and they both refer to the same elements in
array element order, ASSOCIATED will return .FALSE. because the shapes are
not the same. ASSOCIATED is a much stronger test than mere address
comparison.

(2) This text arises from an attempted, but failed, simplification of what
we had before. Unfortunately, it is completely and utterly broken, as it
forbids the use of ASSOCIATED when POINTER is assumed-rank, has INTENT(IN),
is PROTECTED (outside of its module), or is a pointer function reference.
That is because there are no pointer assignment statements where the
pointer
object is permitted to be any of those, and thus the conditions for TARGET
cannot ever be satisfied.

However, the processor is not *required* to report an error when the ranks
differ, as this is not a "Constraint" in the standard. I would expect a
high
quality implementation to do so, but maybe I just have high expectations...

It could also be a deliberate extension, with different semantics provided
by the processor. In that case, the processor would be required to have the
capability to report the use of the extension (but this need not be the
default).

Finally, I note that we are not accepting interpretation requests on
Fortran
2018 at this time, as we are in the process of replacing it with a new
revision (Fortran 2023). However, we will certainly consider whether we can
make any correction to Fortran 2023 before publication (expected next
year);
if there is consensus on how to fix the clearly-incorrect requirements on
TARGET, we can do so. Otherwise, we will need to wait until after Fortran
2023 is published before we can restart the Defect Processing process.

I will undertake to write a meeting paper addressing this issue before this
year's October meeting. If no paper has appeared by mid-September, please
feel free to remind me to do that!

Cheers,




Re: [PATCH, v4] Fortran: detect blanks within literal constants in free-form mode [PR92805]

2022-07-31 Thread Harald Anlauf via Gcc-patches

Hi Mikael,

Am 31.07.22 um 10:35 schrieb Mikael Morin:

Le 30/07/2022 à 21:40, Harald Anlauf a écrit :

Hi Mikael,

Am 30.07.22 um 10:28 schrieb Mikael Morin:

Meh! We killed one check for gfc_current_form but the other one is still
there.
OK, match_kind_param calls two functions that also gobble space, so
there is work remaining here.
So please make match_small_literal_constant and gfc_match_name
space-gobbling wrappers around space-non-gobbling inner functions and
call those inner functions instead in match_kind_param.


well, here's the shortest solution I could come up with.
I added a new argument to 3 functions used in parsing that
controls the gobbling of whitespace.  We use this to handle
whitespace for numerical literals, while the parsing of string
literals remains as in the previous version of the patch.

This version obviously ignores Thomas' request, as that would
require to treat gfc_match_char specially...

Regtested again.  OK now?



PR fortran/92805
* match.cc (gfc_match_small_literal_int): Make gobbling of leading
whitespace optional.
(gfc_match_name): Likewise.
(gfc_match_char): Likewise.
* match.h (gfc_match_small_literal_int): Adjust prototype.
(gfc_match_name): Likewise.
(gfc_match_char): Likewise.
* primary.cc (match_kind_param): Match small literal int or name
without gobbling whitespace.
(get_kind): Do not skip over blanks in free-form mode.

I think the "in free-form mode" applied to the preceding patches but can
be dropped now.

(match_string_constant): Likewise.



diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 1aa3053e70e..c0dc0e89361 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -457,7 +457,7 @@ gfc_match_eos (void)
    will be set to the number of digits.  */

Please add a note about GOBBLE_WS here, like you did for gfc_match_char.


 match
-gfc_match_small_literal_int (int *value, int *cnt)
+gfc_match_small_literal_int (int *value, int *cnt, bool gobble_ws)
 {
   locus old_loc;
   char c;

(...)

@@ -611,14 +612,15 @@ gfc_match_label (void)
    than GFC_MAX_SYMBOL_LEN.  */

Same here.


 match
-gfc_match_name (char *buffer)
+gfc_match_name (char *buffer, bool gobble_ws)
 {
   locus old_loc;
   int i;
   char c;


(...)

@@ -1052,16 +1054,19 @@ cleanup:
 }


-/* Tries to match the next non-whitespace character on the input.
-   This subroutine does not return MATCH_ERROR.  */
+/* Tries to match the next non-whitespace character on the input.  This
+   subroutine does not return MATCH_ERROR.  When gobble_ws is false,
do not
+   skip over leading blanks.
+*/

There should be no line feed before end of comment.


I've adjusted the patch (see attached) and pushed it as

commit r13-1905-gd325e7048c85e13f12ea79aebf9623eddc7ffcaf

Thanks,
Harald


OK with those changes.
thanks for your patience.

Mikael


From d325e7048c85e13f12ea79aebf9623eddc7ffcaf Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Thu, 28 Jul 2022 22:07:02 +0200
Subject: [PATCH] Fortran: detect blanks within literal constants in free-form
 mode [PR92805]

gcc/fortran/ChangeLog:

	PR fortran/92805
	* match.cc (gfc_match_small_literal_int): Make gobbling of leading
	whitespace optional.
	(gfc_match_name): Likewise.
	(gfc_match_char): Likewise.
	* match.h (gfc_match_small_literal_int): Adjust prototype.
	(gfc_match_name): Likewise.
	(gfc_match_char): Likewise.
	* primary.cc (match_kind_param): Match small literal int or name
	without gobbling whitespace.
	(get_kind): Do not skip over blanks.
	(match_string_constant): Likewise.

gcc/testsuite/ChangeLog:

	PR fortran/92805
	* gfortran.dg/literal_constants.f: New test.
	* gfortran.dg/literal_constants.f90: New test.

Co-authored-by: Steven G. Kargl 
---
 gcc/fortran/match.cc  | 24 ---
 gcc/fortran/match.h   |  6 ++---
 gcc/fortran/primary.cc| 14 +++
 gcc/testsuite/gfortran.dg/literal_constants.f | 20 
 .../gfortran.dg/literal_constants.f90 | 24 +++
 5 files changed, 65 insertions(+), 23 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/literal_constants.f
 create mode 100644 gcc/testsuite/gfortran.dg/literal_constants.f90

diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 1aa3053e70e..8b8b6e79c8b 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -454,10 +454,11 @@ gfc_match_eos (void)
 /* Match a literal integer on the input, setting the value on
MATCH_YES.  Literal ints occur in kind-parameters as well as
old-style character length specifications.  If cnt is non-NULL it
-   will be set to the number of digits.  */
+   will be set to the number of digits.
+   When gobble_ws is false, do not skip over leading blanks.  */
 
 match
-gfc_match_small_literal_int (int *value, int *cnt)
+gfc_match_small_literal_int (int *value, int *cnt, bool gobble_ws)
 {
   locus old_loc;
  

[PATCH, v4] Fortran: detect blanks within literal constants in free-form mode [PR92805]

2022-07-30 Thread Harald Anlauf via Gcc-patches

Hi Mikael,

Am 30.07.22 um 10:28 schrieb Mikael Morin:

Meh! We killed one check for gfc_current_form but the other one is still
there.
OK, match_kind_param calls two functions that also gobble space, so
there is work remaining here.
So please make match_small_literal_constant and gfc_match_name
space-gobbling wrappers around space-non-gobbling inner functions and
call those inner functions instead in match_kind_param.


well, here's the shortest solution I could come up with.
I added a new argument to 3 functions used in parsing that
controls the gobbling of whitespace.  We use this to handle
whitespace for numerical literals, while the parsing of string
literals remains as in the previous version of the patch.

This version obviously ignores Thomas' request, as that would
require to treat gfc_match_char specially...

Regtested again.  OK now?

Thanks,
Harald
From cb33d1d0b91b371a864379d920ddaefc15d587f9 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Thu, 28 Jul 2022 22:07:02 +0200
Subject: [PATCH] Fortran: detect blanks within literal constants in free-form
 mode [PR92805]

gcc/fortran/ChangeLog:

	PR fortran/92805
	* match.cc (gfc_match_small_literal_int): Make gobbling of leading
	whitespace optional.
	(gfc_match_name): Likewise.
	(gfc_match_char): Likewise.
	* match.h (gfc_match_small_literal_int): Adjust prototype.
	(gfc_match_name): Likewise.
	(gfc_match_char): Likewise.
	* primary.cc (match_kind_param): Match small literal int or name
	without gobbling whitespace.
	(get_kind): Do not skip over blanks in free-form mode.
	(match_string_constant): Likewise.

gcc/testsuite/ChangeLog:

	PR fortran/92805
	* gfortran.dg/literal_constants.f: New test.
	* gfortran.dg/literal_constants.f90: New test.

Co-authored-by: Steven G. Kargl 
---
 gcc/fortran/match.cc  | 21 +---
 gcc/fortran/match.h   |  6 ++---
 gcc/fortran/primary.cc| 14 +++
 gcc/testsuite/gfortran.dg/literal_constants.f | 20 
 .../gfortran.dg/literal_constants.f90 | 24 +++
 5 files changed, 63 insertions(+), 22 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/literal_constants.f
 create mode 100644 gcc/testsuite/gfortran.dg/literal_constants.f90

diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 1aa3053e70e..c0dc0e89361 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -457,7 +457,7 @@ gfc_match_eos (void)
will be set to the number of digits.  */
 
 match
-gfc_match_small_literal_int (int *value, int *cnt)
+gfc_match_small_literal_int (int *value, int *cnt, bool gobble_ws)
 {
   locus old_loc;
   char c;
@@ -466,7 +466,8 @@ gfc_match_small_literal_int (int *value, int *cnt)
   old_loc = gfc_current_locus;
 
   *value = -1;
-  gfc_gobble_whitespace ();
+  if (gobble_ws)
+gfc_gobble_whitespace ();
   c = gfc_next_ascii_char ();
   if (cnt)
 *cnt = 0;
@@ -611,14 +612,15 @@ gfc_match_label (void)
than GFC_MAX_SYMBOL_LEN.  */
 
 match
-gfc_match_name (char *buffer)
+gfc_match_name (char *buffer, bool gobble_ws)
 {
   locus old_loc;
   int i;
   char c;
 
   old_loc = gfc_current_locus;
-  gfc_gobble_whitespace ();
+  if (gobble_ws)
+gfc_gobble_whitespace ();
 
   c = gfc_next_ascii_char ();
   if (!(ISALPHA (c) || (c == '_' && flag_allow_leading_underscore)))
@@ -1052,16 +1054,19 @@ cleanup:
 }
 
 
-/* Tries to match the next non-whitespace character on the input.
-   This subroutine does not return MATCH_ERROR.  */
+/* Tries to match the next non-whitespace character on the input.  This
+   subroutine does not return MATCH_ERROR.  When gobble_ws is false, do not
+   skip over leading blanks.
+*/
 
 match
-gfc_match_char (char c)
+gfc_match_char (char c, bool gobble_ws)
 {
   locus where;
 
   where = gfc_current_locus;
-  gfc_gobble_whitespace ();
+  if (gobble_ws)
+gfc_gobble_whitespace ();
 
   if (gfc_next_ascii_char () == c)
 return MATCH_YES;
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 495c93e0b5c..1f53e0cb67d 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -45,14 +45,14 @@ extern gfc_access gfc_typebound_default_access;
 match gfc_match_special_char (gfc_char_t *);
 match gfc_match_space (void);
 match gfc_match_eos (void);
-match gfc_match_small_literal_int (int *, int *);
+match gfc_match_small_literal_int (int *, int *, bool = true);
 match gfc_match_st_label (gfc_st_label **);
 match gfc_match_small_int (int *);
-match gfc_match_name (char *);
+match gfc_match_name (char *, bool = true);
 match gfc_match_symbol (gfc_symbol **, int);
 match gfc_match_sym_tree (gfc_symtree **, int);
 match gfc_match_intrinsic_op (gfc_intrinsic_op *);
-match gfc_match_char (char);
+match gfc_match_char (char, bool = true);
 match gfc_match (const char *, ...);
 match gfc_match_iterator (gfc_iterator *, int);
 match gfc_match_parens (void);
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
in

Re: [PATCH, v3] Fortran: detect blanks within literal constants in free-form mode [PR92805]

2022-07-30 Thread Harald Anlauf via Gcc-patches

Hi Thomas,

Am 30.07.22 um 09:46 schrieb Thomas Koenig via Fortran:


Hi Harald,


This introduces the helper function gfc_match_next_char, which is
your second option.


I would be a little bit concerned about compilation times
with the additional function call overhead.


the function it replaces (gfc_match_char) is also in a different
file, thus the overhead is at least neutral.  Given that the latter
has an additional call to gfc_gobble_whitespace(), we actually get
better...


The function is used only in one place; would it make
sense to put it into primary.cc and declare it static?


Can do that.


Best regards

 Thomas



Thanks,
Harald


[PATCH, v3] Fortran: detect blanks within literal constants in free-form mode [PR92805]

2022-07-29 Thread Harald Anlauf via Gcc-patches

Hi Mikael,

Am 29.07.22 um 22:36 schrieb Mikael Morin:

Indeed, I overlooked that, but my opinion remains that we shouldn’t play
with fixed vs free form considerations here.
So the options I can see are:
  - handle the locus in get_kind; we do it a lot already in matching
functions, so it wouldn’t be different here.
  - implement a variant of gfc_match_char without space gobbling.
  - use gfc_match(...), which is a bit heavy weight to match a single
char string, but otherwise would keep things concise.

My preference goes to the third option, but I’m fine with either of them
if you have a different one.



how about the attached?

This introduces the helper function gfc_match_next_char, which is
your second option.

Thanks,
Harald
From 0a95d103e4855fbcc20fd24d44b97b690d570333 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Thu, 28 Jul 2022 22:07:02 +0200
Subject: [PATCH] Fortran: detect blanks within literal constants in free-form
 mode [PR92805]

gcc/fortran/ChangeLog:

	PR fortran/92805
	* gfortran.h (gfc_match_next_char): Declare it.
	* primary.cc (get_kind): Do not skip over blanks in free-form mode.
	(match_string_constant): Likewise.
	* scanner.cc (gfc_match_next_char): New.  Match next character of
	input, treating whitespace depending on fixed or free form.

gcc/testsuite/ChangeLog:

	PR fortran/92805
	* gfortran.dg/literal_constants.f: New test.
	* gfortran.dg/literal_constants.f90: New test.

Co-authored-by: Steven G. Kargl 
---
 gcc/fortran/gfortran.h|  1 +
 gcc/fortran/primary.cc| 17 +
 gcc/fortran/scanner.cc| 17 +
 gcc/testsuite/gfortran.dg/literal_constants.f | 20 
 .../gfortran.dg/literal_constants.f90 | 24 +++
 5 files changed, 68 insertions(+), 11 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/literal_constants.f
 create mode 100644 gcc/testsuite/gfortran.dg/literal_constants.f90

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 696aadd7db6..645a30e7d49 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3209,6 +3209,7 @@ gfc_char_t gfc_next_char (void);
 char gfc_next_ascii_char (void);
 gfc_char_t gfc_peek_char (void);
 char gfc_peek_ascii_char (void);
+match gfc_match_next_char (gfc_char_t);
 void gfc_error_recovery (void);
 void gfc_gobble_whitespace (void);
 void gfc_new_file (void);
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 3f01f67cd49..9fa6779200f 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -92,14 +92,17 @@ get_kind (int *is_iso_c)
 {
   int kind;
   match m;
+  char c;
 
   *is_iso_c = 0;
 
-  if (gfc_match_char ('_') != MATCH_YES)
+  if (gfc_match_next_char ('_') != MATCH_YES)
 return -2;
 
-  m = match_kind_param (&kind, is_iso_c);
-  if (m == MATCH_NO)
+  m = MATCH_NO;
+  c = gfc_peek_ascii_char ();
+  if ((gfc_current_form == FORM_FREE && gfc_is_whitespace (c))
+  || (m = match_kind_param (&kind, is_iso_c)) == MATCH_NO)
 gfc_error ("Missing kind-parameter at %C");
 
   return (m == MATCH_YES) ? kind : -1;
@@ -1074,17 +1077,9 @@ match_string_constant (gfc_expr **result)
   c = gfc_next_char ();
 }
 
-  if (c == ' ')
-{
-  gfc_gobble_whitespace ();
-  c = gfc_next_char ();
-}
-
   if (c != '_')
 goto no_match;
 
-  gfc_gobble_whitespace ();
-
   c = gfc_next_char ();
   if (c != '\'' && c != '"')
 goto no_match;
diff --git a/gcc/fortran/scanner.cc b/gcc/fortran/scanner.cc
index 2dff2514700..2d1980c074c 100644
--- a/gcc/fortran/scanner.cc
+++ b/gcc/fortran/scanner.cc
@@ -1690,6 +1690,23 @@ gfc_peek_ascii_char (void)
 }
 
 
+/* Match next character of input.  In fixed form mode, we also ignore
+   spaces.  */
+
+match
+gfc_match_next_char (gfc_char_t c)
+{
+  locus where;
+
+  where = gfc_current_locus;
+  if (gfc_next_char () == c)
+return MATCH_YES;
+
+  gfc_current_locus = where;
+  return MATCH_NO;
+}
+
+
 /* Recover from an error.  We try to get past the current statement
and get lined up for the next.  The next statement follows a '\n'
or a ';'.  We also assume that we are not within a character
diff --git a/gcc/testsuite/gfortran.dg/literal_constants.f b/gcc/testsuite/gfortran.dg/literal_constants.f
new file mode 100644
index 000..4d1f1b7eb4c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/literal_constants.f
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-ffixed-form" }
+! PR fortran/92805 - blanks within literal constants in fixed-form mode
+
+  implicit none
+  integer, parameter :: ck = kind ("a")  ! default character kind
+  integer, parameter :: rk = kind (1.0)  ! default real kind
+  print *, 1_"abc"
+  print *, 1 _"abc"
+  print *, 1_ "abc"
+  print *, ck_"a&q

Re: [PATCH, v2] Fortran: fix invalid rank error in ASSOCIATED when rank is remapped [PR77652]

2022-07-29 Thread Harald Anlauf via Gcc-patches

Am 28.07.22 um 22:19 schrieb Mikael Morin:

Hello,

Le 27/07/2022 à 21:45, Harald Anlauf via Fortran a écrit :

ok, I have thought about your comments in the review process,
and played with the Cray compiler.  Attached is a refined version
of the patch that now rejects in addition these cases for which there
are no possible related pointer assignments with bounds remapping:

   ASSOCIATED (scalar, array) ! impossible, cannot remap bounds
   ASSOCIATED (array, scalar) ! a scalar is not simply contiguous


In principle, it could make sense to construct a one-sized array pointer
(of any rank) pointing to a scalar, but I agree that if we follow the
rules of the standard to the letter, it should be rejected (and we do
reject such a pointer assignment).
So, with this case eliminated, this patch looks good to me as is.


OK, so I will push that version soon.


Regarding Toon’s suggestion to ask the fortran committee, it sounds
sensible.  I propose to prepare something tomorrow.



Depending on the answer we can later refine the compile-time check
and relax if needed.

Harald


[PATCH, v2] Fortran: detect blanks within literal constants in free-form mode [PR92805]

2022-07-29 Thread Harald Anlauf via Gcc-patches

Hi Mikael,

Am 29.07.22 um 13:11 schrieb Mikael Morin:

Hello,

Le 28/07/2022 à 22:11, Harald Anlauf via Fortran a écrit :

Dear all,

in free-form mode, blanks are significant, so they cannot appear
in literal constants, especially not before or after the "_" that
separates the literal and the kind specifier.

The initial patch from Steve addressed numerical literals, which
I completed by adjusting the parsing of string literals.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?


It looks correct, but I think we should continue to have the free vs
fixed form abstracted away from the parsing code.


yes, that makes sense.


So, I suggest instead to remove the calls to gfc_gobble_whitespace in
match_string_constant,


Indeed, removing these simplifies the function and indeed works!

> and use gfc_next_char instead of gfc_match_char

in get_kind.


There is one important functionality in gfc_match_char(): it manages
the locus.  We would need then to add this explicitly to get_kind,
which does not look to me like a big improvement over the present
solution.  Otherwise I get test regressions.


Mikael



I've attached a revised version with improved match_string_constant().
What do you think?

Thanks,
Harald
From f8e7c297b7c9e5a2b22185c7e0d638764c33aa71 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Thu, 28 Jul 2022 22:07:02 +0200
Subject: [PATCH] Fortran: detect blanks within literal constants in free-form
 mode [PR92805]

gcc/fortran/ChangeLog:

	PR fortran/92805
	* primary.cc (get_kind): Do not skip over blanks in free-form mode.
	(match_string_constant): Likewise.

gcc/testsuite/ChangeLog:

	PR fortran/92805
	* gfortran.dg/literal_constants.f: New test.
	* gfortran.dg/literal_constants.f90: New test.

Co-authored-by: Steven G. Kargl 
---
 gcc/fortran/primary.cc| 19 +++
 gcc/testsuite/gfortran.dg/literal_constants.f | 20 
 .../gfortran.dg/literal_constants.f90 | 24 +++
 3 files changed, 53 insertions(+), 10 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/literal_constants.f
 create mode 100644 gcc/testsuite/gfortran.dg/literal_constants.f90

diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 3f01f67cd49..604f98a8dd9 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -92,14 +92,21 @@ get_kind (int *is_iso_c)
 {
   int kind;
   match m;
+  char c;
 
   *is_iso_c = 0;
 
+  c = gfc_peek_ascii_char ();
+  if (gfc_current_form == FORM_FREE && gfc_is_whitespace (c))
+return -2;
+
   if (gfc_match_char ('_') != MATCH_YES)
 return -2;
 
-  m = match_kind_param (&kind, is_iso_c);
-  if (m == MATCH_NO)
+  m = MATCH_NO;
+  c = gfc_peek_ascii_char ();
+  if ((gfc_current_form == FORM_FREE && gfc_is_whitespace (c))
+  || (m = match_kind_param (&kind, is_iso_c)) == MATCH_NO)
 gfc_error ("Missing kind-parameter at %C");
 
   return (m == MATCH_YES) ? kind : -1;
@@ -1074,17 +1081,9 @@ match_string_constant (gfc_expr **result)
   c = gfc_next_char ();
 }
 
-  if (c == ' ')
-{
-  gfc_gobble_whitespace ();
-  c = gfc_next_char ();
-}
-
   if (c != '_')
 goto no_match;
 
-  gfc_gobble_whitespace ();
-
   c = gfc_next_char ();
   if (c != '\'' && c != '"')
 goto no_match;
diff --git a/gcc/testsuite/gfortran.dg/literal_constants.f b/gcc/testsuite/gfortran.dg/literal_constants.f
new file mode 100644
index 000..4d1f1b7eb4c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/literal_constants.f
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-ffixed-form" }
+! PR fortran/92805 - blanks within literal constants in fixed-form mode
+
+  implicit none
+  integer, parameter :: ck = kind ("a")  ! default character kind
+  integer, parameter :: rk = kind (1.0)  ! default real kind
+  print *, 1_"abc"
+  print *, 1 _"abc"
+  print *, 1_ "abc"
+  print *, ck_"a"
+  print *, ck _"ab"
+  print *, ck_ "ab"
+  print *, 3.1415_4
+  print *, 3.1415 _4
+  print *, 3.1415_ 4
+  print *, 3.1415_rk
+  print *, 3.1415 _rk
+  print *, 3.1415_ rk
+  end
diff --git a/gcc/testsuite/gfortran.dg/literal_constants.f90 b/gcc/testsuite/gfortran.dg/literal_constants.f90
new file mode 100644
index 000..f8908f9ad76
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/literal_constants.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-ffree-form" }
+! PR fortran/92805 - blanks within literal constants in free-form mode
+
+  implicit none
+  integer, parameter :: ck = kind ("a")  ! default character kind
+  integer, parameter :: rk = kind (1.0)  ! default real kind
+  print *, 1_"abc"
+  print *, 1 _"abc"   ! { dg-error "Syntax error" }
+

[PATCH] Fortran: detect blanks within literal constants in free-form mode [PR92805]

2022-07-28 Thread Harald Anlauf via Gcc-patches
Dear all,

in free-form mode, blanks are significant, so they cannot appear
in literal constants, especially not before or after the "_" that
separates the literal and the kind specifier.

The initial patch from Steve addressed numerical literals, which
I completed by adjusting the parsing of string literals.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

From f58c00f5792d6ec0037696df733857580a029ba9 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Thu, 28 Jul 2022 22:07:02 +0200
Subject: [PATCH] Fortran: detect blanks within literal constants in free-form
 mode [PR92805]

gcc/fortran/ChangeLog:

	PR fortran/92805
	* primary.cc (get_kind): Do not skip over blanks in free-form mode.
	(match_string_constant): Likewise.

gcc/testsuite/ChangeLog:

	PR fortran/92805
	* gfortran.dg/literal_constants.f: New test.
	* gfortran.dg/literal_constants.f90: New test.

Co-authored-by: Steven G. Kargl 
---
 gcc/fortran/primary.cc| 18 --
 gcc/testsuite/gfortran.dg/literal_constants.f | 20 
 .../gfortran.dg/literal_constants.f90 | 24 +++
 3 files changed, 60 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/literal_constants.f
 create mode 100644 gcc/testsuite/gfortran.dg/literal_constants.f90

diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 3f01f67cd49..9d200cdf65b 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -92,14 +92,21 @@ get_kind (int *is_iso_c)
 {
   int kind;
   match m;
+  char c;

   *is_iso_c = 0;

+  c = gfc_peek_ascii_char ();
+  if (gfc_current_form == FORM_FREE && gfc_is_whitespace (c))
+return -2;
+
   if (gfc_match_char ('_') != MATCH_YES)
 return -2;

-  m = match_kind_param (&kind, is_iso_c);
-  if (m == MATCH_NO)
+  m = MATCH_NO;
+  c = gfc_peek_ascii_char ();
+  if ((gfc_current_form == FORM_FREE && gfc_is_whitespace (c))
+  || (m = match_kind_param (&kind, is_iso_c)) == MATCH_NO)
 gfc_error ("Missing kind-parameter at %C");

   return (m == MATCH_YES) ? kind : -1;
@@ -1074,6 +1081,9 @@ match_string_constant (gfc_expr **result)
   c = gfc_next_char ();
 }

+  if (gfc_current_form == FORM_FREE && gfc_is_whitespace (c))
+goto no_match;
+
   if (c == ' ')
 {
   gfc_gobble_whitespace ();
@@ -1083,6 +1093,10 @@ match_string_constant (gfc_expr **result)
   if (c != '_')
 goto no_match;

+  c = gfc_peek_ascii_char ();
+  if (gfc_current_form == FORM_FREE && gfc_is_whitespace (c))
+goto no_match;
+
   gfc_gobble_whitespace ();

   c = gfc_next_char ();
diff --git a/gcc/testsuite/gfortran.dg/literal_constants.f b/gcc/testsuite/gfortran.dg/literal_constants.f
new file mode 100644
index 000..4d1f1b7eb4c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/literal_constants.f
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-ffixed-form" }
+! PR fortran/92805 - blanks within literal constants in fixed-form mode
+
+  implicit none
+  integer, parameter :: ck = kind ("a")  ! default character kind
+  integer, parameter :: rk = kind (1.0)  ! default real kind
+  print *, 1_"abc"
+  print *, 1 _"abc"
+  print *, 1_ "abc"
+  print *, ck_"a"
+  print *, ck _"ab"
+  print *, ck_ "ab"
+  print *, 3.1415_4
+  print *, 3.1415 _4
+  print *, 3.1415_ 4
+  print *, 3.1415_rk
+  print *, 3.1415 _rk
+  print *, 3.1415_ rk
+  end
diff --git a/gcc/testsuite/gfortran.dg/literal_constants.f90 b/gcc/testsuite/gfortran.dg/literal_constants.f90
new file mode 100644
index 000..f8908f9ad76
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/literal_constants.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-ffree-form" }
+! PR fortran/92805 - blanks within literal constants in free-form mode
+
+  implicit none
+  integer, parameter :: ck = kind ("a")  ! default character kind
+  integer, parameter :: rk = kind (1.0)  ! default real kind
+  print *, 1_"abc"
+  print *, 1 _"abc"   ! { dg-error "Syntax error" }
+  print *, 1_ "abc"   ! { dg-error "Missing kind-parameter" }
+  print *, 1 _ "abc"  ! { dg-error "Syntax error" }
+  print *, ck_"a"
+  print *, ck _"ab"   ! { dg-error "Syntax error" }
+  print *, ck_ "ab"   ! { dg-error "Syntax error" }
+  print *, ck _ "ab"  ! { dg-error "Syntax error" }
+  print *, 3.1415_4
+  print *, 3.1415 _4  ! { dg-error "Syntax error" }
+  print *, 3.1415_ 4  ! { dg-error "Missing kind-parameter" }
+  print *, 3.1415 _ 4 ! { dg-error "Syntax error" }
+  print *, 3.1415_rk
+  print *, 3.1415 _rk ! { dg-error "Syntax error" }
+  print *, 3.1415_ rk ! { dg-error "Missing kind-parameter" }
+  print *, 3.141 _ rk ! { dg-error "Syntax error" }
+  end
--
2.35.3



[PATCH, v2] Fortran: fix invalid rank error in ASSOCIATED when rank is remapped [PR77652]

2022-07-27 Thread Harald Anlauf via Gcc-patches

Hi Mikael,

Am 26.07.22 um 21:25 schrieb Mikael Morin:

Le 25/07/2022 à 22:18, Harald Anlauf a écrit :

I would normally trust NAG more than Intel and Cray.

… and yourself, it seems.  Too bad.


If somebody else convinces me to accept that NAG has it wrong this
time, I would be happy to proceed.

It won’t convince you about NAG, but here are two reasons to proceed:
  - Consensus among the maintainers is sufficient; it’s the case here.
  - If uncertain, let’s be rather too permissive than too strict; it’s
fine as long as the runtime answer is right.


ok, I have thought about your comments in the review process,
and played with the Cray compiler.  Attached is a refined version
of the patch that now rejects in addition these cases for which there
are no possible related pointer assignments with bounds remapping:

  ASSOCIATED (scalar, array) ! impossible, cannot remap bounds
  ASSOCIATED (array, scalar) ! a scalar is not simply contiguous

(Cray would allow those two, but IMHO these should be disallowed).

See attached for version 2 with updated testcase, regtested again.

I think this is what we could both be happy with... ;-)

Thanks,
Harald
From 5432880ff21de862c64d79626aa19c4eda928cd5 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Wed, 27 Jul 2022 21:34:22 +0200
Subject: [PATCH] Fortran: fix invalid rank error in ASSOCIATED when rank is
 remapped [PR77652]

gcc/fortran/ChangeLog:

	PR fortran/77652
	* check.cc (gfc_check_associated): Make the rank check of POINTER
	vs. TARGET match the allowed forms of pointer assignment for the
	selected Fortran standard.

gcc/testsuite/ChangeLog:

	PR fortran/77652
	* gfortran.dg/associated_target_9a.f90: New test.
	* gfortran.dg/associated_target_9b.f90: New test.
---
 gcc/fortran/check.cc  | 23 ++--
 .../gfortran.dg/associated_target_9a.f90  | 27 +++
 .../gfortran.dg/associated_target_9b.f90  | 23 
 3 files changed, 71 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/associated_target_9a.f90
 create mode 100644 gcc/testsuite/gfortran.dg/associated_target_9b.f90

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 91d87a1b2c1..1da0b3cbe15 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -1502,8 +1502,27 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
 t = false;
   /* F2018 C838 explicitly allows an assumed-rank variable as the first
  argument of intrinsic inquiry functions.  */
-  if (pointer->rank != -1 && !rank_check (target, 0, pointer->rank))
-t = false;
+  if (pointer->rank != -1 && pointer->rank != target->rank)
+{
+  if (pointer->rank == 0 || target->rank == 0)
+	{
+	  /* There exists no valid pointer assignment using bounds
+	 remapping for scalar => array or array => scalar. */
+	  if (!rank_check (target, 0, pointer->rank))
+	t = false;
+	}
+  else if (target->rank != 1)
+	{
+	  if (!gfc_notify_std (GFC_STD_F2008, "Rank remapping target is not "
+			   "rank 1 at %L", &target->where))
+	t = false;
+	}
+  else if ((gfc_option.allow_std & GFC_STD_F2003) == 0)
+	{
+	  if (!rank_check (target, 0, pointer->rank))
+	t = false;
+	}
+}
   if (target->rank > 0 && target->ref)
 {
   for (i = 0; i < target->rank; i++)
diff --git a/gcc/testsuite/gfortran.dg/associated_target_9a.f90 b/gcc/testsuite/gfortran.dg/associated_target_9a.f90
new file mode 100644
index 000..708645d5bcb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associated_target_9a.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! { dg-options "-std=f2018" }
+! PR fortran/77652 - Invalid rank error in ASSOCIATED when rank is remapped
+! Contributed by Paul Thomas
+
+program p
+  real, dimension(100),  target  :: array
+  real, dimension(:,:),  pointer :: matrix
+  real, dimension(20,5), target  :: array2
+  real, dimension(:),pointer :: matrix2
+  matrix(1:20,1:5) => array
+  matrix2(1:100)   => array2
+  !
+  ! F2018:16.9.16, ASSOCIATED (POINTER [, TARGET])
+  ! Case(v): If TARGET is present and is an array target, the result is
+  ! true if and only if POINTER is associated with a target that has
+  ! the same shape as TARGET, ...
+  if (associated (matrix, array )) stop 1
+  if (associated (matrix2,array2)) stop 2
+  call check (matrix2, array2)
+contains
+  subroutine check (ptr, tgt)
+real, pointer :: ptr(..)
+real, target  :: tgt(:,:)
+if (associated (ptr, tgt)) stop 3
+  end subroutine check
+end
diff --git a/gcc/testsuite/gfortran.dg/associated_target_9b.f90 b/gcc/testsuite/gfortran.dg/associated_target_9b.f90
new file mode 100644
index 000..1daa0a7dde1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associated_target_9b.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! PR fortran/77652 - Invalid rank error 

[PATCH] Fortran: error recovery from calculation of storage size of a symbol [PR103504]

2022-07-25 Thread Harald Anlauf via Gcc-patches
Dear all,

we currently may ICE when array bounds of a dummy argument have
a non-integer type, and the procedure with the bad declaration is
referenced.  The same applies to bad character length of dummies.
We could simply punt in such a situation, as the causing error
seems to be reliably diagnosed, see testcase.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

This is a really safe fix and potentially backportable to other
open branches.  Would that be fine?

Thanks,
Harald

From 04bea97afd7f17083774b4309ee4d3c45e278dd3 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Mon, 25 Jul 2022 22:29:50 +0200
Subject: [PATCH] Fortran: error recovery from calculation of storage size of a
 symbol [PR103504]

gcc/fortran/ChangeLog:

	PR fortran/103504
	* interface.cc (get_sym_storage_size): Array bounds and character
	length can only be of integer type.

gcc/testsuite/ChangeLog:

	PR fortran/103504
	* gfortran.dg/pr103504.f90: New test.
---
 gcc/fortran/interface.cc   |  7 +--
 gcc/testsuite/gfortran.dg/pr103504.f90 | 28 ++
 2 files changed, 33 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr103504.f90

diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index 7ed6e13711f..71eec78259b 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -2792,7 +2792,8 @@ get_sym_storage_size (gfc_symbol *sym)
   if (sym->ts.type == BT_CHARACTER)
 {
   if (sym->ts.u.cl && sym->ts.u.cl->length
-  && sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+	  && sym->ts.u.cl->length->expr_type == EXPR_CONSTANT
+	  && sym->ts.u.cl->length->ts.type == BT_INTEGER)
 	strlen = mpz_get_ui (sym->ts.u.cl->length->value.integer);
   else
 	return 0;
@@ -2809,7 +2810,9 @@ get_sym_storage_size (gfc_symbol *sym)
   for (i = 0; i < sym->as->rank; i++)
 {
   if (sym->as->upper[i]->expr_type != EXPR_CONSTANT
-	  || sym->as->lower[i]->expr_type != EXPR_CONSTANT)
+	  || sym->as->lower[i]->expr_type != EXPR_CONSTANT
+	  || sym->as->upper[i]->ts.type != BT_INTEGER
+	  || sym->as->lower[i]->ts.type != BT_INTEGER)
 	return 0;

   elements *= mpz_get_si (sym->as->upper[i]->value.integer)
diff --git a/gcc/testsuite/gfortran.dg/pr103504.f90 b/gcc/testsuite/gfortran.dg/pr103504.f90
new file mode 100644
index 000..607d1c6c8cc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr103504.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! PR fortran/103504 - ICE in get_sym_storage_size, at fortran/interface.c:2800
+! Contributed by G.Steinmetz
+
+program p
+  implicit none
+  real  :: y(1)
+  character :: b
+  call s(y)
+  call t(y)
+  call u(y)
+  call c(b)
+contains
+  subroutine s(x)
+real :: x(abs(1.):1)! { dg-error "must be of INTEGER type" }
+  end
+  subroutine t(x)
+real :: x(abs(1.):1)! { dg-error "must be of INTEGER type" }
+  end
+  subroutine u(x)
+real :: x(1:abs(1.))! { dg-error "must be of INTEGER type" }
+  end
+  subroutine c(z)
+character(len=abs(1.)) :: z ! { dg-error "must be of INTEGER type" }
+  end subroutine c
+end
+
+! { dg-prune-output "must be of INTEGER type" }
--
2.35.3



Re: [PATCH] Fortran: fix invalid rank error in ASSOCIATED when rank is remapped [PR77652]

2022-07-25 Thread Harald Anlauf via Gcc-patches
Hi Mikael,

> > https://community.intel.com/t5/Intel-Fortran-Compiler/Intel-rejects-ASSOCIATED-pointer-target-for-non-equal-ranks/m-p/1402799/highlight/true#M162159
> > 
> 
> I disagree with the conclusion.  Quoting Steve Lionel’s post:
> > What you're missing is this:
> > 
> > TARGET (optional) shall be allowable as the data-target or proc-target in a 
> > pointer assignment statement (10.2.2) in which POINTER is 
> > data-pointer-object or proc-pointer-object.
> > 
> > We then go to 10.2.2 which says (emphasis mine):
> > 
> > C1019 (R1033) If bounds-remapping-list is not specified, the ranks of 
> > data-pointer-object and data-target shall be the same.
> > 
> > So... not valid Fortran 2018.
> 
> except, that there is also this:
> > C1018 (R1033) If bounds-remapping-list is specified, the number of 
> > bounds-remappings shall equal the rank of data-pointer-object.
> which practically imposes no conformance rule between 
> data-pointer-object and data-target.

this is also why I initially thought that rank remapping is fine.

> Note that in the syntax definition, bounds-remapping-list is not part of 
> data-pointer-object.  In other words, by collating a 
> bounds-remapping-list next to POINTER, one can construct an allowable 
> pointer assignment from TARGET to POINTER, which satisfies the 
> requirement, even if TARGET and POINTER don’t have the same rank.

I fully agree with you here.

My current state of - sort-of - knowledge:

- Crayftn 14.0 allows for rank remapping, accepts code the way you describe,
  including assumed-rank for the POINTER argument.

- Nvidia 22.5 allows for rank remapping, but does not handle assumed-rank.

- NAG 7.1 is said to reject non-equal rank.  NAG 7.0 does not accept it.

- Intel rejects non-equal rank.  Steve Lionel even thinks that assumed-rank
  should not be allowed here.  I believe he is wrong here.

I would normally trust NAG more than Intel and Cray.  If somebody else convinces
me to accept that NAG has it wrong this time, I would be happy to proceed.

Apart from the above discussion about what the compiler should accept,
the library side of gfortran seems to be fine...  :-)

Harald



Re: [PATCH] Fortran: fix invalid rank error in ASSOCIATED when rank is remapped [PR77652]

2022-07-25 Thread Harald Anlauf via Gcc-patches
Hi Mikael, all,

a discussion in the Intel compiler forum suggests that the F2018
standard prohibits such use of the ASSOCIATED intrinsic.

https://community.intel.com/t5/Intel-Fortran-Compiler/Intel-rejects-ASSOCIATED-pointer-target-for-non-equal-ranks/m-p/1402799/highlight/true#M162159

As a consequence, the PR is likely invalid, as is the patch.
Withdrawing.

Sorry for the noise!

Harald


> Gesendet: Montag, 25. Juli 2022 um 12:43 Uhr
> Von: "Mikael Morin" 
> An: "Harald Anlauf" , "fortran" , 
> "gcc-patches" 
> Betreff: Re: [PATCH] Fortran: fix invalid rank error in ASSOCIATED when rank 
> is remapped [PR77652]
>
> Le 21/07/2022 à 22:12, Harald Anlauf via Fortran a écrit :
> > Dear all,
> > 
> > the rank check for ASSOCIATED (POINTER, TARGET) did not allow all
> > rank combinations that were allowed in pointer assignment for
> > newer versions of the Fortran standard (F2008+).  Fix the logic.
> > 
> So, if I understand correctly the (fixed) logic, it is:
>   f2008+=> no check
>   f2003 => check target’s rank different from 1
>   up to f95 => check pointer’s rank equals target’s
> 
> 
> I think one check is missing, that is when pointer is scalar and the 
> target is non-scalar (either rank 1 or not).  This case should also be 
> rejected for f2003+, not just up to f95.
> 
> Mikael
>


[PATCH] Fortran: fix invalid rank error in ASSOCIATED when rank is remapped [PR77652]

2022-07-21 Thread Harald Anlauf via Gcc-patches
Dear all,

the rank check for ASSOCIATED (POINTER, TARGET) did not allow all
rank combinations that were allowed in pointer assignment for
newer versions of the Fortran standard (F2008+).  Fix the logic.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

From 338b43aefece04435d32f961c33d217aaa511095 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Thu, 21 Jul 2022 22:02:58 +0200
Subject: [PATCH] Fortran: fix invalid rank error in ASSOCIATED when rank is
 remapped [PR77652]

gcc/fortran/ChangeLog:

	PR fortran/77652
	* check.cc (gfc_check_associated): Make the rank check of POINTER
	vs. TARGET match the selected Fortran standard.

gcc/testsuite/ChangeLog:

	PR fortran/77652
	* gfortran.dg/associated_target_9a.f90: New test.
	* gfortran.dg/associated_target_9b.f90: New test.
---
 gcc/fortran/check.cc  | 16 +--
 .../gfortran.dg/associated_target_9a.f90  | 27 +++
 .../gfortran.dg/associated_target_9b.f90  | 15 +++
 3 files changed, 56 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/associated_target_9a.f90
 create mode 100644 gcc/testsuite/gfortran.dg/associated_target_9b.f90

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 91d87a1b2c1..6d3a4701950 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -1502,8 +1502,20 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
 t = false;
   /* F2018 C838 explicitly allows an assumed-rank variable as the first
  argument of intrinsic inquiry functions.  */
-  if (pointer->rank != -1 && !rank_check (target, 0, pointer->rank))
-t = false;
+  if (pointer->rank != -1 && pointer->rank != target->rank)
+{
+  if (target->rank != 1)
+	{
+	  if (!gfc_notify_std (GFC_STD_F2008, "Rank remapping target is not "
+			   "rank 1 at %L", &target->where))
+	t = false;
+	}
+  else if ((gfc_option.allow_std & GFC_STD_F2003) == 0)
+	{
+	  if (!rank_check (target, 0, pointer->rank))
+	t = false;
+	}
+}
   if (target->rank > 0 && target->ref)
 {
   for (i = 0; i < target->rank; i++)
diff --git a/gcc/testsuite/gfortran.dg/associated_target_9a.f90 b/gcc/testsuite/gfortran.dg/associated_target_9a.f90
new file mode 100644
index 000..708645d5bcb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associated_target_9a.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! { dg-options "-std=f2018" }
+! PR fortran/77652 - Invalid rank error in ASSOCIATED when rank is remapped
+! Contributed by Paul Thomas
+
+program p
+  real, dimension(100),  target  :: array
+  real, dimension(:,:),  pointer :: matrix
+  real, dimension(20,5), target  :: array2
+  real, dimension(:),pointer :: matrix2
+  matrix(1:20,1:5) => array
+  matrix2(1:100)   => array2
+  !
+  ! F2018:16.9.16, ASSOCIATED (POINTER [, TARGET])
+  ! Case(v): If TARGET is present and is an array target, the result is
+  ! true if and only if POINTER is associated with a target that has
+  ! the same shape as TARGET, ...
+  if (associated (matrix, array )) stop 1
+  if (associated (matrix2,array2)) stop 2
+  call check (matrix2, array2)
+contains
+  subroutine check (ptr, tgt)
+real, pointer :: ptr(..)
+real, target  :: tgt(:,:)
+if (associated (ptr, tgt)) stop 3
+  end subroutine check
+end
diff --git a/gcc/testsuite/gfortran.dg/associated_target_9b.f90 b/gcc/testsuite/gfortran.dg/associated_target_9b.f90
new file mode 100644
index 000..ca62ab155c0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associated_target_9b.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! PR fortran/77652 - Invalid rank error in ASSOCIATED when rank is remapped
+! Contributed by Paul Thomas
+
+subroutine s
+  real, dimension(100),  target  :: array
+  real, dimension(:,:),  pointer :: matrix
+  real, dimension(20,5), target  :: array2
+  real, dimension(:),pointer :: matrix2
+! matrix(1:20,1:5) => array
+! matrix2(1:100)   => array2
+  print *, associated (matrix, array ) ! Technically legal F2003
+  print *, associated (matrix2,array2) ! { dg-error "is not rank 1" }
+end
--
2.35.3



[PATCH, committed] Fortran: fix parsing of omp task affinity iterator clause [PR101330]

2022-07-20 Thread Harald Anlauf via Gcc-patches
Dear all,

there was some left-over code - likely from development - that could
lead to a compiler segfault when given invalid input.  Steve found
the offending line.  Removing it solves the issue.

The fix was acknowledged by Tobias in the PR.

Regtested on x86_64-pc-linux-gnu.

Pushed as: r13-1767-g26bbe78f77f73bb66af1ac13d0deec888a3c6510

Will backport to 12-branch, as the offending code was introduced there.

Thanks,
Harald

From 26bbe78f77f73bb66af1ac13d0deec888a3c6510 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Wed, 20 Jul 2022 20:40:23 +0200
Subject: [PATCH] Fortran: fix parsing of omp task affinity iterator clause
 [PR101330]

gcc/fortran/ChangeLog:

	PR fortran/101330
	* openmp.cc (gfc_match_iterator): Remove left-over code from
	development that could lead to a crash on invalid input.

gcc/testsuite/ChangeLog:

	PR fortran/101330
	* gfortran.dg/gomp/affinity-clause-7.f90: New test.
---
 gcc/fortran/openmp.cc |  1 -
 .../gfortran.dg/gomp/affinity-clause-7.f90| 19 +++
 2 files changed, 19 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/affinity-clause-7.f90

diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index bd4ff259fe0..df9cdf43eb7 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -1181,7 +1181,6 @@ gfc_match_iterator (gfc_namespace **ns, bool permit_var)
 	}
   if (':' == gfc_peek_ascii_char ())
 	{
-	  step = gfc_get_expr ();
 	  if (gfc_match (": %e ", &step) != MATCH_YES)
 	{
 	  gfc_free_expr (begin);
diff --git a/gcc/testsuite/gfortran.dg/gomp/affinity-clause-7.f90 b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-7.f90
new file mode 100644
index 000..5b1ca85aba3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-7.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! PR fortran/101330 - ICE in free_expr0(): Bad expr type
+! Contributed by G.Steinmetz
+
+  implicit none
+  integer :: j, b(10)
+!$omp task affinity (iterator(j=1:2:1) : b(j))
+!$omp end task
+!$omp task affinity (iterator(j=1:2:) : b(j)) ! { dg-error "Invalid character" }
+!!$omp end task
+!$omp task affinity (iterator(j=1:2:  ! { dg-error "Invalid character" }
+!!$omp end task
+!$omp task affinity (iterator(j=1:2:) ! { dg-error "Invalid character" }
+!!$omp end task
+!$omp task affinity (iterator(j=1:2::)! { dg-error "Invalid character" }
+!!$omp end task
+!$omp task affinity (iterator(j=1:2:))! { dg-error "Invalid character" }
+!!$omp end task
+end
--
2.35.3



Re: [PATCH] Fortran: error recovery on invalid array reference of non-array [PR103590]

2022-07-19 Thread Harald Anlauf via Gcc-patches

Hi Mikael,

Am 19.07.22 um 22:53 schrieb Mikael Morin:

It could be anything better than the (unhelpfull) internal error it is
replacing.
I suggest for example "Invalid array reference of a non-array entity at
%L".


yes, that's much better!  The attached updated patch uses this.

Committed: r13-1757-gf838d15641d256e21ffc126c3277b290ed743928



gfortran's behavior during error handling is difficult to understand.
While the proposed new error message is emitted for associate_54.f90,
it never makes it far enough for the testcase of the present PR
(associate_59.f90).


Indeed.  We try to match several types of statement one after the other,
and each failed match can possibly register an error.  But it is emitted
only if all have failed (see gfc_error_check).  There is no choice of
the best error; the last one registered wins.

This buffering behavior is controlled by calls to gfc_buffer_error(...).
  Error handling during resolution doesn’t need to delay error reporting
as far as I know, and the calls to gfc_buffer_error (false) seem to
correctly disable buffering at the end of every call to next_statement.
  I don’t know why it remains active in this case.



Alright, I should try to remember this and take a closer look next time
I get confused about not getting the error message I wanted...

Thanks,
Harald


Re: [PATCH] Fortran: error recovery on invalid array reference of non-array [PR103590]

2022-07-19 Thread Harald Anlauf via Gcc-patches

Hi Mikael,

Am 19.07.22 um 11:03 schrieb Mikael Morin:

Hello,

the principle looks good, but...

Le 18/07/2022 à 22:43, Harald Anlauf via Fortran a écrit :


diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 2ebf076f730..dacd33561d0 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -5004,7 +5004,11 @@ find_array_spec (gfc_expr *e)
   {
   case REF_ARRAY:
 if (as == NULL)
-  gfc_internal_error ("find_array_spec(): Missing spec");
+  {
+    gfc_error ("Symbol %qs at %L has not been declared as an array",
+   e->symtree->n.sym->name, &e->where);


... the error here only makes sense if the array reference follows a
variable reference.  If it follows a derived type component reference, a
slightly different error message would be more appropriate.


how detailed or tailored should the error message be, or can
we just have a more generic message, like "Name at %L ...",
or "Invalid subscript reference at %L"?  We seem to not hit
that internal error very often...

I have played only little with invalid code in the present context,
but often hit another code path that shows up in associate_54.f90
and gives

Error: Associate-name 'state' at (1) is used as array

For the testcase in the PR, Intel says:

associate_59.f90(7): error #6410: This name has not been declared as an
array or a function.   [A]
print *, [character(a(1)) :: '1'] ! { dg-error "Scalar INTEGER
expression" }
^

Crayftn 14.0 says:

  Improper ir tree in expr_semantics.

print *, [character(a(1)) :: '1'] ! { dg-error "Scalar INTEGER
expression" }
 ^

ftn-873 crayftn: ERROR P, File = associate_59.f90, Line = 7, Column = 26
  Invalid subscripted reference of a scalar ASSOCIATE name.


gfortran's behavior during error handling is difficult to understand.
While the proposed new error message is emitted for associate_54.f90,
it never makes it far enough for the testcase of the present PR
(associate_59.f90).

Thanks,
Harald


[PATCH] Fortran: error recovery on invalid array reference of non-array [PR103590]

2022-07-18 Thread Harald Anlauf via Gcc-patches
Dear all,

I intend to commit the attached patch as obvious to mainline
within the next 24h unless someone complains.  It replaces a
lazy gfc_internal_error by an explicit error message and an
error recovery path.

As a side-effect, we now diagnose a previously missed error
in testcase gfortran.dg/associate_54.f90 similarly to Intel.

Regtested on x86_64-pc-linux-gnu.

Thanks,
Harald

From e6ecc4d8227afea565b0555e95a4f5dcb8f4ecab Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Mon, 18 Jul 2022 22:34:53 +0200
Subject: [PATCH] Fortran: error recovery on invalid array reference of
 non-array [PR103590]

gcc/fortran/ChangeLog:

	PR fortran/103590
	* resolve.cc (find_array_spec): Change function result to bool to
	enable error recovery.  Generate error message for missing array
	spec instead of an internal error.
	(gfc_resolve_ref): Use function result from find_array_spec for
	error recovery.

gcc/testsuite/ChangeLog:

	PR fortran/103590
	* gfortran.dg/associate_54.f90: Adjust.
	* gfortran.dg/associate_59.f90: New test.
---
 gcc/fortran/resolve.cc | 13 ++---
 gcc/testsuite/gfortran.dg/associate_54.f90 |  3 +--
 gcc/testsuite/gfortran.dg/associate_59.f90 |  9 +
 3 files changed, 20 insertions(+), 5 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/associate_59.f90

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 2ebf076f730..dacd33561d0 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -4976,7 +4976,7 @@ gfc_resolve_dim_arg (gfc_expr *dim)
 static void
 resolve_assoc_var (gfc_symbol* sym, bool resolve_target);

-static void
+static bool
 find_array_spec (gfc_expr *e)
 {
   gfc_array_spec *as;
@@ -5004,7 +5004,11 @@ find_array_spec (gfc_expr *e)
   {
   case REF_ARRAY:
 	if (as == NULL)
-	  gfc_internal_error ("find_array_spec(): Missing spec");
+	  {
+	gfc_error ("Symbol %qs at %L has not been declared as an array",
+		   e->symtree->n.sym->name, &e->where);
+	return false;
+	  }

 	ref->u.ar.as = as;
 	as = NULL;
@@ -5028,6 +5032,8 @@ find_array_spec (gfc_expr *e)

   if (as != NULL)
 gfc_internal_error ("find_array_spec(): unused as(2)");
+
+  return true;
 }


@@ -5346,7 +5352,8 @@ gfc_resolve_ref (gfc_expr *expr)
   for (ref = expr->ref; ref; ref = ref->next)
 if (ref->type == REF_ARRAY && ref->u.ar.as == NULL)
   {
-	find_array_spec (expr);
+	if (!find_array_spec (expr))
+	  return false;
 	break;
   }

diff --git a/gcc/testsuite/gfortran.dg/associate_54.f90 b/gcc/testsuite/gfortran.dg/associate_54.f90
index 003175a47fd..b23a4f160ac 100644
--- a/gcc/testsuite/gfortran.dg/associate_54.f90
+++ b/gcc/testsuite/gfortran.dg/associate_54.f90
@@ -26,9 +26,8 @@ contains
 integer, intent(in) :: a
 associate (state => obj%state(TEST_STATES)) ! { dg-error "is used as array" }
 !  state = a
-  state(TEST_STATE) = a
+  state(TEST_STATE) = a ! { dg-error "has not been declared as an array" }
 end associate
   end subroutine test_alter_state1

 end module test
-
diff --git a/gcc/testsuite/gfortran.dg/associate_59.f90 b/gcc/testsuite/gfortran.dg/associate_59.f90
new file mode 100644
index 000..2da97731d39
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_59.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR fortran/103590 - ICE: find_array_spec(): Missing spec
+! Contributed by G.Steinmetz
+
+program p
+  associate (a => 1)
+print *, [character(a(1)) :: '1'] ! { dg-error "Scalar INTEGER expression" }
+  end associate
+end
--
2.35.3



[PATCH, committed] Fortran: do not generate conflicting results under -ff2c [PR104313]

2022-07-15 Thread Harald Anlauf via Gcc-patches
Dear all,

the attached patch by Steve fixes a regression under -ff2c for functions
where the result is not set.  There would otherwise be conflicting
declarations of the returned result, which gimple doesn't like.

I've committed this as obvious after discussion with Steve for him,
see PR, as

commit r13-1715-g517fb1a78102df43f052c6934c27dd51d786aff7

This fixes a 10/11/12/13 regression, will be backported in the next days.

Thanks,
Harald

From 517fb1a78102df43f052c6934c27dd51d786aff7 Mon Sep 17 00:00:00 2001
From: Steve Kargl 
Date: Fri, 15 Jul 2022 22:07:15 +0200
Subject: [PATCH] Fortran: do not generate conflicting results under -ff2c
 [PR104313]

gcc/fortran/ChangeLog:

	PR fortran/104313
	* trans-decl.cc (gfc_generate_return): Do not generate conflicting
	fake results for functions with no result variable under -ff2c.

gcc/testsuite/ChangeLog:

	PR fortran/104313
	* gfortran.dg/pr104313.f: New test.
---
 gcc/fortran/trans-decl.cc|  2 +-
 gcc/testsuite/gfortran.dg/pr104313.f | 11 +++
 2 files changed, 12 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr104313.f

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 6493cc2f6b1..908a4c6d42e 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -6474,7 +6474,7 @@ gfc_generate_return (void)
 	 NULL_TREE, and a 'return' is generated without a variable.
 	 The following generates a 'return __result_XXX' where XXX is
 	 the function name.  */
-	  if (sym == sym->result && sym->attr.function)
+	  if (sym == sym->result && sym->attr.function && !flag_f2c)
 	{
 	  result = gfc_get_fake_result_decl (sym, 0);
 	  result = fold_build2_loc (input_location, MODIFY_EXPR,
diff --git a/gcc/testsuite/gfortran.dg/pr104313.f b/gcc/testsuite/gfortran.dg/pr104313.f
new file mode 100644
index 000..89c8947cb0a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr104313.f
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-additional-options "-ff2c -fdump-tree-original" }
+!
+! PR fortran/104313 - ICE verify_gimple failed with -ff2c
+! Contributed by G.Steinmetz
+
+  function f(a)
+  return
+  end
+
+! { dg-final { scan-tree-dump-times "return" 1 "original" } }
--
2.35.3



[PATCH, committed] Fortran: error recovery for bad initializers of implied-shape arrays [PR106209]

2022-07-14 Thread Harald Anlauf via Gcc-patches
Dear all,

the attached patch introduces error recovery for two cases of using
an invalid array in a declaration of an implied-shape array instead
of hitting internal errors.

Initial patch by Steve.  The final version was approved in the PR
by Steve.

Committed as:

https://gcc.gnu.org/g:748f8a8b145dde59c7b63aa68b5a59515b7efc49

Thanks,
Harald

From 748f8a8b145dde59c7b63aa68b5a59515b7efc49 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Thu, 14 Jul 2022 22:24:55 +0200
Subject: [PATCH] Fortran: error recovery for bad initializers of implied-shape
 arrays [PR106209]

gcc/fortran/ChangeLog:

	PR fortran/106209
	* decl.cc (add_init_expr_to_sym): Handle bad initializers for
	implied-shape arrays.

gcc/testsuite/ChangeLog:

	PR fortran/106209
	* gfortran.dg/pr106209.f90: New test.

Co-authored-by: Steven G. Kargl 
---
 gcc/fortran/decl.cc| 15 +--
 gcc/testsuite/gfortran.dg/pr106209.f90 |  9 +
 2 files changed, 22 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr106209.f90

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 339f8b15035..b6400514731 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -2129,10 +2129,21 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
 	  /* The shape may be NULL for EXPR_ARRAY, set it.  */
 	  if (init->shape == NULL)
 	{
-	  gcc_assert (init->expr_type == EXPR_ARRAY);
+	  if (init->expr_type != EXPR_ARRAY)
+		{
+		  gfc_error ("Bad shape of initializer at %L", &init->where);
+		  return false;
+		}
+
 	  init->shape = gfc_get_shape (1);
 	  if (!gfc_array_size (init, &init->shape[0]))
-		  gfc_internal_error ("gfc_array_size failed");
+		{
+		  gfc_error ("Cannot determine shape of initializer at %L",
+			 &init->where);
+		  free (init->shape);
+		  init->shape = NULL;
+		  return false;
+		}
 	}

 	  for (dim = 0; dim < sym->as->rank; ++dim)
diff --git a/gcc/testsuite/gfortran.dg/pr106209.f90 b/gcc/testsuite/gfortran.dg/pr106209.f90
new file mode 100644
index 000..44f9233ec2f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr106209.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR fortran/106209 - ICE in add_init_expr_to_sym
+! Contributed by G.Steinmetz
+
+program p
+  integer, parameter :: a(:) = 0   ! { dg-error "of deferred shape" }
+  integer, parameter :: b(*) = a   ! { dg-error "Bad shape of initializer" }
+  integer, parameter :: c(*) = [a] ! { dg-error "Cannot determine shape" }
+end
--
2.35.3



Re: [PATCH] Fortran: error recovery simplifying PACK with invalid arguments [PR106049]

2022-07-12 Thread Harald Anlauf via Gcc-patches

As there were no comments, committed as r13-1650.

Am 05.07.22 um 22:31 schrieb Harald Anlauf via Fortran:

Dear all,

poor error recovery while trying to simplify intrinsics with given
invalid arguments seems to be a recurrent theme in testcases submitted
by Gerhard.  In the present case, simplification of PACK() chokes on
the array argument being a bad decl.

The most general approach that came to my mind is to modify function
is_constant_array_expr: when the declared shape of the array indicates
a size greater than zero, but the constructor is missing or empty,
then something bad may have happened, and the array cannot be
considered constant.  We thus punt on simplification of something
that cannot be simplified.  With some luck, this might prevent issues
in similar cases elsewhere...

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald





[PATCH] Fortran: error recovery simplifying PACK with invalid arguments [PR106049]

2022-07-05 Thread Harald Anlauf via Gcc-patches
Dear all,

poor error recovery while trying to simplify intrinsics with given
invalid arguments seems to be a recurrent theme in testcases submitted
by Gerhard.  In the present case, simplification of PACK() chokes on
the array argument being a bad decl.

The most general approach that came to my mind is to modify function
is_constant_array_expr: when the declared shape of the array indicates
a size greater than zero, but the constructor is missing or empty,
then something bad may have happened, and the array cannot be
considered constant.  We thus punt on simplification of something
that cannot be simplified.  With some luck, this might prevent issues
in similar cases elsewhere...

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

From b70a225cd9ac83cd182938bb8019f9138f85b222 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Tue, 5 Jul 2022 22:20:05 +0200
Subject: [PATCH] Fortran: error recovery simplifying PACK with invalid
 arguments [PR106049]

gcc/fortran/ChangeLog:

	PR fortran/106049
	* simplify.cc (is_constant_array_expr): A non-zero-sized constant
	array shall have a non-empty constructor.  When the constructor is
	empty or missing, treat as non-constant.

gcc/testsuite/ChangeLog:

	PR fortran/106049
	* gfortran.dg/pack_simplify_1.f90: New test.
---
 gcc/fortran/simplify.cc   | 12 
 gcc/testsuite/gfortran.dg/pack_simplify_1.f90 | 15 +++
 2 files changed, 27 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/pack_simplify_1.f90

diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index ab59fbca622..fb725994653 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -233,6 +233,18 @@ is_constant_array_expr (gfc_expr *e)
   if (e->expr_type != EXPR_ARRAY || !gfc_is_constant_expr (e))
 return false;

+  /* A non-zero-sized constant array shall have a non-empty constructor.  */
+  if (e->rank > 0 && e->shape != NULL && e->value.constructor == NULL)
+{
+  mpz_init_set_ui (size, 1);
+  for (int j = 0; j < e->rank; j++)
+	mpz_mul (size, size, e->shape[j]);
+  bool not_size0 = (mpz_cmp_si (size, 0) != 0);
+  mpz_clear (size);
+  if (not_size0)
+	return false;
+}
+
   for (c = gfc_constructor_first (e->value.constructor);
c; c = gfc_constructor_next (c))
 if (c->expr->expr_type != EXPR_CONSTANT
diff --git a/gcc/testsuite/gfortran.dg/pack_simplify_1.f90 b/gcc/testsuite/gfortran.dg/pack_simplify_1.f90
new file mode 100644
index 000..06bc55a14f3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pack_simplify_1.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! PR fortran/106049 - ICE in gfc_simplify_pack
+! Contributed by G.Steinmetz
+
+program p
+  type t
+  end type
+  logical, parameter :: m(0) = [ logical :: ]
+  type(t), parameter :: a(0) = [ t :: ]
+  type(t), parameter :: b(1) = [ t()  ]
+  type(t), parameter :: c(1) = [ t :: ]! { dg-error "Different shape" }
+  type(t), parameter :: d(0) = pack(a, m)
+  type(t), parameter :: e(1) = pack(b, [.true.])
+  type(t), parameter :: f(1) = pack(c, [.true.])
+end
--
2.35.3



Re: [PATCH] Fortran: error recovery on invalid CLASS(), PARAMETER declarations [PR105243]

2022-06-30 Thread Harald Anlauf via Gcc-patches

Hi Tobias,

Am 30.06.22 um 11:58 schrieb Tobias Burnus:

The initial patch is by Steve.  I adjusted and moved
it slightly so that it also handles CLASS(*)
(unlimited polymorphic) at the same time.

Shouldn't you then also acknowledge him, e.g. via Co-authored-by?


yeah, I noticed that right after submitting the mail
and immediately amended the commit message.  Pushed as

https://gcc.gnu.org/g:4c233cabbe388a6b8957c1507e129090e9267ceb

Thanks,
Harald


[PATCH] Fortran: error recovery on invalid CLASS(), PARAMETER declarations [PR105243]

2022-06-29 Thread Harald Anlauf via Gcc-patches
Dear all,

a CLASS entity cannot have the PARAMETER attribute.
This is detected in some situations, but in others
we ICE because we never reach the existing check.
Adding a similar check when handling the declaration
improves error recovery.

The initial patch is by Steve.  I adjusted and moved
it slightly so that it also handles CLASS(*)
(unlimited polymorphic) at the same time.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

This patch actually addresses multiple PRs, some of
which are marked as regressions.  As I consider the
patch safe, I would like to backport to open branches
as far as it seems appropriate.

Thanks,
Harald

From e0d5aeadd218f21e450db6601956691293210156 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Wed, 29 Jun 2022 21:36:17 +0200
Subject: [PATCH] Fortran: error recovery on invalid CLASS(), PARAMETER
 declarations [PR105243]

gcc/fortran/ChangeLog:

	PR fortran/103137
	PR fortran/103138
	PR fortran/103693
	PR fortran/105243
	* decl.cc (gfc_match_data_decl): Reject CLASS entity declaration
	when it is given the PARAMETER attribute.

gcc/testsuite/ChangeLog:

	PR fortran/103137
	PR fortran/103138
	PR fortran/103693
	PR fortran/105243
	* gfortran.dg/class_58.f90: Fix test.
	* gfortran.dg/class_73.f90: New test.
---
 gcc/fortran/decl.cc|  8 
 gcc/testsuite/gfortran.dg/class_58.f90 |  2 +-
 gcc/testsuite/gfortran.dg/class_73.f90 | 17 +
 3 files changed, 26 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/class_73.f90

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 26ff54d4684..339f8b15035 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -6262,6 +6262,14 @@ gfc_match_data_decl (void)
   goto cleanup;
 }

+  /* F2018:C708.  */
+  if (current_ts.type == BT_CLASS && current_attr.flavor == FL_PARAMETER)
+{
+  gfc_error ("CLASS entity at %C cannot have the PARAMETER attribute");
+  m = MATCH_ERROR;
+  goto cleanup;
+}
+
   if (current_ts.type == BT_CLASS
 	&& current_ts.u.derived->attr.unlimited_polymorphic)
 goto ok;
diff --git a/gcc/testsuite/gfortran.dg/class_58.f90 b/gcc/testsuite/gfortran.dg/class_58.f90
index 20b601a2f51..fceb575432d 100644
--- a/gcc/testsuite/gfortran.dg/class_58.f90
+++ b/gcc/testsuite/gfortran.dg/class_58.f90
@@ -9,5 +9,5 @@ subroutine s
   end type
   class(t), parameter :: x = t()  ! { dg-error "cannot have the PARAMETER attribute" }
   class(t), parameter :: y = x! { dg-error "cannot have the PARAMETER attribute" }
-  class(t) :: z = x   ! { dg-error "must be dummy, allocatable or pointer" }
+  class(t) :: z = t() ! { dg-error "must be dummy, allocatable or pointer" }
 end
diff --git a/gcc/testsuite/gfortran.dg/class_73.f90 b/gcc/testsuite/gfortran.dg/class_73.f90
new file mode 100644
index 000..c11ee38c086
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_73.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! Error recovery on invalid CLASS(), PARAMETER declarations
+! PR fortran/103137
+! PR fortran/103138
+! PR fortran/103693
+! PR fortran/105243
+! Contributed by G.Steinmetz
+
+program p
+  type t
+ character(3) :: c = '(a)'
+  end type
+  class(t), parameter :: x = 1.  ! { dg-error "PARAMETER attribute" }
+  class(*), parameter :: y = t() ! { dg-error "PARAMETER attribute" }
+  class(*), parameter :: z = 1   ! { dg-error "PARAMETER attribute" }
+  print x%c  ! { dg-error "Syntax error" }
+end
--
2.35.3



[PATCH] Fortran: improve error recovery for EXTENDS_TYPE_OF() [PR106121]

2022-06-28 Thread Harald Anlauf via Gcc-patches
Dear all,

the simplification of EXTENDS_TYPE_OF() did not handle the
situation that one of its arguments were a CLASS variable
that was improperly declared.  NULL pointer dereference.

The fix is obvious.  Steve found a similar solution, which
is why I added him as co-author.

Regtested on x86_64-pc-linux-gnu.

Will commit to mainline as obvious within 24 hours unless
there are loud objections.

Thanks,
Harald

From 55aacfd22d73edfb38871e211f85b2ae69fd0072 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Tue, 28 Jun 2022 22:29:28 +0200
Subject: [PATCH] Fortran: improve error recovery for EXTENDS_TYPE_OF()
 [PR106121]

gcc/fortran/ChangeLog:

	PR fortran/106121
	* simplify.cc (gfc_simplify_extends_type_of): Do not attempt to
	simplify when one of the arguments is a CLASS variable that was
	not properly declared.

gcc/testsuite/ChangeLog:

	PR fortran/106121
	* gfortran.dg/extends_type_of_4.f90: New test.

Co-authored-by: Steven G. Kargl 
---
 gcc/fortran/simplify.cc   |  4 
 .../gfortran.dg/extends_type_of_4.f90 | 20 +++
 2 files changed, 24 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/extends_type_of_4.f90

diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index e8e3ec63669..ab59fbca622 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -3096,6 +3096,10 @@ gfc_simplify_extends_type_of (gfc_expr *a, gfc_expr *mold)
   if (UNLIMITED_POLY (a) || UNLIMITED_POLY (mold))
 return NULL;

+  if ((a->ts.type == BT_CLASS && !gfc_expr_attr (a).class_ok)
+  || (mold->ts.type == BT_CLASS && !gfc_expr_attr (mold).class_ok))
+return NULL;
+
   /* Return .false. if the dynamic type can never be an extension.  */
   if ((a->ts.type == BT_CLASS && mold->ts.type == BT_CLASS
&& !gfc_type_is_extension_of
diff --git a/gcc/testsuite/gfortran.dg/extends_type_of_4.f90 b/gcc/testsuite/gfortran.dg/extends_type_of_4.f90
new file mode 100644
index 000..64373322387
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/extends_type_of_4.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! PR fortran/106121 - ICE in gfc_simplify_extends_type_of
+! Contributed by G.Steinmetz
+
+program p
+   type t
+   end type
+   type(t)  :: x
+   class(t) :: y   ! { dg-error "dummy, allocatable or pointer" }
+   print *, extends_type_of (x, y)
+end
+
+subroutine s
+   type t
+  integer :: i
+   end type
+   type(t)  :: x
+   class(t) :: y   ! { dg-error "dummy, allocatable or pointer" }
+   stop extends_type_of (x, y) ! { dg-error "STOP code" }
+end
--
2.35.3



Re: [PATCH] fortran, libgfortran, v2: Avoid using libquadmath for glibc 2.26+

2022-06-24 Thread Harald Anlauf via Gcc-patches

Hi Jakub,

Am 24.06.22 um 12:29 schrieb Jakub Jelinek via Gcc-patches:

On Thu, Jun 23, 2022 at 11:17:50PM +0200, Jakub Jelinek via Gcc-patches wrote:

We currently use
%rename lib liborig
*lib: %{static-libgfortran:--as-needed} -lquadmath 
%{static-libgfortran:--no-as-needed} -lm %(libgcc) %(liborig)
in libgfortran.spec (on targets where we do configure in libquadmath).
So, I believe the patch as is is an ABI change for *.o files if they use
real(kind=16) math functions (one needs to recompile them), but not
for linked shared libraries or executables, because the above aranges
for them to be linked with -lquadmath or for -static-libgfortran with
--as-needed -lquadmath --no-as-needed.  The former adds libquadmath.so.0
automatically to anything gfortran links, the latter to anything that
actually needs it (i.e. has undefined math/complex *q symbols).

Note, libgfortran.so.5 itself is ABI compatible, just no longer has
DT_NEEDED libquadmath.so.0 and uses the *f128 APIs + str{to,from}f128
instead of *q APIs + strtoflt128 and quadmath_snprintf.

Now, what we could do if we'd want to also preserve *.o file compatibility,
would be for gcc configured on glibc 2.26+ change libgfortran.spec to
*lib: --as-needed -lquadmath --no-as-needed -lm %(libgcc) %(liborig)
so that we even without -static-libgfortran link in libquadmath.so.0
only if it is needed.  So, if there will be any gcc <= 12 compiled
*.o files or *.o files compiled by gcc 13 if it was configured against
glibc 2.25 or older, we'd link -lquadmath in, but if there are just
*.o files referencing *f128 symbols, we wouldn't.


Am I right in assuming that this also effectively fixes PR46539?
(Add -static-libquadmath).


That was one of the intents of the patch.
But sure, it doesn't introduce -static-libquadmath, nor arranges for
-static-libgfortran to link libquadmath statically, just in some cases
(gcc configured on glibc 2.26 or later) and when everything that calls
real(kind=16) math functions has been recompiled arranges for libquadmath
not to be used at all.


Here is an updated patch that does that.


very good!


--- gcc/fortran/trans-intrinsic.cc.jj   2022-05-16 11:14:57.587427707 +0200
+++ gcc/fortran/trans-intrinsic.cc  2022-06-23 11:42:03.355899271 +0200
@@ -155,7 +155,7 @@ builtin_decl_for_precision (enum built_i
 else if (precision == TYPE_PRECISION (double_type_node))
   i = m->double_built_in;
 else if (precision == TYPE_PRECISION (long_double_type_node)
-  && (!gfc_real16_is_float128
+  && ((!gfc_real16_is_float128 & !gfc_real16_is__Float128)


Shouldn't this be && instead of & ?


You're right, will fix.


And this too.

So I believe it should now be fully ABI compatible.


Great, thanks!

Harald



[PATCH, committed] Fortran: fix checking of arguments to UNPACK when MASK is a variable [PR105813]

2022-06-24 Thread Harald Anlauf via Gcc-patches
Dear all,

we failed to fully check arguments to UNPACK when the MASK
argument was not simplified and considered a variable instead
of an array.  The fix is a one-liner.

Regtested on x86_64-pc-linux-gnu and committed to mainline
as obvious after an OK by Steve in the PR.

Thanks,
Harald

From f21f17f95c0237f4f987a5fa9f1fa9c7e0db3c40 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Fri, 24 Jun 2022 22:21:39 +0200
Subject: [PATCH] Fortran: fix checking of arguments to UNPACK when MASK is a
 variable [PR105813]

gcc/fortran/ChangeLog:

	PR fortran/105813
	* check.cc (gfc_check_unpack): Try to simplify MASK argument to
	UNPACK so that checking of the VECTOR argument can work when MASK
	is a variable.

gcc/testsuite/ChangeLog:

	PR fortran/105813
	* gfortran.dg/unpack_vector_1.f90: New test.
---
 gcc/fortran/check.cc  |  2 ++
 gcc/testsuite/gfortran.dg/unpack_vector_1.f90 | 12 
 2 files changed, 14 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/unpack_vector_1.f90

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 0c2cb50c6a7..91d87a1b2c1 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -6353,6 +6353,8 @@ gfc_check_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field)
   if (!same_type_check (vector, 0, field, 2))
 return false;

+  gfc_simplify_expr (mask, 0);
+
   if (mask->expr_type == EXPR_ARRAY
   && gfc_array_size (vector, &vector_size))
 {
diff --git a/gcc/testsuite/gfortran.dg/unpack_vector_1.f90 b/gcc/testsuite/gfortran.dg/unpack_vector_1.f90
new file mode 100644
index 000..5347c111e8f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unpack_vector_1.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! PR fortran/105813
+! Fix checking of VECTOR argument to UNPACK when MASK is a variable.
+! Contributed by G.Steinmetz
+
+program p
+  logical, parameter :: mask(2,2) = reshape ([.true.,  .true.,  &
+  .false., .true.], &
+  shape (mask))
+  print *, unpack ([1,2,3], mask, 0) ! OK
+  print *, unpack ([1,2],   mask, 0) ! { dg-error "must provide at least" }
+end
--
2.35.3



Re: [PATCH] fortran, libgfortran: Avoid using libquadmath for glibc 2.26+

2022-06-23 Thread Harald Anlauf via Gcc-patches

Hi Jakub,

Am 23.06.22 um 14:04 schrieb Jakub Jelinek via Gcc-patches:

Hi!

As mentioned by Joseph in PR105101, glibc 2.26 or later has on x86
(both -m32/-m64), powerpc64le, ia64 and mips support for
*f128 math/complex APIs plus strtof128 and strfromf128, and these APIs allow
us to avoid libquadmath for Fortran purposes on these architectures,
replace *q math/complex APIs, strtof128 instead of strtoflt128 and,
while strfromf128 unfortunately isn't a perfect replacement to
quadmath_snprintf, it can be made to work.

The advantage of this is that when configured against such glibcs
(2.26 is now almost 5 years old), we can avoid linking against an extra shared
library and the math support in glibc is maintained better than libquadmath.

We need both a compiler change (so that for glibc 2.26+ it uses *f128 APIs
instead of *q) and library change.


this is quite an important change in the gfortran ABI, as it will
require recompilation of (library) code using quad precision.
Not that I am particularly affected, but this should be highlighted
for users.

Am I right in assuming that this also effectively fixes PR46539?
(Add -static-libquadmath).


So far lightly tested on x86_64-linux with glibc 2.35 (removed libgfortran
dirs, rebuilt stage3 f951 and make all-target-libgfortran + make
check-gfortran), ok for trunk if it passes full testing?


I did not look into all details, but noticed the following:


--- gcc/fortran/trans-intrinsic.cc.jj   2022-05-16 11:14:57.587427707 +0200
+++ gcc/fortran/trans-intrinsic.cc  2022-06-23 11:42:03.355899271 +0200
@@ -155,7 +155,7 @@ builtin_decl_for_precision (enum built_i
else if (precision == TYPE_PRECISION (double_type_node))
  i = m->double_built_in;
else if (precision == TYPE_PRECISION (long_double_type_node)
-  && (!gfc_real16_is_float128
+  && ((!gfc_real16_is_float128 & !gfc_real16_is__Float128)


Shouldn't this be && instead of & ?


   || long_double_type_node != gfc_float128_type_node))
  i = m->long_double_built_in;
else if (precision == TYPE_PRECISION (gfc_float128_type_node))
@@ -175,7 +175,7 @@ gfc_builtin_decl_for_float_kind (enum bu
  {
int i = gfc_validate_kind (BT_REAL, kind, false);

-  if (gfc_real_kinds[i].c_float128)
+  if (gfc_real_kinds[i].c_float128 || gfc_real_kinds[i].c__Float128)
  {
/* For _Float128, the story is a bit different, because we return
 a decl to a library function rather than a built-in.  */
@@ -688,7 +688,7 @@ gfc_build_intrinsic_lib_fndecls (void)
gfc_intrinsic_map_t *m;
tree quad_decls[END_BUILTINS + 1];

-  if (gfc_real16_is_float128)
+  if (gfc_real16_is_float128 || gfc_real16_is__Float128)
{
  /* If we have soft-float types, we create the decls for their
 C99-like library functions.  For now, we only handle _Float128
@@ -739,7 +739,10 @@ gfc_build_intrinsic_lib_fndecls (void)
 builtin_decl_for_float_type(). The others are all constructed by
 gfc_get_intrinsic_lib_fndecl().  */
  #define OTHER_BUILTIN(ID, NAME, TYPE, CONST) \
-  quad_decls[BUILT_IN_ ## ID] = define_quad_builtin (NAME "q", func_ ## TYPE, 
CONST);
+quad_decls[BUILT_IN_ ## ID]
\
+  = define_quad_builtin (gfc_real16_is__Float128   \
+? NAME "f128" : NAME "q", func_ ## TYPE,   \
+CONST);

  #include "mathbuiltins.def"

@@ -751,8 +754,9 @@ gfc_build_intrinsic_lib_fndecls (void)
  /* There is one built-in we defined manually, because it gets called
 with builtin_decl_for_precision() or builtin_decl_for_float_type()
 even though it is not an OTHER_BUILTIN: it is SQRT.  */
-quad_decls[BUILT_IN_SQRT] = define_quad_builtin ("sqrtq", func_1, true);
-
+quad_decls[BUILT_IN_SQRT]
+  = define_quad_builtin (gfc_real16_is__Float128
+? "sqrtf128" : "sqrtq", func_1, true);
}

/* Add GCC builtin functions.  */
@@ -775,7 +779,7 @@ gfc_build_intrinsic_lib_fndecls (void)
m->complex10_decl
  = builtin_decl_explicit (m->complex_long_double_built_in);

-  if (!gfc_real16_is_float128)
+  if (!gfc_real16_is_float128 && !gfc_real16_is__Float128)
{
  if (m->long_double_built_in != END_BUILTINS)
m->real16_decl = builtin_decl_explicit (m->long_double_built_in);
@@ -876,6 +880,9 @@ gfc_get_intrinsic_lib_fndecl (gfc_intrin
else if (gfc_real_kinds[n].c_float128)
snprintf (name, sizeof (name), "%s%s%s",
  ts->type == BT_COMPLEX ? "c" : "", m->name, "q");
+  else if (gfc_real_kinds[n].c__Float128)
+   snprintf (name, sizeof (name), "%s%s%s",
+ ts->type == BT_COMPLEX ? "c" : "", m->name, "f128");
else
gcc_unreachable ();
  }
--- gcc/fortran/trans-expr.cc.jj2022-04-23 10:10:51.146097072 +0200
+++ gcc/fortran/trans-expr.cc   2022-06-23 11:49:31.191964727 +0200

[PATCH] Fortran: fix simplification of INDEX(str1,str2) [PR105691]

2022-06-21 Thread Harald Anlauf via Gcc-patches
Dear all,

compile time simplification of INDEX(str1,str2,back=.true.) gave wrong
results.  Looking at gfc_simplify_index, this appeared to be close to
a complete mess, while the runtime library code - which was developed
later - was a relief.

The solution is to use the runtime library code as template to fix this.
I took the opportunity to change string index and length variables
in gfc_simplify_index to HOST_WIDE_INT.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

As this is a wrong-code issue, would this qualify for backports to
open branches?

Thanks,
Harald

From 2cfe8034340424ffa15784c61584634ccac4c4fc Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Tue, 21 Jun 2022 23:20:18 +0200
Subject: [PATCH] Fortran: fix simplification of INDEX(str1,str2) [PR105691]

gcc/fortran/ChangeLog:

	PR fortran/105691
	* simplify.cc (gfc_simplify_index): Replace old simplification
	code by the equivalent of the runtime library implementation.  Use
	HOST_WIDE_INT instead of int for string index, length variables.

gcc/testsuite/ChangeLog:

	PR fortran/105691
	* gfortran.dg/index_6.f90: New test.
---
 gcc/fortran/simplify.cc   | 131 ++
 gcc/testsuite/gfortran.dg/index_6.f90 |  31 ++
 2 files changed, 60 insertions(+), 102 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/index_6.f90

diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index c8f2ef9fbf4..e8e3ec63669 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -3515,17 +3515,15 @@ gfc_expr *
 gfc_simplify_index (gfc_expr *x, gfc_expr *y, gfc_expr *b, gfc_expr *kind)
 {
   gfc_expr *result;
-  int back, len, lensub;
-  int i, j, k, count, index = 0, start;
+  bool back;
+  HOST_WIDE_INT len, lensub, start, last, i, index = 0;
+  int k, delta;

   if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT
   || ( b != NULL && b->expr_type !=  EXPR_CONSTANT))
 return NULL;

-  if (b != NULL && b->value.logical != 0)
-back = 1;
-  else
-back = 0;
+  back = (b != NULL && b->value.logical != 0);

   k = get_kind (BT_INTEGER, kind, "INDEX", gfc_default_integer_kind);
   if (k == -1)
@@ -3542,111 +3540,40 @@ gfc_simplify_index (gfc_expr *x, gfc_expr *y, gfc_expr *b, gfc_expr *kind)
   return result;
 }

-  if (back == 0)
+  if (lensub == 0)
 {
-  if (lensub == 0)
-	{
-	  mpz_set_si (result->value.integer, 1);
-	  return result;
-	}
-  else if (lensub == 1)
-	{
-	  for (i = 0; i < len; i++)
-	{
-	  for (j = 0; j < lensub; j++)
-		{
-		  if (y->value.character.string[j]
-		  == x->value.character.string[i])
-		{
-		  index = i + 1;
-		  goto done;
-		}
-		}
-	}
-	}
+  if (back)
+	index = len + 1;
   else
-	{
-	  for (i = 0; i < len; i++)
-	{
-	  for (j = 0; j < lensub; j++)
-		{
-		  if (y->value.character.string[j]
-		  == x->value.character.string[i])
-		{
-		  start = i;
-		  count = 0;
-
-		  for (k = 0; k < lensub; k++)
-			{
-			  if (y->value.character.string[k]
-			  == x->value.character.string[k + start])
-			count++;
-			}
-
-		  if (count == lensub)
-			{
-			  index = start + 1;
-			  goto done;
-			}
-		}
-		}
-	}
-	}
+	index = 1;
+  goto done;
+}

+  if (!back)
+{
+  last = len + 1 - lensub;
+  start = 0;
+  delta = 1;
 }
   else
 {
-  if (lensub == 0)
-	{
-	  mpz_set_si (result->value.integer, len + 1);
-	  return result;
-	}
-  else if (lensub == 1)
+  last = -1;
+  start = len - lensub;
+  delta = -1;
+}
+
+  for (; start != last; start += delta)
+{
+  for (i = 0; i < lensub; i++)
 	{
-	  for (i = 0; i < len; i++)
-	{
-	  for (j = 0; j < lensub; j++)
-		{
-		  if (y->value.character.string[j]
-		  == x->value.character.string[len - i])
-		{
-		  index = len - i + 1;
-		  goto done;
-		}
-		}
-	}
+	  if (x->value.character.string[start + i]
+	  != y->value.character.string[i])
+	break;
 	}
-  else
+  if (i == lensub)
 	{
-	  for (i = 0; i < len; i++)
-	{
-	  for (j = 0; j < lensub; j++)
-		{
-		  if (y->value.character.string[j]
-		  == x->value.character.string[len - i])
-		{
-		  start = len - i;
-		  if (start <= len - lensub)
-			{
-			  count = 0;
-			  for (k = 0; k < lensub; k++)
-			if (y->value.character.string[k]
-			== x->value.character.string[k + start])
-			  count++;
-
-			  if (count == lensub)
-			{
-			  index = start + 1;
-			  goto done;
-			}
-			}
-		  else
-			{
-			  continue;
-			}
-		}
-		}
-	}
+	  index = start + 1;
+	  goto done;
 	}
 }

diff --git a/gcc/testsuite/gfortran.dg/index_6.f90 b/gcc/testsuite/gfortran.dg/index_6.f90
new file mode 100644
index 000..61d492985ad
--- /dev/null
+++ b/gcc/

[PATCH] Fortran: handle explicit-shape specs with constant bounds [PR105954]

2022-06-20 Thread Harald Anlauf via Gcc-patches
Dear all,

after simplification of constant bound expressions of an explicit
shape spec of an array, we need to ensure that we never obtain
negative extents.  In some cases this did happen, and we ICEd
as we hit an assert that this should never happen...

The original testcase by Gerhard exhibited this for sizeof()
of a derived type with an array component, but the issue is
more fundamental and affects other intrinsics during
simplification.

A straightforward solution "fixes up" the upper bound in the
shape spec when it is known to be below lower bounds minus one.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

From 65f7fd793415cb291ffb5bca8cdbcb10fc511ab8 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Mon, 20 Jun 2022 20:59:55 +0200
Subject: [PATCH] Fortran: handle explicit-shape specs with constant bounds
 [PR105954]

gcc/fortran/ChangeLog:

	PR fortran/105954
	* decl.cc (variable_decl): Adjust upper bounds for explicit-shape
	specs with constant bound expressions to ensure non-negative
	extents.

gcc/testsuite/ChangeLog:

	PR fortran/105954
	* gfortran.dg/pr105954.f90: New test.
---
 gcc/fortran/decl.cc| 12 
 gcc/testsuite/gfortran.dg/pr105954.f90 | 26 ++
 2 files changed, 38 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/pr105954.f90

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index bd586e75008..26ff54d4684 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -2775,6 +2775,18 @@ variable_decl (int elem)
 		  else
 		gfc_free_expr (n);
 		}
+	  /* For an explicit-shape spec with constant bounds, ensure
+		 that the effective upper bound is not lower than the
+		 respective lower bound minus one.  Otherwise adjust it so
+		 that the extent is trivially derived to be zero.  */
+	  if (as->lower[i]->expr_type == EXPR_CONSTANT
+		  && as->upper[i]->expr_type == EXPR_CONSTANT
+		  && as->lower[i]->ts.type == BT_INTEGER
+		  && as->upper[i]->ts.type == BT_INTEGER
+		  && mpz_cmp (as->upper[i]->value.integer,
+			  as->lower[i]->value.integer) < 0)
+		mpz_sub_ui (as->upper[i]->value.integer,
+			as->lower[i]->value.integer, 1);
 	}
 	}
 }
diff --git a/gcc/testsuite/gfortran.dg/pr105954.f90 b/gcc/testsuite/gfortran.dg/pr105954.f90
new file mode 100644
index 000..89004bf9aa7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr105954.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+! PR fortran/105954 - ICE in gfc_element_size, at fortran/target-memory.cc:132
+! Contributed by G.Steinmetz
+
+program p
+  use iso_c_binding, only: c_float, c_sizeof
+  implicit none
+  integer, parameter :: n = -99
+  type t
+ real :: b(3,7:n)
+  end type
+  type, bind(c) :: u
+ real(c_float) :: b(3,7:n)
+  end type
+  type(t) :: d
+  type(u) :: e
+  integer, parameter :: k = storage_size(d)
+  integer, parameter :: m = sizeof(d)
+  integer, parameter :: l = c_sizeof(e)
+  if (k /= 0) stop 1
+  if (m /= 0) stop 2
+  if (l /= 0) stop 3
+end
+
+! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "original" } }
--
2.35.3



[PATCH] Fortran: check POS and LEN arguments simplifying bit intrinsics [PR105986]

2022-06-15 Thread Harald Anlauf via Gcc-patches
Dear all,

we need to check the POS (and LEN) arguments of bit intrinsics
when simplifying, e.g. when used in array constructors.
Otherwise we ICE.  Found by Gerhard.

The fix is straightforward, see attached.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

From 32c95012378ada5ce555a819dbc640e1dd2b88d5 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Wed, 15 Jun 2022 22:20:09 +0200
Subject: [PATCH] Fortran: check POS and LEN arguments simplifying bit
 intrinsics [PR105986]

gcc/fortran/ChangeLog:

	PR fortran/105986
	* simplify.cc (gfc_simplify_btest): Add check for POS argument.
	(gfc_simplify_ibclr): Add check for POS argument.
	(gfc_simplify_ibits): Add check for POS and LEN arguments.
	(gfc_simplify_ibset): Add check for POS argument.

gcc/testsuite/ChangeLog:

	PR fortran/105986
	* gfortran.dg/check_bits_3.f90: New test.
---
 gcc/fortran/simplify.cc| 12 
 gcc/testsuite/gfortran.dg/check_bits_3.f90 | 16 
 2 files changed, 28 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/check_bits_3.f90

diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 233cc42137f..c8f2ef9fbf4 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -1644,6 +1644,9 @@ gfc_simplify_btest (gfc_expr *e, gfc_expr *bit)
   if (e->expr_type != EXPR_CONSTANT || bit->expr_type != EXPR_CONSTANT)
 return NULL;

+  if (!gfc_check_bitfcn (e, bit))
+return &gfc_bad_expr;
+
   if (gfc_extract_int (bit, &b) || b < 0)
 return gfc_get_logical_expr (gfc_default_logical_kind, &e->where, false);

@@ -3353,6 +3356,9 @@ gfc_simplify_ibclr (gfc_expr *x, gfc_expr *y)
   if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
 return NULL;

+  if (!gfc_check_bitfcn (x, y))
+return &gfc_bad_expr;
+
   gfc_extract_int (y, &pos);

   k = gfc_validate_kind (x->ts.type, x->ts.kind, false);
@@ -3384,6 +3390,9 @@ gfc_simplify_ibits (gfc_expr *x, gfc_expr *y, gfc_expr *z)
   || z->expr_type != EXPR_CONSTANT)
 return NULL;

+  if (!gfc_check_ibits (x, y, z))
+return &gfc_bad_expr;
+
   gfc_extract_int (y, &pos);
   gfc_extract_int (z, &len);

@@ -3438,6 +3447,9 @@ gfc_simplify_ibset (gfc_expr *x, gfc_expr *y)
   if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
 return NULL;

+  if (!gfc_check_bitfcn (x, y))
+return &gfc_bad_expr;
+
   gfc_extract_int (y, &pos);

   k = gfc_validate_kind (x->ts.type, x->ts.kind, false);
diff --git a/gcc/testsuite/gfortran.dg/check_bits_3.f90 b/gcc/testsuite/gfortran.dg/check_bits_3.f90
new file mode 100644
index 000..3018e6977ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/check_bits_3.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! PR fortran/105986
+! Contributed by G.Steinmetz
+
+program p
+  integer :: i
+  logical, parameter :: a(*) = [(btest(8_4,i), i=-1,-1)] ! { dg-error "nonnegative" }
+  integer, parameter :: b(*) = [(ibclr(8_4,i), i=-1,-1)] ! { dg-error "nonnegative" }
+  integer, parameter :: c(*) = [(ibset(8_4,i), i=-1,-1)] ! { dg-error "nonnegative" }
+  logical, parameter :: d(*) = [(btest(8_1,i), i= 8, 8)] ! { dg-error "must be less" }
+  integer, parameter :: e(*) = [(ibclr(8_2,i), i=16,16)] ! { dg-error "must be less" }
+  integer, parameter :: f(*) = [(ibset(8_4,i), i=32,32)] ! { dg-error "must be less" }
+  integer, parameter :: g(*) = [(ibits(8_4,i,1),i=-1,-1)] ! { dg-error "nonnegative" }
+  integer, parameter :: h(*) = [(ibits(8_4,1,i),i=-1,-1)] ! { dg-error "nonnegative" }
+  integer, parameter :: j(*) = [(ibits(8_4,i,i),i=32,32)] ! { dg-error "must be less" }
+end
--
2.35.3



[PATCH] Fortran: improve runtime error message with ALLOCATE and, ERRMSG= [PR91300]

2022-05-30 Thread Harald Anlauf via Gcc-patches

Hi Tobias,

Am 30.05.22 um 09:33 schrieb Tobias Burnus:

On 28.05.22 22:25, Harald Anlauf via Fortran wrote:

the PR rightfully complained that we did not differentiate errors on
ALLOCATE(...,stat=,errmsg=) for failures from allocation of already
allocated objects or insufficient virtual memory.

It is even worse: The error message states the wrong reason.

The attached patch introduces a new STAT value LIBERROR_NO_MEMORY
that is returned for insufficient virtual memory, and a corresponding
(simple and invariant) ERRMSG: "Insufficient virtual memory".

I think the message is fine – at least on Linux 'virtual memory' is
what's used and it is clear what's meant, even if I stumble a bit about
the wording. (But do not have a crisp short & comprehensive wording
myself.)


for reference these are the messages of selected compilers:

ifort: insufficient virtual memory
nag: Out of memory
crayftn: The program was unable to request more memory space.

And since Intel's message for attempting to allocate an already
allocated object was closest to gfortran's version, and Cray is
far too verbose for my taste, I threw mental dice between Intel
and NAG, and Intel won.


(In the PR Janne mentions checking for errno, but since the standard
malloc(3) only mentions ENOMEM as possible error value, and the user
may replace malloc by a special library, I believe that won't be easy
to handle in a general way.)

I con concur. Especially as POSIX and the Linux manpage only list ENOMEM
as only value.

Most compilers I tried (Intel/NAG/Crayftn) behave similarly, except
for Nvidia/Flang, which try to return the size of the allocation in
the error message.

I am not sure that this is worth the effort.

I think it is not needed – especially as we generate the message in the
FE and not in libgfortran. The advantage for the users is that they know
what value has been requested – but they cannot really do much with the
knowledge, either.


Thanks for confirming this.


The testcase should be able to handle 32 and 64 bit systems.
At least that's what I think.


I hope it is – at least on 64bit, I currently expect it too fail
somewhat reliably, with 32bit I think it won't – but that's also handled.

But you could add a -fdump-tree-original + '! { dg-final {
scan-tree-dump*' to do some checking in addition (e.g. whether both
strings appear in the dump; could be more complex, but that's probably
not needed).


Regtested on x86_64-pc-linux-gnu.  OK for mainline?  Suggestions?


LGTM – with considering comments on the testcase.



Fortran: improve runtime error message with ALLOCATE and ERRMSG=


Consider appending [PR91300] in that line – and try to make the
gcc-patches@ and fortran@ lines the same

(Searching for the PR number or case-insignificantly for the string in
the mailing list archive, will fine the message; thus, that's okay.)


OK, will do from now on.  My visual parsing and reading ability of
subject lines is not really positive-correlated with their machine-
readability, but then gcc-patches@ is not what I'm reading... ;-)
(I consider it basically a write-only list).


ALLOCATE: generate different STAT,ERRMSG results for failures from
allocation of already allocated objects or insufficient virtual memory.

gcc/fortran/ChangeLog:

  PR fortran/91300
  * libgfortran.h: Define new error code LIBERROR_NO_MEMORY.
  * trans-stmt.cc (gfc_trans_allocate): Generate code for setting
  ERRMSG depending on result of STAT result of ALLOCATE.
  * trans.cc (gfc_allocate_using_malloc): Use STAT value of
  LIBERROR_NO_MEMORY in case of failed malloc.

gcc/testsuite/ChangeLog:

  PR fortran/91300
  * gfortran.dg/allocate_alloc_opt_15.f90: New test.
---

...


+  stat1   = -1
+  errmsg1 = ""
+  allocate (array(1), stat=stat1, errmsg=errmsg1)
+  if (stat1   /=  0) stop 1
+  if (errmsg1 /= "") stop 1

Consider to init the errmsg1 and then check that is has not been
touched. (For completeness, I think we already have such tests).

+  ! Obtain stat,errmsg for attempt to allocate an allocated object
+  allocate (array(1), stat=stat1, errmsg=errmsg1)
+  if (stat1   ==  0) stop 2
+  if (errmsg1 == "") stop 2

Consider to check (either here or as a third test) for the
gfortran-specific error message.

+  stat2   = -1
+  errmsg2 = ""
+  ! Try to allocate very large object
+  allocate (bigarray(bignumber), stat=stat2, errmsg=errmsg2)
+  if (stat2 /= 0) then
+ print *, "stat  =", stat1
+ print *, "errmsg: ", trim (errmsg1)
+ print *, "stat  =", stat2
+ print *, "errmsg: ", trim (errmsg2)
+ ! Ensure different results for stat, errmsg variables
+ if (stat2   == stat1 ) stop 3
+ if (errmsg2 == "" .or. errmsg2 == errmsg1) stop 4


Likewise for errmsg2


I've adjusted the testcase as s

[PATCH] PR fortran/91300 - runtime error message with allocate and errmsg=

2022-05-28 Thread Harald Anlauf via Gcc-patches
Dear Fortranners,

the PR rightfully complained that we did not differentiate errors on
ALLOCATE(...,stat=,errmsg=) for failures from allocation of already
allocated objects or insufficient virtual memory.

The attached patch introduces a new STAT value LIBERROR_NO_MEMORY
that is returned for insufficient virtual memory, and a corresponding
(simple and invariant) ERRMSG: "Insufficient virtual memory".

(In the PR Janne mentions checking for errno, but since the standard
malloc(3) only mentions ENOMEM as possible error value, and the user
may replace malloc by a special library, I believe that won't be easy
to handle in a general way.)

Most compilers I tried (Intel/NAG/Crayftn) behave similarly, except
for Nvidia/Flang, which try to return the size of the allocation in
the error message.

I am not sure that this is worth the effort.  First, ERRMSG is very
compiler-dependent anyway and thus not really portable.  If a user
wants to know what the size of the failed allocation is and really
wants to recover, he/she should find that out himself.  Second, I
think that the more important change is the introduction of a STAT
value that allows the distinction between the different causes of
failure.

The testcase should be able to handle 32 and 64 bit systems.
At least that's what I think.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?  Suggestions?

Thanks,
Harald

From 19ccd22ee9359bd14b32a95bd9efcaead3593b2f Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Sat, 28 May 2022 22:02:20 +0200
Subject: [PATCH] Fortran: improve runtime error message with ALLOCATE and
 ERRMSG=

ALLOCATE: generate different STAT,ERRMSG results for failures from
allocation of already allocated objects or insufficient virtual memory.

gcc/fortran/ChangeLog:

	PR fortran/91300
	* libgfortran.h: Define new error code LIBERROR_NO_MEMORY.
	* trans-stmt.cc (gfc_trans_allocate): Generate code for setting
	ERRMSG depending on result of STAT result of ALLOCATE.
	* trans.cc (gfc_allocate_using_malloc): Use STAT value of
	LIBERROR_NO_MEMORY in case of failed malloc.

gcc/testsuite/ChangeLog:

	PR fortran/91300
	* gfortran.dg/allocate_alloc_opt_15.f90: New test.
---
 gcc/fortran/libgfortran.h |  1 +
 gcc/fortran/trans-stmt.cc | 33 +--
 gcc/fortran/trans.cc  |  4 +-
 .../gfortran.dg/allocate_alloc_opt_15.f90 | 40 +++
 4 files changed, 73 insertions(+), 5 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/allocate_alloc_opt_15.f90

diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index 064795eb469..4328447be04 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -133,6 +133,7 @@ typedef enum
   LIBERROR_CORRUPT_FILE,
   LIBERROR_INQUIRE_INTERNAL_UNIT, /* Must be different from STAT_STOPPED_IMAGE.  */
   LIBERROR_BAD_WAIT_ID,
+  LIBERROR_NO_MEMORY,
   LIBERROR_LAST			/* Not a real error, the last error # + 1.  */
 }
 libgfortran_error_codes;
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 79096816c6e..fd6d294147e 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -7130,7 +7130,8 @@ gfc_trans_allocate (gfc_code * code)
   if (code->expr1 && code->expr2)
 {
   const char *msg = "Attempt to allocate an allocated object";
-  tree slen, dlen, errmsg_str;
+  const char *oommsg = "Insufficient virtual memory";
+  tree slen, dlen, errmsg_str, oom_str, oom_loc;
   stmtblock_t errmsg_block;

   gfc_init_block (&errmsg_block);
@@ -7151,8 +7152,34 @@ gfc_trans_allocate (gfc_code * code)
 			 gfc_default_character_kind);
   dlen = gfc_finish_block (&errmsg_block);

-  tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
-			 stat, build_int_cst (TREE_TYPE (stat), 0));
+  tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+			 stat, build_int_cst (TREE_TYPE (stat),
+		  LIBERROR_ALLOCATION));
+
+  tmp = build3_v (COND_EXPR, tmp,
+		  dlen, build_empty_stmt (input_location));
+
+  gfc_add_expr_to_block (&block, tmp);
+
+  oom_str = gfc_create_var (pchar_type_node, "OOMMSG");
+  oom_loc = gfc_build_localized_cstring_const (oommsg);
+  gfc_add_modify (&errmsg_block, oom_str,
+		  gfc_build_addr_expr (pchar_type_node, oom_loc));
+
+  slen = build_int_cst (gfc_charlen_type_node, strlen (oommsg));
+  dlen = gfc_get_expr_charlen (code->expr2);
+  slen = fold_build2_loc (input_location, MIN_EXPR,
+			  TREE_TYPE (slen), dlen, slen);
+
+  gfc_trans_string_copy (&errmsg_block, dlen, errmsg,
+			 code->expr2->ts.kind,
+			 slen, oom_str,
+			 gfc_default_character_kind);
+  dlen = gfc_finish_block (&errmsg_block);
+
+  tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+			 stat, build_int_cst (TREE_

[PATCH] PR fortran/105230 - [9/10/11/12/13 Regression] ICE in find_array_section, at fortran/expr.cc:1634

2022-05-10 Thread Harald Anlauf via Gcc-patches
Dear all,

I intend to commit the attached patch as obvious within the next
24 hours unless there are objections.  It fixes the logic which
is intended to prevent a NULL pointer dereference on invalid
code, which is related to PR104849.  (Both PRs by Gerhard).

Co-authored by Steve.  Regtested on x86_64-pc-linux-gnu.
I plan to backport as seems appropriate.

Thanks,
Harald

From eac44ace68dd0476bda93ea49a758904c30e3a33 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Tue, 10 May 2022 23:41:57 +0200
Subject: [PATCH] Fortran: fix error recovery on invalid array section

gcc/fortran/ChangeLog:

	PR fortran/105230
	* expr.cc (find_array_section): Correct logic to avoid NULL
	pointer dereference on invalid array section.

gcc/testsuite/ChangeLog:

	PR fortran/105230
	* gfortran.dg/pr105230.f90: New test.

Co-authored-by: Steven G. Kargl 
---
 gcc/fortran/expr.cc| 4 ++--
 gcc/testsuite/gfortran.dg/pr105230.f90 | 8 
 2 files changed, 10 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr105230.f90

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 86d61fed302..be94c18c836 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -1595,8 +1595,8 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
 	  if ((begin && begin->expr_type != EXPR_CONSTANT)
 	  || (finish && finish->expr_type != EXPR_CONSTANT)
 	  || (step && step->expr_type != EXPR_CONSTANT)
-	  || (!begin && !lower)
-	  || (!finish && !upper))
+	  || !lower
+	  || !upper)
 	{
 	  t = false;
 	  goto cleanup;
diff --git a/gcc/testsuite/gfortran.dg/pr105230.f90 b/gcc/testsuite/gfortran.dg/pr105230.f90
new file mode 100644
index 000..6c6b42ef9bf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr105230.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! PR fortran/105230 - ICE in find_array_section
+! Contributed by G.Steinmetz
+
+program p
+  integer, parameter :: a(:) = [1, 2] ! { dg-error "deferred shape" }
+  print *, reshape([3, 4], a(1:2))
+end
--
2.35.3



[PATCH] PR fortran/105526 - [Coarray] Add missing checks for arguments of type TEAM_TYPE

2022-05-09 Thread Harald Anlauf via Gcc-patches
Dear Fortranners,

we were lacking checks for arguments of type TEAM_TYPE to some
coarray intrinsics (FORM TEAM, CHANGE TEAM, and SYNC TEAM).
The attached patch adds these, and as a bonus verifies that
TEAM NUMBER is a scalar integer.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

From 9e5aefa51df49a498854b25ce9dacd46bf58eb4e Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Mon, 9 May 2022 22:14:21 +0200
Subject: [PATCH] Fortran: check TEAM arguments to coarray intrinsics

TEAM arguments to coarray intrinsics must be scalar expressions of type
TEAM_TYPE of intrinsic module ISO_FORTRAN_ENV.

gcc/fortran/ChangeLog:

	PR fortran/105526
	* resolve.cc (check_team): New.
	(gfc_resolve_code): Add checks for arguments to coarray intrinsics
	FORM TEAM, CHANGE TEAM, and SYNC TEAM.

gcc/testsuite/ChangeLog:

	PR fortran/105526
	* gfortran.dg/coarray_50.f90: New test.
---
 gcc/fortran/resolve.cc   | 32 
 gcc/testsuite/gfortran.dg/coarray_50.f90 | 22 
 2 files changed, 54 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/coarray_50.f90

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 29df531cdb6..c8335f939a9 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -11831,6 +11831,23 @@ deferred_op_assign (gfc_code **code, gfc_namespace *ns)
 }


+static bool
+check_team (gfc_expr *team, const char *intrinsic)
+{
+  if (team->rank != 0
+  || team->ts.type != BT_DERIVED
+  || team->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV
+  || team->ts.u.derived->intmod_sym_id != ISOFORTRAN_TEAM_TYPE)
+{
+  gfc_error ("TEAM argument to %qs at %L must be a scalar expression "
+		 "of type TEAM_TYPE", intrinsic, &team->where);
+  return false;
+}
+
+  return true;
+}
+
+
 /* Given a block of code, recursively resolve everything pointed to by this
code block.  */

@@ -11999,10 +12016,25 @@ start:
 	  break;

 	case EXEC_FAIL_IMAGE:
+	  break;
+
 	case EXEC_FORM_TEAM:
+	  if (code->expr1 != NULL
+	  && (code->expr1->ts.type != BT_INTEGER || code->expr1->rank))
+	gfc_error ("TEAM NUMBER argument to FORM TEAM at %L must be "
+		   "a scalar INTEGER", &code->expr1->where);
+	  check_team (code->expr2, "FORM TEAM");
+	  break;
+
 	case EXEC_CHANGE_TEAM:
+	  check_team (code->expr1, "CHANGE TEAM");
+	  break;
+
 	case EXEC_END_TEAM:
+	  break;
+
 	case EXEC_SYNC_TEAM:
+	  check_team (code->expr1, "SYNC TEAM");
 	  break;

 	case EXEC_ENTRY:
diff --git a/gcc/testsuite/gfortran.dg/coarray_50.f90 b/gcc/testsuite/gfortran.dg/coarray_50.f90
new file mode 100644
index 000..e88d9d93f0e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_50.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! PR fortran/105526 - check TEAM arguments to coarray intrinsics
+
+subroutine p
+  use iso_fortran_env, only: team_type
+  implicit none
+  type(team_type) :: team
+  type t
+ integer :: i
+  end type t
+  type(t) :: z
+  form team (0, team)
+  form team (0, 0)  ! { dg-error "scalar expression of type TEAM_TYPE" }
+  form team (0, [team]) ! { dg-error "scalar expression of type TEAM_TYPE" }
+  form team ([0], team) ! { dg-error "scalar INTEGER" }
+  form team (0., team)  ! { dg-error "scalar INTEGER" }
+  change team (0)   ! { dg-error "scalar expression of type TEAM_TYPE" }
+  end team
+  sync team (0) ! { dg-error "scalar expression of type TEAM_TYPE" }
+end
--
2.35.3



Re: [PATCH] PR fortran/105501 - check for non-optional spaces between adjacent keywords

2022-05-09 Thread Harald Anlauf via Gcc-patches

Hi Mikael,

Am 09.05.22 um 20:24 schrieb Mikael Morin:

The fix itself looks good.  Regarding the test, I don’t understand the
problem.  Can’t there be multiple subroutines, each having one (or more)
problematic statement(s)?


that's why I tried but failed.  Example:

subroutine a
  errorstop
end
subroutine b
  errorstop
end

This now gives just one (the first) error, after which it bails out:

xxx.f90:2:3:

2 |   errorstop
  |   1
Error: Unclassifiable statement at (1)

That is the reason I mentioned it.

I'll commit the patch as-is.

Thanks for the review!
Harald


[PATCH] PR fortran/105501 - check for non-optional spaces between adjacent keywords

2022-05-08 Thread Harald Anlauf via Gcc-patches
Dear all,

the PR correctly notes that a space between keywords 'TYPE' and 'IS' is
required in free-form, but we currently accept 'TYPEIS'.  We shouldn't.
The combinations with non-optional blanks are listed in the standard;
in F2018 this is table 6.2.

While at it, I saw a couple of other keyword combinations in the matcher
and fixed these too.  I cross-checked my findings with Intel, Crayftn,
and NAG (as far as possible).

Regarding the testcase: I do not know how to write a (single!) testcase
that is able to check multiple of those fixes.  I also do not think that
it makes sense to provide a testcase for each single fixed pattern.
Therefore a provided a single, minimal testcase based on the report.

Regtested on x86_64-pc-linux-gnu.  OK for mainline (i.e. 13-master)?

Thanks,
Harald

From 8b04cb084e138966cf20187887da676ad9e4a00e Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Sun, 8 May 2022 22:04:27 +0200
Subject: [PATCH] Fortran: check for non-optional spaces between adjacent
 keywords

In free format, spaces between adjacent keywords are not optional except
when a combination is explicitly listed (e.g. F2018: table 6.2).  The
following combinations thus require separating blanks: CHANGE TEAM,
ERROR STOP, EVENT POST, EVENT WAIT, FAIL IMAGE, FORM TEAM, SELECT RANK,
SYNC ALL, SYNC IMAGES, SYNC MEMORY, SYNC TEAM, TYPE IS.

gcc/fortran/ChangeLog:

	PR fortran/105501
	* match.cc (gfc_match_if): Adjust patterns used for matching.
	(gfc_match_select_rank): Likewise.
	* parse.cc (decode_statement): Likewise.

gcc/testsuite/ChangeLog:

	PR fortran/105501
	* gfortran.dg/pr105501.f90: New test.
---
 gcc/fortran/match.cc   | 22 +++---
 gcc/fortran/parse.cc   | 22 +++---
 gcc/testsuite/gfortran.dg/pr105501.f90 | 15 +++
 3 files changed, 37 insertions(+), 22 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr105501.f90

diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 205811bb969..1aa3053e70e 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -1606,21 +1606,21 @@ gfc_match_if (gfc_statement *if_type)
   match ("assign", gfc_match_assign, ST_LABEL_ASSIGNMENT)
   match ("backspace", gfc_match_backspace, ST_BACKSPACE)
   match ("call", gfc_match_call, ST_CALL)
-  match ("change team", gfc_match_change_team, ST_CHANGE_TEAM)
+  match ("change% team", gfc_match_change_team, ST_CHANGE_TEAM)
   match ("close", gfc_match_close, ST_CLOSE)
   match ("continue", gfc_match_continue, ST_CONTINUE)
   match ("cycle", gfc_match_cycle, ST_CYCLE)
   match ("deallocate", gfc_match_deallocate, ST_DEALLOCATE)
   match ("end file", gfc_match_endfile, ST_END_FILE)
   match ("end team", gfc_match_end_team, ST_END_TEAM)
-  match ("error stop", gfc_match_error_stop, ST_ERROR_STOP)
-  match ("event post", gfc_match_event_post, ST_EVENT_POST)
-  match ("event wait", gfc_match_event_wait, ST_EVENT_WAIT)
+  match ("error% stop", gfc_match_error_stop, ST_ERROR_STOP)
+  match ("event% post", gfc_match_event_post, ST_EVENT_POST)
+  match ("event% wait", gfc_match_event_wait, ST_EVENT_WAIT)
   match ("exit", gfc_match_exit, ST_EXIT)
-  match ("fail image", gfc_match_fail_image, ST_FAIL_IMAGE)
+  match ("fail% image", gfc_match_fail_image, ST_FAIL_IMAGE)
   match ("flush", gfc_match_flush, ST_FLUSH)
   match ("forall", match_simple_forall, ST_FORALL)
-  match ("form team", gfc_match_form_team, ST_FORM_TEAM)
+  match ("form% team", gfc_match_form_team, ST_FORM_TEAM)
   match ("go to", gfc_match_goto, ST_GOTO)
   match ("if", match_arithmetic_if, ST_ARITHMETIC_IF)
   match ("inquire", gfc_match_inquire, ST_INQUIRE)
@@ -1634,10 +1634,10 @@ gfc_match_if (gfc_statement *if_type)
   match ("rewind", gfc_match_rewind, ST_REWIND)
   match ("stop", gfc_match_stop, ST_STOP)
   match ("wait", gfc_match_wait, ST_WAIT)
-  match ("sync all", gfc_match_sync_all, ST_SYNC_CALL);
-  match ("sync images", gfc_match_sync_images, ST_SYNC_IMAGES);
-  match ("sync memory", gfc_match_sync_memory, ST_SYNC_MEMORY);
-  match ("sync team", gfc_match_sync_team, ST_SYNC_TEAM)
+  match ("sync% all", gfc_match_sync_all, ST_SYNC_CALL);
+  match ("sync% images", gfc_match_sync_images, ST_SYNC_IMAGES);
+  match ("sync% memory", gfc_match_sync_memory, ST_SYNC_MEMORY);
+  match ("sync% team", gfc_match_sync_team, ST_SYNC_TEAM)
   match ("unlock", gfc_match_unlock, ST_UNLOCK)
   match ("where", match_simple_where, ST_WHERE)
   match ("write", gfc_match_write, ST_WRITE)
@@ -6716,7 +6716,7 @@ gfc_match_select_rank (v

Re: [PATCH v2] fortran: Avoid infinite self-recursion [PR105381]

2022-04-26 Thread Harald Anlauf via Gcc-patches

Hi Mikael,

Am 26.04.22 um 21:10 schrieb Mikael Morin:

Le 26/04/2022 à 19:12, Mikael Morin a écrit :

Le 26/04/2022 à 15:32, Jakub Jelinek a écrit :

or one can repeat it like:
 if (DECL_P (expr)
&& DECL_LANG_SPECIFIC (expr)
&& GFC_DECL_SAVED_DESCRIPTOR (expr)
&& GFC_DECL_SAVED_DESCRIPTOR (expr) != expr)
   return non_negative_strides_array_p (GFC_DECL_SAVED_DESCRIPTOR
(expr));


I think I’ll use that.


Here it comes.
Regression tested again. OK?


works for me.

Thanks for the quick fix!

Harald


Re: [PATCH v2] fortran: Detect duplicate unlimited polymorphic types [PR103662]

2022-04-23 Thread Harald Anlauf via Gcc-patches

Hi Mikael,

Am 22.04.22 um 12:53 schrieb Mikael Morin:

Le 21/04/2022 à 23:14, Mikael Morin a écrit :

Hello,

this is a fix for PR103662, a TBAA issue with unlimited polymorphic
types.

I attached a draft patch to the PR which was accumulating all unlimited
polymorphic symbols to a single namespace, avoiding duplicate symbols
and thus eliminating the problem.

After reviewing the code more in detail, I was afraid that some symbols
could still end up in the local namespace, and that the problem would
remain for them after all.

Despite not being able to generate a testcase where it happened, I
decided to produce a patch based on Jakub’s analysis in the PR audit
trail, as that way supports duplicates by design.

On top of Jakub’s patch, there are a couple more types registrations
just in case (they handle duplicates so that’s fine), and the type
comparison fix that he was too fortran-uncomfortable to do.

The testcase had to be fixed as we found out in the PR audit trail.

Regression tested on x86_64-pc-linux-gnu. OK for master?

Mikael


I have read Jakub’s analysis again, and it says the type registration is
useless for unlimited polymorphic fake symbols, as they are all
translated as ptr_type_node.
So it can be dropped, which brings this v2 patch closer to Jakub’s
original.

Regression tested again. OK?


LGTM.

Thanks for the patch!

Harald


Re: [PATCH] PR fortran/105310 - ICE when UNION is after the 8th field in a DEC STRUCTURE with -finit-derived -finit-local-zero

2022-04-20 Thread Harald Anlauf via Gcc-patches

Hi Fritz,

Am 20.04.22 um 20:03 schrieb Fritz Reese via Fortran:

See the bug report at gcc dot gnu dot org/bugzilla/show_bug.cgi?id=105310 .

This code was originally authored by me and the fix is trivial, so I
intend to commit the attached patch in the next few days if there is
no dissent.


OK if you add a/the testcase.



The bug is caused by gfc_conv_union_initializer in
gcc/fortran/trans-expr.cc, which accepts a pointer to a vector of
constructor trees (vec*) as an argument, then
appends one or two field constructors to the vector. The problem is
the use of CONSTRUCTOR_APPEND_ELT(v, ...) within
gfc_conv_union_initializer, which modifies the vector pointer v when a
reallocation of the vector occurs, but the pointer is passed by value.
Therefore, when a vector reallocation occurs, the caller's
(gfc_conv_structure) vector pointer is not updated and subsequently
points to freed memory. Chaos ensues.

The bug only occurs when gfc_conv_union_initializer itself triggers
the reallocation, which is whenever the vector is "full"
(v->m_vecpfx.m_alloc == v->m_vecpfx.m_num). Since the vector defaults
to allocating 8 elements and doubles in size for every reallocation,
the bug only occurs when there are 8, 16, 32, etc... fields with
initializers prior to the union, causing the vector of constructors to
be resized when entering gfc_conv_union_initializer. The
-finit-derived and -finit-local-zero options together ensure each
field has an initializer, triggering the bug.

The patch fixes the bug by passing the vector pointer to
gfc_conv_union_initializer by reference, matching the signature of
vec_safe_push from within the CONSTRUCTOR_APPEND_ELT macro.

--
Fritz Reese


As this affects all branches, you may backport the patch as far as
you feel reasonable.  (No, I do not use DEC extensions personally.)

Thanks for the patch!

Harald


Re: [PATCH] PR fortran/104812: generate error for constuct-name clash with symbols

2022-04-19 Thread Harald Anlauf via Gcc-patches

Hi Mike,

for contributing, you'd need to have a GNU copyright assignment or
DCO certification, and I cannot find your name in the usual place.

See e.g. https://gcc.gnu.org/dco.html for details.

Thanks,
Harald

Am 05.04.22 um 19:33 schrieb Mike Kashkarov via Gcc-patches:


Greetings,

Propose patch for https://gcc.gnu.org/bugzilla/show_bug.cgi?id=104812 to
reject non-conforming code when construct-name clashes with already
defined symbol names, e.g:

  subroutine s1
logical :: x
x: if (x) then ! Currently gfortran accepts 'x' as constuct-name
end if x
  end
  
Steve Kargl poited that (Fortran 2018, 19.4, p 498):


Identifiers of entities, other than statement or construct entities (19.4),
in the classes

  (1) named variables, ..., named constructs, ...,

   Within its scope, a local identifier of one class shall not be the
   same as another local identifier of the same class,
   


Regtested on x86_64-pc-linux-gnu, OK for mainline?

Thanks.







[PATCH, v2] PR fortran/105184 - ICE in gfc_array_init_size, at fortran/trans-array.cc:5841

2022-04-08 Thread Harald Anlauf via Gcc-patches

Dear all,

Am 06.04.22 um 22:30 schrieb Harald Anlauf via Fortran:

Dear all,

the logic for checking the allocate-coshape-spec in an ALLOCATE
statement was sort of sideways, and allowed to pass invalid
specifications to the code generation.

The fix seems obvious (to me).


after submitting the previous patch, I found another invalid case with
a missing lower bound which was still silently accepted.  The attached
revised patch adds this check, improves the original error message to
actually point to the coarray specification, and renames the testcase
to align better with existing coarray testcases.


Regtested on x86_64-pc-linux-gnu.  OK for mainline?
(12 or wait for 13?).


Regtested again with no new failures.  OK for mainline?

Thanks,
Harald
From 483cbf9942dcfcf74a912312dbbcda2f108200ea Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Wed, 6 Apr 2022 22:24:21 +0200
Subject: [PATCH] Fortran: fix checking of coshape specification in ALLOCATE
 statement

gcc/fortran/ChangeLog:

	PR fortran/105184
	* array.cc (match_subscript): Reject assumed size coarray
	specification with missing lower bound.
	* resolve.cc (resolve_allocate_expr): Fix logic for checking
	allocate-coshape-spec in ALLOCATE statement.

gcc/testsuite/ChangeLog:

	PR fortran/105184
	* gfortran.dg/coarray_44.f90: Adjust expected output.
	* gfortran.dg/coarray_allocate_11.f90: Likewise.
	* gfortran.dg/coarray_allocate_12.f90: New test.
---
 gcc/fortran/array.cc  |  7 +++
 gcc/fortran/resolve.cc| 11 ++-
 gcc/testsuite/gfortran.dg/coarray_44.f90  |  2 ++
 .../gfortran.dg/coarray_allocate_11.f90   |  6 +++---
 .../gfortran.dg/coarray_allocate_12.f90   | 19 +++
 5 files changed, 37 insertions(+), 8 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/coarray_allocate_12.f90

diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index eb9ed8580a0..90ea812d699 100644
--- a/gcc/fortran/array.cc
+++ b/gcc/fortran/array.cc
@@ -134,6 +134,13 @@ end_element:
   if (m == MATCH_ERROR)
 return MATCH_ERROR;
 
+  if (star && ar->start[i] == NULL)
+{
+  gfc_error ("Missing lower bound in assumed size "
+		 "coarray specification at %C");
+  return MATCH_ERROR;
+}
+
   /* See if we have an optional stride.  */
   if (gfc_match_char (':') == MATCH_YES)
 {
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 21c8797c938..05f8f1bf6c2 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -8108,12 +8108,13 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec)
 	goto failure;
 
 	  case  DIMEN_RANGE:
-	if (ar->start[i] == 0 || ar->end[i] == 0)
+	/* F2018:R937:
+	 * allocate-coshape-spec is [ lower-bound-expr : ] upper-bound-expr
+	 */
+	if (ar->start[i] == 0 || ar->end[i] == 0 || ar->stride[i] != NULL)
 	  {
-		/* If ar->stride[i] is NULL, we issued a previous error.  */
-		if (ar->stride[i] == NULL)
-		  gfc_error ("Bad array specification in ALLOCATE statement "
-			 "at %L", &e->where);
+		gfc_error ("Bad coarray specification in ALLOCATE statement "
+			   "at %L", &e->where);
 		goto failure;
 	  }
 	else if (gfc_dep_compare_expr (ar->start[i], ar->end[i]) == 1)
diff --git a/gcc/testsuite/gfortran.dg/coarray_44.f90 b/gcc/testsuite/gfortran.dg/coarray_44.f90
index 15fb8c76ce4..545b5462251 100644
--- a/gcc/testsuite/gfortran.dg/coarray_44.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_44.f90
@@ -10,3 +10,5 @@ program pr70071
   allocate (z(2)[1::2,*])  ! { dg-error "Bad array dimension" }
   allocate (z(1::2)[2,*])  ! { dg-error "Bad array specification in ALLOCATE" }
 end program pr70071
+
+! { dg-prune-output "Bad coarray specification in ALLOCATE statement" }
diff --git a/gcc/testsuite/gfortran.dg/coarray_allocate_11.f90 b/gcc/testsuite/gfortran.dg/coarray_allocate_11.f90
index 0e806f0955b..0e4f64e1e3d 100644
--- a/gcc/testsuite/gfortran.dg/coarray_allocate_11.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_allocate_11.f90
@@ -3,10 +3,10 @@
 program p
integer, allocatable :: z[:,:]
integer :: i
-   allocate (z[1:,*]) ! { dg-error "Bad array specification in ALLOCATE statement" }
-   allocate (z[:2,*]) ! { dg-error "Bad array specification in ALLOCATE statement" }
+   allocate (z[1:,*]) ! { dg-error "Bad coarray specification in ALLOCATE statement" }
+   allocate (z[:2,*]) ! { dg-error "Bad coarray specification in ALLOCATE statement" }
allocate (z[2:1,*]) ! { dg-error "Upper cobound is less than lower cobound" }
-   allocate (z[:0,*]) ! { dg-error "Bad array specification in ALLOCATE statement" }
+   allocate (z[:0,*]) ! { dg-error "Bad coarray specification in ALLOCATE statement" }
allocate (z[0,*]

[PATCH] PR fortran/105184 - ICE in gfc_array_init_size, at fortran/trans-array.cc:5841

2022-04-06 Thread Harald Anlauf via Gcc-patches
Dear all,

the logic for checking the allocate-coshape-spec in an ALLOCATE
statement was sort of sideways, and allowed to pass invalid
specifications to the code generation.

The fix seems obvious (to me).

Regtested on x86_64-pc-linux-gnu.  OK for mainline?
(12 or wait for 13?).

Thanks,
Harald

From 2adcdbd40e3a64d1f2d42eb0e0fdcc7e593da137 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Wed, 6 Apr 2022 22:24:21 +0200
Subject: [PATCH] Fortran: fix logic for checking coshape specification in
 ALLOCATE statement

gcc/fortran/ChangeLog:

	PR fortran/105184
	* resolve.cc (resolve_allocate_expr): Fix logic for checking
	allocate-coshape-spec in ALLOCATE statement.

gcc/testsuite/ChangeLog:

	PR fortran/105184
	* gfortran.dg/coarray_44.f90: Adjust expected output.
	* gfortran.dg/coarray_50.f90: New test.
---
 gcc/fortran/resolve.cc   | 10 +-
 gcc/testsuite/gfortran.dg/coarray_44.f90 |  2 ++
 gcc/testsuite/gfortran.dg/coarray_50.f90 | 17 +
 3 files changed, 24 insertions(+), 5 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/coarray_50.f90

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 21c8797c938..45a04dab703 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -8108,12 +8108,12 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec)
 	goto failure;

 	  case  DIMEN_RANGE:
-	if (ar->start[i] == 0 || ar->end[i] == 0)
+	// F2018:R937:
+	// allocate-coshape-spec is [ lower-bound-expr : ] upper-bound-expr
+	if (ar->start[i] == 0 || ar->end[i] == 0 || ar->stride[i] != NULL)
 	  {
-		/* If ar->stride[i] is NULL, we issued a previous error.  */
-		if (ar->stride[i] == NULL)
-		  gfc_error ("Bad array specification in ALLOCATE statement "
-			 "at %L", &e->where);
+		gfc_error ("Bad array specification in ALLOCATE statement "
+			   "at %L", &e->where);
 		goto failure;
 	  }
 	else if (gfc_dep_compare_expr (ar->start[i], ar->end[i]) == 1)
diff --git a/gcc/testsuite/gfortran.dg/coarray_44.f90 b/gcc/testsuite/gfortran.dg/coarray_44.f90
index 15fb8c76ce4..f83e3e9b19d 100644
--- a/gcc/testsuite/gfortran.dg/coarray_44.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_44.f90
@@ -10,3 +10,5 @@ program pr70071
   allocate (z(2)[1::2,*])  ! { dg-error "Bad array dimension" }
   allocate (z(1::2)[2,*])  ! { dg-error "Bad array specification in ALLOCATE" }
 end program pr70071
+
+! { dg-prune-output "Bad array specification in ALLOCATE statement" }
diff --git a/gcc/testsuite/gfortran.dg/coarray_50.f90 b/gcc/testsuite/gfortran.dg/coarray_50.f90
new file mode 100644
index 000..9e8bd5d53de
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_50.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! PR fortran/105184
+! Based on testcases by Gerhard Steinmetz
+
+program p
+  real, allocatable :: x[:,:]
+  integer :: n = 2
+  allocate (x[  n, *])
+  allocate (x[1:n, *])
+  allocate (x[n:n, *])
+  allocate (x[ :n,   *]) ! { dg-error "Bad array specification" }
+  allocate (x[::n,   *]) ! { dg-error "Bad array specification" }
+  allocate (x[ :1:1, *]) ! { dg-error "Bad array specification" }
+  allocate (x[1:n:n, *]) ! { dg-error "Bad array specification" }
+end
--
2.34.1



*Ping* [PATCH] PR fortran/104210 - [11/12 Regression] ICE in gfc_zero_size_array, at fortran/arith.cc:1685

2022-04-04 Thread Harald Anlauf via Gcc-patches

Am 29.03.22 um 23:41 schrieb Harald Anlauf via Fortran:

Dear all,

during error recovery on invalid declarations of functions as
coarrays we may hit multiple places with NULL pointer dereferences.
The attached patch provides a minimal and conservative solution.

Regtested on x86_64-pc-linux-gnu.  OK for mainline/11-branch?

Thanks,
Harald





[PATCH] PR fortran/105138 - Bogus error when function name does not shadow an intrinsic when RESULT clause is used

2022-04-04 Thread Harald Anlauf via Gcc-patches
Dear all,

Steve's analysis (see PR) showed that we confused the case when a
symbol refererred to a recursive procedure which was named the same
as an intrinsic.  The standard allows such recursive references
(see e.g. F2018:19.3.1).

The attached patch is based on Steve's, but handles both functions
and subroutines.  Testcase verified with NAG and Crayftn.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

This bug is a rejects-valid, but could also lead to wrong code,
see e.g. the PR, comment#4.  Would this qualify for a backport
to e.g. the 11-branch?

Thanks,
Harald

From 4c23f78a41fad7cb19ad84c99a73d761fa02 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Mon, 4 Apr 2022 20:42:51 +0200
Subject: [PATCH] Fortran: a RECURSIVE procedure cannot be an INTRINSIC

gcc/fortran/ChangeLog:

	PR fortran/105138
	* intrinsic.cc (gfc_is_intrinsic): When a symbol refers to a
	RECURSIVE procedure, it cannot be an INTRINSIC.

gcc/testsuite/ChangeLog:

	PR fortran/105138
	* gfortran.dg/recursive_reference_3.f90: New test.

Co-authored-by: Steven G. Kargl 
---
 gcc/fortran/intrinsic.cc   |  1 +
 .../gfortran.dg/recursive_reference_3.f90  | 14 ++
 2 files changed, 15 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/recursive_reference_3.f90

diff --git a/gcc/fortran/intrinsic.cc b/gcc/fortran/intrinsic.cc
index 2339d9050ec..e89131f5a71 100644
--- a/gcc/fortran/intrinsic.cc
+++ b/gcc/fortran/intrinsic.cc
@@ -1164,6 +1164,7 @@ gfc_is_intrinsic (gfc_symbol* sym, int subroutine_flag, locus loc)

   /* Check for attributes which prevent the symbol from being INTRINSIC.  */
   if (sym->attr.external || sym->attr.contained
+  || sym->attr.recursive
   || sym->attr.if_source == IFSRC_IFBODY)
 return false;

diff --git a/gcc/testsuite/gfortran.dg/recursive_reference_3.f90 b/gcc/testsuite/gfortran.dg/recursive_reference_3.f90
new file mode 100644
index 000..f4e2963aec2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_reference_3.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-std=f2018" }
+! PR fortran/105138 - recursive procedures and shadowing of intrinsics
+
+RECURSIVE FUNCTION LOG_GAMMA(Z) RESULT(RES)
+  COMPLEX, INTENT(IN) :: Z
+  COMPLEX :: RES
+  RES = LOG_GAMMA(Z)
+END FUNCTION LOG_GAMMA
+
+recursive subroutine date_and_time (z)
+  real :: z
+  if (z > 0) call date_and_time (z-1)
+end subroutine date_and_time
--
2.34.1



[committed] PR fortran/100892 - ICE on procedure pointer to function returning array of size n

2022-03-30 Thread Harald Anlauf via Gcc-patches
Dear all,

I committed the attached patch as obvious: we had a NULL pointer
dereference when checking the arguments of the ASSOCIATED intrinsic
when the target was an array-valued function.

Regtested on x86_64-pc-linux-gnu.

Thanks,
Harald

From b4e4b35f4ebe561826489bed971324efc99c5423 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Wed, 30 Mar 2022 22:36:12 +0200
Subject: [PATCH] Fortran: NULL pointer dereference checking arguments to
 ASSOCIATED intrinsic

gcc/fortran/ChangeLog:

	PR fortran/100892
	* check.cc (gfc_check_associated): Avoid NULL pointer dereference.

gcc/testsuite/ChangeLog:

	PR fortran/100892
	* gfortran.dg/associated_target_8.f90: New test.
---
 gcc/fortran/check.cc |  2 +-
 .../gfortran.dg/associated_target_8.f90  | 16 
 2 files changed, 17 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/associated_target_8.f90

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index fc97bb1371e..0c2cb50c6a7 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -1504,7 +1504,7 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
  argument of intrinsic inquiry functions.  */
   if (pointer->rank != -1 && !rank_check (target, 0, pointer->rank))
 t = false;
-  if (target->rank > 0)
+  if (target->rank > 0 && target->ref)
 {
   for (i = 0; i < target->rank; i++)
 	if (target->ref->u.ar.dimen_type[i] == DIMEN_VECTOR)
diff --git a/gcc/testsuite/gfortran.dg/associated_target_8.f90 b/gcc/testsuite/gfortran.dg/associated_target_8.f90
new file mode 100644
index 000..75c2740a188
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associated_target_8.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! PR fortran/100892 - procedure pointer to function returning array of size n
+
+module m
+  implicit none
+  procedure(func1), pointer :: my_ptr => null()
+contains
+  subroutine test_sub
+if (associated (my_ptr, func1)) print *,'associated'
+  end subroutine test_sub
+  function func1 (n)
+integer, intent(in) :: n
+real, dimension(n)  :: func1
+func1 = 0.
+  end function
+end module m
--
2.34.1



[PATCH] PR fortran/104210 - [11/12 Regression] ICE in gfc_zero_size_array, at fortran/arith.cc:1685

2022-03-29 Thread Harald Anlauf via Gcc-patches
Dear all,

during error recovery on invalid declarations of functions as
coarrays we may hit multiple places with NULL pointer dereferences.
The attached patch provides a minimal and conservative solution.

Regtested on x86_64-pc-linux-gnu.  OK for mainline/11-branch?

Thanks,
Harald

From ce80d4b2ce3f35684f09bbb2f95f6edc5827224b Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Tue, 29 Mar 2022 23:33:23 +0200
Subject: [PATCH] Fortran: improve error recovery for invalid coarray function
 declarations

gcc/fortran/ChangeLog:

	PR fortran/104210
	* arith.cc (eval_intrinsic): Avoid NULL pointer dereference.
	(gfc_zero_size_array): Likewise.

gcc/testsuite/ChangeLog:

	PR fortran/104210
	* gfortran.dg/pr104210.f90: New test.
---
 gcc/fortran/arith.cc   |  9 ++---
 gcc/testsuite/gfortran.dg/pr104210.f90 | 15 +++
 2 files changed, 21 insertions(+), 3 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr104210.f90

diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index 06e032e22db..d57059a375f 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -1489,6 +1489,9 @@ eval_intrinsic (gfc_intrinsic_op op,
   int unary;
   arith rc;

+  if (!op1)
+return NULL;
+
   gfc_clear_ts (&temp.ts);

   switch (op)
@@ -1703,11 +1706,11 @@ eval_type_intrinsic0 (gfc_intrinsic_op iop, gfc_expr *op)

 /* Return nonzero if the expression is a zero size array.  */

-static int
+static bool
 gfc_zero_size_array (gfc_expr *e)
 {
-  if (e->expr_type != EXPR_ARRAY)
-return 0;
+  if (e == NULL || e->expr_type != EXPR_ARRAY)
+return false;

   return e->value.constructor == NULL;
 }
diff --git a/gcc/testsuite/gfortran.dg/pr104210.f90 b/gcc/testsuite/gfortran.dg/pr104210.f90
new file mode 100644
index 000..182404c265b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr104210.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+! PR fortran/104210
+! Contributed by G.Steinmetz
+
+function f()  ! { dg-error "shall not be a coarray" }
+  integer :: f[*]
+end
+program p
+  interface
+ function f() ! { dg-error "shall not be a coarray" }
+   integer :: f[*]
+ end
+  end interface
+end
--
2.34.1



[PATCH, committed] PR fortran/104571 - ICE in resolve_elemental_actual, at fortran/resolve.cc:2383

2022-03-29 Thread Harald Anlauf via Gcc-patches
Dear all,

I committed an obvious patch by Steve to avoid a NULL pointer dereference
on checking for invalid specification of an elemental procedure argument:

https://gcc.gnu.org/g:69db6e7f4e1d07bf8f33e93a29139cc16c1e0a2f

Regtested on x86_64-pc-linux-gnu.

Thanks,
Harald

From 69db6e7f4e1d07bf8f33e93a29139cc16c1e0a2f Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Tue, 29 Mar 2022 22:12:15 +0200
Subject: [PATCH] Fortran: avoid NULL pointer dereference checking elemental
 procedure args

gcc/fortran/ChangeLog:

	PR fortran/104571
	* resolve.cc (resolve_elemental_actual): Avoid NULL pointer
	dereference.

gcc/testsuite/ChangeLog:

	PR fortran/104571
	* gfortran.dg/pr104571.f90: New test.

Co-authored-by: Steven G. Kargl 
---
 gcc/fortran/resolve.cc |  5 +++--
 gcc/testsuite/gfortran.dg/pr104571.f90 | 12 
 2 files changed, 15 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr104571.f90

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 290767723d8..21c8797c938 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -2397,8 +2397,9 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c)
   if (rank > 0 && esym && expr == NULL)
 for (eformal = esym->formal, arg = arg0; arg && eformal;
 	 arg = arg->next, eformal = eformal->next)
-  if ((eformal->sym->attr.intent == INTENT_OUT
-	   || eformal->sym->attr.intent == INTENT_INOUT)
+  if (eformal->sym
+	  && (eformal->sym->attr.intent == INTENT_OUT
+	  || eformal->sym->attr.intent == INTENT_INOUT)
 	  && arg->expr && arg->expr->rank == 0)
 	{
 	  gfc_error ("Actual argument at %L for INTENT(%s) dummy %qs of "
diff --git a/gcc/testsuite/gfortran.dg/pr104571.f90 b/gcc/testsuite/gfortran.dg/pr104571.f90
new file mode 100644
index 000..9a6f2d0e872
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr104571.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+! PR fortran/104571 - ICE in resolve_elemental_actual
+! Contributed by G.Steinmetz
+
+program p
+  real :: x(3)
+  call g(x) ! { dg-error "Missing alternate return" }
+contains
+  elemental subroutine g(*) ! { dg-error "Alternate return specifier" }
+  end
+end
--
2.34.1



Re: [PATCH] PR fortran/50549 - should detect different type parameters in structure constructors

2022-03-29 Thread Harald Anlauf via Gcc-patches

Hi Tobias,

Am 29.03.22 um 09:14 schrieb Tobias Burnus:

Hi Harald,

On 28.03.22 22:03, Harald Anlauf via Fortran wrote:

All current cases of printing a HOST_WIDE_INT in gcc/fortran/ use
'sprintf', and I did not find any other use of %wd/%wu.  So the
mentioned implementation is not really stressed yet... ;-)


That's all your fault ;-)


true; I'm pleading guilty for that one.


(Your commit
https://gcc.gnu.org/r12-3273-ge4cb3bb9ac11b4126ffa718287dd509a4b10a658
did remove the only user.)


I've now made good for it.  ;-)


That's only a warning. Have you tried whether it works at runtime?
My bet is that it does!


Yes, it did work, it was just the warning alerting me ...


Question: Do you build with --disable-bootstrap ? Or do you do a proper
bootstrap?


... because I did build with --disable-bootstrap to save on time for
building the compiler on my local machine, and the system's default
gcc is older.


Can you check & try again?  I don't mind getting a format warning with
GCC < GCC 12. But with GCC 12 compiled (either installed compiler or
when bootstrapping) it should compile without errors.

If you can confirm my suspicion, the patch LGTM.


I've just pushed that version as

  https://gcc.gnu.org/g:0712f356374c2cf26015cccfa3141537e42cbb12

Sorry for the noise, and thanks for the review!

Harald


Tobias




Re: [PATCH] PR fortran/50549 - should detect different type parameters in structure constructors

2022-03-28 Thread Harald Anlauf via Gcc-patches

Hi Tobias,

sorry for replying to myself now, but

Am 28.03.22 um 22:03 schrieb Harald Anlauf via Fortran:

All current cases of printing a HOST_WIDE_INT in gcc/fortran/ use
'sprintf', and I did not find any other use of %wd/%wu.  So the
mentioned implementation is not really stressed yet... ;-)


using HOST_WIDE_INT_PRINT_DEC in the format argument to gfc_error
instead of using %wd does not produce a warning and works.
(Also verified with insane character lengths on x86_64).

Harald
From f6b337c8c5f38acc40787ac6bef029c5321a3f4a Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Sun, 27 Mar 2022 21:35:15 +0200
Subject: [PATCH] Fortran: character length of pointer assignments in structure
 constructors

gcc/fortran/ChangeLog:

	PR fortran/50549
	* resolve.cc (resolve_structure_cons): Reject pointer assignments
	of character with different lengths in structure constructor.

gcc/testsuite/ChangeLog:

	PR fortran/50549
	* gfortran.dg/char_pointer_assign_7.f90: New test.
---
 gcc/fortran/resolve.cc| 14 ++-
 .../gfortran.dg/char_pointer_assign_7.f90 | 38 +++
 2 files changed, 51 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/char_pointer_assign_7.f90

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 5522be75199..57362a75baa 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -1375,11 +1375,23 @@ resolve_structure_cons (gfc_expr *expr, int init)
 	  && comp->ts.u.cl->length->expr_type == EXPR_CONSTANT
 	  && cons->expr->ts.u.cl && cons->expr->ts.u.cl->length
 	  && cons->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT
-	  && cons->expr->rank != 0
 	  && mpz_cmp (cons->expr->ts.u.cl->length->value.integer,
 		  comp->ts.u.cl->length->value.integer) != 0)
 	{
+	  if (comp->attr.pointer)
+	{
+	  HOST_WIDE_INT la, lb;
+	  la = gfc_mpz_get_hwi (comp->ts.u.cl->length->value.integer);
+	  lb = gfc_mpz_get_hwi (cons->expr->ts.u.cl->length->value.integer);
+	  gfc_error ("Unequal character lengths ("
+			 HOST_WIDE_INT_PRINT_DEC "/" HOST_WIDE_INT_PRINT_DEC
+			 ") for pointer component %qs in constructor at %L",
+			 la, lb, comp->name, &cons->expr->where);
+	  t = false;
+	}
+
 	  if (cons->expr->expr_type == EXPR_VARIABLE
+	  && cons->expr->rank != 0
 	  && cons->expr->symtree->n.sym->attr.flavor == FL_PARAMETER)
 	{
 	  /* Wrap the parameter in an array constructor (EXPR_ARRAY)
diff --git a/gcc/testsuite/gfortran.dg/char_pointer_assign_7.f90 b/gcc/testsuite/gfortran.dg/char_pointer_assign_7.f90
new file mode 100644
index 000..08bdf176d8b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_pointer_assign_7.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! PR fortran/50549 - should reject pointer assignments of different lengths
+! in structure constructors
+
+program test
+  implicit none
+  type t
+ character(2), pointer ::  p2
+  end type t
+  type t2
+ character(2), pointer ::  p(:)
+  end type t2
+  type td
+ character(:), pointer ::  pd
+  end type td
+  interface
+ function f1 ()
+   character(1), pointer :: f1
+ end function f1
+ function f2 ()
+   character(2), pointer :: f2
+ end function f2
+  end interface
+
+  character(1),target  ::  p1
+  character(1),pointer ::  q1(:)
+  character(2),pointer ::  q2(:)
+  type(t)  :: u
+  type(t2) :: u2
+  type(td) :: v
+  u  = t(p1)! { dg-error "Unequal character lengths" }
+  u  = t(f1())  ! { dg-error "Unequal character lengths" }
+  u  = t(f2())  ! OK
+  u2 = t2(q1)   ! { dg-error "Unequal character lengths" }
+  u2 = t2(q2)   ! OK
+  v  = td(p1)   ! OK
+  v  = td(f1()) ! OK
+end
-- 
2.34.1



Re: [PATCH] PR fortran/50549 - should detect different type parameters in structure constructors

2022-03-28 Thread Harald Anlauf via Gcc-patches

Hi Tobias,

Am 28.03.22 um 12:05 schrieb Tobias Burnus:

Thanks for the patch! LGTM and I think GCC 12 is still okay.

However, I have a nit:


--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -1375,11 +1375,22 @@ resolve_structure_cons (gfc_expr *expr, int init)
...
+   long len_a, len_b;
+   len_a = mpz_get_si (comp->ts.u.cl->length->value.integer);
+   len_b = mpz_get_si
(cons->expr->ts.u.cl->length->value.integer);
+   gfc_error ("Unequal character lengths (%ld/%ld) for pointer "
+  "component %qs in constructor at %L",
+  len_a, len_b, comp->name, &cons->expr->where);


'long' might be int32_t instead of int64_t (e.g. on Windows, I think both
MinGW32 and MinGW64, but I am not quite sure). Thus, I wonder whether it
makes more sense to use:

   HOST_WIDE_INT, gfc_mpz_get_hwi() and '%wd'

I note that '%wd' (and '%lld') is only supported since last August
(commit https://gcc.gnu.org/r12-3044-g1b507b1e3c5 ), but now that it is,
I think we should use it at places where the value can be larger than
INT_MAX.


using HOST_WIDE_INT as in the updated patch (sort of) works, but for
some reason I do not yet understand the format check kicks in for
gfc_error, producing:

../../gcc-trunk/gcc/fortran/resolve.cc: In function 'bool
resolve_structure_cons(gfc_expr*, int)':
../../gcc-trunk/gcc/fortran/resolve.cc:1388:43: warning: unknown
conversion type character 'w' in format [-Wformat=]
 la, lb, comp->name, &cons->expr->where);
   ^
../../gcc-trunk/gcc/fortran/resolve.cc:1388:43: warning: unknown
conversion type character 'w' in format [-Wformat=]
../../gcc-trunk/gcc/fortran/resolve.cc:1388:43: warning: format '%s'
expects argument of type 'char*', but argument 2 has type 'long int'
[-Wformat=]
../../gcc-trunk/gcc/fortran/resolve.cc:1388:43: warning: format '%L'
expects argument of type 'locus*', but argument 3 has type 'long int'
[-Wformat=]
../../gcc-trunk/gcc/fortran/resolve.cc:1388:43: warning: too many
arguments for format [-Wformat-extra-args]

This would likely lead to a bootstrap error.

Do I need to add some forgotten include?  Or some annotation to
suppress the warning?

Or should I rather convert the character lengths via sprintf first
before generating the error message?  (That would be the quick fix.)


I think at some point, we should also check the rest of the code and
change those mpz_get_si to gfc_mpz_get_hwi which can exceed INT_MAX.
Likewise, some of the %ld/%lu or %lld/%llu code should be also converted
to %wd/%wu.

Tobias

PS: For using HWI with 'sprintf' instead of diagnostic's error/warning,
HOST_WIDE_INT_PRINT_DEC exists and has to be used.


All current cases of printing a HOST_WIDE_INT in gcc/fortran/ use
'sprintf', and I did not find any other use of %wd/%wu.  So the
mentioned implementation is not really stressed yet... ;-)

Thanks,
Harald


-
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201,
80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer:
Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München;
Registergericht München, HRB 106955

From 7efd0613261c5d2120e189387f4b916917c25683 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Sun, 27 Mar 2022 21:35:15 +0200
Subject: [PATCH] Fortran: character length of pointer assignments in structure
 constructors

gcc/fortran/ChangeLog:

	PR fortran/50549
	* resolve.cc (resolve_structure_cons): Reject pointer assignments
	of character with different lengths in structure constructor.

gcc/testsuite/ChangeLog:

	PR fortran/50549
	* gfortran.dg/char_pointer_assign_7.f90: New test.
---
 gcc/fortran/resolve.cc| 13 ++-
 .../gfortran.dg/char_pointer_assign_7.f90 | 38 +++
 2 files changed, 50 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/char_pointer_assign_7.f90

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 5522be75199..290767723d8 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -1375,11 +1375,22 @@ resolve_structure_cons (gfc_expr *expr, int init)
 	  && comp->ts.u.cl->length->expr_type == EXPR_CONSTANT
 	  && cons->expr->ts.u.cl && cons->expr->ts.u.cl->length
 	  && cons->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT
-	  && cons->expr->rank != 0
 	  && mpz_cmp (cons->expr->ts.u.cl->length->value.integer,
 		  comp->ts.u.cl->length->value.integer) != 0)
 	{
+	  if (comp->attr.pointer)
+	{
+	  HOST_WIDE_INT la, lb;
+	  la = gfc_mpz_get_hwi (comp->ts.u.cl->length->value.integer);
+	  lb = 

<    1   2   3   4   5   6   7   8   9   10   >