+2016-07-07 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch6.adb (Expand_Internal_Init_Call): Subsidiary procedure
+ to Expand_Protected_ Subprogram_Call, to handle properly a
+ call to a protected function that provides the initialization
+ expression for a private component of the same protected type.
+ * sem_ch9.adb (Analyze_Protected_Definition): Layout must be
+ applied to itypes generated for a private operation of a protected
+ type that has a formal of an anonymous access to subprogram,
+ because these itypes have no freeze nodes and are frozen in place.
+ * sem_ch4.adb (Analyze_Selected_Component): If prefix is a
+ protected type and it is not a current instance, do not examine
+ the first private component of the type.
+
+2016-07-07 Arnaud Charlet <charlet@adacore.com>
+
+ * exp_imgv.adb, g-dynhta.adb, s-regexp.adb, s-fatgen.adb, s-poosiz.adb:
+ Minor removal of extra whitespace.
+ * einfo.ads: minor removal of repeated "as" in comment
+
+2016-07-07 Vadim Godunko <godunko@adacore.com>
+
+ * adaint.c: Complete previous change.
+
2016-07-07 Vadim Godunko <godunko@adacore.com>
* adainit.h, adainit.c (__gnat_is_read_accessible_file): New
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
- return !_access (wname, 4);
+ return !_waccess (wname, 4);
+
+#elif defined (__vxworks)
+ int fd;
+
+ if (fd = open (name, O_RDONLY, 0) < 0)
+ return 0;
+ close (fd);
+ return 1;
+
#else
return !access (name, R_OK);
#endif
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
- return !_access (wname, 2);
+ return !_waccess (wname, 2);
+
+#elif defined (__vxworks)
+ int fd;
+
+ if (fd = open (name, O_WRONLY, 0) < 0)
+ return 0;
+ close (fd);
+ return 1;
+
#else
return !access (name, W_OK);
#endif
void __gnat_killprocesstree (int pid, int sig_num)
{
#if defined(_WIN32)
- HANDLE hWnd;
PROCESSENTRY32 pe;
memset(&pe, 0, sizeof(PROCESSENTRY32));
while (bContinue)
{
- if (pe.th32ParentProcessID == (int)pid)
+ if (pe.th32ParentProcessID == (DWORD)pid)
__gnat_killprocesstree (pe.th32ProcessID, sig_num);
bContinue = Process32Next (hSnap, &pe);
-- The following list of access functions applies to all entities for
-- types and subtypes. References to this list appear subsequently as
- -- as "(plus type attributes)" for each appropriate Entity_Kind.
+ -- "(plus type attributes)" for each appropriate Entity_Kind.
-- Associated_Node_For_Itype (Node8)
-- Class_Wide_Type (Node9)
is
Rec : Node_Id;
+ procedure Expand_Internal_Init_Call;
+ -- A call to an operation of the type may occur in the initialization
+ -- of a private component. In that case the prefix of the call is an
+ -- entity name and the call is treated as internal even though it
+ -- appears in code outside of the protected type.
+
procedure Freeze_Called_Function;
-- If it is a function call it can appear in elaboration code and
-- the called entity must be frozen before the call. This must be
-- to something other than a call (e.g. a temporary initialized in a
-- transient block).
+ -------------------------------
+ -- Expand_Internal_Init_Call --
+ -------------------------------
+
+ procedure Expand_Internal_Init_Call is
+ begin
+ -- If the context is a protected object (rather than a protected
+ -- type) the call itself is bound to raise program_error because
+ -- the protected body will not have been elaborated yet. This is
+ -- diagnosed subsequently in Sem_Elab.
+
+ Freeze_Called_Function;
+
+ -- The target of the internal call is the first formal of the
+ -- enclosing initialization procedure.
+
+ Rec := New_Occurrence_Of (First_Formal (Current_Scope), Sloc (N));
+ Build_Protected_Subprogram_Call (N,
+ Name => Name (N),
+ Rec => Rec,
+ External => False);
+ Analyze (N);
+ Resolve (N, Etype (Subp));
+ end Expand_Internal_Init_Call;
+
----------------------------
-- Freeze_Called_Function --
----------------------------
-- case this must be handled as an inter-object call.
if not In_Open_Scopes (Scop)
- or else not Is_Entity_Name (Name (N))
+ or else (not Is_Entity_Name (Name (N)))
then
if Nkind (Name (N)) = N_Selected_Component then
Rec := Prefix (Name (N));
- else
- pragma Assert (Nkind (Name (N)) = N_Indexed_Component);
+ elsif Nkind (Name (N)) = N_Indexed_Component then
Rec := Prefix (Prefix (Name (N)));
+
+ else
+ -- If the context is the initialization procedure for a protected
+ -- type, the call is legal because the called entity must be a
+ -- function of that enclosing type, and this is treated as an
+ -- internal call.
+
+ pragma Assert (Is_Entity_Name (Name (N))
+ and then Inside_Init_Proc);
+ Expand_Internal_Init_Call;
+ return;
end if;
Freeze_Called_Function;
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2016, 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- --
if Ttyp = Standard_Integer_8 then
Func := RE_Value_Enumeration_8;
- elsif Ttyp = Standard_Integer_16 then
+ elsif Ttyp = Standard_Integer_16 then
Func := RE_Value_Enumeration_16;
else
Func := RE_Value_Enumeration_32;
when Normal =>
if Ttyp = Standard_Integer_8 then
XX := RE_Width_Enumeration_8;
- elsif Ttyp = Standard_Integer_16 then
+ elsif Ttyp = Standard_Integer_16 then
XX := RE_Width_Enumeration_16;
else
XX := RE_Width_Enumeration_32;
when Wide =>
if Ttyp = Standard_Integer_8 then
XX := RE_Wide_Width_Enumeration_8;
- elsif Ttyp = Standard_Integer_16 then
+ elsif Ttyp = Standard_Integer_16 then
XX := RE_Wide_Width_Enumeration_16;
else
XX := RE_Wide_Width_Enumeration_32;
when Wide_Wide =>
if Ttyp = Standard_Integer_8 then
XX := RE_Wide_Wide_Width_Enumeration_8;
- elsif Ttyp = Standard_Integer_16 then
+ elsif Ttyp = Standard_Integer_16 then
XX := RE_Wide_Wide_Width_Enumeration_16;
else
XX := RE_Wide_Wide_Width_Enumeration_32;
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2015, AdaCore --
+-- Copyright (C) 2002-2016, AdaCore --
-- --
-- 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- --
-- Get --
---------
- function Get (T : Instance; K : Key) return Elmt_Ptr is
- Elmt : Elmt_Ptr;
+ function Get (T : Instance; K : Key) return Elmt_Ptr is
+ Elmt : Elmt_Ptr;
begin
if T = null then
-- Get --
---------
- function Get (T : Instance; K : Key) return Element is
+ function Get (T : Instance; K : Key) return Element is
Tmp : Elmt_Ptr;
begin
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, 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- --
-- the sign of the exponent. The absolute value of Frac is in the range
-- 0.0 <= Frac < 1.0. If Frac = 0.0 or -0.0, then Expo is always zero.
- function Gradual_Scaling (Adjustment : UI) return T;
+ function Gradual_Scaling (Adjustment : UI) return T;
-- Like Scaling with a first argument of 1.0, but returns the smallest
-- denormal rather than zero when the adjustment is smaller than
-- Machine_Emin. Used for Succ and Pred.
Result := Truncation (abs X);
Tail := abs X - Result;
- if Tail >= 0.5 then
+ if Tail >= 0.5 then
Result := Result + 1.0;
end if;
Result := Truncation (abs X);
Tail := abs X - Result;
- if Tail >= 0.5 then
+ if Tail >= 0.5 then
Result := Result + 1.0;
end if;
Result := Truncation (Abs_X);
Tail := Abs_X - Result;
- if Tail > 0.5 then
+ if Tail > 0.5 then
Result := Result + 1.0;
elsif Tail = 0.5 then
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, 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- --
-- Initialize --
----------------
- procedure Initialize (Pool : in out Stack_Bounded_Pool) is
+ procedure Initialize (Pool : in out Stack_Bounded_Pool) is
-- Define the appropriate alignment for allocations. This is the
-- maximum of the requested alignment, and the alignment required
-- Storage_Size --
------------------
- function Storage_Size
+ function Storage_Size
(Pool : Stack_Bounded_Pool) return SSE.Storage_Count
is
begin
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2015, AdaCore --
+-- Copyright (C) 1999-2016, AdaCore --
-- --
-- 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- --
("Incorrect character ']' in regular expression", J);
when '\' =>
- if J < S'Last then
+ if J < S'Last then
J := J + 1;
Add_In_Map (S (J));
In_Scope := In_Open_Scopes (Prefix_Type);
while Present (Comp) loop
+ -- Do not examine private operations of the type if not within
+ -- its scope.
+
if Chars (Comp) = Chars (Sel) then
- if Is_Overloadable (Comp) then
+ if Is_Overloadable (Comp)
+ and then (In_Scope
+ or else Comp /= First_Private_Entity (Type_To_Use))
+ then
Add_One_Interp (Sel, Comp, Etype (Comp));
-- If the prefix is tagged, the correct interpretation may
-- composite types with inner components, we traverse recursively
-- the private components of the protected type, and indicate that
-- all itypes within are frozen. This ensures that no freeze nodes
- -- will be generated for them.
+ -- will be generated for them. In the case of itypes that are access
+ -- types we need to complete their representation by calling layout,
+ -- which would otherwise be invoked when freezing a type.
--
-- On the other hand, components of the corresponding record are
-- frozen (or receive itype references) as for other records.
Set_Has_Delayed_Freeze (Comp, False);
Set_Is_Frozen (Comp);
+ if Is_Access_Type (Comp) then
+ Layout_Type (Comp);
+ end if;
+
if Is_Record_Type (Comp)
or else Is_Protected_Type (Comp)
then
projects / gcc.git / commitdiff