public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-1481] [Ada] Remove exception propagation during bootstrap
@ 2022-07-05 8:29 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2022-07-05 8:29 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:1d5018955a37fa665acc8dcba8121dd365dbe9be
commit r13-1481-g1d5018955a37fa665acc8dcba8121dd365dbe9be
Author: Arnaud Charlet <charlet@adacore.com>
Date: Sat Jun 4 10:44:13 2022 +0000
[Ada] Remove exception propagation during bootstrap
To help the bootstrap path, we want to keep the compiler free from any
exception propagation during bootstrap. This has been broken recently in
various places.
Also introduce a way to more easily detect such breakage via the
-DNO_EXCEPTION_PROPAGATION which can now be used as part of BOOT_CFLAGS.
gcc/ada/
* exp_imgv.adb (Build_Enumeration_Image_Tables): Also disable
perfect hash in GNAT_Mode.
* raise-gcc.c (__gnat_Unwind_RaiseException): Add support for
disabling exception propagation.
* sem_eval.adb (Compile_Time_Known_Value): Update comment and
remove wrong call to Check_Error_Detected.
* sem_prag.adb (Check_Loop_Pragma_Grouping, Analyze_Pragma):
Remove exception propagation during bootstrap.
Diff:
---
gcc/ada/exp_imgv.adb | 4 +++-
gcc/ada/raise-gcc.c | 4 ++++
gcc/ada/sem_eval.adb | 4 ++--
gcc/ada/sem_prag.adb | 42 +++++++++++++++++++++---------------------
4 files changed, 30 insertions(+), 24 deletions(-)
diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb
index 6ab717c20ee..51f1195a8c6 100644
--- a/gcc/ada/exp_imgv.adb
+++ b/gcc/ada/exp_imgv.adb
@@ -289,12 +289,14 @@ package body Exp_Imgv is
-- If the unit where the type is declared is the main unit, and the
-- number of literals is greater than Threshold_For_Size when we are
-- optimizing for size, and the restriction No_Implicit_Loops is not
- -- active, and -gnatd_h is not specified, generate the hash function.
+ -- active, and -gnatd_h is not specified, and not GNAT_Mode, generate
+ -- the hash function.
if In_Main_Unit
and then (Optimize_Size = 0 or else Nlit > Threshold_For_Size)
and then not Restriction_Active (No_Implicit_Loops)
and then not Debug_Flag_Underscore_H
+ and then not GNAT_Mode
then
declare
LB : constant Positive := 2 * Positive (Nlit) + 1;
diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c
index f4c42c09273..b03964cc019 100644
--- a/gcc/ada/raise-gcc.c
+++ b/gcc/ada/raise-gcc.c
@@ -1377,6 +1377,10 @@ __gnat_cleanupunwind_handler (int version ATTRIBUTE_UNUSED,
_Unwind_Reason_Code
__gnat_Unwind_RaiseException (_Unwind_Exception *e)
{
+#ifdef NO_EXCEPTION_PROPAGATION
+ abort();
+#endif
+
#ifdef __USING_SJLJ_EXCEPTIONS__
return _Unwind_SjLj_RaiseException (e);
#else
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 114c90460ba..2ba46088940 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -1816,10 +1816,10 @@ package body Sem_Eval is
begin
-- Never known at compile time if bad type or raises Constraint_Error
- -- or empty (latter case occurs only as a result of a previous error).
+ -- or empty (which can occur as a result of a previous error or in the
+ -- case of e.g. an imported constant).
if No (Op) then
- Check_Error_Detected;
return False;
elsif Op = Error
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 3660c75fc69..3431e3f6101 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -6152,15 +6152,11 @@ package body Sem_Prag is
--------------------------------
procedure Check_Loop_Pragma_Grouping (Loop_Stmt : Node_Id) is
- Stop_Search : exception;
- -- This exception is used to terminate the recursive descent of
- -- routine Check_Grouping.
-
- procedure Check_Grouping (L : List_Id);
+ function Check_Grouping (L : List_Id) return Boolean;
-- Find the first group of pragmas in list L and if successful,
-- ensure that the current pragma is part of that group. The
- -- routine raises Stop_Search once such a check is performed to
- -- halt the recursive descent.
+ -- routine returns True once such a check is performed to
+ -- stop the analysis.
procedure Grouping_Error (Prag : Node_Id);
pragma No_Return (Grouping_Error);
@@ -6171,7 +6167,7 @@ package body Sem_Prag is
-- Check_Grouping --
--------------------
- procedure Check_Grouping (L : List_Id) is
+ function Check_Grouping (L : List_Id) return Boolean is
HSS : Node_Id;
Stmt : Node_Id;
Prag : Node_Id := Empty; -- init to avoid warning
@@ -6219,7 +6215,7 @@ package body Sem_Prag is
-- Stop the search as the placement is legal.
if Stmt = N then
- raise Stop_Search;
+ return True;
-- Skip group members, but keep track of the
-- last pragma in the group.
@@ -6266,15 +6262,21 @@ package body Sem_Prag is
elsif Nkind (Stmt) = N_Block_Statement then
HSS := Handled_Statement_Sequence (Stmt);
- Check_Grouping (Declarations (Stmt));
+ if Check_Grouping (Declarations (Stmt)) then
+ return True;
+ end if;
if Present (HSS) then
- Check_Grouping (Statements (HSS));
+ if Check_Grouping (Statements (HSS)) then
+ return True;
+ end if;
end if;
end if;
Next (Stmt);
end loop;
+
+ return False;
end Check_Grouping;
--------------------
@@ -6287,6 +6289,8 @@ package body Sem_Prag is
Error_Pragma ("pragma% must appear next to pragma#");
end Grouping_Error;
+ Ignore : Boolean;
+
-- Start of processing for Check_Loop_Pragma_Grouping
begin
@@ -6294,10 +6298,7 @@ package body Sem_Prag is
-- within to determine whether the current pragma is part of the
-- first topmost grouping of Loop_Invariant and Loop_Variant.
- Check_Grouping (Statements (Loop_Stmt));
-
- exception
- when Stop_Search => null;
+ Ignore := Check_Grouping (Statements (Loop_Stmt));
end Check_Loop_Pragma_Grouping;
--------------------
@@ -24617,7 +24618,7 @@ package body Sem_Prag is
Check_First_Subtype (Task_Type);
if Rep_Item_Too_Late (Ent, N) then
- raise Pragma_Exit;
+ return;
end if;
end Task_Storage;
@@ -24879,7 +24880,7 @@ package body Sem_Prag is
or else
Rep_Item_Too_Late (E, N)
then
- raise Pragma_Exit;
+ return;
end if;
Set_Has_Pragma_Thread_Local_Storage (E);
@@ -25642,16 +25643,15 @@ package body Sem_Prag is
if CodePeer_Mode or GNATprove_Mode then
Rewrite (N, Make_Null_Statement (Loc));
Analyze (N);
- raise Pragma_Exit;
+ return;
end if;
elsif Chars (Argx) = Name_Gnatprove then
if not GNATprove_Mode then
Rewrite (N, Make_Null_Statement (Loc));
Analyze (N);
- raise Pragma_Exit;
+ return;
end if;
-
else
raise Program_Error;
end if;
@@ -25679,7 +25679,7 @@ package body Sem_Prag is
Chars => Name_Warnings,
Pragma_Argument_Associations => Shifted_Args));
Analyze (N);
- raise Pragma_Exit;
+ return;
end if;
-- One argument case
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-07-05 8:29 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-07-05 8:29 [gcc r13-1481] [Ada] Remove exception propagation during bootstrap Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).