Checks: Add Ada Checks ADA95_5.4.1, ADA95_5.4.5, ADA95_5.4.6

Author: kennethctdmn

CodeCheck/Published Standards/Ada 95/ADA95_5.4.1/check.upy

@@ -0,0 +1,131 @@
+ERR1 = "Use a more constrained subtype for discriminant"
+
+_PREDEFINED_SCALAR = frozenset(
+    {
+        "integer",
+        "long_integer",
+        "short_integer",
+        "long_long_integer",
+        "short_short_integer",
+        "natural",
+        "positive",
+        "float",
+        "long_float",
+        "short_float",
+        "duration",
+    }
+)
+
+_SCALAR_KEYWORDS = ("range", "digits", "delta", "mod ")
+
+
+def ids():
+    return ("ADA95_5.4.1",)
+
+
+def name(id):
+    return {
+        "ADA95_5.4.1": "Published Standards/Ada 95/5.4.1 Discriminated Records",
+    }[id]
+
+
+def tags(id):
+    return {
+        "ADA95_5.4.1": [
+            "Language: Ada",
+            "Standard: Ada 95",
+            "Data Structures",
+        ],
+    }.get(id, [])
+
+
+def detailed_description(id):
+    return {
+        "ADA95_5.4.1": """
+<p><b>Guideline</b></p>
+<p>&#8226; When declaring a discriminant, use as constrained a subtype as possible (i.e., subtype with as specific a range constraint as possible).</p>
+<p>&#8226; Use a discriminated record rather than a constrained array to represent an array whose actual values are unconstrained.</p>
+
+<p><b>Example</b></p>
+<p>An object of type <code>Number_Holder_2</code> imposes a more reasonable restriction on the length of its string component:</p>
+<pre><code language="Ada">type Number_List is array (Integer range &lt;&gt;) of Integer;
+type Number_Holder_1 (Current_Length : Natural := 0) is
+   record
+      Numbers : Number_List (1 .. Current_Length);
+   end record;
+</code></pre>
+
+<pre><code language="Ada">type    Number_List is array (Integer range &lt;&gt;) of Integer;
+subtype Max_Numbers is Natural range 0 .. 42;
+type Number_Holder_2 (Current_Length : Max_Numbers := 0) is
+   record
+      Numbers : Number_List (1 .. Current_Length);
+   end record;
+</code></pre>
+
+<p><b>Rationale</b></p>
+<p>When you use the discriminant to constrain an array inside a discriminated record, the larger the range of values the discriminant can assume, the more space an object of the type might require. Although your program may compile and link, it will fail at execution when the run-time system is unable to create an object of the potential size required.</p>
+<p>The discriminated record captures the intent of an array whose bounds may vary at run-time. A simple constrained array definition (e.g., <code>type Number_List is array (1 .. 42) of Integer;</code>) does not capture the intent that there are at most 42 possible numbers in the list.</p>
+
+<p><b>Developer's Note</b></p>
+<p>Guideline 1 (use as constrained a subtype as possible for discriminants) is automated: this check flags discriminants whose declared type is a predefined unconstrained scalar type (Integer, Natural, Positive, Float, etc.) or a user-defined subtype that carries no range constraint. Discriminants typed with an enumeration type or with a user subtype that includes a range, digits, delta, or modular constraint are not flagged.</p>
+<p>Guideline 2 (prefer discriminated record over constrained array) is not automatable: it requires knowing the programmer's intent — whether the array bounds are meant to vary at run-time — which cannot be determined statically.</p>
+""",
+    }[id]
+
+
+def test_entity(file):
+    return file.kind().check("Ada File")
+
+
+def _type_str(ent):
+    return str(ent.type()).lower() if ent and ent.type() else ""
+
+
+def check(check, file):
+    seen_discriminants = set()
+
+    for disc_ref in file.filerefs("Declare", "Discriminant"):
+        disc_ent = disc_ref.ent()
+
+        if disc_ent.id() in seen_discriminants:
+            continue
+
+        seen_discriminants.add(disc_ent.id())
+
+        type_ref = disc_ent.ref("Typed", "Type")
+
+        if not type_ref:
+            type_name = _type_str(disc_ent)
+            type_first = type_name.split()[0] if type_name else ""
+
+            if type_first in _PREDEFINED_SCALAR:
+                check.violation(
+                    disc_ent, file, disc_ref.line(), disc_ref.column(), ERR1
+                )
+
+            continue
+
+        type_ent = type_ref.ent()
+
+        if type_ent.kind().check("Enumeration, Access"):
+            continue
+
+        type_ent_name = str(type_ent.name()).lower()
+
+        if type_ent_name in _PREDEFINED_SCALAR:
+            check.violation(disc_ent, file, disc_ref.line(), disc_ref.column(), ERR1)
+            continue
+
+        if any(kw in _type_str(type_ent) for kw in _SCALAR_KEYWORDS):
+            continue
+
+        base_ref = type_ent.ref("Subtypefrom", "Type")
+
+        if not base_ref:
+            continue
+
+        base_ent = base_ref.ent()
+
+        if str(base_ent.name()).lower() in _PREDEFINED_SCALAR:
+            check.violation(disc_ent, file, disc_ref.line(), disc_ref.column(), ERR1)

