+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>
* exp_ch4.adb (Expand_Concatenation): Do not use calls at -Os.
#endif
/* 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;
#else
+#undef IS_CROSS
int __gnat_is_cross_compiler = 0;
#endif
char *os_name, int *o_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);
*o_length = strlen (os_name);
strcpy (encoding, "encoding=utf8");
int
__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];
int
__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];
int
__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];
int
__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];
FILE *
__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 wmode[10];
FILE *
__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 wmode[10];
{
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;
DWORD name_size, value_size;
}
#endif
-#if defined (CROSS_DIRECTORY_STRUCTURE) \
+#if defined (IS_CROSS) \
|| (! ((defined (sparc) || defined (i386)) && defined (sun) \
&& defined (__SVR4)) \
&& ! (defined (linux) && (defined (i386) || defined (__x86_64__))) \
Typ : Entity_Id;
No_Sliding : Boolean := False);
-- 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
- -- is only relevant for constrained array types, if set to True, it
- -- checks that indexes are in range.
+ -- Checks that expression N satisfies the constraint of type Typ.
+ -- No_Sliding is only relevant for constrained array types, if set to True,
+ -- it checks that indexes are in range.
procedure Apply_Discriminant_Check
(N : Node_Id;
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
Aggr : Node_Id);
-- Alloc is the allocator whose expression is the aggregate Aggr.
-- 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
-- that temporary.
end if;
-- Resolution is now finished, make sure we don't start analysis again
- -- because of the duplication
+ -- because of the duplication.
Set_Analyzed (N);
Ref := Duplicate_Subexpr_No_Checks (N);
- -- Now we can generate the Attach Call, note that this value is
- -- always in the (secondary) stack and thus is attached to a singly
- -- linked final list:
+ -- Now we can generate the Attach Call. Note that this value is always
+ -- on the (secondary) stack and thus is attached to a singly linked
+ -- final list:
-- Resx := F (X)'reference;
-- 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);
- -- 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, 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);
- -- 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
- -- is_controlled
+ -- 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
+ -- Is_Controlled:
-- Attach_To_Final_List (_Lx, Resx (Resx'last)._controller, 3);
end if;
end;
- -- Here we know that 'Ref' has a controller so we may as well
- -- attach it directly
+ -- Here we know that 'Ref' has a controller so we may as well attach
+ -- it directly.
Action :=
Make_Attach_Call (
With_Attach => Make_Integer_Literal (Loc, Attach_Level));
end if;
- -- Here, we have a controlled type that does not seem to have
- -- controlled components but it could be a class wide type whose
- -- further derivations have controlled components. So we don't know
- -- if the object itself needs to be attached or if it has a record
- -- controller. We need to call a runtime function (Deep_Tag_Attach)
- -- which knows what to do thanks to the RC_Offset in the dispatch table.
+ -- Here, we have a controlled type that does not seem to have controlled
+ -- components but it could be a class wide type whose further
+ -- derivations have controlled components. So we don't know if the
+ -- object itself needs to be attached or if it has a record controller.
+ -- We need to call a runtime function (Deep_Tag_Attach) which knows what
+ -- to do thanks to the RC_Offset in the dispatch table.
else
Action :=
DU : Node_Id;
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
DU := No_Dependence.Table (J).Unit;
Set_Entity_With_Style_Check (Name (N), E_Name);
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
Pref := Prefix (Name (N));
Par_Name := Scope (E_Name);
Set_Entity_With_Style_Check (Pref, Par_Name);
Generate_Reference (Par_Name, Pref);
+ Check_Restriction_No_Dependence (Pref, N);
Pref := Prefix (Pref);
-- If E_Name is the dummy entity for a nonexistent unit, its scope