* einfo.ads: Minor typo fix.
* sem_ch13.adb (Build_Predicate_Functions): Reject cases where
Static_Predicate is applied to a non-scalar or non-static type.
* sem_prag.adb: Minor typo fix.
2013-04-23 Doug Rupp <rupp@adacore.com>
* init.c (GNAT$STOP) [VMS]: New function.
2013-04-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb: Add exp_pakd to context.
(Constrain_Component_Type): If the component of the parent is
packed, and the record subtype being built is already frozen,
as is the case for an itype, the component type itself will not
be frozen, and the packed array type for it must be constructed
explicitly.
2013-04-23 Thomas Quinot <quinot@adacore.com>
* g-socket.adb, g-socket.ads (Set_Close_On_Exec): New subprogram.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@198196
138bc75d-0d04-0410-961f-
82ee72b054a4
2013-04-23 Yannick Moy <moy@adacore.com>
+ * einfo.ads: Minor typo fix.
+ * sem_ch13.adb (Build_Predicate_Functions): Reject cases where
+ Static_Predicate is applied to a non-scalar or non-static type.
+ * sem_prag.adb: Minor typo fix.
+
+2013-04-23 Doug Rupp <rupp@adacore.com>
+
+ * init.c (GNAT$STOP) [VMS]: New function.
+
+2013-04-23 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch3.adb: Add exp_pakd to context.
+ (Constrain_Component_Type): If the component of the parent is
+ packed, and the record subtype being built is already frozen,
+ as is the case for an itype, the component type itself will not
+ be frozen, and the packed array type for it must be constructed
+ explicitly.
+
+2013-04-23 Thomas Quinot <quinot@adacore.com>
+
+ * g-socket.adb, g-socket.ads (Set_Close_On_Exec): New subprogram.
+
+2013-04-23 Yannick Moy <moy@adacore.com>
+
* err_vars.ads (Error_Msg_Qual_Level): Set variable to zero
at declaration.
* opt.ads (Multiple_Unit_Index): Set variable to zero at declaration.
-- entirely synthesized, by looking at the bounds, and the immediate
-- subtype parent. However, this method does not work for some Itypes
-- that have no parent set (and the only way to find the immediate
--- subtype parent is to go through the tree). For now, this flay is set
+-- subtype parent is to go through the tree). For now, this flag is set
-- conservatively, i.e. if it is set then for sure the subtype is non-
-- static, but if it is not set, then the type may or may not be static.
-- Thus the test for a static subtype is that this flag is clear AND that
Insert_Socket_In_Set (Item.Set'Access, C.int (Socket));
end Set;
+ -----------------------
+ -- Set_Close_On_Exec --
+ -----------------------
+
+ procedure Set_Close_On_Exec
+ (Socket : Socket_Type;
+ Close_On_Exec : Boolean;
+ Status : out Boolean)
+ is
+ function C_Set_Close_On_Exec
+ (Socket : Socket_Type; Close_On_Exec : C.int)
+ return C.int;
+ pragma Import (C, C_Set_Close_On_Exec, "__gnat_set_close_on_exec");
+
+ begin
+ Status := C_Set_Close_On_Exec (Socket, Boolean'Pos (Close_On_Exec)) = 0;
+ end Set_Close_On_Exec;
+
----------------------
-- Set_Forced_Flags --
----------------------
-- socket. Count is set to the count of transmitted stream elements. Flags
-- allow control over transmission.
+ procedure Set_Close_On_Exec
+ (Socket : Socket_Type;
+ Close_On_Exec : Boolean;
+ Status : out Boolean);
+ -- When Close_On_Exec is True, mark Socket to be closed automatically when
+ -- a new program is executed by the calling process (i.e. prevent Socket
+ -- from being inherited by child processes). When Close_On_Exec is False,
+ -- mark Socket to not be closed on exec (i.e. allow it to be inherited).
+ -- Status is False if the operation could not be performed, or is not
+ -- supported on the target platform.
+
procedure Set_Socket_Option
(Socket : Socket_Type;
Level : Level_Type := Socket_Level;
Raise_From_Signal_Handler (exception, msg);
}
+#if defined (IN_RTS) && defined (__IA64)
+/* Called only from adasigio.b32. This is a band aid to avoid going
+ through the VMS signal handling code which results in a 0x8000 per
+ handled exception memory leak in P2 space (see VMS source listing
+ sys/lis/exception.lis) due to the allocation of working space that
+ is expected to be deallocated upon return from the condition handler,
+ which doesn't return in GNAT compiled code. */
+void
+GNAT$STOP (int *sigargs)
+{
+ /* Note that there are no mechargs. We rely on the fact that condtions
+ raised from DEClib I/O do not require an "adjust". */
+ __gnat_handle_vms_condition (sigargs, 0);
+}
+#endif
+
void
__gnat_install_handler (void)
{
-- Perform analysis of the External_Name or Link_Name aspects
procedure Analyze_Aspect_Implicit_Dereference;
- -- Perform analysis of the Implicit_Dereference aspects
+ -- Perform analysis of the Implicit_Dereference aspects
procedure Make_Aitem_Pragma
(Pragma_Argument_Associations : List_Id;
Pragma_Argument_Associations,
Pragma_Identifier =>
Make_Identifier (Sloc (Id), Pragma_Name),
- Class_Present => Class_Present (Aspect),
- Split_PPC => Split_PPC (Aspect));
+ Class_Present => Class_Present (Aspect),
+ Split_PPC => Split_PPC (Aspect));
-- Set additional semantic fields
-- Build_Predicate_Functions --
-------------------------------
- -- The procedures that are constructed here has the form:
+ -- The procedures that are constructed here have the form:
-- function typPredicate (Ixxx : typ) return Boolean is
-- begin
-- use this function even if checks are off, e.g. for membership tests.
-- If the expression has at least one Raise_Expression, then we also build
- -- the typPredicateM version of the function, in which any occurence of a
- -- Raise_Expressioon is converted to "return False".
+ -- the typPredicateM version of the function, in which any occurrence of a
+ -- Raise_Expression is converted to "return False".
procedure Build_Predicate_Functions (Typ : Entity_Id; N : Node_Id) is
Loc : constant Source_Ptr := Sloc (Typ);
-- Deal with static predicate case
- if Ekind_In (Typ, E_Enumeration_Subtype,
- E_Modular_Integer_Subtype,
- E_Signed_Integer_Subtype)
+ -- ??? We don't currently deal with real types
+ -- ??? Why requiring that Typ is static?
+
+ if Ekind (Typ) in Discrete_Kind
and then Is_Static_Subtype (Typ)
and then not Dynamic_Predicate_Present
then
- Build_Static_Predicate (Typ, Expr, Object_Name);
+ -- Only build the predicate for subtypes
- if Present (Static_Predicate_Present)
- and No (Static_Predicate (Typ))
+ if Ekind_In (Typ, E_Enumeration_Subtype,
+ E_Modular_Integer_Subtype,
+ E_Signed_Integer_Subtype)
then
- Error_Msg_F
- ("expression does not have required form for "
- & "static predicate",
- Next (First (Pragma_Argument_Associations
- (Static_Predicate_Present))));
+ Build_Static_Predicate (Typ, Expr, Object_Name);
+
+ if Present (Static_Predicate_Present)
+ and No (Static_Predicate (Typ))
+ then
+ Error_Msg_F
+ ("expression does not have required form for "
+ & "static predicate",
+ Next (First (Pragma_Argument_Associations
+ (Static_Predicate_Present))));
+ end if;
+ end if;
+
+ -- If a Static_Predicate applies on other types, that's an error:
+ -- either the type is scalar but non-static, or it's not even a
+ -- scalar type. We do not issue an error on generated types, as these
+ -- would be duplicates of the same error on a source type.
+
+ elsif Present (Static_Predicate_Present)
+ and then Comes_From_Source (Typ)
+ then
+ if Is_Scalar_Type (Typ) then
+ Error_Msg_FE
+ ("static predicate not allowed for non-static type&",
+ Typ, Typ);
+ else
+ Error_Msg_FE
+ ("static predicate not allowed for non-scalar type&",
+ Typ, Typ);
end if;
end if;
end if;
with Exp_Ch9; use Exp_Ch9;
with Exp_Disp; use Exp_Disp;
with Exp_Dist; use Exp_Dist;
+with Exp_Pakd; use Exp_Pakd;
with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
with Fname; use Fname;
is
Loc : constant Source_Ptr := Sloc (Constrained_Typ);
Compon_Type : constant Entity_Id := Etype (Comp);
+ Array_Comp : Node_Id;
function Build_Constrained_Array_Type
(Old_Type : Entity_Id) return Entity_Id;
return Compon_Type;
elsif Is_Array_Type (Compon_Type) then
- return Build_Constrained_Array_Type (Compon_Type);
+ Array_Comp := Build_Constrained_Array_Type (Compon_Type);
+
+ -- If the component of the parent is packed, and the record type is
+ -- already frozen, as is the case for an itype, the component type
+ -- itself will not be frozen, and the packed array type for it must
+ -- be constructed explicitly.
+
+ if Is_Packed (Compon_Type)
+ and then Is_Frozen (Current_Scope)
+ then
+ Create_Packed_Array_Type (Array_Comp);
+ end if;
+ return Array_Comp;
elsif Has_Discriminants (Compon_Type) then
return Build_Constrained_Discriminated_Type (Compon_Type);
-- Set Check_On to indicate check status
-- If this comes from an aspect, we have already taken care of
- -- the policy active when the aspect was analyzed, and Is_Ignore
- -- is set appriately already.
+ -- the policy active when the aspect was analyzed, and Is_Ignored
+ -- is set appropriately already.
if From_Aspect_Specification (N) then
Check_On := not Is_Ignored (N);
projects / platform / upstream / linaro-gcc.git / commitdiff