Commit bf327c92 by Arnaud Charlet

[multiple changes]

2009-04-17  Thomas Quinot  <quinot@adacore.com>

	* exp_ch7.adb: Minor reformatting

2009-04-17  Robert Dewar  <dewar@adacore.com>

	* restrict.adb (Check_Restriction_No_Dependence): Don't check
	restriction if outside main extended source unit.

	* sem_ch10.adb (Analyze_With_Clause): Check No_Dependence restriction
	for parents of child units as well as the child unit itself.

2009-04-17  Bob Duff  <duff@adacore.com>

	* checks.ads: Minor comment fix

	* exp_aggr.ads: Minor comment fix

2009-04-17  Nicolas Roche  <roche@adacore.com>

	* adaint.c: Improve cross compiler detection and handling.

From-SVN: r146236
parent ffec8e81
2009-04-17 Thomas Quinot <quinot@adacore.com>
* exp_ch7.adb: Minor reformatting
2009-04-17 Robert Dewar <dewar@adacore.com>
* restrict.adb (Check_Restriction_No_Dependence): Don't check
restriction if outside main extended source unit.
* sem_ch10.adb (Analyze_With_Clause): Check No_Dependence restriction
for parents of child units as well as the child unit itself.
2009-04-17 Bob Duff <duff@adacore.com>
* checks.ads: Minor comment fix
* exp_aggr.ads: Minor comment fix
2009-04-17 Nicolas Roche <roche@adacore.com>
* adaint.c: Improve cross compiler detection and handling.
2009-04-17 Eric Botcazou <ebotcazou@adacore.com> 2009-04-17 Eric Botcazou <ebotcazou@adacore.com>
* exp_ch4.adb (Expand_Concatenation): Do not use calls at -Os. * exp_ch4.adb (Expand_Concatenation): Do not use calls at -Os.
...@@ -237,9 +237,11 @@ struct vstring ...@@ -237,9 +237,11 @@ struct vstring
#endif #endif
/* Check for cross-compilation */ /* Check for cross-compilation */
#ifdef CROSS_DIRECTORY_STRUCTURE #if defined (CROSS_COMPILE) || defined (CROSS_DIRECTORY_STRUCTURE)
#define IS_CROSS 1
int __gnat_is_cross_compiler = 1; int __gnat_is_cross_compiler = 1;
#else #else
#undef IS_CROSS
int __gnat_is_cross_compiler = 0; int __gnat_is_cross_compiler = 0;
#endif #endif
...@@ -664,7 +666,7 @@ __gnat_os_filename (char *filename, char *w_filename ATTRIBUTE_UNUSED, ...@@ -664,7 +666,7 @@ __gnat_os_filename (char *filename, char *w_filename ATTRIBUTE_UNUSED,
char *os_name, int *o_length, char *os_name, int *o_length,
char *encoding ATTRIBUTE_UNUSED, int *e_length) char *encoding ATTRIBUTE_UNUSED, int *e_length)
{ {
#if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE) #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
WS2SC (os_name, (TCHAR *)w_filename, o_length); WS2SC (os_name, (TCHAR *)w_filename, o_length);
*o_length = strlen (os_name); *o_length = strlen (os_name);
strcpy (encoding, "encoding=utf8"); strcpy (encoding, "encoding=utf8");
...@@ -681,7 +683,7 @@ __gnat_os_filename (char *filename, char *w_filename ATTRIBUTE_UNUSED, ...@@ -681,7 +683,7 @@ __gnat_os_filename (char *filename, char *w_filename ATTRIBUTE_UNUSED,
int int
__gnat_unlink (char *path) __gnat_unlink (char *path)
{ {
#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (CROSS_COMPILE) #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
{ {
TCHAR wpath[GNAT_MAX_PATH_LEN]; TCHAR wpath[GNAT_MAX_PATH_LEN];
...@@ -698,7 +700,7 @@ __gnat_unlink (char *path) ...@@ -698,7 +700,7 @@ __gnat_unlink (char *path)
int int
__gnat_rename (char *from, char *to) __gnat_rename (char *from, char *to)
{ {
#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (CROSS_COMPILE) #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
{ {
TCHAR wfrom[GNAT_MAX_PATH_LEN], wto[GNAT_MAX_PATH_LEN]; TCHAR wfrom[GNAT_MAX_PATH_LEN], wto[GNAT_MAX_PATH_LEN];
...@@ -716,7 +718,7 @@ __gnat_rename (char *from, char *to) ...@@ -716,7 +718,7 @@ __gnat_rename (char *from, char *to)
int int
__gnat_chdir (char *path) __gnat_chdir (char *path)
{ {
#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (CROSS_COMPILE) #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
{ {
TCHAR wpath[GNAT_MAX_PATH_LEN]; TCHAR wpath[GNAT_MAX_PATH_LEN];
...@@ -733,7 +735,7 @@ __gnat_chdir (char *path) ...@@ -733,7 +735,7 @@ __gnat_chdir (char *path)
int int
__gnat_rmdir (char *path) __gnat_rmdir (char *path)
{ {
#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (CROSS_COMPILE) #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
{ {
TCHAR wpath[GNAT_MAX_PATH_LEN]; TCHAR wpath[GNAT_MAX_PATH_LEN];
...@@ -748,7 +750,7 @@ __gnat_rmdir (char *path) ...@@ -748,7 +750,7 @@ __gnat_rmdir (char *path)
FILE * FILE *
__gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED) __gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED)
{ {
#if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE) #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
TCHAR wpath[GNAT_MAX_PATH_LEN]; TCHAR wpath[GNAT_MAX_PATH_LEN];
TCHAR wmode[10]; TCHAR wmode[10];
...@@ -772,7 +774,7 @@ __gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED) ...@@ -772,7 +774,7 @@ __gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED)
FILE * FILE *
__gnat_freopen (char *path, char *mode, FILE *stream, int encoding ATTRIBUTE_UNUSED) __gnat_freopen (char *path, char *mode, FILE *stream, int encoding ATTRIBUTE_UNUSED)
{ {
#if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE) #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
TCHAR wpath[GNAT_MAX_PATH_LEN]; TCHAR wpath[GNAT_MAX_PATH_LEN];
TCHAR wmode[10]; TCHAR wmode[10];
...@@ -1578,7 +1580,8 @@ __gnat_get_libraries_from_registry (void) ...@@ -1578,7 +1580,8 @@ __gnat_get_libraries_from_registry (void)
{ {
char *result = (char *) ""; char *result = (char *) "";
#if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE) && ! defined (RTX) #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS) \
&& ! defined (RTX)
HKEY reg_key; HKEY reg_key;
DWORD name_size, value_size; DWORD name_size, value_size;
...@@ -3178,7 +3181,7 @@ _flush_cache() ...@@ -3178,7 +3181,7 @@ _flush_cache()
} }
#endif #endif
#if defined (CROSS_DIRECTORY_STRUCTURE) \ #if defined (IS_CROSS) \
|| (! ((defined (sparc) || defined (i386)) && defined (sun) \ || (! ((defined (sparc) || defined (i386)) && defined (sun) \
&& defined (__SVR4)) \ && defined (__SVR4)) \
&& ! (defined (linux) && (defined (i386) || defined (__x86_64__))) \ && ! (defined (linux) && (defined (i386) || defined (__x86_64__))) \
......
...@@ -135,9 +135,9 @@ package Checks is ...@@ -135,9 +135,9 @@ package Checks is
Typ : Entity_Id; Typ : Entity_Id;
No_Sliding : Boolean := False); No_Sliding : Boolean := False);
-- Top-level procedure, calls all the others depending on the class of Typ. -- Top-level procedure, calls all the others depending on the class of Typ.
-- Checks that expression N verifies the constraint of type Typ. No_Sliding -- Checks that expression N satisfies the constraint of type Typ.
-- is only relevant for constrained array types, if set to True, it -- No_Sliding is only relevant for constrained array types, if set to True,
-- checks that indexes are in range. -- it checks that indexes are in range.
procedure Apply_Discriminant_Check procedure Apply_Discriminant_Check
(N : Node_Id; (N : Node_Id;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -45,7 +45,7 @@ package Exp_Aggr is ...@@ -45,7 +45,7 @@ package Exp_Aggr is
Aggr : Node_Id); Aggr : Node_Id);
-- Alloc is the allocator whose expression is the aggregate Aggr. -- Alloc is the allocator whose expression is the aggregate Aggr.
-- Decl is an N_Object_Declaration created during allocator expansion. -- Decl is an N_Object_Declaration created during allocator expansion.
-- This procedure perform in-place aggregate assignment into the -- This procedure performs in-place aggregate assignment into the
-- temporary declared in Decl, and the allocator becomes an access to -- temporary declared in Decl, and the allocator becomes an access to
-- that temporary. -- that temporary.
......
...@@ -1371,36 +1371,36 @@ package body Exp_Ch7 is ...@@ -1371,36 +1371,36 @@ package body Exp_Ch7 is
end if; end if;
-- Resolution is now finished, make sure we don't start analysis again -- Resolution is now finished, make sure we don't start analysis again
-- because of the duplication -- because of the duplication.
Set_Analyzed (N); Set_Analyzed (N);
Ref := Duplicate_Subexpr_No_Checks (N); Ref := Duplicate_Subexpr_No_Checks (N);
-- Now we can generate the Attach Call, note that this value is -- Now we can generate the Attach Call. Note that this value is always
-- always in the (secondary) stack and thus is attached to a singly -- on the (secondary) stack and thus is attached to a singly linked
-- linked final list: -- final list:
-- Resx := F (X)'reference; -- Resx := F (X)'reference;
-- Attach_To_Final_List (_Lx, Resx.all, 1); -- Attach_To_Final_List (_Lx, Resx.all, 1);
-- or when there are controlled components -- or when there are controlled components:
-- Attach_To_Final_List (_Lx, Resx._controller, 1); -- Attach_To_Final_List (_Lx, Resx._controller, 1);
-- or when it is both is_controlled and has_controlled_components -- or when it is both Is_Controlled and Has_Controlled_Components:
-- Attach_To_Final_List (_Lx, Resx._controller, 1); -- Attach_To_Final_List (_Lx, Resx._controller, 1);
-- Attach_To_Final_List (_Lx, Resx, 1); -- Attach_To_Final_List (_Lx, Resx, 1);
-- or if it is an array with is_controlled (and has_controlled) -- or if it is an array with Is_Controlled (and Has_Controlled)
-- Attach_To_Final_List (_Lx, Resx (Resx'last), 3); -- Attach_To_Final_List (_Lx, Resx (Resx'last), 3);
-- An attach level of 3 means that a whole array is to be
-- attached to the finalization list (including the controlled
-- components)
-- or if it is an array with has_controlled components but not -- An attach level of 3 means that a whole array is to be attached to
-- is_controlled -- the finalization list (including the controlled components).
-- or if it is an array with Has_Controlled_Components but not
-- Is_Controlled:
-- Attach_To_Final_List (_Lx, Resx (Resx'last)._controller, 3); -- Attach_To_Final_List (_Lx, Resx (Resx'last)._controller, 3);
...@@ -1466,8 +1466,8 @@ package body Exp_Ch7 is ...@@ -1466,8 +1466,8 @@ package body Exp_Ch7 is
end if; end if;
end; end;
-- Here we know that 'Ref' has a controller so we may as well -- Here we know that 'Ref' has a controller so we may as well attach
-- attach it directly -- it directly.
Action := Action :=
Make_Attach_Call ( Make_Attach_Call (
...@@ -1485,12 +1485,12 @@ package body Exp_Ch7 is ...@@ -1485,12 +1485,12 @@ package body Exp_Ch7 is
With_Attach => Make_Integer_Literal (Loc, Attach_Level)); With_Attach => Make_Integer_Literal (Loc, Attach_Level));
end if; end if;
-- Here, we have a controlled type that does not seem to have -- Here, we have a controlled type that does not seem to have controlled
-- controlled components but it could be a class wide type whose -- components but it could be a class wide type whose further
-- further derivations have controlled components. So we don't know -- derivations have controlled components. So we don't know if the
-- if the object itself needs to be attached or if it has a record -- object itself needs to be attached or if it has a record controller.
-- controller. We need to call a runtime function (Deep_Tag_Attach) -- We need to call a runtime function (Deep_Tag_Attach) which knows what
-- which knows what to do thanks to the RC_Offset in the dispatch table. -- to do thanks to the RC_Offset in the dispatch table.
else else
Action := Action :=
......
...@@ -316,6 +316,15 @@ package body Restrict is ...@@ -316,6 +316,15 @@ package body Restrict is
DU : Node_Id; DU : Node_Id;
begin begin
-- Ignore call if node U is not in the main source unit. This avoids
-- cascaded errors, e.g. when Ada.Containers units with other units.
if not In_Extended_Main_Source_Unit (U) then
return;
end if;
-- Loop through entries in No_Dependence table to check each one in turn
for J in No_Dependence.First .. No_Dependence.Last loop for J in No_Dependence.First .. No_Dependence.Last loop
DU := No_Dependence.Table (J).Unit; DU := No_Dependence.Table (J).Unit;
......
...@@ -2405,6 +2405,8 @@ package body Sem_Ch10 is ...@@ -2405,6 +2405,8 @@ package body Sem_Ch10 is
Set_Entity_With_Style_Check (Name (N), E_Name); Set_Entity_With_Style_Check (Name (N), E_Name);
Generate_Reference (E_Name, Name (N), 'w', Set_Ref => False); Generate_Reference (E_Name, Name (N), 'w', Set_Ref => False);
-- Generate references and check No_Dependence restriction for parents
if Is_Child_Unit (E_Name) then if Is_Child_Unit (E_Name) then
Pref := Prefix (Name (N)); Pref := Prefix (Name (N));
Par_Name := Scope (E_Name); Par_Name := Scope (E_Name);
...@@ -2413,6 +2415,7 @@ package body Sem_Ch10 is ...@@ -2413,6 +2415,7 @@ package body Sem_Ch10 is
Set_Entity_With_Style_Check (Pref, Par_Name); Set_Entity_With_Style_Check (Pref, Par_Name);
Generate_Reference (Par_Name, Pref); Generate_Reference (Par_Name, Pref);
Check_Restriction_No_Dependence (Pref, N);
Pref := Prefix (Pref); Pref := Prefix (Pref);
-- If E_Name is the dummy entity for a nonexistent unit, its scope -- If E_Name is the dummy entity for a nonexistent unit, its scope
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment