If a string is used as an argument instead of an integer,
Check_Arg_Is_OK_Static_Expression with Any_Integer will falsely verify causing
the compiler to halt compilation when the caller acts on the assumption that it
was verified. This patch creates checks so that Any_Integer works properly and
documentation to explain how unresolved types get handled.
------------
-- Source --
------------
-- static_int_test.adb
pragma C_Pass_By_Copy("JUNK"); -- Expects a static integer expression
procedure Static_Int_Test is
Another_Error : String := 1;
begin
null;
end Static_Int_Test;
----------------------------
-- Compilation and output --
----------------------------
$ gnatmake -q -f static_int_test.adb
static_int_test.adb:1:23: expected an integer type
static_int_test.adb:1:23: found a string type
static_int_test.adb:3:30: expected type "Standard.String"
static_int_test.adb:3:30: found type universal integer
gnatmake: "static_int_test.adb" compilation error
Tested on x86_64-pc-linux-gnu, committed on trunk
2016-06-22 Justin Squirek <squi...@adacore.com>
* sem_prag.adb (Check_Expr_Is_OK_Static_Expression): Fix ordering
of if-block and add in a condition to test for errors during
resolution.
* sem_res.adb (Resolution_Failed): Add comment to explain why
the type of a node which failed to resolve is set to the desired
type instead of Any_Type.
* sem_ch8.adb (Analyze_Object_Renaming): Add a check for Any_Type
to prevent crashes on Is_Access_Constant.
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 237686)
+++ sem_prag.adb (working copy)
@@ -5060,12 +5060,15 @@
Analyze_And_Resolve (Expr);
end if;
- if Is_OK_Static_Expression (Expr) then
- return;
+ -- An expression cannot be considered static if its resolution failed
+ -- or if it erroneous. Stop the analysis of the related pragma.
- elsif Etype (Expr) = Any_Type then
+ if Etype (Expr) = Any_Type or else Error_Posted (Expr) then
raise Pragma_Exit;
+ elsif Is_OK_Static_Expression (Expr) then
+ return;
+
-- An interesting special case, if we have a string literal and we
-- are in Ada 83 mode, then we allow it even though it will not be
-- flagged as static. This allows the use of Ada 95 pragmas like
@@ -5077,12 +5080,6 @@
then
return;
- -- Static expression that raises Constraint_Error. This has already
- -- been flagged, so just exit from pragma processing.
-
- elsif Is_OK_Static_Expression (Expr) then
- raise Pragma_Exit;
-
-- Finally, we have a real error
else
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 237680)
+++ sem_res.adb (working copy)
@@ -1974,7 +1974,12 @@
procedure Resolution_Failed is
begin
Patch_Up_Value (N, Typ);
+
+ -- Set the type to the desired one to minimize cascaded errors. Note
+ -- that this is an approximation and does not work in all cases.
+
Set_Etype (N, Typ);
+
Debug_A_Exit ("resolving ", N, " (done, resolution failed)");
Set_Is_Overloaded (N, False);
Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb (revision 237680)
+++ sem_ch8.adb (working copy)
@@ -1022,22 +1022,30 @@
Resolve (Nam, T);
+ -- Do not perform the legality checks below when the resolution of
+ -- the renaming name failed because the associated type is Any_Type.
+
+ if Etype (Nam) = Any_Type then
+ null;
+
-- Ada 2005 (AI-231): In the case where the type is defined by an
-- access_definition, the renamed entity shall be of an access-to-
-- constant type if and only if the access_definition defines an
-- access-to-constant type. ARM 8.5.1(4)
- if Constant_Present (Access_Definition (N))
+ elsif Constant_Present (Access_Definition (N))
and then not Is_Access_Constant (Etype (Nam))
then
- Error_Msg_N ("(Ada 2005): the renamed object is not "
- & "access-to-constant (RM 8.5.1(6))", N);
+ Error_Msg_N
+ ("(Ada 2005): the renamed object is not access-to-constant "
+ & "(RM 8.5.1(6))", N);
elsif not Constant_Present (Access_Definition (N))
and then Is_Access_Constant (Etype (Nam))
then
- Error_Msg_N ("(Ada 2005): the renamed object is not "
- & "access-to-variable (RM 8.5.1(6))", N);
+ Error_Msg_N
+ ("(Ada 2005): the renamed object is not access-to-variable "
+ & "(RM 8.5.1(6))", N);
end if;
if Is_Access_Subprogram_Type (Etype (Nam)) then
