decl.c (gnat_to_gnu_entity, [...]): Make constant variant of designated type for…

decl.c (gnat_to_gnu_entity, [...]): Make constant variant of designated type for Is_Access_Constant.

	* decl.c (gnat_to_gnu_entity, case E_General_Access_Type):
	Make constant variant of designated type for Is_Access_Constant.
	Call update_pointer_to with main variant.

	* trans.c (process_freeze_entity, process_type):
	Call update_pointer_to on main variant.

	* utils.c (update_pointer_to): Make corresponding variant for NEW_TYPE.
	If main variant, update all other variants.

	* utils2.c (build_unary_op, case INDIRECT_REF): No longer set
	TREE_STATIC.

From-SVN: r46547

gcc/ada/ChangeLog

+2001-10-26  Richard Kenner <kenner@gnat.com>
+
+	* decl.c (gnat_to_gnu_entity, case E_General_Access_Type): 
+	Make constant variant of designated type for Is_Access_Constant.
+	Call update_pointer_to with main variant.
+	
+	* trans.c (process_freeze_entity, process_type): 
+	Call update_pointer_to on main variant.
+	
+	* utils.c (update_pointer_to): Make corresponding variant for NEW_TYPE.
+	If main variant, update all other variants.
+	
+	* utils2.c (build_unary_op, case INDIRECT_REF): No longer set 
+	TREE_STATIC.
+
 2001-10-26  Robert Dewar <dewar@gnat.com>
 
 	* prj-util.adb: Minor reformatting

gcc/ada/decl.c

@@ -2730,6 +2730,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition)
 	     : In_Extended_Main_Code_Unit (gnat_desig_type));
 	int got_fat_p = 0;
 	int made_dummy = 0;
+	tree gnu_desig_type = 0;
 
 	if (No (gnat_desig_full)
 	    && (Ekind (gnat_desig_type) == E_Class_Wide_Type
@@ -2838,8 +2839,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition)
 	/* If we already know what the full type is, use it.  */
 	else if (Present (gnat_desig_full)
 		 && present_gnu_tree (gnat_desig_full))
-	  gnu_type
-	    = build_pointer_type (TREE_TYPE (get_gnu_tree (gnat_desig_full)));
+	  gnu_desig_type = TREE_TYPE (get_gnu_tree (gnat_desig_full));
 
 	/* Get the type of the thing we are to point to and build a pointer
 	   to it.  If it is a reference to an incomplete or private type with a
@@ -2851,7 +2851,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition)
 		 && ! present_gnu_tree (gnat_desig_full)
 		 && Is_Record_Type (gnat_desig_full))
 	  {
-	    gnu_type = build_pointer_type (make_dummy_type (gnat_desig_type));
+	    gnu_desig_type = make_dummy_type (gnat_desig_type);
 	    made_dummy = 1;
 	  }
 
@@ -2867,7 +2867,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition)
 			 && (Is_Record_Type (gnat_desig_full)
 			     || Is_Array_Type (gnat_desig_full)))))
 	  {
-	    gnu_type = build_pointer_type (make_dummy_type (gnat_desig_type));
+	    gnu_desig_type = make_dummy_type (gnat_desig_type);
 	    made_dummy = 1;
 	  }
 	else if (gnat_desig_type == gnat_entity)
@@ -2876,7 +2876,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition)
 	    TREE_TYPE (gnu_type) = TYPE_POINTER_TO (gnu_type) = gnu_type;
 	  }
 	else
-	  gnu_type = build_pointer_type (gnat_to_gnu_type (gnat_desig_type));
+	  gnu_desig_type = gnat_to_gnu_type (gnat_desig_type);
 
 	/* It is possible that the above call to gnat_to_gnu_type resolved our
 	   type.  If so, just return it.  */
@@ -2886,6 +2886,21 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition)
 	    break;
 	  }
 
