This patch implements the rule given in RM 4.2 (11): if the component type of
a string literal is a character type with a static predicate, that predicate
must be applied to each character in the string.
Compiling the example below must yield:
gcc -c -gnata main.adb
main.adb:4:23: warning: static expression fails static predicate check on "C"
main.adb:4:23: warning: expression is no longer considered static
main.adb:4:24: warning: static expression fails static predicate check on "C"
main.adb:4:24: warning: expression is no longer considered static
main.adb:4:25: warning: static expression fails static predicate check on "C"
main.adb:4:25: warning: expression is no longer considered static
Execution must yield:
raised SYSTEM.ASSERTIONS.ASSERT_FAILURE :
Static_Predicate failed at main.adb:4
----
procedure Main is
subtype C is Character with Static_Predicate => C in 'A' | 'B' | 'C';
type S is array (Positive range <>) of C;
X : constant S := "abc";
begin
null;
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-05-31 Ed Schonberg <[email protected]>
gcc/ada/
* sem_res.adb (Resolve_String_Literal): If the type is a string type
whose component subtype has a static predicate, ensure that the
predicate is applied to each character by expanding the string into the
equivalent aggregate. This is also done if the component subtype is
constrained.
--- gcc/ada/sem_res.adb
+++ gcc/ada/sem_res.adb
@@ -10774,7 +10774,9 @@ package body Sem_Res is
-- whether the evaluation of the string will raise constraint error.
-- Otherwise we need to transform the string literal into the
-- corresponding character aggregate and let the aggregate code do
- -- the checking.
+ -- the checking. We use the same transformation if the component
+ -- type has a static predicate, which will be applied to each
+ -- character when the aggregate is resolved.
if Is_Standard_Character_Type (R_Typ) then
@@ -10811,7 +10813,9 @@ package body Sem_Res is
end if;
end loop;
- return;
+ if not Has_Static_Predicate (C_Typ) then
+ return;
+ end if;
end if;
end;
end if;