2008-08-04 Doug Rupp <rupp@adacore.com>

	* gcc-interface/utils2.c:
	(fill_vms_descriptor): Raise CE if attempt made to pass 64bit pointer
	in 32bit descriptor.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@138588 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 400d61d..65cc4f0 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,40 @@
+2008-08-04  Doug Rupp  <rupp@adacore.com>
+
+       * gcc-interface/utils2.c:
+       (fill_vms_descriptor): Raise CE if attempt made to pass 64bit pointer
+       in 32bit descriptor.
+
+2008-08-04  Robert Dewar  <dewar@adacore.com>
+
+       * par-ch10.adb: Minor reformatting
+
+       * i-cobol.adb: Minor reformatting.
+
+2008-08-04  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch3.adb (Access_Definition): Create an itype reference for an
+       anonymous access return type of a regular function that is not a
+       compilation unit.
+
+2008-08-04  Vincent Celier  <celier@adacore.com>
+
+       * prj-attr.adb: New Builder attribute Global_Compilation_Switches
+       
+       * snames.adb: New standard name Global_Compilation_Switches
+       
+       * snames.ads: New standard name Global_Compilation_Switches
+
+       * make.adb: Correct spelling error in comment
+
+2008-08-04  Arnaud Charlet  <charlet@adacore.com>
+
+       * sem_prag.adb (Check_Form_Of_Interface_Name): Fix handling for CLI
+       target.
+
+2008-08-04  Thomas Quinot  <quinot@adacore.com>
+
+       * sem_ch10.adb: Minor comment fix.
+
 2008-08-04  Robert Dewar  <dewar@adacore.com>
 
        * restrict.adb: Improved messages for restriction warnings

diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c
index d1a6786..8cd6155 100644 (file)
--- a/gcc/ada/gcc-interface/utils2.c
+++ b/gcc/ada/gcc-interface/utils2.c
@@ -2169,19 +2169,37 @@ fill_vms_descriptor (tree expr, Entity_Id gnat_formal)
   tree field;
   tree parm_decl = get_gnu_tree (gnat_formal);
   tree const_list = NULL_TREE;
-  tree record_type;
+  tree record_type = TREE_TYPE (TREE_TYPE (parm_decl));
+  int do_range_check =
+      strcmp ("MBO",
+             IDENTIFIER_POINTER (DECL_NAME (TYPE_FIELDS (record_type))));
 
-  record_type = TREE_TYPE (TREE_TYPE (parm_decl));
   expr = maybe_unconstrained_array (expr);
   gnat_mark_addressable (expr);
 
   for (field = TYPE_FIELDS (record_type); field; field = TREE_CHAIN (field))
-    const_list
-      = tree_cons (field,
-                  convert (TREE_TYPE (field),
-                           SUBSTITUTE_PLACEHOLDER_IN_EXPR
-                           (DECL_INITIAL (field), expr)),
-                  const_list);
+    {
+      tree conexpr = convert (TREE_TYPE (field),
+                             SUBSTITUTE_PLACEHOLDER_IN_EXPR
+                             (DECL_INITIAL (field), expr));
+
+      /* Check to ensure that only 32bit pointers are passed in
+        32bit descriptors */
+      if (do_range_check &&
+          strcmp (IDENTIFIER_POINTER (DECL_NAME (field)), "POINTER") == 0)
+        {
+          tree t = build3 (COND_EXPR, void_type_node,
+                          build_binary_op (LT_EXPR, integer_type_node,
+                                           convert (integer_type_node,
+                                                    conexpr), 
+                                           integer_zero_node),
+                          build_call_raise (CE_Range_Check_Failed, Empty,
+                                            N_Raise_Constraint_Error),
+                          NULL_TREE);
+          add_stmt (t);
+        }
+      const_list = tree_cons (field, conexpr, const_list);
+    }
 
   return gnat_build_constructor (record_type, nreverse (const_list));
 }