[gcc(refs/users/omachota/heads/rtl-ssa-dce)] rtl-ssa-dce: add may_trap_or_fault_p as another prelive condition

2025-03-16 Thread Ondrej Machota via Gcc-cvs
https://gcc.gnu.org/g:ea280c3ed885befd456eb1b9a54601a93ebaf8af

commit ea280c3ed885befd456eb1b9a54601a93ebaf8af
Author: Ondřej Machota 
Date:   Sun Mar 16 12:41:31 2025 +0100

rtl-ssa-dce: add may_trap_or_fault_p as another prelive condition

Diff:
---
 gcc/dce.cc | 9 -
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/gcc/dce.cc b/gcc/dce.cc
index c8c8be2293a1..55aeb64269ca 100644
--- a/gcc/dce.cc
+++ b/gcc/dce.cc
@@ -1473,7 +1473,12 @@ bool is_rtx_insn_prelive(rtx_insn *insn) {
   if (GET_CODE(body) == CLOBBER) // 
gcc/gcc/testsuite/gcc.c-torture/compile/2605-1.c
 return true;
 
-  if (side_effects_with_mem(body) || can_throw_internal(body))
+  // may_trap_or_fault_p helps a lot to pass some tests from 
RUNTESTSFLAGS=execute.exp
+  // e. g. this one: testsuite/gcc.c-torture/execute/20020418-1.c
+  // TODO : debug the testcase
+  // It seems that the issue was due to trap_if rtl insn and fixed with 
may_trap_or_fault_p
+  // What about can_throw_internal?
+  if (side_effects_with_mem(body) || can_throw_internal(body) || 
may_trap_or_fault_p(body))
 return true;
 
   // TODO : parallel, {pre,post}_{int,dec}, {pre,post}_modify, 
may_trap_or_fault_p
@@ -1523,6 +1528,8 @@ bool is_prelive(insn_info *insn)
 static void
 rtl_ssa_dce_init()
 {
+  // internal compiler error: gcc.c-torture/execute/20040811-1.c - 
rtl_ssa::function_info::add_phi_nodes
+
   calculate_dominance_info(CDI_DOMINATORS);
   // here we create ssa form for function
   crtl->ssa = new rtl_ssa::function_info(cfun);


[gcc r15-8074] PR modula2/115111 Incorrect line debugging locations at the end of the WHILE loop

2025-03-16 Thread Gaius Mulley via Gcc-cvs
https://gcc.gnu.org/g:5ed0564f2879db35106272556ba91f028177c5cd

commit r15-8074-g5ed0564f2879db35106272556ba91f028177c5cd
Author: Gaius Mulley 
Date:   Sun Mar 16 15:56:48 2025 +

PR modula2/115111 Incorrect line debugging locations at the end of the 
WHILE loop

This fix corrects the END token position used during the GotoOp at the
bottom of the WHILE loop.  The fix is to pass the relative token position
down to M2Quads.  This method should be replicated for the other loops
END or UNTIL keywords and possibly the END statements for
conditional statements.

gcc/m2/ChangeLog:

PR modula2/115111
* gm2-compiler/M2GenGCC.mod (CodeStatementNote): Add debugging.
* gm2-compiler/M2Quads.def (BuildEndWhile): New parameter reltokpos.
* gm2-compiler/M2Quads.mod (BuildEndWhile): Reimplement using new 
parameter.
* gm2-compiler/P3Build.bnf (WhileStatement): Call BuildEndWhile
with -1 relative position.
* gm2-gcc/m2block.cc (do_add_stmt): Tidy comment.
(GetGlobals): Ditto.
(flush_pending_note): Remove #if 0 code.
* gm2-gcc/m2pp.cc (m2pp_nop_expr): New function.
(m2pp_statement): New case clause call m2pp_nop_expr.

gcc/testsuite/ChangeLog:

PR modula2/115111
* gm2/pim/pass/whilestep.mod: New test.

Signed-off-by: Gaius Mulley 

Diff:
---
 gcc/m2/gm2-compiler/M2GenGCC.mod |  4 
 gcc/m2/gm2-compiler/M2Quads.def  |  2 +-
 gcc/m2/gm2-compiler/M2Quads.mod  | 15 +--
 gcc/m2/gm2-compiler/P3Build.bnf  |  2 +-
 gcc/m2/gm2-gcc/m2block.cc| 21 -
 gcc/m2/gm2-gcc/m2pp.cc   | 15 +++
 gcc/testsuite/gm2/pim/pass/whilestep.mod | 18 ++
 7 files changed, 52 insertions(+), 25 deletions(-)

diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index 761e79bef295..ec38dc2e7cb4 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -1032,6 +1032,10 @@ END FoldStatementNote ;
 
 PROCEDURE CodeStatementNote (tokenno: CARDINAL) ;
 BEGIN
+   IF Debugging
+   THEN
+  MetaErrorT0 (tokenno, '{%W} statement note')
+   END ;
CurrentQuadToken := tokenno ;
addStmtNote (TokenToLocation (tokenno))
 END CodeStatementNote ;
diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def
index ec82accf5aaf..28e43aa45ebe 100644
--- a/gcc/m2/gm2-compiler/M2Quads.def
+++ b/gcc/m2/gm2-compiler/M2Quads.def
@@ -1188,7 +1188,7 @@ PROCEDURE BuildDoWhile ;
False exit is backpatched with q+1
 *)
 
-PROCEDURE BuildEndWhile ;
+PROCEDURE BuildEndWhile (reltokpos: INTEGER) ;
 
 
 (*
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index d057a27fd862..a45d67a198ab 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -4283,16 +4283,19 @@ END BuildDoWhile ;
False exit is backpatched with q+1
 *)
 
-PROCEDURE BuildEndWhile ;
+PROCEDURE BuildEndWhile (reltokpos: INTEGER) ;
 VAR
+   tok  : CARDINAL ;
While,
t, f : CARDINAL ;
 BEGIN
-   PopBool(t, f) ;
-   Assert(t=0) ;
-   PopT(While) ;
-   GenQuad(GotoOp, NulSym, NulSym, While) ;
-   BackPatch(f, NextQuad)
+   tok := GetTokenNo () ;
+   tok := VAL (INTEGER, tok) + reltokpos ;
+   PopBool (t, f) ;
+   Assert (t=0) ;
+   PopT (While) ;
+   GenQuadO (tok, GotoOp, NulSym, NulSym, While, FALSE) ;
+   BackPatch (f, NextQuad)
 END BuildEndWhile ;
 
 
diff --git a/gcc/m2/gm2-compiler/P3Build.bnf b/gcc/m2/gm2-compiler/P3Build.bnf
index d181f2381dfb..4f6ffb772211 100644
--- a/gcc/m2/gm2-compiler/P3Build.bnf
+++ b/gcc/m2/gm2-compiler/P3Build.bnf
@@ -1299,7 +1299,7 @@ WhileStatement := "WHILE" 
 % Bui
   % 
BuildStmtNote (0) %
  "DO"  % 
BuildDoWhile %
   StatementSequence% 
BuildStmtNote (0) %
-   "END"  % 
DisplayStack ; BuildEndWhile %
+   "END"  % 
DisplayStack ; BuildEndWhile (-1) %
 =:
 
 RepeatStatement := "REPEAT"
diff --git a/gcc/m2/gm2-gcc/m2block.cc b/gcc/m2/gm2-gcc/m2block.cc
index 40ab96b15131..c4877d1b0416 100644
--- a/gcc/m2/gm2-gcc/m2block.cc
+++ b/gcc/m2/gm2-gcc/m2block.cc
@@ -28,6 +28,7 @@ along with GNU Modula-2; see the file COPYING3.  If not see
 #include "m2options.h"
 #include "m2tree.h"
 #include "m2treelib.h"
+#include "m2pp.h"
 
 /* For each binding contour we allocate a binding_level structure
which records the entities defined or declared in that contour.
@@ -667,8 +668,7 @@ m2block_GetErrorNo

[gcc r15-8079] Fortran: fix bogus dependency check in ALLOCATE statement [PR60560]

2025-03-16 Thread Harald Anlauf via Gcc-cvs
https://gcc.gnu.org/g:b2b139ddee763dd5fd71a3368e5e66399e3c52a3

commit r15-8079-gb2b139ddee763dd5fd71a3368e5e66399e3c52a3
Author: Harald Anlauf 
Date:   Sat Mar 15 15:11:22 2025 +0100

Fortran: fix bogus dependency check in ALLOCATE statement [PR60560]

Restrict dependency check of ALLOCATE object to variables in the same
statement, but exclude check of length type parameter that might be
set in the declaration and could lead to a bogus cyclic dependency.

PR fortran/60560

gcc/fortran/ChangeLog:

* expr.cc (gfc_traverse_expr): Do not descend into length type
parameter for negative values of auxiliary parameter f.
* resolve.cc (gfc_find_var_in_expr): New helper function to check
dependence of an expression on given variable.
(resolve_allocate_expr): Use it to determine if array bounds in an
ALLOCATE statement depend explicitly on a variable.

gcc/testsuite/ChangeLog:

* gfortran.dg/allocate_error_8.f90: New test.

Diff:
---
 gcc/fortran/expr.cc| 28 +++---
 gcc/fortran/resolve.cc | 12 +--
 gcc/testsuite/gfortran.dg/allocate_error_8.f90 | 17 
 3 files changed, 43 insertions(+), 14 deletions(-)

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 9d84e761576b..0753667e061d 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -5488,11 +5488,14 @@ gfc_traverse_expr (gfc_expr *expr, gfc_symbol *sym,
   if ((*func) (expr, sym, &f))
 return true;
 
-  if (expr->ts.type == BT_CHARACTER
-   && expr->ts.u.cl
-   && expr->ts.u.cl->length
-   && expr->ts.u.cl->length->expr_type != EXPR_CONSTANT
-   && gfc_traverse_expr (expr->ts.u.cl->length, sym, func, f))
+  /* Descend into length type parameter of character expressions only for
+ non-negative f.  */
+  if (f >= 0
+  && expr->ts.type == BT_CHARACTER
+  && expr->ts.u.cl
+  && expr->ts.u.cl->length
+  && expr->ts.u.cl->length->expr_type != EXPR_CONSTANT
+  && gfc_traverse_expr (expr->ts.u.cl->length, sym, func, f))
 return true;
 
   switch (expr->expr_type)
@@ -5572,13 +5575,14 @@ gfc_traverse_expr (gfc_expr *expr, gfc_symbol *sym,
  break;
 
case REF_COMPONENT:
- if (ref->u.c.component->ts.type == BT_CHARACTER
-   && ref->u.c.component->ts.u.cl
-   && ref->u.c.component->ts.u.cl->length
-   && ref->u.c.component->ts.u.cl->length->expr_type
-!= EXPR_CONSTANT
-   && gfc_traverse_expr (ref->u.c.component->ts.u.cl->length,
- sym, func, f))
+ if (f >= 0
+ && ref->u.c.component->ts.type == BT_CHARACTER
+ && ref->u.c.component->ts.u.cl
+ && ref->u.c.component->ts.u.cl->length
+ && ref->u.c.component->ts.u.cl->length->expr_type
+ != EXPR_CONSTANT
+ && gfc_traverse_expr (ref->u.c.component->ts.u.cl->length,
+   sym, func, f))
return true;
 
  if (ref->u.c.component->as)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 34c8210f66a4..d64edff85079 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -8629,6 +8629,14 @@ gfc_find_sym_in_expr (gfc_symbol *sym, gfc_expr *e)
   return gfc_traverse_expr (e, sym, sym_in_expr, 0);
 }
 
+/* Same as gfc_find_sym_in_expr, but do not descend into length type parameter
+   of character expressions.  */
+static bool
+gfc_find_var_in_expr (gfc_symbol *sym, gfc_expr *e)
+{
+  return gfc_traverse_expr (e, sym, sym_in_expr, -1);
+}
+
 
 /* Given the expression node e for an allocatable/pointer of derived type to be
allocated, get the expression node to be initialized afterwards (needed for
@@ -9190,9 +9198,9 @@ check_symbols:
continue;
 
  if ((ar->start[i] != NULL
-  && gfc_find_sym_in_expr (sym, ar->start[i]))
+  && gfc_find_var_in_expr (sym, ar->start[i]))
  || (ar->end[i] != NULL
- && gfc_find_sym_in_expr (sym, ar->end[i])))
+ && gfc_find_var_in_expr (sym, ar->end[i])))
{
  gfc_error ("%qs must not appear in the array specification at "
 "%L in the same ALLOCATE statement where it is "
diff --git a/gcc/testsuite/gfortran.dg/allocate_error_8.f90 
b/gcc/testsuite/gfortran.dg/allocate_error_8.f90
new file mode 100644
index ..5637f9fae4d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_error_8.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! PR fortran/60560
+!
+! Original test case by Marco Restelli.
+
+module mstr
+  implicit none
+contains
+  subroutine sub(s)
+character(len=*),  allocatable, intent(out) :: s(:)
+character(len=len(s)), allocatable  :: s_tmp(:)
+allocate(s_tmp(

[gcc r15-8073] Darwin: Pass -macos_version_min to the linker [PR119172].

2025-03-16 Thread Iain D Sandoe via Gcc-cvs
https://gcc.gnu.org/g:952e17223d3a9809a32be23f86f77166b5860b36

commit r15-8073-g952e17223d3a9809a32be23f86f77166b5860b36
Author: Iain Sandoe 
Date:   Sun Mar 9 09:24:34 2025 +

Darwin: Pass -macos_version_min to the linker [PR119172].

For binaries to be notarised, the SDK version must be available.
Since we do not, at present, parse this information we have been
passing "0.0" to ld64.  This now results in a warning and a fail
to notarise.  As a quick-fix, we can fall back to letting ld64
figure out the SDK version (which it does for -macos_version_min).

TODO: Parse the SDKSetting.plist at some point.

PR target/119172

gcc/ChangeLog:

* config.in: Regenerate.
* config/darwin.h (DARWIN_PLATFORM_ID): Add the option to
use -macos_version_min where available.
* configure: Regenerate.
* configure.ac: Check for ld64 support of -macos_version_min.

Signed-off-by: Iain Sandoe 
(cherry picked from commit 36f5ea5806d246d78555e65273a057718833e3cd)

Diff:
---
 gcc/config.in   |  6 ++
 gcc/config/darwin.h | 13 +
 gcc/configure   | 17 +
 gcc/configure.ac| 12 
 4 files changed, 44 insertions(+), 4 deletions(-)

diff --git a/gcc/config.in b/gcc/config.in
index 2e7e0fe9942c..0b46faa1e512 100644
--- a/gcc/config.in
+++ b/gcc/config.in
@@ -2332,6 +2332,12 @@
 #endif
 
 
+/* Define to 1 if ld64 supports '-macos_version_min'. */
+#ifndef USED_FOR_TARGET
+#undef LD64_HAS_MACOS_VERSION_MIN
+#endif
+
+
 /* Define to 1 if ld64 supports '-platform_version'. */
 #ifndef USED_FOR_TARGET
 #undef LD64_HAS_PLATFORM_VERSION
diff --git a/gcc/config/darwin.h b/gcc/config/darwin.h
index 328d878ca118..3d2ced5fca31 100644
--- a/gcc/config/darwin.h
+++ b/gcc/config/darwin.h
@@ -284,12 +284,17 @@ extern GTY(()) int darwin_ms_struct;
 #define DARWIN_RDYNAMIC "%{rdynamic:%nrdynamic is not supported}"
 #endif
 
-#if LD64_HAS_PLATFORM_VERSION
-#define DARWIN_PLATFORM_ID \
-  "%{mmacosx-version-min=*: -platform_version macos %* 0.0} "
+#if LD64_HAS_MACOS_VERSION_MIN
+# define DARWIN_PLATFORM_ID \
+  "%{mmacosx-version-min=*:-macos_version_min %*} "
 #else
-#define DARWIN_PLATFORM_ID \
+# if LD64_HAS_PLATFORM_VERSION
+#  define DARWIN_PLATFORM_ID \
+  "%{mmacosx-version-min=*: -platform_version macos %* 0.0} "
+# else
+#  define DARWIN_PLATFORM_ID \
   "%{mmacosx-version-min=*:-macosx_version_min %*} "
+# endif
 #endif
 
 /* Code built with mdynamic-no-pic does not support PIE/PIC, so  we disallow
diff --git a/gcc/configure b/gcc/configure
index a34ae586d908..57640f92789f 100755
--- a/gcc/configure
+++ b/gcc/configure
@@ -32650,6 +32650,7 @@ if test x"$ld64_flag" = x"yes"; then
   # Set defaults for possibly untestable items.
   gcc_cv_ld64_export_dynamic=0
   gcc_cv_ld64_platform_version=0
+  gcc_cv_ld64_macos_version_min=0
   gcc_cv_ld64_demangle=0
 
   if test "$build" = "$host"; then
@@ -32682,6 +32683,7 @@ $as_echo "$gcc_cv_ld64_major" >&6; }
 fi
 if test "$gcc_cv_ld64_major" -ge 512; then
   gcc_cv_ld64_platform_version=1
+  gcc_cv_ld64_macos_version_min=1
 fi
   elif test -x "$gcc_cv_ld" -a "$darwin_try_test" -eq 1; then
 # If the version was not specified, try to find it.
@@ -32720,6 +32722,15 @@ $as_echo_n "checking linker for -platform_version 
support... " >&6; }
 fi
 { $as_echo "$as_me:${as_lineno-$LINENO}: result: 
$gcc_cv_ld64_platform_version" >&5
 $as_echo "$gcc_cv_ld64_platform_version" >&6; }
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking linker for 
-macos_version_min" >&5
+$as_echo_n "checking linker for -macos_version_min... " >&6; }
+gcc_cv_ld64_macosx_version_min=1
+if $gcc_cv_ld -macos_version_min 10.5 < /dev/null 2>&1 | grep 'unknown 
option' > /dev/null; then
+  gcc_cv_ld64_macosx_version_min=0
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: 
$gcc_cv_ld64_macosx_version_min" >&5
+$as_echo "$gcc_cv_ld64_macosx_version_min" >&6; }
   fi
 
   if test x"${gcc_cv_ld64_version}" != x; then
@@ -32747,6 +32758,12 @@ cat >>confdefs.h <<_ACEOF
 #define LD64_HAS_PLATFORM_VERSION $gcc_cv_ld64_platform_version
 _ACEOF
 
+
+
+cat >>confdefs.h <<_ACEOF
+#define LD64_HAS_MACOS_VERSION_MIN $gcc_cv_ld64_macosx_version_min
+_ACEOF
+
 fi
 
 if test x"$dsymutil_flag" = x"yes"; then
diff --git a/gcc/configure.ac b/gcc/configure.ac
index 7e78ed6e1d9e..be77c182f962 100644
--- a/gcc/configure.ac
+++ b/gcc/configure.ac
@@ -6358,6 +6358,7 @@ if test x"$ld64_flag" = x"yes"; then
   # Set defaults for possibly untestable items.
   gcc_cv_ld64_export_dynamic=0
   gcc_cv_ld64_platform_version=0
+  gcc_cv_ld64_macos_version_min=0
   gcc_cv_ld64_demangle=0
 
   if test "$build" = "$host"; then
@@ -6388,6 +6389,7 @@ if test x"$ld64_flag" = x"yes"; then
 fi
 if test "$gcc_cv_ld64_major" -ge 512; then
   gcc_cv_ld64_platform_version=1
+  gcc_cv_ld64_macos_version_min=1
 fi
   el

[gcc(refs/users/mikael/heads/refactor_descriptor_v03)] Extraction get_descr_element_length

2025-03-16 Thread Mikael Morin via Gcc-cvs
https://gcc.gnu.org/g:a2000fe823cd591d941a71382f690ccc4e66e10d

commit a2000fe823cd591d941a71382f690ccc4e66e10d
Author: Mikael Morin 
Date:   Sun Mar 16 19:37:31 2025 +0100

Extraction get_descr_element_length

Diff:
---
 gcc/fortran/trans-descriptor.cc | 93 +
 1 file changed, 58 insertions(+), 35 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 5fc181113475..09c44cf1482f 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1016,7 +1016,6 @@ public:
   virtual bool use_tree_type () const { return false; }
   virtual bool is_initialization () const { return false; }
   virtual bt get_type_type (const gfc_typespec &) const { return BT_UNKNOWN; }
-  virtual tree get_length (gfc_typespec *ts) const { return get_size_info 
(*ts); }
 };
 
 class nullification : public modify_info
@@ -1067,7 +1066,6 @@ public:
 : value(arg_value), use_tree_type_ (arg_use_tree_type) { }
   virtual bool use_tree_type () const { return use_tree_type_; }
   virtual bt get_type_type (const gfc_typespec &) const;
-  virtual tree get_length (gfc_typespec *ts) const;
 };
 
 
@@ -1230,8 +1228,8 @@ get_descr_caf_token (const descr_change_info &info)
 }
 
 
-tree
-scalar_value::get_elt_type () const
+static tree
+get_elt_type (tree value)
 {
   tree tmp = value;
 
@@ -1247,47 +1245,76 @@ scalar_value::get_elt_type () const
   return etype;
 }
 
-bt
-scalar_value::get_type_type (const gfc_typespec & type_info) const
+
+static tree
+get_descr_element_length (const descr_change_info &change_info,
+ gfc_typespec *ts)
 {
-  bt n;
-  if (use_tree_type ())
+  if (change_info.type == UNKNOWN_CHANGE
+  || change_info.type == EXPLICIT_NULLIFICATION
+  || !ts
+  || ts->type == BT_CLASS
+  || (ts->type == BT_CHARACTER && ts->deferred))
+return NULL_TREE;
+
+  if (change_info.type == SCALAR_VALUE)
 {
-  tree etype = get_elt_type ();
-  gfc_get_type_info (etype, &n, nullptr);
+  scalar_value *scalar_value_info = change_info.u.scalar_value.info;
+  tree value = change_info.u.scalar_value.value;
+  if (scalar_value_info->use_tree_type ())
+   {
+ if (TREE_CODE (value) == COMPONENT_REF)
+   {
+ tree parent_obj = TREE_OPERAND (value, 0);
+ tree len;
+ if (GFC_CLASS_TYPE_P (TREE_TYPE (parent_obj))
+ && gfc_class_len_get (parent_obj, &len))
+   return len;
+   }
+
+ tree size;
+ tree etype = get_elt_type (value);
+ gfc_get_type_info (etype, nullptr, &size);
+ return size;
+   }
 }
-  else
-n = get_type_info (type_info.type);
 
-  return n;
+  return get_size_info (*ts);
 }
 
+
 tree
-scalar_value::get_length (gfc_typespec * type_info) const
+scalar_value::get_elt_type () const
+{
+  tree tmp = value;
+
+  if (POINTER_TYPE_P (TREE_TYPE (tmp)))
+tmp = TREE_TYPE (tmp);
+
+  tree etype = TREE_TYPE (tmp);
+
+  /* For arrays, which are not scalar coarrays.  */
+  if (TREE_CODE (etype) == ARRAY_TYPE && !TYPE_STRING_FLAG (etype))
+etype = TREE_TYPE (etype);
+
+  return etype;
+}
+
+bt
+scalar_value::get_type_type (const gfc_typespec & type_info) const
 {
   bt n;
-  tree size;
   if (use_tree_type ())
 {
-  if (TREE_CODE (value) == COMPONENT_REF)
-   {
- tree parent_obj = TREE_OPERAND (value, 0);
- tree len;
- if (GFC_CLASS_TYPE_P (TREE_TYPE (parent_obj))
- && gfc_class_len_get (parent_obj, &len))
-   return len;
-   }
-
   tree etype = get_elt_type ();
-  gfc_get_type_info (etype, &n, &size);
+  gfc_get_type_info (etype, &n, nullptr);
 }
   else
-size = modify_info::get_length (type_info);
+n = get_type_info (type_info.type);
 
-  return size;
+  return n;
 }
 
