aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2016-07-07 15:20:30 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2016-07-07 15:20:30 +0200
commit86ec3bfb9fc3729d1e17d750e2d76be03f4f7110 (patch)
tree5f9cb4cf824f99f62768c9f881adcfe0418ff120 /gcc/ada
parent0640c7d139ea91870c378de96cab14d708517593 (diff)
downloadgcc-86ec3bfb9fc3729d1e17d750e2d76be03f4f7110.zip
gcc-86ec3bfb9fc3729d1e17d750e2d76be03f4f7110.tar.gz
gcc-86ec3bfb9fc3729d1e17d750e2d76be03f4f7110.tar.bz2
[multiple changes]
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. From-SVN: r238117
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog24
-rw-r--r--gcc/ada/adaint.c25
-rw-r--r--gcc/ada/einfo.ads2
-rw-r--r--gcc/ada/exp_ch6.adb47
-rw-r--r--gcc/ada/exp_imgv.adb10
-rw-r--r--gcc/ada/g-dynhta.adb8
-rw-r--r--gcc/ada/s-fatgen.adb10
-rw-r--r--gcc/ada/s-poosiz.adb6
-rw-r--r--gcc/ada/s-regexp.adb4
-rw-r--r--gcc/ada/sem_ch4.adb8
-rw-r--r--gcc/ada/sem_ch9.adb8
11 files changed, 123 insertions, 29 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5b2b9fa..f7fa41d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,27 @@
+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
diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index 9d8a438..67bdad3 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -1919,7 +1919,16 @@ __gnat_is_read_accessible_file (char *name)
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
@@ -1983,7 +1992,16 @@ __gnat_is_write_accessible_file (char *name)
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
@@ -3291,7 +3309,6 @@ __gnat_kill (int pid, int sig, int close ATTRIBUTE_UNUSED)
void __gnat_killprocesstree (int pid, int sig_num)
{
#if defined(_WIN32)
- HANDLE hWnd;
PROCESSENTRY32 pe;
memset(&pe, 0, sizeof(PROCESSENTRY32));
@@ -3315,7 +3332,7 @@ void __gnat_killprocesstree (int pid, int sig_num)
while (bContinue)
{
- if (pe.th32ParentProcessID == (int)pid)
+ if (pe.th32ParentProcessID == (DWORD)pid)
__gnat_killprocesstree (pe.th32ProcessID, sig_num);
bContinue = Process32Next (hSnap, &pe);
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index ec065a9..1085862 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -5502,7 +5502,7 @@ package Einfo is
-- 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)
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 938484b..a14274c 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5945,6 +5945,12 @@ package body Exp_Ch6 is
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
@@ -5952,6 +5958,31 @@ package body Exp_Ch6 is
-- 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 --
----------------------------
@@ -5975,14 +6006,24 @@ package body Exp_Ch6 is
-- 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;
diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb
index f249afe..e4a07f7 100644
--- a/gcc/ada/exp_imgv.adb
+++ b/gcc/ada/exp_imgv.adb
@@ -6,7 +6,7 @@
-- --
-- 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- --
@@ -694,7 +694,7 @@ package body Exp_Imgv is
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;
@@ -1278,7 +1278,7 @@ package body Exp_Imgv is
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;
@@ -1287,7 +1287,7 @@ package body Exp_Imgv is
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;
@@ -1296,7 +1296,7 @@ package body Exp_Imgv is
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;
diff --git a/gcc/ada/g-dynhta.adb b/gcc/ada/g-dynhta.adb
index 449ac17..10931cc 100644
--- a/gcc/ada/g-dynhta.adb
+++ b/gcc/ada/g-dynhta.adb
@@ -6,7 +6,7 @@
-- --
-- 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- --
@@ -57,8 +57,8 @@ package body GNAT.Dynamic_HTables is
-- 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
@@ -224,7 +224,7 @@ package body GNAT.Dynamic_HTables is
-- Get --
---------
- function Get (T : Instance; K : Key) return Element is
+ function Get (T : Instance; K : Key) return Element is
Tmp : Elmt_Ptr;
begin
diff --git a/gcc/ada/s-fatgen.adb b/gcc/ada/s-fatgen.adb
index 35d037a..c2185e0 100644
--- a/gcc/ada/s-fatgen.adb
+++ b/gcc/ada/s-fatgen.adb
@@ -6,7 +6,7 @@
-- --
-- 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- --
@@ -84,7 +84,7 @@ package body System.Fat_Gen is
-- 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.
@@ -368,7 +368,7 @@ package body System.Fat_Gen is
Result := Truncation (abs X);
Tail := abs X - Result;
- if Tail >= 0.5 then
+ if Tail >= 0.5 then
Result := Result + 1.0;
end if;
@@ -553,7 +553,7 @@ package body System.Fat_Gen is
Result := Truncation (abs X);
Tail := abs X - Result;
- if Tail >= 0.5 then
+ if Tail >= 0.5 then
Result := Result + 1.0;
end if;
@@ -775,7 +775,7 @@ package body System.Fat_Gen is
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
diff --git a/gcc/ada/s-poosiz.adb b/gcc/ada/s-poosiz.adb
index 683f32e..da3a0c5 100644
--- a/gcc/ada/s-poosiz.adb
+++ b/gcc/ada/s-poosiz.adb
@@ -6,7 +6,7 @@
-- --
-- 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- --
@@ -148,7 +148,7 @@ package body System.Pool_Size is
-- 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
@@ -180,7 +180,7 @@ package body System.Pool_Size is
-- Storage_Size --
------------------
- function Storage_Size
+ function Storage_Size
(Pool : Stack_Bounded_Pool) return SSE.Storage_Count
is
begin
diff --git a/gcc/ada/s-regexp.adb b/gcc/ada/s-regexp.adb
index 6a44534..e9faa1c 100644
--- a/gcc/ada/s-regexp.adb
+++ b/gcc/ada/s-regexp.adb
@@ -6,7 +6,7 @@
-- --
-- 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- --
@@ -551,7 +551,7 @@ package body System.Regexp is
("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));
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 45ad8d6..5c0f4f6 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -4804,8 +4804,14 @@ package body Sem_Ch4 is
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
diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index 39e8dc1..8297db8 100644
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -1875,7 +1875,9 @@ package body Sem_Ch9 is
-- 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.
@@ -1903,6 +1905,10 @@ package body Sem_Ch9 is
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