+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
-- 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 / gcc.git / commitdiff