OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2015-02-20  Yannick Moy  <moy@adacore.com>

	* sem_prag.ads: Minor typo in comment.

2015-02-20  Pascal Obry  <obry@adacore.com>

	* s-osprim-mingw.adb: Fix Get_Base_Time parameter mode.

2015-02-20  Vincent Celier  <celier@adacore.com>

	* makeutl.adb (Get_Directories.Add_Dir): Add a directory only
	if it exists.

2015-02-20  Robert Dewar  <dewar@adacore.com>

	* sem_eval.ads: Minor reformatting.

2015-02-20  Eric Botcazou  <ebotcazou@adacore.com>

	* freeze.adb (Size_Known): Do not set the packed size for
	independent type or component.
	(Freeze_Array_Type): Check for Independent[_Components] with packing
	or explicit component size clause.
	* gnat1drv.adb (Post_Compilation_Validation_Checks): Do the validation
	of independence pragmas only for non-GCC back-ends.
	* sem_ch13.adb (Initialize): Likewise for the initialization.
	* sem_prag.adb (Record_Independence_Check): New procedure to record an
	independence check in the table.
	(Analyze_Pragma): Use it throughout instead of doing it manually.
	* gcc-interface/decl.c (gnat_to_gnu_field): Add support for
	independent type or component.

2015-02-20  Thomas Quinot  <quinot@adacore.com>

	* adaint.c (__gnat_readdir): For Solaris, use 64 bit variants of
	struct direct and readdir. This is required for NFS filesystems
	mounted from servers that use 64-bit cookies.

2015-02-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Analyze_Subprogram_Instantiaion): New subprogram
	Build_Subprogram_Renaming, to create renaming of subprogram
	instance in the the declaration of the wrapper package rather
	than in its body, so that it is available for analysis of aspects
	propagated from generic to instantiation.
	(Check_Mismatch): An actual for a formal package that is an
	incomplete type matches a formal type that is incomplete.
	(Instantiate_Package_Body): Move code that builds subprogram
	renaming to Analyze_Subprogram_Instantiation.
	(Instantiate_Type): The generated subtype is a limited view if
	the actual is a limited view.
	(Load_Parent_Of_Generic): Retrieve instance declaration from
	its new position within wrapper package.

2015-02-20  Arnaud Charlet  <charlet@adacore.com>

	* s-parame-vxworks.adb, s-os_lib.ads: Update comments.

2015-02-20  Robert Dewar  <dewar@adacore.com>

	* s-osinte-vxworks.ads (To_Timespec): Add comment about the
	issue of negative arguments.

From-SVN: r220850
This commit is contained in:
Arnaud Charlet 2015-02-20 12:38:17 +01:00
parent 6b9861b12d
commit 07aff4e355
15 changed files with 313 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
gcc/ada/ChangeLog
View File

@ -1,3 +1,66 @@
2015-02-20 Yannick Moy <moy@adacore.com>
* sem_prag.ads: Minor typo in comment.
2015-02-20 Pascal Obry <obry@adacore.com>
* s-osprim-mingw.adb: Fix Get_Base_Time parameter mode.
2015-02-20 Vincent Celier <celier@adacore.com>
* makeutl.adb (Get_Directories.Add_Dir): Add a directory only
if it exists.
2015-02-20 Robert Dewar <dewar@adacore.com>
* sem_eval.ads: Minor reformatting.
2015-02-20 Eric Botcazou <ebotcazou@adacore.com>
* freeze.adb (Size_Known): Do not set the packed size for
independent type or component.
(Freeze_Array_Type): Check for Independent[_Components] with packing
or explicit component size clause.
* gnat1drv.adb (Post_Compilation_Validation_Checks): Do the validation
of independence pragmas only for non-GCC back-ends.
* sem_ch13.adb (Initialize): Likewise for the initialization.
* sem_prag.adb (Record_Independence_Check): New procedure to record an
independence check in the table.
(Analyze_Pragma): Use it throughout instead of doing it manually.
* gcc-interface/decl.c (gnat_to_gnu_field): Add support for
independent type or component.
2015-02-20 Thomas Quinot <quinot@adacore.com>
* adaint.c (__gnat_readdir): For Solaris, use 64 bit variants of
struct direct and readdir. This is required for NFS filesystems
mounted from servers that use 64-bit cookies.
2015-02-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Analyze_Subprogram_Instantiaion): New subprogram
Build_Subprogram_Renaming, to create renaming of subprogram
instance in the the declaration of the wrapper package rather
than in its body, so that it is available for analysis of aspects
propagated from generic to instantiation.
(Check_Mismatch): An actual for a formal package that is an
incomplete type matches a formal type that is incomplete.
(Instantiate_Package_Body): Move code that builds subprogram
renaming to Analyze_Subprogram_Instantiation.
(Instantiate_Type): The generated subtype is a limited view if
the actual is a limited view.
(Load_Parent_Of_Generic): Retrieve instance declaration from
its new position within wrapper package.
2015-02-20 Arnaud Charlet <charlet@adacore.com>
* s-parame-vxworks.adb, s-os_lib.ads: Update comments.
2015-02-20 Robert Dewar <dewar@adacore.com>
* s-osinte-vxworks.ads (To_Timespec): Add comment about the
issue of negative arguments.
2015-02-20 Eric Botcazou <ebotcazou@adacore.com>
* gnat1drv.adb: Minor consistency fix.

