Re: [PATCH 1/2] symtab: also change RTL decl name

2022-11-17 Thread Bernhard Reutner-Fischer via Fortran
Hi Honza, Ping.
Regtests cleanly for c,fortran,c++,ada,d,go,lto,objc,obj-c++
Ok?
I'd need this for attribute target_clones for the Fortran FE.
thanks,

On Wed,  9 Nov 2022 20:02:24 +0100
Bernhard Reutner-Fischer  wrote:

> We were changing the ASSEMBLER_NAME of the function decl
> but not the name in DECL_RTL which is used as the function name
> fnname in rest_of_handle_final(). This led to using the old, wrong name
> for the attribute target default function when using target_clones.
> 
> Bootstrapped and regtested cleanly on x86_64-unknown-linux
> for c,c++,fortran,lto.
> Ok for trunk?
> 
> gcc/ChangeLog:
> 
>   * symtab.cc: Remove stray comment.
>   (symbol_table::change_decl_assembler_name): Also update the
>   name in DECL_RTL.
> 
> Cc: Jan Hubicka 
> ---
>  gcc/symtab.cc | 6 --
>  1 file changed, 4 insertions(+), 2 deletions(-)
> 
> diff --git a/gcc/symtab.cc b/gcc/symtab.cc
> index f2d96c0268b..2e20bf5fefc 100644
> --- a/gcc/symtab.cc
> +++ b/gcc/symtab.cc
> @@ -154,8 +154,6 @@ symbol_table::decl_assembler_name_equal (tree decl, 
> const_tree asmname)
>  }
>  
>  
> -/* Returns nonzero if P1 and P2 are equal.  */
> -
>  /* Insert NODE to assembler name hash.  */
>  
>  void
> @@ -303,6 +301,10 @@ symbol_table::change_decl_assembler_name (tree decl, 
> tree name)
>   warning (0, "%qD renamed after being referenced in assembly", decl);
>  
>SET_DECL_ASSEMBLER_NAME (decl, name);
> +  /* Set the new name in rtl.  */
> +  if (DECL_RTL_SET_P (decl))
> + XSTR (XEXP (DECL_RTL (decl), 0), 0) = IDENTIFIER_POINTER (name);
> +
>if (alias)
>   {
> IDENTIFIER_TRANSPARENT_ALIAS (name) = 1;



Re: typespec in forall and implied-do

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

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


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

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

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

[PATCH] Fortran: reject NULL actual argument without explicit interface [PR107576]

2022-11-17 Thread Harald Anlauf via Fortran
Dear all,

one cannot pass a NULL actual argument to a procedure without an
explicit interface.  This is detected and reported by NAG and Intel.
(Cray accepts this silently, and some other brands ICE.)

The testcase by Gerhard even tricked gfortran into inconsistent
behavior which could lead to an ICE with -fallow-argument-mismatch,
or silently accepting invalid code.

The solution is to reject such code, see attached patch.

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

As this is marked as a regression which started at v7,
OK for backports to open branches?

Thanks,
Harald

From c6b19d662f51b1e2d2691e81cfeb68ad953a4c09 Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Thu, 17 Nov 2022 21:36:49 +0100
Subject: [PATCH] Fortran: reject NULL actual argument without explicit
 interface [PR107576]

gcc/fortran/ChangeLog:

	PR fortran/107576
	* interface.cc (gfc_procedure_use): Reject NULL as actual argument
	when there is no explicit procedure interface.

gcc/testsuite/ChangeLog:

	PR fortran/107576
	* gfortran.dg/null_actual_3.f90: New test.
---
 gcc/fortran/interface.cc|  8 
 gcc/testsuite/gfortran.dg/null_actual_3.f90 | 18 ++
 2 files changed, 26 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/null_actual_3.f90

diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index 616ae2b1197..73799c175b7 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -4162,6 +4162,14 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
 	  return false;
 	}

+	  if (a->expr && a->expr->expr_type == EXPR_NULL)
+	{
+	  gfc_error ("Passing intrinsic NULL as actual argument at %L "
+			 "requires an explicit interface", &a->expr->where);
+	  a->expr->error = 1;
+	  return false;
+	}
+
 	  /* TS 29113, C407b.  */
 	  if (a->expr && a->expr->expr_type == EXPR_VARIABLE
 	  && symbol_rank (a->expr->symtree->n.sym) == -1)
diff --git a/gcc/testsuite/gfortran.dg/null_actual_3.f90 b/gcc/testsuite/gfortran.dg/null_actual_3.f90
new file mode 100644
index 000..ea49f9630c9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/null_actual_3.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-fallow-argument-mismatch -w" }
+! PR fortran/107576
+! Contributed by G.Steinmetz
+
+program p
+  implicit none
+  interface
+ subroutine r(y)
+   integer, pointer :: y(:)
+ end subroutine r
+  end interface
+  integer, pointer :: z(:) => null()
+  call r(z)
+  call s(z)
+  call r(null(z))
+  call s(null(z)) ! { dg-error "requires an explicit interface" }
+end
--
2.35.3