diff options
author | Arnaud Charlet <charlet@adacore.com> | 2022-06-04 10:44:13 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2022-07-05 08:28:18 +0000 |
commit | 1d5018955a37fa665acc8dcba8121dd365dbe9be (patch) | |
tree | 32b0bd301f6a92b6bddc0e8861edc175feedac0b /gcc | |
parent | 4844a259b41b4f31940b478216d6dc9faa2bcbca (diff) | |
download | gcc-1d5018955a37fa665acc8dcba8121dd365dbe9be.zip gcc-1d5018955a37fa665acc8dcba8121dd365dbe9be.tar.gz gcc-1d5018955a37fa665acc8dcba8121dd365dbe9be.tar.bz2 |
[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.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/exp_imgv.adb | 4 | ||||
-rw-r--r-- | gcc/ada/raise-gcc.c | 4 | ||||
-rw-r--r-- | gcc/ada/sem_eval.adb | 4 | ||||
-rw-r--r-- | 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 6ab717c..51f1195 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 f4c42c0..b03964c 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 114c904..2ba4608 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 3660c75..3431e3f 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 |