-
 static tree
 get_descr_dtype (const descr_change_info &change_info, gfc_typespec *ts,
 int rank, const symbol_attribute & ATTRIBUTE_UNUSED)
@@ -1336,15 +1363,11 @@ get_descr_dtype (const descr_change_info &change_info, 
gfc_typespec *ts,
   if (type_info == nullptr)
 type_info = ts;
 
-  if (!(init_info->is_initialization ()
-   && type_info
-   && (type_info->type == BT_CLASS
-   || (type_info->type == BT_CHARACTER
-   && type_info->deferred
+  tree elem_len_val = get_descr_element_length (change_info, type_info);
+  if (elem_len_val != NULL_TREE)
 {
   tree elem_len_field = gfc_advance_chain (fields, GFC_DTYPE_ELEM_LEN);
-  tree elem_len_val = fold_convert (TREE_TYPE (elem_len_field),
-   init_info->get_length (type_info));
+  elem_len_val = fold_convert (TREE_TYPE (elem_len_field), elem_len_val);
   CONSTRUCTOR_APPEND_ELT (v, elem_len_field, elem_len_val);
 }


[gcc r15-8080] [RISC-V][PR target/116256][V4] Fix minor code quality regression in reassociated arithmetic

2025-03-16 Thread Jeff Law via Gcc-cvs
https://gcc.gnu.org/g:9d68a2a67351fc5b56262c0028ef8fd1d1466627

commit r15-8080-g9d68a2a67351fc5b56262c0028ef8fd1d1466627
Author: Jeff Law 
Date:   Sun Mar 16 17:43:48 2025 -0600

[RISC-V][PR target/116256][V4] Fix minor code quality regression in 
reassociated arithmetic

Arggh.  This time add arguments for rv32.  Hand edited the testcase part of 
the
patch, but I think I got it right.

One.  More.  Time.

-pedantic-errors this time ;(  Adding an explicit -std=gnu23 to shut that 
up.
Part of me wants to know why that's getting added by the pre-commit, but not
enough to chase it down.

--

This failed pre-commit CI the first time through. The only change is in the
return type in the test bool -> _Bool.

The patch for target/116256 significantly simplified the condition and, I 
guess
not too surprisingly, exposed a minor code quality regression.

Specifically the split part of the define_insn_and_split only splits after
reload (because we use a match_scratch).  So there's nothing to combine the
load-immediate with the subsequent add into an addi when the immediate fits
into a simm12 field.

This patch adjusts the split code to handle that scenario directly and 
generate
the more efficient code.  We can squeeze out the slli in this test with a 
bit
more work, but that's out of scope right now since that isn't a regression.

Tested in my tester.  Waiting on pre-commit testing to render a verdict.

PR target/116256
gcc
* config/riscv/riscv.md (reassociation splitters): Do not load the
adjusted addend into a register if it fits in a simm12.

gcc/testsuite
* gcc.target/riscv/pr116256-1.c: New test.

Diff:
---
 gcc/config/riscv/riscv.md   | 39 +++--
 gcc/testsuite/gcc.target/riscv/pr116256-1.c | 15 +++
 2 files changed, 47 insertions(+), 7 deletions(-)

diff --git a/gcc/config/riscv/riscv.md b/gcc/config/riscv/riscv.md
index 95951605fb46..84bce409bc72 100644
--- a/gcc/config/riscv/riscv.md
+++ b/gcc/config/riscv/riscv.md
@@ -4684,10 +4684,22 @@
   "(TARGET_64BIT && riscv_const_insns (operands[3], false) == 1)"
   "#"
   "&& reload_completed"
-  [(set (match_dup 0) (ashift:DI (match_dup 1) (match_dup 2)))
-   (set (match_dup 4) (match_dup 3))
-   (set (match_dup 0) (plus:DI (match_dup 0) (match_dup 4)))]
-  ""
+  [(const_int 0)]
+  "{
+ rtx x = gen_rtx_ASHIFT (DImode, operands[1], operands[2]);
+ emit_insn (gen_rtx_SET (operands[0], x));
+
+ /* If the constant fits in a simm12, use it directly as we do not
+   get another good chance to optimize things again.  */
+ if (!SMALL_OPERAND (INTVAL (operands[3])))
+   emit_move_insn (operands[4], operands[3]);
+ else
+   operands[4] = operands[3];
+
+ x = gen_rtx_PLUS (DImode, operands[0], operands[4]);
+ emit_insn (gen_rtx_SET (operands[0], x));
+ DONE;
+   }"
   [(set_attr "type" "arith")])
 
 (define_insn_and_split ""
@@ -4700,13 +4712,26 @@
   "(TARGET_64BIT && riscv_const_insns (operands[3], false) == 1)"
   "#"
   "&& reload_completed"
-  [(set (match_dup 0) (ashift:DI (match_dup 1) (match_dup 2)))
-   (set (match_dup 4) (match_dup 3))
-   (set (match_dup 0) (sign_extend:DI (plus:SI (match_dup 5) (match_dup 6]
+  [(const_int 0)]
   "{
  operands[1] = gen_lowpart (DImode, operands[1]);
  operands[5] = gen_lowpart (SImode, operands[0]);
  operands[6] = gen_lowpart (SImode, operands[4]);
+
+ rtx x = gen_rtx_ASHIFT (DImode, operands[1], operands[2]);
+ emit_insn (gen_rtx_SET (operands[0], x));
+
+ /* If the constant fits in a simm12, use it directly as we do not
+   get another good chance to optimize things again.  */
+ if (!SMALL_OPERAND (INTVAL (operands[3])))
+   emit_move_insn (operands[4], operands[3]);
+ else
+   operands[6] = operands[3];
+
+ x = gen_rtx_PLUS (SImode, operands[5], operands[6]);
+ x = gen_rtx_SIGN_EXTEND (DImode, x);
+ emit_insn (gen_rtx_SET (operands[0], x));
+ DONE;
}"
   [(set_attr "type" "arith")])
 
diff --git a/gcc/testsuite/gcc.target/riscv/pr116256-1.c 
b/gcc/testsuite/gcc.target/riscv/pr116256-1.c
new file mode 100644
index ..46fd7f2b399c
--- /dev/null
+++ b/gcc/testsuite/gcc.target/riscv/pr116256-1.c
@@ -0,0 +1,15 @@
+/* { dg-do compile } */
+/* { dg-options "-std=gnu23 -march=rv32gcb -mabi=ilp32" { target { rv32 } } } 
*/
+/* { dg-options "-std=gnu23 -march=rv64gcb -mabi=lp64d" { target { rv64 } } } 
*/
+
+
+_Bool f1(long a)
+{
+long b = a << 4;
+return b == -128;
+}
+
+/* We want to verify that we have generated addi
+   rather than li+add.  */
+/* { dg-final { scan-assembler-not "add\t" } } */
+/* { dg-final { scan-assembler "addi\t" } } */


[gcc(refs/users/mikael/heads/refactor_descriptor_v03)] Extraction fonction get_descr_type

2025-03-16 Thread Mikael Morin via Gcc-cvs
https://gcc.gnu.org/g:c4238fcd476dd0b4cfd57ba6df9a5078898e48fe

commit c4238fcd476dd0b4cfd57ba6df9a5078898e48fe
Author: Mikael Morin 
Date:   Sun Mar 16 21:07:23 2025 +0100

Extraction fonction get_descr_type

Diff:
---
 gcc/fortran/trans-descriptor.cc | 91 ++---
 1 file changed, 48 insertions(+), 43 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index a14ef8742c72..763308ef5c21 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1014,8 +1014,6 @@ class modify_info
 {
 public:
   virtual bool use_tree_type () const { return false; }
-  virtual bool is_initialization () const { return false; }
-  virtual bt get_type_type (const gfc_typespec &) const { return BT_UNKNOWN; }
 };
 
 class nullification : public modify_info
@@ -1024,17 +1022,8 @@ class nullification : public modify_info
 
 class init_info : public modify_info
 {
-public:
-  virtual bool is_initialization () const { return true; }
-  virtual bt get_type_type (const gfc_typespec &) const;
 };
 
-bt
-init_info::get_type_type (const gfc_typespec & type_info) const
-{
-  return get_type_info (type_info.type);
-}
-
 class default_init : public init_info
 {
 private:
@@ -1065,7 +1054,6 @@ public:
   scalar_value(tree arg_value, bool arg_use_tree_type)
 : value(arg_value), use_tree_type_ (arg_use_tree_type) { }
   virtual bool use_tree_type () const { return use_tree_type_; }
-  virtual bt get_type_type (const gfc_typespec &) const;
 };
 
 
@@ -1283,6 +1271,48 @@ get_descr_element_length (const descr_change_info 
&change_info,
 }
 
 
+static tree
+get_descr_type (const struct descr_change_info &change_info,
+   gfc_typespec *type_info)
+{
+  bt n;
+  switch (change_info.type)
+{
+case UNKNOWN_CHANGE:
+case EXPLICIT_NULLIFICATION:
+  n = BT_UNKNOWN;
+  break;
+
+case INITIALISATION:
+case DEFAULT_INITIALISATION:
+case NULL_INITIALISATION:
+  n = get_type_info (type_info->type);
+  break;
+
+case SCALAR_VALUE:
+  {
+   scalar_value *scalar_value_info = change_info.u.scalar_value.info;
+   if (scalar_value_info->use_tree_type ())
+ {
+   tree etype = get_elt_type (change_info.u.scalar_value.value);
+   gfc_get_type_info (etype, &n, nullptr);
+ }
+   else
+ n = get_type_info (type_info->type);
+  }
+  break;
+
+default:
+  gcc_unreachable ();
+}
+
+  tree descriptor_type = change_info.descriptor_type;
+  tree type_info_field = gfc_advance_chain (TYPE_FIELDS (descriptor_type),
+   GFC_DTYPE_TYPE);
+  return build_int_cst (TREE_TYPE (type_info_field), n);
+}
+
+
 tree
 scalar_value::get_elt_type () const
 {
@@ -1300,21 +1330,6 @@ scalar_value::get_elt_type () const
   return etype;
 }
 
-bt
-scalar_value::get_type_type (const gfc_typespec & type_info) const
-{
-  bt n;
-  if (use_tree_type ())
-{
-  tree etype = get_elt_type ();
-  gfc_get_type_info (etype, &n, nullptr);
-}
-  else
-n = get_type_info (type_info.type);
-
-  return n;
-}
-
 static tree
 get_descr_dtype (const descr_change_info &change_info, gfc_typespec *ts,
 int rank, const symbol_attribute & ATTRIBUTE_UNUSED)
@@ -1325,18 +1340,6 @@ get_descr_dtype (const descr_change_info &change_info, 
gfc_typespec *ts,
 
   vec *v = nullptr;
 
-  const init_info *init_info = nullptr;
-  if (change_info.type == INITIALISATION)
-init_info = change_info.u.initialization_info;
-  else if (change_info.type == NULL_INITIALISATION)
-init_info = change_info.u.null_init.info;
-  else if (change_info.type == DEFAULT_INITIALISATION)
-init_info = change_info.u.default_init.info;
-  else if (change_info.type == SCALAR_VALUE)
-init_info = change_info.u.scalar_value.info;
-  else
-gcc_unreachable ();
-
   tree type = get_dtype_type_node ();
 
   tree fields = TYPE_FIELDS (type);
@@ -1382,10 +1385,12 @@ get_descr_dtype (const descr_change_info &change_info, 
gfc_typespec *ts,
   CONSTRUCTOR_APPEND_ELT (v, rank_field, rank_val);
 }
 
-  tree type_info_field = gfc_advance_chain (fields, GFC_DTYPE_TYPE);
-  bt n = init_info->get_type_type (*type_info);
-  tree type_info_val = build_int_cst (TREE_TYPE (type_info_field), n);
-  CONSTRUCTOR_APPEND_ELT (v, type_info_field, type_info_val);
+  tree type_val = get_descr_type (change_info, type_info);
+  if (type_val != NULL_TREE)
+{
+  tree type_info_field = gfc_advance_chain (fields, GFC_DTYPE_TYPE);
+  CONSTRUCTOR_APPEND_ELT (v, type_info_field, type_val);
+}
 
   return build_constructor (type, v);
 }


[gcc r15-8076] cobol: add cobol.dg/group1/escape.cob test; modify cobol.dg/gd.exp to handle it

2025-03-16 Thread Robert Dubner via Gcc-cvs
https://gcc.gnu.org/g:427972b2f1335c7430785ad4afd15386a17156ec

commit r15-8076-g427972b2f1335c7430785ad4afd15386a17156ec
Author: Robert Dubner 
Date:   Sun Mar 16 12:20:01 2025 -0400

cobol: add cobol.dg/group1/escape.cob test; modify cobol.dg/gd.exp to 
handle it

gcc/testsuite

* cobol.dg/dg.exp: modified to recurse into directories without
.exp files and find *.cob files therein.
* cobol.dg/group1/escape.cob: New testcase.

Diff:
---
 gcc/testsuite/cobol.dg/dg.exp| 17 +++--
 gcc/testsuite/cobol.dg/group1/escape.cob | 11 +++
 2 files changed, 26 insertions(+), 2 deletions(-)

diff --git a/gcc/testsuite/cobol.dg/dg.exp b/gcc/testsuite/cobol.dg/dg.exp
index e75e3ab18954..d40cbd54e99d 100644
--- a/gcc/testsuite/cobol.dg/dg.exp
+++ b/gcc/testsuite/cobol.dg/dg.exp
@@ -33,10 +33,23 @@ set cobol_test_path $srcdir/$subdir
 
 set all_flags $DEFAULT_COBFLAGS
 
+# Recursively find files in $dir and subdirs, do not walk into subdirs 
+# that contain their own .exp file.
+proc find-cob-tests { dir suffix } {
+set tests [lsort [glob -nocomplain -directory $dir "*.$suffix" ]]
+foreach subdir [lsort [glob -nocomplain -type d -directory $dir *]] {
+if { [glob -nocomplain -directory $subdir *.exp] eq "" } {
+eval lappend tests [find-cob-tests $subdir $suffix]
+}
+}
+return $tests
+}
+
+set tests [find-cob-tests $srcdir/$subdir {cob}]
+
 # Main loop.
 if [check_effective_target_cobol] {
-cobol-dg-runtest [lsort \
-   [glob -nocomplain $srcdir/$subdir/*.cob ] ] "" $all_flags
+cobol-dg-runtest $tests "" $all_flags
 }
 
 # All done.
diff --git a/gcc/testsuite/cobol.dg/group1/escape.cob 
b/gcc/testsuite/cobol.dg/group1/escape.cob
new file mode 100644
index ..0ab52398cfe3
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group1/escape.cob
@@ -0,0 +1,11 @@
+*> { dg-do run }
+*> { dg-output {Testing the testing(\n|\r|\r\n)} }
+*> { dg-output {\.\^\$\*\+\-\?\(\)\[\]\{\}\\\|(\n|\r|\r\n)} }
+*> { dg-output {"\.\^\$\*\+\-\?\(\)\[\]\{\}\\\|"} }
+identification division.
+program-id. escape.
+procedure division.
+display "Testing the testing"
+display ".^$*+-?()[]{}\|"  
+display '".^$*+-?()[]{}\|"'  .
+end program escape.


[gcc(refs/users/mikael/heads/refactor_descriptor_v03)] Correction régression associate_62.f90

2025-03-16 Thread Mikael Morin via Gcc-cvs
https://gcc.gnu.org/g:c6ec65afe4f07bcb72ed5037a0d6dc245f2895b3

commit c6ec65afe4f07bcb72ed5037a0d6dc245f2895b3
Author: Mikael Morin 
Date:   Sun Mar 16 21:51:03 2025 +0100

Correction régression associate_62.f90

Diff:
---
 gcc/fortran/trans-descriptor.cc | 5 -
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 763308ef5c21..76437f8e3508 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1307,7 +1307,10 @@ get_descr_type (const struct descr_change_info 
&change_info,
 }
 
   tree descriptor_type = change_info.descriptor_type;
-  tree type_info_field = gfc_advance_chain (TYPE_FIELDS (descriptor_type),
+  tree dtype_field = gfc_advance_chain (TYPE_FIELDS (descriptor_type),
+   DTYPE_FIELD);
+  tree dtype_type = TREE_TYPE (dtype_field);
+  tree type_info_field = gfc_advance_chain (TYPE_FIELDS (dtype_type),
GFC_DTYPE_TYPE);
   return build_int_cst (TREE_TYPE (type_info_field), n);
 }


[gcc(refs/users/mikael/heads/refactor_descriptor_v03)] Correction régression sizeof_4.f90

2025-03-16 Thread Mikael Morin via Gcc-cvs
https://gcc.gnu.org/g:2af3e2d7e92f9c9b6e2496365c1a34794553ee48

commit 2af3e2d7e92f9c9b6e2496365c1a34794553ee48
Author: Mikael Morin 
Date:   Sun Mar 16 20:16:11 2025 +0100

Correction régression sizeof_4.f90

Diff:
---
 gcc/fortran/trans-descriptor.cc | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 09c44cf1482f..a14ef8742c72 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1252,9 +1252,9 @@ get_descr_element_length (const descr_change_info 
&change_info,
 {
   if (change_info.type == UNKNOWN_CHANGE
   || change_info.type == EXPLICIT_NULLIFICATION
-  || !ts
-  || ts->type == BT_CLASS
-  || (ts->type == BT_CHARACTER && ts->deferred))
+  || (ts
+ && (ts->type == BT_CLASS
+ || (ts->type == BT_CHARACTER && ts->deferred
 return NULL_TREE;
 
   if (change_info.type == SCALAR_VALUE)