+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.
* *
* 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- *
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
\f
#define MAYBE_TO_PTR32(argv) argv
/* 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)
{
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
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);
bool definition, bool debug_info_p)
{
const Entity_Id gnat_field_type = Etype (gnat_field);
- 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
+ const bool is_aliased
= Is_Aliased (gnat_field);
- bool is_atomic
+ const bool is_atomic
= (Is_Atomic (gnat_field) || Is_Atomic (gnat_field_type));
- bool is_volatile
+ 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));
- bool needs_strict_alignment
- = (is_aliased || is_volatile || Strict_Alignment (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;
/* If this field requires strict alignment, we cannot pack it because
it would very likely be under-aligned in the record. */
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))
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))
{
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))
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
-- --
-- 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- --
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;
-- --
-- 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- --
-- 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.
-- 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- --
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
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
-- 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
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- Version used on all VxWorks, Nucleus, and RTX RTSS targets
+-- Version used on all VxWorks targets
package body System.Parameters 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
-- 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 --
------------------------------------
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;
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
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",
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;
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.
-
- 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.
+ -- 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.
- 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);
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
-- Subprogram instance
else
- -- The instance_spec is the wrapper package,
- -- and the subprogram declaration is the last
- -- declaration in the wrapper.
-
- Info.Act_Decl :=
- Last
- (Visible_Declarations
- (Specification (Info.Act_Decl)));
+ -- The instance_spec is in the wrapper package,
+ -- usually followed by its local renaming
+ -- declaration. See Build_Subprogram_Renaming
+ -- for details.
+
+ 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);
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;
---------------------------
-- --
-- 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- --
-- 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.
-- 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
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;
Set_Is_Independent (E);
if Prag_Id = Pragma_Independent then
- Independence_Checks.Append ((N, E));
+ Record_Independence_Check (N, E);
end if;
end if;
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 --
------------------
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
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);
-- --
-- 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- --
-- 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);