CodeCheck/Published Standards/Ada 95/ADA95_5.4.1/test.ads

@@ -0,0 +1,183 @@
+package Test_5_4_1 is
+
+   type Number_List is array (Integer range <>) of Integer;
+
+   -- Violation: discriminant typed with unconstrained Natural
+   type Number_Holder_1 (Current_Length : Natural := 0) is      -- UndCC_Violation
+      record
+         Numbers : Number_List (1 .. Current_Length);
+      end record;
+
+   -- Valid: discriminant typed with constrained subtype
+   subtype Max_Numbers is Natural range 0 .. 42;
+   type Number_Holder_2 (Current_Length : Max_Numbers := 0) is  -- UndCC_Valid
+      record
+         Numbers : Number_List (1 .. Current_Length);
+      end record;
+
+   -- Violation: discriminant typed with unconstrained Integer
+   type Holder_3 (Size : Integer := 0) is                       -- UndCC_Violation
+      record
+         Data : Number_List (1 .. Size);
+      end record;
+
+   -- Valid: discriminant typed with constrained subtype of Integer
+   subtype Small_Size is Integer range 1 .. 100;
+   type Holder_4 (Size : Small_Size := 1) is                    -- UndCC_Valid
+      record
+         Data : Number_List (1 .. Size);
+      end record;
+
+   -- Violation: discriminant typed with Positive (predefined, unconstrained)
+   type Holder_5 (Count : Positive := 1) is                     -- UndCC_Violation
+      record
+         Data : Number_List (1 .. Count);
+      end record;
+
+   -- Valid: discriminant typed with enumeration (already constrained by values)
+   type Color is (Red, Green, Blue);
+   type Color_Record (C : Color := Red) is                      -- UndCC_Valid
+      record
+         Value : Integer;
+      end record;
+
+   -- Valid: discriminant typed with a Float subtype with digits constraint
+   subtype Precise_Float is Float digits 6;
+   type Float_Record (F : Precise_Float := 0.0) is              -- UndCC_Valid
+      record
+         Value : Integer;
+      end record;
+
+   -- Violation: discriminant typed with unconstrained Float
+   type Float_Holder (F : Float := 0.0) is                      -- UndCC_Violation
+      record
+         Value : Integer;
+      end record;
+
+   -- Violation: discriminant typed with Long_Integer (predefined, unconstrained)
+   type Long_Holder (N : Long_Integer := 0) is                  -- UndCC_Violation
+      record
+         Value : Integer;
+      end record;
+
+   -- Violation: discriminant typed with Duration (predefined, unconstrained)
+   type Timed_Record (T : Duration := 0.0) is                   -- UndCC_Violation
+      record
+         Value : Integer;
+      end record;
+
+   -- Valid: discriminant typed with Boolean (predefined enumeration)
+   type Bool_Record (Flag : Boolean := False) is                -- UndCC_Valid
+      record
+         Value : Integer;
+      end record;
+
+   -- Valid: discriminant typed with Character (predefined enumeration)
+   type Char_Record (Ch : Character := ' ') is                  -- UndCC_Valid
+      record
+         Value : Integer;
+      end record;
+
+   -- Valid: named constrained subtype of Integer used as discriminant
+   subtype Tiny_Int is Integer range 1 .. 10;
+   type Int_Constrained (D : Tiny_Int := 1) is                 -- UndCC_Valid
+      record
+         Value : Integer;
+      end record;
+
+   -- Valid: fixed-point subtype with delta+range constraint
+   subtype Small_Delta is Duration delta 0.001 range 0.0 .. 1.0;
+   type Delta_Record (T : Small_Delta := 0.0) is                -- UndCC_Valid
+      record
+         Value : Integer;
+      end record;
+
+   -- Valid: variant record with enumeration discriminant
+   type Shape_Kind is (Circle, Rectangle);
+   type Shape (Kind : Shape_Kind := Circle) is                  -- UndCC_Valid
+      record
+         case Kind is
+            when Circle =>
+               Radius : Float;
+            when Rectangle =>
+               Width : Float;
+               Height : Float;
+         end case;
+      end record;
+
+   -- Multiple discriminants: one unconstrained, one constrained
+   subtype Max_Cols is Natural range 1 .. 80;
+   type Grid (Rows : Natural := 0; Cols : Max_Cols := 1) is     -- UndCC_Violation
+      record
+         Value : Integer;
+      end record;
+
+   -- Violation: tagged type with unconstrained discriminant
+   type Tagged_T (N : Natural := 0) is tagged                   -- UndCC_Violation
+      record
+         Value : Integer;
+      end record;
+
+   -- Violation: unconstrained subtype of Integer resolves to "Integer"
+   subtype Bare_Int is Integer;
+   type Bare_Holder (D : Bare_Int := 0) is                      -- UndCC_Violation
+      record
+         Value : Integer;
+      end record;
+
+   -- Violation: discriminant with no default value, unconstrained Natural
+   type No_Default_Holder (N : Natural) is                      -- UndCC_Violation
+      record
+         Data : Number_List (1 .. N);
+      end record;
+
+   -- Valid: discriminant with no default value, constrained subtype
+   type No_Default_Constrained (N : Max_Numbers) is             -- UndCC_Valid
+      record
+         Data : Number_List (1 .. N);
+      end record;
+
+   -- Valid: modular type discriminant (constrained by its modulus)
+   type Byte is mod 256;
+   type Byte_Record (B : Byte := 0) is                          -- UndCC_Valid
+      record
+         Value : Integer;
+      end record;
+
+   -- Valid: discriminant typed with a user modular subtype
+   subtype Half_Byte is Byte range 0 .. 15;
+   type Half_Record (H : Half_Byte := 0) is                     -- UndCC_Valid
+      record
+         Value : Integer;
+      end record;
+
+   -- Violation: multiple unconstrained discriminants — each is flagged
+   type Multi_Bad (Rows : Natural := 0; Cols : Natural := 0) is -- UndCC_Violation
+      record
+         Value : Integer;
+      end record;
+
+   -- Valid: multiple discriminants all constrained
+   subtype Row_Count is Natural range 1 .. 100;
+   subtype Col_Count is Natural range 1 .. 200;
+   type Multi_Good (Rows : Row_Count := 1; Cols : Col_Count := 1) is -- UndCC_Valid
+      record
+         Value : Integer;
+      end record;
+
+private
+
+   -- Violation: private type with unconstrained discriminant
+   type Private_Holder (N : Natural := 0) is                    -- UndCC_Violation
+      record
+         Value : Integer;
+      end record;
+
+   -- Valid: private type with constrained discriminant
+   subtype Private_Size is Natural range 0 .. 10;
+   type Private_Constrained (N : Private_Size := 0) is          -- UndCC_Valid
+      record
+         Value : Integer;
+      end record;
+
+end Test_5_4_1;