]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Crash with pragma Ignore_Pragma in SPARK mode
authorBob Duff <duff@adacore.com>
Wed, 7 Jan 2026 18:57:52 +0000 (13:57 -0500)
committerMarc Poulhiès <dkm@gcc.gnu.org>
Mon, 25 May 2026 08:28:06 +0000 (10:28 +0200)
This patch fixes a bug in the expansion of protected bodies.

Consolidate the various cases that simply copy the Op_Body,
which is usually a protected subprogram declaration or body.
Remove the "raise Program_Error", because it's not really the
job of this code to enforce the rules about what can appear
in a protected body. Better to remove all the cases that
have accreted over the years, and just assume that anything
not allowed syntactically must be an artifact of expansion.

The specific goal here is to avoid raising Program_Error
when Op_Body is a null statement, which happens when there
is a "SPARK_Mode => Off" aspect (turned into a pragma)
and also a "pragma Ignore_Pragma (SPARK_Mode)" (which turns
the pragma into a null statement). The fix here is more
general and more "DRY".

gcc/ada/ChangeLog:

* exp_ch9.adb (Expand_N_Protected_Body):
Remove "raise Program_Error" and consolidate other
cases.

gcc/ada/exp_ch9.adb

index 2f5446e79f1547cbee5ffbe581817c10aec450eb..054c6db06057e452d68a62f7b0d11039d50c895d 100644 (file)
@@ -8250,8 +8250,8 @@ package body Exp_Ch9 is
       Op_Body := First (Declarations (N));
 
       --  The protected body is replaced with the bodies of its protected
-      --  operations, and the declarations for internal objects that may
-      --  have been created for entry family bounds.
+      --  operations, and other things, such as pragmas and byproducts of
+      --  expansion.
 
       Rewrite (N, Make_Null_Statement (Sloc (N)));
       Analyze (N);
@@ -8366,20 +8366,14 @@ package body Exp_Ch9 is
                Current_Node := New_Op_Body;
                Analyze (New_Op_Body);
 
-            when N_Implicit_Label_Declaration =>
-               null;
-
-            when N_Call_Marker
-               | N_Itype_Reference
-            =>
-               New_Op_Body := New_Copy (Op_Body);
-               Insert_After (Current_Node, New_Op_Body);
-               Current_Node := New_Op_Body;
+            --  Anything else, such as object declarations produced by
+            --  expansion, are copied.
 
-            when N_Freeze_Entity =>
+            when others =>
                New_Op_Body := New_Copy (Op_Body);
 
-               if Present (Entity (Op_Body))
+               if Nkind (Op_Body) = N_Freeze_Entity
+                 and then Present (Entity (Op_Body))
                  and then Freeze_Node (Entity (Op_Body)) = Op_Body
                then
                   Set_Freeze_Node (Entity (Op_Body), New_Op_Body);
@@ -8388,22 +8382,6 @@ package body Exp_Ch9 is
                Insert_After (Current_Node, New_Op_Body);
                Current_Node := New_Op_Body;
                Analyze (New_Op_Body);
-
-            when N_Pragma =>
-               New_Op_Body := New_Copy (Op_Body);
-               Insert_After (Current_Node, New_Op_Body);
-               Current_Node := New_Op_Body;
-               Analyze (New_Op_Body);
-
-            when N_Object_Declaration =>
-               pragma Assert (not Comes_From_Source (Op_Body));
-               New_Op_Body := New_Copy (Op_Body);
-               Insert_After (Current_Node, New_Op_Body);
-               Current_Node := New_Op_Body;
-               Analyze (New_Op_Body);
-
-            when others =>
-               raise Program_Error;
          end case;
 
          Next (Op_Body);