===================================================================
@@ -5469,6 +5469,40 @@
return Skip;
end;
+ -- The predicate function may contain string-comparison operations
+ -- that have been converted into calls to run-time array-comparison
+ -- routines. To evaluate the predicate statically, we recover the
+ -- original comparison operation and replace the occurrence of the
+ -- formal by the static string value. The actuals of the generated
+ -- call are of the form X'Address.
+
+ elsif Nkind (N) in N_Op_Compare
+ and then Nkind (Left_Opnd (N)) = N_Function_Call
+ then
+ declare
+ C : constant Node_Id := Left_Opnd (N);
+ F : constant Node_Id := First (Parameter_Associations (C));
+ L : constant Node_Id := Prefix (F);
+ R : constant Node_Id := Prefix (Next (F));
+
+ begin
+ -- If an operand is an entity name, it is the formal of the
+ -- predicate function, so replace it with the string value.
+ -- It may be either operand in the call. The other operand
+ -- is a static string from the original predicate.
+
+ if Is_Entity_Name (L) then
+ Rewrite (Left_Opnd (N), New_Copy (Val));
+ Rewrite (Right_Opnd (N), New_Copy (R));
+
+ else
+ Rewrite (Left_Opnd (N), New_Copy (L));
+ Rewrite (Right_Opnd (N), New_Copy (Val));
+ end if;
+
+ return Skip;
+ end;
+
else
return OK;
end if;
===================================================================
@@ -11603,11 +11603,18 @@
function Is_Type_Ref (N : Node_Id) return Boolean;
pragma Inline (Is_Type_Ref);
+
-- Returns True if N is a reference to the type for the predicate in the
-- expression (i.e. if it is an identifier whose Chars field matches the
-- Nam given in the call). N must not be parenthesized, if the type name
-- appears in parens, this routine will return False.
+ -- The routine also returns True for function calls generated during the
+ -- expansion of comparison operators on strings, which are intended to
+ -- be legal in static predicates, and are converted into calls to array
+ -- comparison routines in the body of the corresponding predicate
+ -- function.
+
----------------------------------
-- All_Static_Case_Alternatives --
----------------------------------
@@ -11671,9 +11678,10 @@
function Is_Type_Ref (N : Node_Id) return Boolean is
begin
- return Nkind (N) = N_Identifier
- and then Chars (N) = Nam
- and then Paren_Count (N) = 0;
+ return (Nkind (N) = N_Identifier
+ and then Chars (N) = Nam
+ and then Paren_Count (N) = 0)
+ or else Nkind (N) = N_Function_Call;
end Is_Type_Ref;
-- Start of processing for Is_Predicate_Static
@@ -11723,10 +11731,12 @@
-- and inequality operations to be valid on strings (this helps deal
-- with cases where we transform A in "ABC" to A = "ABC).
+ -- In fact, it appears that the intent of the ARG is to extend static
+ -- predicates to strings, and that the extension should probably apply
+ -- to static expressions themselves. The code below accepts comparison
+ -- operators that apply to static strings.
+
elsif Nkind (Expr) in N_Op_Compare
- and then ((not Is_String_Type (Etype (Left_Opnd (Expr))))
- or else (Nkind_In (Expr, N_Op_Eq, N_Op_Ne)
- and then not Comes_From_Source (Expr)))
and then ((Is_Type_Ref (Left_Opnd (Expr))
and then Is_OK_Static_Expression (Right_Opnd (Expr)))
or else
@@ -12323,7 +12333,7 @@
and then From_Aspect_Specification (N)
then
Error_Msg_NE
- ("aspect specification causes premature freezing of&", T, N);
+ ("aspect specification causes premature freezing of&", N, T);
Set_Has_Delayed_Freeze (T, False);
return True;
end if;
RM 3.2.4 stipulates that comparison operators on strings are legal in the expression for a Static_Predicate aspect of a string type. The implementation of this capability was deferred because it conflicts with the definition of static expression (RM 4.9) which excludes string comparisons from staticness. This inconsistency will eventually be resolved by the ARG, but it is worth implementing the wider scope of static predicates to include string comparison. Executing: gnatmake -q -gnatws -gnata main main must yield: Some_String OK Early_String OK Middle_String OK Late_String OK --- with Text_IO; use Text_IO; with support; use support; procedure main is Maybe : Boolean := String'("ABC") < "CDE"; begin begin declare Wrong : constant some_String := "abcdefg"; begin null; end; exception when others => Put_Line ("Some_String OK"); end; begin declare Wrong : Early_String := "ebcdefg"; begin null; end; exception when others => Put_Line ("Early_String OK"); end; begin declare Wrong : Middle_String := "abcdefg"; begin null; end; exception when others => Put_Line ("Middle_String OK"); end; begin declare Wrong : Late_String := "abcdefg"; begin null; end; exception when others => Put_Line ("Late_String OK"); end; end; --- package Support is subtype My_String is String (1 .. 7); subtype My_Special_String is My_String with Static_Predicate => My_Special_String = "aaaaaaa"; subtype My_short_String is My_String with Static_Predicate => My_short_String'length > 6; subtype Early_String is My_String with Static_Predicate => Early_String < "ddddddd"; subtype Late_String is My_String with Static_Predicate => "ddddddd" < Late_String; subtype Middle_String is MY_String with Static_Predicate => Middle_String >= "aaa" and then "ggg" < Middle_String; subtype Some_String is My_String with Static_Predicate => Some_String in "aaaaaaa" | "zzzzzzz"; end Support; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-01-13 Ed Schonberg <schonberg@adacore.com> * sem_ch13.adb (Is_Predicate_Static): Following the intent of the RM, treat comparisons on strings as legal in a Static_Predicate. (Is_Predicate_Static, Is_Type_Ref): Predicate also returns true on a function call that is the expansion of a string comparison.The function call is built when compiling the corresponding predicate function, but the expression has been found legal as a static predicate during earlier analysis. * sem_eval.adb (Real_Or_String_Static_Predicate_Matches): Handle properly a function call that is the expansion of a string comparison operation, in order to recover the Static_Predicate expression and apply it to a static argument when needed.