https://gcc.gnu.org/g:3e9251519d9d6550fa8381496380690610daf68b

commit r17-721-g3e9251519d9d6550fa8381496380690610daf68b
Author: Steve Baird <[email protected]>
Date:   Mon Dec 15 13:47:35 2025 -0800

    ada: New aspects for use in CodePeer's taint analysis.
    
    Add minimal compiler support for three new aspects: Taint_Sanitizer,
    Taint_Sink, and Taint_Source. This support consists of accepting (with no
    accompanying semantic analysis) aspect specifications for these aspects, 
using
    either aspect_specification syntax or pragmas. Such aspect specifications 
are
    subsequently ignored by the compiler front end. These aspects are intended 
for
    use with CodePeer and are (or will be) documented in CodePeer documentation;
    they are not documented in the GNAT RM.
    
    gcc/ada/ChangeLog:
    
            * aspects.ads: Add three new Taint_Xxx aspects to the Aspect_Id
            enumeration type and define a corresponding subtype,
            Ignored_Aspects.
            * exp_prag.adb (Expand_N_Pragma): Don't rewrite a taint-related
            pragma as a null statement. We want to leave the (unanalyzed)
            pragma in the tree.
            * sem_ch13.adb (Analyze_One_Aspect): Leave taint-related aspect
            specifications
            (and their arguments, if any) unanalyzed.
            (Check_Aspect_At_Freeze_Point): Update a case statement to treat
            the new aspects as an error case.
            * sem_util.adb (Should_Ignore_Pragma_Sem): Return True for an
            ignored pragma.
            * snames.ads-tmpl: Define names for the three new aspects.

Diff:
---
 gcc/ada/aspects.ads     | 18 ++++++++++++++++++
 gcc/ada/exp_prag.adb    |  9 ++++++++-
 gcc/ada/sem_ch13.adb    |  5 +++++
 gcc/ada/sem_util.adb    |  3 ++-
 gcc/ada/snames.ads-tmpl |  3 +++
 5 files changed, 36 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index 88b951700a96..9e01abf233fc 100644
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -159,6 +159,9 @@ package Aspects is
       Aspect_Super,                         -- GNAT
       Aspect_Suppress,
       Aspect_Synchronization,
+      Aspect_Taint_Sanitizer,               -- GNAT
+      Aspect_Taint_Sink,                    -- GNAT
+      Aspect_Taint_Source,                  -- GNAT
       Aspect_Test_Case,                     -- GNAT
       Aspect_Type_Invariant,
       Aspect_Unimplemented,                 -- GNAT
@@ -281,6 +284,14 @@ package Aspects is
       Aspect_Type_Invariant    => True,
       others                   => False);
 
+   --  Ignored aspects are intended for use by other tools (e.g., CodePeer) and
+   --  should be accepted and then ignored by the compiler.
+   --  Any aspect_definition in an aspect_specification for an ignored aspect
+   --  is parsed but is otherwise ignored (in particular, it is not analyzed).
+
+   subtype Ignored_Aspects is Aspect_Id range
+     Aspect_Taint_Sanitizer .. Aspect_Taint_Source;
+
    --  The following array identifies all implementation defined aspects
 
    Implementation_Defined_Aspect : constant array (Aspect_Id) of Boolean :=
@@ -363,6 +374,7 @@ package Aspects is
       Aspect_Volatile_Full_Access       => True,
       Aspect_Volatile_Function          => True,
       Aspect_Warnings                   => True,
+      Ignored_Aspects                   => True,
       others                            => False);
 
    --  The following array indicates aspects that specify operational
@@ -525,6 +537,7 @@ package Aspects is
       Aspect_Warnings                   => Name,
       Aspect_Write                      => Name,
 
+      Ignored_Aspects                   => Optional_Expression,
       Library_Unit_Aspects              => Optional_Expression,
       Boolean_Aspects                   => Optional_Expression);
 
@@ -633,6 +646,7 @@ package Aspects is
       Aspect_Warnings                     => False,
       Aspect_Write                        => False,
 
+      Ignored_Aspects                     => False,
       Library_Unit_Aspects                => False,
 
       Aspect_Always_Terminates            => False,
@@ -838,6 +852,9 @@ package Aspects is
       Aspect_Suppress                     => Name_Suppress,
       Aspect_Suppress_Debug_Info          => Name_Suppress_Debug_Info,
       Aspect_Suppress_Initialization      => Name_Suppress_Initialization,
+      Aspect_Taint_Sanitizer              => Name_Taint_Sanitizer,
+      Aspect_Taint_Sink                   => Name_Taint_Sink,
+      Aspect_Taint_Source                 => Name_Taint_Source,
       Aspect_Thread_Local_Storage         => Name_Thread_Local_Storage,
       Aspect_Synchronization              => Name_Synchronization,
       Aspect_Test_Case                    => Name_Test_Case,
@@ -1123,6 +1140,7 @@ package Aspects is
       Aspect_Volatile_Function            => Never_Delay,
       Aspect_Warnings                     => Never_Delay,
       Aspect_Yield                        => Never_Delay,
+      Ignored_Aspects                     => Never_Delay,
 
       Aspect_Alignment                    => Rep_Aspect,
       Aspect_Atomic                       => Rep_Aspect,
diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index c982cf7be43a..bf11c70f0b7b 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;        use Aspects;
 with Atree;          use Atree;
 with Casing;         use Casing;
 with Checks;         use Checks;
@@ -145,7 +146,13 @@ package body Exp_Prag is
         or else (Prag_Id = Pragma_Default_Scalar_Storage_Order
                  and then Ignore_Rep_Clauses)
       then
-         Rewrite (N, Make_Null_Statement (Sloc (N)));
+         --  For a pragma specifying an ignored aspect, we want to leave
+         --  the unanalyzed pragma in the tree.
+         if Get_Aspect_Id (Chars (Pragma_Identifier (N)))
+           not in Ignored_Aspects
+         then
+            Rewrite (N, Make_Null_Statement (Sloc (N)));
+         end if;
          return;
       end if;
 
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index f2493e53a719..c3cdeeff59bc 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -5391,6 +5391,10 @@ package body Sem_Ch13 is
                   end if;
                end Super;
 
+               when Ignored_Aspects =>
+                  --  nothing to do
+                  goto Continue;
+
                when Boolean_Aspects
                   | Library_Unit_Aspects
                =>
@@ -12321,6 +12325,7 @@ package body Sem_Ch13 is
             | Aspect_Unimplemented
             | Aspect_Unsuppress
             | Aspect_User_Aspect
+            | Ignored_Aspects
          =>
             raise Program_Error;
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 05e7844d3613..dc086b1e52ef 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -29147,7 +29147,8 @@ package body Sem_Util is
                       and then not In_Internal_Unit (N);
 
    begin
-      return Result;
+      return Result
+        or else Get_Aspect_Id (Prag_Name) in Ignored_Aspects;
    end Should_Ignore_Pragma_Sem;
 
    --------------------
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 510fac92ec00..6d0ab5eeecff 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -171,6 +171,9 @@ package Snames is
    Name_Storage_Model_Type             : constant Name_Id := N + $;
    Name_String_Literal                 : constant Name_Id := N + $;
    Name_Synchronization                : constant Name_Id := N + $;
+   Name_Taint_Sanitizer                : constant Name_Id := N + $;
+   Name_Taint_Sink                     : constant Name_Id := N + $;
+   Name_Taint_Source                   : constant Name_Id := N + $;
    Name_Unimplemented                  : constant Name_Id := N + $;
    Name_User_Aspect                    : constant Name_Id := N + $;

Reply via email to