[Ada] Analysis of pragmas containing integer expressions not verified properly

[Ada] Analysis of pragmas containing integer expressions not verified properly

[Arnaud Charlet]

[-- Attachment #1: Type: text/plain, Size: 1488 bytes --]

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  <squirek@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.


[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 3507 bytes --]

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