+	/* If we have a GCC type for the designated type, possibly
+	   modify it if we are pointing only to constant objects and then
+	   make a pointer to it.  Don't do this for unconstrained arrays.  */
+	if (gnu_type == 0 && gnu_desig_type != 0)
+	  {
+	    if (Is_Access_Constant (gnat_entity)
+		&& TREE_CODE (gnu_desig_type) != UNCONSTRAINED_ARRAY_TYPE)
+	      gnu_desig_type
+		= build_qualified_type (gnu_desig_type,
+					(TYPE_QUALS (gnu_desig_type)
+					 | TYPE_QUAL_CONST));
+
+	    gnu_type = build_pointer_type (gnu_desig_type);
+	  }
+
 	/* If we are not defining this object and we made a dummy pointer,
 	   save our current definition, evaluate the actual type, and replace
 	   the tentative type we made with the actual one.  If we are to defer
@@ -2912,8 +2927,8 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition)
 	    this_made_decl = saved = 1;
 
 	    if (defer_incomplete_level == 0)
-	      update_pointer_to
-		(gnu_old_type, gnat_to_gnu_type (gnat_desig_type));
+	      update_pointer_to (TYPE_MAIN_VARIANT (gnu_old_type),
+				 gnat_to_gnu_type (gnat_desig_type));
 	    else
 	      {
 		struct incomplete *p
@@ -3808,7 +3823,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition)
 	  next = incp->next;
 
 	  if (incp->old_type != 0)
-	    update_pointer_to (incp->old_type,
+	    update_pointer_to (TYPE_MAIN_VARIANT (incp->old_type),
 			       gnat_to_gnu_type (incp->full_type));
 	  free (incp);
 	}
@@ -3823,7 +3838,8 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition)
       for (incp = defer_incomplete_list; incp; incp = incp->next)
 	if (incp->old_type != 0 && incp->full_type == gnat_entity)
 	  {
-	    update_pointer_to (incp->old_type, TREE_TYPE (gnu_decl));
+	    update_pointer_to (TYPE_MAIN_VARIANT (incp->old_type),
+			       TREE_TYPE (gnu_decl));
 	    incp->old_type = 0;
 	  }
     }

gcc/ada/trans.c

@@ -4048,7 +4048,8 @@ process_freeze_entity (gnat_node)
   if (gnu_old != 0)
     {
       DECL_NAME (gnu_new) = DECL_NAME (gnu_old);
-      update_pointer_to (TREE_TYPE (gnu_old), TREE_TYPE (gnu_new));
+      update_pointer_to (TYPE_MAIN_VARIANT (TREE_TYPE (gnu_old)),
+			 TREE_TYPE (gnu_new));
     }
 }
 
@@ -4725,7 +4726,8 @@ process_type (gnat_entity)
   /* If we have an old type and we've made pointers to this type,
      update those pointers.  */
   if (gnu_old != 0)
-    update_pointer_to (TREE_TYPE (gnu_old), TREE_TYPE (gnu_new));
+    update_pointer_to (TYPE_MAIN_VARIANT (TREE_TYPE (gnu_old)),
+		       TREE_TYPE (gnu_new));
 
   /* If this is a record type corresponding to a task or protected type 
      that is a completion of an incomplete type, perform a similar update
@@ -4744,7 +4746,8 @@ process_type (gnat_entity)
       save_gnu_tree (Corresponding_Concurrent_Type (gnat_entity),
 		     gnu_new, 0);
 
-      update_pointer_to (TREE_TYPE (gnu_task_old), TREE_TYPE (gnu_new));
+      update_pointer_to (TYPE_MAIN_VARIANT (TREE_TYPE (gnu_task_old)),
+			 TREE_TYPE (gnu_new));
     }
 }
 

gcc/ada/utils.c

@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *                            $Revision: 1.4 $
+ *                            $Revision$
  *                                                                          *
  *          Copyright (C) 1992-2001, Free Software Foundation, Inc.         *
  *                                                                          *
@@ -2581,8 +2581,22 @@ update_pointer_to (old_type, new_type)
 {
   tree ptr = TYPE_POINTER_TO (old_type);
   tree ref = TYPE_REFERENCE_TO (old_type);
+  tree type;
+
+  /* If this is the main variant, process all the other variants first.  */
+  if (TYPE_MAIN_VARIANT (old_type) == old_type)
+    for (type = TYPE_NEXT_VARIANT (old_type); type != 0;
+	 type = TYPE_NEXT_VARIANT (type))
+      update_pointer_to (type, new_type);
+
+  /* If no pointer or reference, we are done.  Otherwise, get the new type with
+     the same qualifiers as the old type and see if it is the same as the old
+     type.  */
+  if (ptr == 0 && ref == 0)
+    return;
 
-  if ((ptr == 0 && ref == 0) || old_type == new_type)
+  new_type = build_qualified_type (new_type, TYPE_QUALS (old_type));
+  if (old_type == new_type)
     return;
 
   /* First handle the simple case.  */

gcc/ada/utils2.c

@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *                            $Revision: 1.1 $
+ *                            $Revision$
  *                                                                          *
  *          Copyright (C) 1992-2001, Free Software Foundation, Inc.         *
  *                                                                          *
@@ -1279,8 +1279,7 @@ build_unary_op (op_code, result_type, operand)
       else
 	{
 	  result = fold (build1 (op_code, TREE_TYPE (type), operand));
-	  TREE_READONLY (result) = TREE_STATIC (result)
-	    = TREE_READONLY (TREE_TYPE (type));
+	  TREE_READONLY (result) = TREE_READONLY (TREE_TYPE (type));
 	}
 
       side_effects = flag_volatile