12
gcc/ada/adaint.c
View File

@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 1992-2014, Free Software Foundation, Inc. *
* Copyright (C) 1992-2015, 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- *
@ -297,7 +297,8 @@ int max_path_len = GNAT_MAX_PATH_LEN;
int __gnat_use_acl = 1;
/* The following macro HAVE_READDIR_R should be defined if the
system provides the routine readdir_r. */
system provides the routine readdir_r.
... but we never define it anywhere??? */
#undef HAVE_READDIR_R
#define MAYBE_TO_PTR32(argv) argv
@ -1223,6 +1224,13 @@ DIR* __gnat_opendir (char *name)
/* Read the next entry in a directory. The returned string points somewhere
in the buffer. */
#if defined (sun) && defined (__SVR4)
/* For Solaris, be sure to use the 64-bit version, otherwise NFS reads may
fail with EOVERFLOW if the server uses 64-bit cookies. */
#define dirent dirent64
#define readdir readdir64
#endif
char *
__gnat_readdir (DIR *dirp, char *buffer, int *len)
{

67
gcc/ada/freeze.adb
View File

@ -944,12 +944,15 @@ package body Freeze is
Packed_Size_Known := False;
end if;
-- We do not know the packed size if we have a by reference
-- type, or an atomic type or an atomic component, or an
-- aliased component (because packing does not touch these).
-- We do not know the packed size if we have an atomic type
-- or component, or an independent type or component, or a
-- by reference type or aliased component (because packing
-- does not touch these).
if Is_Atomic (Ctyp)
or else Is_Atomic (Comp)
or else Is_Independent (Ctyp)
or else Is_Independent (Comp)
or else Is_By_Reference_Type (Ctyp)
or else Is_Aliased (Comp)
then
@ -2500,6 +2503,64 @@ package body Freeze is
end Alias_Atomic_Check;
end if;
-- Check for Independent_Components/Independent with unsuitable
-- packing or explicit component size clause given.
if (Has_Independent_Components (Arr) or else Is_Independent (Ctyp))
and then
(Has_Component_Size_Clause (Arr) or else Is_Packed (Arr))
then
begin
-- If object size of component type isn't known, we cannot
-- be sure so we defer to the back end.
if not Known_Static_Esize (Ctyp) then
null;
-- Case where component size has no effect. First check for
-- object size of component type multiple of the storage
-- unit size.
elsif Esize (Ctyp) mod System_Storage_Unit = 0
-- OK in both packing case and component size case if RM
-- size is known and multiple of the storage unit size.
and then
((Known_Static_RM_Size (Ctyp)
and then RM_Size (Ctyp) mod System_Storage_Unit = 0)
-- Or if we have an explicit component size clause and
-- the component size is larger than the object size.
or else
(Has_Component_Size_Clause (Arr)
and then Component_Size (Arr) >= Esize (Ctyp)))
then
null;
else
if Has_Component_Size_Clause (Arr) then
Clause :=
Get_Attribute_Definition_Clause
(FS, Attribute_Component_Size);
Error_Msg_N
("incorrect component size for "
& "independent components", Clause);
Error_Msg_Uint_1 := Esize (Ctyp);
Error_Msg_N
("\minimum allowed is^", Clause);
else
Error_Msg_N
("cannot pack independent components",
Get_Rep_Pragma (FS, Name_Pack));
end if;
end if;
end;
end if;
-- Warn for case of atomic type
Clause := Get_Rep_Pragma (FS, Name_Atomic);

30
gcc/ada/gcc-interface/decl.c
View File

@ -6427,17 +6427,22 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
bool definition, bool debug_info_p)
{
const Entity_Id gnat_field_type = Etype (gnat_field);
const bool is_aliased
= Is_Aliased (gnat_field);
const bool is_atomic
= (Is_Atomic (gnat_field) || Is_Atomic (gnat_field_type));
const bool is_independent
= (Is_Independent (gnat_field) || Is_Independent (gnat_field_type));
const bool is_volatile
= (Treat_As_Volatile (gnat_field) || Treat_As_Volatile (gnat_field_type));
const bool needs_strict_alignment
= (is_aliased
|| is_independent
|| is_volatile
|| Strict_Alignment (gnat_field_type));
tree gnu_field_type = gnat_to_gnu_type (gnat_field_type);
tree gnu_field_id = get_entity_name (gnat_field);
tree gnu_field, gnu_size, gnu_pos;
bool is_aliased
= Is_Aliased (gnat_field);
bool is_atomic
= (Is_Atomic (gnat_field) || Is_Atomic (gnat_field_type));
bool is_volatile
= (Treat_As_Volatile (gnat_field) || Treat_As_Volatile (gnat_field_type));
bool needs_strict_alignment
= (is_aliased || is_volatile || Strict_Alignment (gnat_field_type));
/* If this field requires strict alignment, we cannot pack it because
it would very likely be under-aligned in the record. */
@ -6555,6 +6560,8 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
s = "position of atomic field& must be multiple of ^ bits";
else if (is_aliased)
s = "position of aliased field& must be multiple of ^ bits";
else if (is_independent)
s = "position of independent field& must be multiple of ^ bits";
else if (is_volatile)
s = "position of volatile field& must be multiple of ^ bits";
else if (Strict_Alignment (gnat_field_type))
@ -6583,6 +6590,8 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
s = "size of atomic field& must be ^ bits";
else if (is_aliased)
s = "size of aliased field& must be ^ bits";
else if (is_independent)
s = "size of independent field& must be at least ^ bits";
else if (is_volatile)
s = "size of volatile field& must be at least ^ bits";
else if (Strict_Alignment (gnat_field_type))
@ -6602,7 +6611,10 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
{
const char *s;
if (is_volatile)
if (is_independent)
s = "size of independent field& must be multiple of"
" Storage_Unit";
else if (is_volatile)
s = "size of volatile field& must be multiple of"
" Storage_Unit";
else if (Strict_Alignment (gnat_field_type))

10
gcc/ada/gnat1drv.adb
View File

@ -833,10 +833,14 @@ procedure Gnat1drv is
Sem_Ch13.Validate_Address_Clauses;
-- Validate independence pragmas (again using values annotated by
-- the back end for component layout etc.)
-- Validate independence pragmas (again using values annotated by the
-- back end for component layout where possible) but only for non-GCC
-- back ends, as this is done a priori for GCC back ends.
if VM_Target /= No_VM or else AAMP_On_Target then
Sem_Ch13.Validate_Independence;
end if;
Sem_Ch13.Validate_Independence;
end Post_Compilation_Validation_Checks;
-- Start of processing for Gnat1drv

6
gcc/ada/makeutl.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2014, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2015, 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- --
@ -897,7 +897,9 @@ package body Makeutl is
Add_It : Boolean := True;
begin
if Value /= No_Path then
if Value /= No_Path
and then Is_Directory (Get_Name_String (Value))
then
for Index in 1 .. Directories.Last loop
if Directories.Table (Index) = Value then
Add_It := False;

4
gcc/ada/s-os_lib.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2015, 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- --
@ -910,7 +910,7 @@ package System.OS_Lib is
-- On other Unix-like systems: fork, followed in the child
-- process by execv.
-- On vxworks, nucleus, and RTX, spawning of processes is not supported
-- On vxworks, spawning of processes is not supported
-- For details, look at the functions __gnat_portable_spawn and
-- __gnat_portable_no_block_spawn in adaint.c.

8
gcc/ada/s-osinte-vxworks.ads
View File

@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2015, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -252,6 +252,12 @@ package System.OS_Interface is
function To_Timespec (D : Duration) return timespec;
pragma Inline (To_Timespec);
-- Convert a Duration value to a timespec value. Note that in VxWorks,
-- timespec is always non-negative (since time_t is defined above as
-- unsigned long). This means that there is a potential problem if a
-- negative argument is passed for D. However, in actual usage, the
-- value of the input argument D is always non-negative, so no problem
-- arises in practice.
function To_Clock_Ticks (D : Duration) return int;
-- Convert a duration value (in seconds) into clock ticks

4
gcc/ada/s-osprim-mingw.adb
View File

@ -90,7 +90,7 @@ package body System.OS_Primitives is
Signature : Signature_Type := 0;
pragma Atomic (Signature);
procedure Get_Base_Time (Data : out Clock_Data);
procedure Get_Base_Time (Data : in out Clock_Data);
-- Retrieve the base time and base ticks. These values will be used by
-- clock to compute the current time by adding to it a fraction of the
-- performance counter. This is for the implementation of a high-resolution
@ -166,7 +166,7 @@ package body System.OS_Primitives is
-- Get_Base_Time --
-------------------
procedure Get_Base_Time (Data : out Clock_Data) is
procedure Get_Base_Time (Data : in out Clock_Data) is
-- The resolution for GetSystemTime is 1 millisecond

4
gcc/ada/s-parame-vxworks.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1995-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2015, 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- --
@ -29,7 +29,7 @@
-- --
------------------------------------------------------------------------------
-- Version used on all VxWorks, Nucleus, and RTX RTSS targets
-- Version used on all VxWorks targets
package body System.Parameters is

151
gcc/ada/sem_ch12.adb
View File

@ -4603,7 +4603,13 @@ package body Sem_Ch12 is
Gen_Decl : Node_Id;
Pack_Id : Entity_Id;
Parent_Installed : Boolean := False;
Renaming_List : List_Id;
Renaming_List : List_Id;
-- The list of declarations that link formals and actuals of the
-- instance. These are subtype declarations for formal types, and
-- renaming declarations for other formals. The subprogram declaration
-- for the instance is then appended to the list, and the last item on
-- the list is the renaming declaration for the instance.
procedure Analyze_Instance_And_Renamings;
-- The instance must be analyzed in a context that includes the mappings
@ -4612,6 +4618,14 @@ package body Sem_Ch12 is
-- package. The subprogram instance is simply an alias for the internal
-- subprogram, declared in the current scope.
procedure Build_Subprogram_Renaming;
-- If the subprogram is recursive, there are occurrences of the name of
-- the generic within the body, which must resolve to the current
-- instance. We add a renaming declaration after the declaration, which
-- is available in the instance body, as well as in the analysis of
-- aspects that appear in the generic. This renaming declaration is
-- inserted after the instance declaration which it renames.
------------------------------------
-- Analyze_Instance_And_Renamings --
------------------------------------
@ -4766,6 +4780,52 @@ package body Sem_Ch12 is
end if;
end Analyze_Instance_And_Renamings;
-------------------------------
-- Build_Subprogram_Renaming --
-------------------------------
procedure Build_Subprogram_Renaming is
Renaming_Decl : Node_Id;
Unit_Renaming : Node_Id;
begin
Unit_Renaming :=
Make_Subprogram_Renaming_Declaration (Loc,
Specification =>
Copy_Generic_Node
(Specification (Original_Node (Gen_Decl)),
Empty,
Instantiating => True),
Name => New_Occurrence_Of (Anon_Id, Loc));
-- The generic may be a a child unit. The renaming needs an
-- identifier with the proper name.
Set_Defining_Unit_Name (Specification (Unit_Renaming),
Make_Defining_Identifier (Loc, Chars (Gen_Unit)));
-- If there is a formal subprogram with the same name as the unit
-- itself, do not add this renaming declaration, to prevent
-- ambiguities when there is a call with that name in the body.
-- This is a partial and ugly fix for one ACATS test. ???
Renaming_Decl := First (Renaming_List);
while Present (Renaming_Decl) loop
if Nkind (Renaming_Decl) = N_Subprogram_Renaming_Declaration
and then
Chars (Defining_Entity (Renaming_Decl)) = Chars (Gen_Unit)
then
exit;
end if;
Next (Renaming_Decl);
end loop;
if No (Renaming_Decl) then
Append (Unit_Renaming, Renaming_List);
end if;
end Build_Subprogram_Renaming;
-- Local variables
Save_IPSM : constant Boolean := Ignore_Pragma_SPARK_Mode;
@ -4931,6 +4991,7 @@ package body Sem_Ch12 is
end if;
Append (Act_Decl, Renaming_List);
Build_Subprogram_Renaming;
Analyze_Instance_And_Renamings;
-- If the generic is marked Import (Intrinsic), then so is the
@ -5515,6 +5576,12 @@ package body Sem_Ch12 is
then
null;
-- Ada 2012: If both formal and actual are incomplete types they
-- are conformant.
elsif Is_Incomplete_Type (E1) and then Is_Incomplete_Type (E2) then
null;
elsif B then
Error_Msg_NE
("actual for & in actual instance does not match formal",
@ -10686,14 +10753,11 @@ package body Sem_Ch12 is
Defining_Unit_Name (Specification (Act_Decl));
Pack_Id : constant Entity_Id :=
Defining_Unit_Name (Parent (Act_Decl));
Decls : List_Id;
Gen_Body : Node_Id;
Gen_Body_Id : Node_Id;
Act_Body : Node_Id;
Pack_Body : Node_Id;
Prev_Formal : Entity_Id;
Ret_Expr : Node_Id;
Unit_Renaming : Node_Id;
Parent_Installed : Boolean := False;
@ -10823,47 +10887,14 @@ package body Sem_Ch12 is
Parent_Installed := True;
end if;
-- Inside its body, a reference to the generic unit is a reference
-- to the instance. The corresponding renaming is the first
-- declaration in the body.
-- Subprogram body is placed in the body of wrapper package,
-- whose spec contains the subprogram declaration as well as
-- the renaming declarations for the generic parameters.
Unit_Renaming :=
Make_Subprogram_Renaming_Declaration (Loc,
Specification =>
Copy_Generic_Node (
Specification (Original_Node (Gen_Body)),
Empty,
Instantiating => True),
Name => New_Occurrence_Of (Anon_Id, Loc));
-- If there is a formal subprogram with the same name as the unit
-- itself, do not add this renaming declaration. This is a temporary
-- fix for one ACATS test. ???
Prev_Formal := First_Entity (Pack_Id);
while Present (Prev_Formal) loop
if Chars (Prev_Formal) = Chars (Gen_Unit)
and then Is_Overloadable (Prev_Formal)
then
exit;
end if;
Next_Entity (Prev_Formal);
end loop;
if Present (Prev_Formal) then
Decls := New_List (Act_Body);
else
Decls := New_List (Unit_Renaming, Act_Body);
end if;
-- The subprogram body is placed in the body of a dummy package body,
-- whose spec contains the subprogram declaration as well as the
-- renaming declarations for the generic parameters.
Pack_Body := Make_Package_Body (Loc,
Defining_Unit_Name => New_Copy (Pack_Id),
Declarations => Decls);
Pack_Body :=
Make_Package_Body (Loc,
Defining_Unit_Name => New_Copy (Pack_Id),
Declarations => New_List (Act_Body));
Set_Corresponding_Spec (Pack_Body, Pack_Id);
@ -12297,6 +12328,14 @@ package body Sem_Ch12 is
Set_Has_Private_View (Subtype_Indication (Decl_Node));
end if;
-- In Ada 2012 the actual may be a limited view. Indicate that
-- the local subtype must be treated as such.
if From_Limited_With (Act_T) then
Set_Ekind (Subt, E_Incomplete_Subtype);
Set_From_Limited_With (Subt);
end if;
Decl_Nodes := New_List (Decl_Node);
-- Flag actual derived types so their elaboration produces the
@ -12666,14 +12705,24 @@ package body Sem_Ch12 is
-- Subprogram instance
else
-- The instance_spec is the wrapper package,
-- and the subprogram declaration is the last
-- declaration in the wrapper.
-- The instance_spec is in the wrapper package,
-- usually followed by its local renaming
-- declaration. See Build_Subprogram_Renaming
-- for details.
Info.Act_Decl :=
Last
(Visible_Declarations
(Specification (Info.Act_Decl)));
declare
Decl : Node_Id :=
(Last (Visible_Declarations
(Specification (Info.Act_Decl))));
begin
if Nkind (Decl) =
N_Subprogram_Renaming_Declaration
then
Decl := Prev (Decl);
end if;
Info.Act_Decl := Decl;
end;
Instantiate_Subprogram_Body
(Info, Body_Optional => True);

5
gcc/ada/sem_ch13.adb
View File

@ -11048,8 +11048,11 @@ package body Sem_Ch13 is
procedure Initialize is
begin
Address_Clause_Checks.Init;
Independence_Checks.Init;
Unchecked_Conversions.Init;
if VM_Target /= No_VM or else AAMP_On_Target then
Independence_Checks.Init;
end if;
end Initialize;
---------------------------

4
gcc/ada/sem_eval.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
@ -248,7 +248,7 @@ package Sem_Eval is
-- Determines whether a subtype fits the definition of an Ada static
-- subtype as given in (RM 4.9(26)) with the additional check that neither
-- bound raises constraint error (meaning that Expr_Value[_R|S] can be used
-- on these bounds. Important note: This check does not include the Ada
-- on these bounds). Important note: This check does not include the Ada
-- 2012 case of a non-static predicate which results in an otherwise static
-- subtype being non-static. Such a subtype will return True for this test,
-- so if the distinction is important, the caller must deal with this.

27
gcc/ada/sem_prag.adb
View File

@ -3216,6 +3216,10 @@ package body Sem_Prag is
-- Suppress_Case is True for the Suppress case, and False for the
-- Unsuppress case.
procedure Record_Independence_Check (N : Node_Id; E : Entity_Id);
-- Subsidiary to the analysis of pragmas Independent[_Components].
-- Record such a pragma N applied to entity E for future checks.
procedure Set_Exported (E : Entity_Id; Arg : Node_Id);
-- This procedure sets the Is_Exported flag for the given entity,
-- checking that the entity was not previously imported. Arg is
@ -6232,7 +6236,7 @@ package body Sem_Prag is
Set_Is_Independent (Base_Type (E));
if Prag_Id = Pragma_Independent then
Independence_Checks.Append ((N, Base_Type (E)));
Record_Independence_Check (N, Base_Type (E));
end if;
end if;
@ -6307,7 +6311,7 @@ package body Sem_Prag is
Set_Is_Independent (E);
if Prag_Id = Pragma_Independent then
Independence_Checks.Append ((N, E));
Record_Independence_Check (N, E);
end if;
end if;
@ -9194,6 +9198,21 @@ package body Sem_Prag is
end if;
end Process_Suppress_Unsuppress;
-------------------------------
-- Record_Independence_Check --
-------------------------------
procedure Record_Independence_Check (N : Node_Id; E : Entity_Id) is
begin
-- For GCC back ends the validation is done a priori
if VM_Target = No_VM and then not AAMP_On_Target then
return;
end if;
Independence_Checks.Append ((N, E));
end Record_Independence_Check;
------------------
-- Set_Exported --
------------------
@ -14995,7 +15014,7 @@ package body Sem_Prag is
and then (Is_Array_Type (E) or else Is_Record_Type (E))
then
Set_Has_Independent_Components (Base_Type (E));
Independence_Checks.Append ((N, Base_Type (E)));
Record_Independence_Check (N, Base_Type (E));
-- For record type, set all components independent
@ -15013,7 +15032,7 @@ package body Sem_Prag is
N_Constrained_Array_Definition
then
Set_Has_Independent_Components (E);
Independence_Checks.Append ((N, E));
Record_Independence_Check (N, E);
else
Error_Pragma_Arg ("inappropriate entity for pragma%", Arg1);

4
gcc/ada/sem_prag.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
@ -244,7 +244,7 @@ package Sem_Prag is
-- Returns True if Nam is one of the names recognized as a valid assertion
-- kind by the Assertion_Policy pragma. Note that the 'Class cases are
-- represented by the corresponding special names Name_uPre, Name_uPost,
-- Name_uInviarnat, and Name_uType_Invariant (_Pre, _Post, _Invariant,
-- Name_uInvariant, and Name_uType_Invariant (_Pre, _Post, _Invariant,
-- and _Type_Invariant).
procedure Make_Aspect_For_PPC_In_Gen_Sub_Decl (Decl : Node_Id);