aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2014-10-17 11:20:50 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2014-10-17 11:20:50 +0200
commit43c58950be209f57279c16f4663437956eb5a593 (patch)
treeac2ce43d8b87906a4f1c44c43fc8feeb03aaee9a /gcc
parentfa2e6e2570459be86a7a47482ad7bd2a7115982a (diff)
downloadgcc-43c58950be209f57279c16f4663437956eb5a593.zip
gcc-43c58950be209f57279c16f4663437956eb5a593.tar.gz
gcc-43c58950be209f57279c16f4663437956eb5a593.tar.bz2
[multiple changes]
2014-10-17 Robert Dewar <dewar@adacore.com> * exp_ch9.adb (Expand_N_Task_Body): Add defense against previous errors. * freeze.adb (Freeze_Entity): Add defense against checking null scope for generic. * restrict.adb (Tasking_Allowed): Add test for No_Run_Time mode. * sem_ch13.adb (Freeze_Entity_Checks): Add defense against previous errors. * sem_ch9.adb (Analyze_Task_Type_Declaration): Give error if in No_Run_Time mode. 2014-10-17 Robert Dewar <dewar@adacore.com> * prj-makr.adb: Minor reformatting. 2014-10-17 Robert Dewar <dewar@adacore.com> * gnatcmd.adb, make.adb, prj-part.adb, gnatlink.adb, prj-nmsc.adb, prj-conf.adb, prj-env.adb: Use Is_Directory_Separator where possible. 2014-10-17 Ed Schonberg <schonberg@adacore.com> * exp_prag.adb (Undo_Initialization): If Initialize_Scalars is enabled, code will be generated for some composite types to initialize an object after its declaration. If there is a subsequent Import pragma for the object, that code must be removed as specified byw the semantics of the pragma, and to prevent out-of-order elaboration issues in the back-end. 2014-10-17 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch4.adb (Expand_N_Op_Concat): Keep concatenation operator wrapping mechanism under debug flag -gnatd.h. * debug.adb: Claim debug switch -gnatd.h. From-SVN: r216384
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog36
-rw-r--r--gcc/ada/debug.adb7
-rw-r--r--gcc/ada/exp_ch4.adb35
-rw-r--r--gcc/ada/exp_ch9.adb7
-rw-r--r--gcc/ada/exp_prag.adb21
-rw-r--r--gcc/ada/freeze.adb3
-rw-r--r--gcc/ada/gnatcmd.adb11
-rw-r--r--gcc/ada/gnatlink.adb5
-rw-r--r--gcc/ada/make.adb6
-rw-r--r--gcc/ada/prj-conf.adb6
-rw-r--r--gcc/ada/prj-env.adb13
-rw-r--r--gcc/ada/prj-makr.adb11
-rw-r--r--gcc/ada/prj-nmsc.adb46
-rw-r--r--gcc/ada/prj-part.adb3
-rw-r--r--gcc/ada/restrict.adb3
-rw-r--r--gcc/ada/sem_ch13.adb3
-rw-r--r--gcc/ada/sem_ch9.adb15
17 files changed, 165 insertions, 66 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ba51cc3..70bad2f 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,39 @@
+2014-10-17 Robert Dewar <dewar@adacore.com>
+
+ * exp_ch9.adb (Expand_N_Task_Body): Add defense against
+ previous errors.
+ * freeze.adb (Freeze_Entity): Add defense against checking null
+ scope for generic.
+ * restrict.adb (Tasking_Allowed): Add test for No_Run_Time mode.
+ * sem_ch13.adb (Freeze_Entity_Checks): Add defense against
+ previous errors.
+ * sem_ch9.adb (Analyze_Task_Type_Declaration): Give error if
+ in No_Run_Time mode.
+
+2014-10-17 Robert Dewar <dewar@adacore.com>
+
+ * prj-makr.adb: Minor reformatting.
+
+2014-10-17 Robert Dewar <dewar@adacore.com>
+
+ * gnatcmd.adb, make.adb, prj-part.adb, gnatlink.adb, prj-nmsc.adb,
+ prj-conf.adb, prj-env.adb: Use Is_Directory_Separator where possible.
+
+2014-10-17 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_prag.adb (Undo_Initialization): If Initialize_Scalars
+ is enabled, code will be generated for some composite types
+ to initialize an object after its declaration. If there is
+ a subsequent Import pragma for the object, that code must be
+ removed as specified byw the semantics of the pragma, and to
+ prevent out-of-order elaboration issues in the back-end.
+
+2014-10-17 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch4.adb (Expand_N_Op_Concat): Keep concatenation operator
+ wrapping mechanism under debug flag -gnatd.h.
+ * debug.adb: Claim debug switch -gnatd.h.
+
2014-10-17 Doug Rupp <rupp@adacore.com>
* gcc-interface/Makefile.in: Enable the socket runtime bits
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 94da7a6..2b249e9 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -98,7 +98,7 @@ package body Debug is
-- d.e Enable atomic synchronization
-- d.f Inhibit folding of static expressions
-- d.g Enable conversion of raise into goto
- -- d.h
+ -- d.h Minimize the creation of public internal symbols for concatenation
-- d.i Ignore Warnings pragmas
-- d.j Generate listing of frontend inlined calls
-- d.k
@@ -525,6 +525,11 @@ package body Debug is
-- this if this debug flag is set. Later we will enable this more
-- generally by default.
+ -- d.h Minimize the creation of public internal symbols for concatenation
+ -- by enforcing a secondary stack-like handling of the final result.
+ -- The target of the concatenation is thus constrained in place and
+ -- initialized with the result instead of acting as its alias.
+
-- d.i Ignore all occurrences of pragma Warnings in the sources. This can
-- be used in particular to disable Warnings (Off) to check if any of
-- these statements are inappropriate.
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 5fdba53..eeada2c 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -6589,7 +6589,40 @@ package body Exp_Ch4 is
Append (Right_Opnd (Cnode), Opnds);
end loop Inner;
- Expand_Concatenate (Cnode, Opnds);
+ -- Note: The following code is a temporary workaround for N731-034
+ -- and N829-028 and will be kept until the general issue of internal
+ -- symbol serialization is addressed. The workaround is kept under a
+ -- debug switch to avoid permiating into the general case.
+
+ -- Wrap the node to concatenate into an expression actions node to
+ -- keep it nicely packaged. This is useful in the case of an assert
+ -- pragma with a concatenation where we want to be able to delete
+ -- the concatenation and all its expansion stuff.
+
+ if Debug_Flag_Dot_H then
+ declare
+ Cnod : constant Node_Id := Relocate_Node (Cnode);
+ Typ : constant Entity_Id := Base_Type (Etype (Cnode));
+
+ begin
+ -- Note: use Rewrite rather than Replace here, so that for
+ -- example Why_Not_Static can find the original concatenation
+ -- node OK!
+
+ Rewrite (Cnode,
+ Make_Expression_With_Actions (Sloc (Cnode),
+ Actions => New_List (Make_Null_Statement (Sloc (Cnode))),
+ Expression => Cnod));
+
+ Expand_Concatenate (Cnod, Opnds);
+ Analyze_And_Resolve (Cnode, Typ);
+ end;
+
+ -- Default case
+
+ else
+ Expand_Concatenate (Cnode, Opnds);
+ end if;
exit Outer when Cnode = N;
Cnode := Parent (Cnode);
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index aff566d..9682859 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -11449,6 +11449,13 @@ package body Exp_Ch9 is
-- Used to determine the proper location of wrapper body insertions
begin
+ -- if no task body procedure, means we had an error in configurable
+ -- run-time mode, and there is no point in proceeding further.
+
+ if No (Task_Body_Procedure (Ttyp)) then
+ return;
+ end if;
+
-- Add renaming declarations for discriminals and a declaration for the
-- entry family index (if applicable).
diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index f48db6f..6ceaf31 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -1863,6 +1863,27 @@ package body Exp_Prag is
if No (Init_Call) and then Present (Expression (Parent (Def_Id))) then
Set_Expression (Parent (Def_Id), Empty);
end if;
+
+ -- The object may not have any initialization, but in the presence of
+ -- Initialize_Scalars code is inserted after then declaration, which
+ -- must now be removed as well. The code carries the same source
+ -- location as the declaration itself.
+
+ if Initialize_Scalars and then Is_Array_Type (Etype (Def_Id)) then
+ declare
+ Init : Node_Id;
+ Nxt : Node_Id;
+ begin
+ Init := Next (Parent (Def_Id));
+ while not Comes_From_Source (Init)
+ and then Sloc (Init) = Sloc (Def_Id)
+ loop
+ Nxt := Next (Init);
+ Remove (Init);
+ Init := Nxt;
+ end loop;
+ end;
+ end if;
end Undo_Initialization;
end Exp_Prag;
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 2eea620..5b4bfd9 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -5024,7 +5024,8 @@ package body Freeze is
-- that later when the full type is frozen).
elsif Ekind_In (E, E_Record_Type, E_Record_Subtype)
- and then not Is_Generic_Unit (Scope (E))
+ and then not (Present (Scope (E))
+ and then Is_Generic_Unit (Scope (E)))
then
Freeze_Record_Type (E);
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index 77cf6dc..c7a1330 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -883,10 +883,9 @@ procedure GNATCmd is
if not Is_Absolute_Path (Exec_File_Name) then
for Index in Exec_File_Name'Range loop
if Exec_File_Name (Index) = Directory_Separator then
- Fail ("relative executable (""" &
- Exec_File_Name &
- """) with directory part not allowed " &
- "when using project files");
+ Fail ("relative executable (""" & Exec_File_Name
+ & """) with directory part not allowed "
+ & "when using project files");
end if;
end loop;
@@ -1398,9 +1397,7 @@ procedure GNATCmd is
else
for K in Switch'Range loop
- if Switch (K) = '/'
- or else Switch (K) = Directory_Separator
- then
+ if Is_Directory_Separator (Switch (K)) then
Test_Existence := True;
exit;
end if;
diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb
index 6c93c0b..190aadf 100644
--- a/gcc/ada/gnatlink.adb
+++ b/gcc/ada/gnatlink.adb
@@ -1204,9 +1204,8 @@ procedure Gnatlink is
if GCC_Index = 0 then
GCC_Index :=
Index (Path (1 .. Path_Last),
- Directory_Separator &
- "lib" &
- Directory_Separator);
+ Directory_Separator & "lib"
+ & Directory_Separator);
end if;
-- If we have found a "lib" subdir in
diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index 07f960b..eb062e3 100644
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.adb
@@ -4057,8 +4057,7 @@ package body Make is
begin
First := Name'Last;
while First > Name'First
- and then Name (First - 1) /= Directory_Separator
- and then Name (First - 1) /= '/'
+ and then not Is_Directory_Separator (Name (First - 1))
loop
First := First - 1;
end loop;
@@ -6805,8 +6804,7 @@ package body Make is
begin
First := Name'Last;
while First > Name'First
- and then Name (First - 1) /= Directory_Separator
- and then Name (First - 1) /= '/'
+ and then not Is_Directory_Separator (Name (First - 1))
loop
First := First - 1;
end loop;
diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb
index 56d116e..6d5cdc7 100644
--- a/gcc/ada/prj-conf.adb
+++ b/gcc/ada/prj-conf.adb
@@ -26,6 +26,7 @@
with Makeutl; use Makeutl;
with MLib.Tgt;
with Opt; use Opt;
+with Osint; use Osint;
with Output; use Output;
with Prj.Env;
with Prj.Err;
@@ -1526,11 +1527,12 @@ package body Prj.Conf is
function Is_Base_Name (Path : String) return Boolean is
begin
- for I in Path'Range loop
- if Path (I) = Directory_Separator or else Path (I) = '/' then
+ for J in Path'Range loop
+ if Is_Directory_Separator (Path (J)) then
return False;
end if;
end loop;
+
return True;
end Is_Base_Name;
diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb
index 30f2b99..9dcd324 100644
--- a/gcc/ada/prj-env.adb
+++ b/gcc/ada/prj-env.adb
@@ -1435,7 +1435,7 @@ package body Prj.Env is
function Is_Base_Name (Path : String) return Boolean is
begin
for J in Path'Range loop
- if Path (J) = Directory_Separator or else Path (J) = '/' then
+ if Is_Directory_Separator (Path (J)) then
return False;
end if;
end loop;
@@ -2131,14 +2131,14 @@ package body Prj.Env is
-- $prefix/share/gpr
Add_Str_To_Name_Buffer
- (Path_Separator & Prefix.all &
- "share" & Directory_Separator & "gpr");
+ (Path_Separator & Prefix.all & "share"
+ & Directory_Separator & "gpr");
-- $prefix/lib/gnat
Add_Str_To_Name_Buffer
- (Path_Separator & Prefix.all &
- "lib" & Directory_Separator & "gnat");
+ (Path_Separator & Prefix.all & "lib"
+ & Directory_Separator & "gnat");
end if;
Free (Prefix);
@@ -2293,8 +2293,7 @@ package body Prj.Env is
exit Check_Dot;
end if;
- exit Check_Dot when File (K) = Directory_Separator
- or else File (K) = '/';
+ exit Check_Dot when Is_Directory_Separator (File (K));
end loop Check_Dot;
if not Is_Absolute_Path (File) then
diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb
index d58f4df..06cb64b 100644
--- a/gcc/ada/prj-makr.adb
+++ b/gcc/ada/prj-makr.adb
@@ -1187,7 +1187,7 @@ package body Prj.Makr is
Canonical_Case_File_Name (Canon (1 .. Last));
if Is_Regular_File
- (Dir_Name & Directory_Separator & Str (1 .. Last))
+ (Dir_Name & Directory_Separator & Str (1 .. Last))
then
Matched := True;
@@ -1277,10 +1277,9 @@ package body Prj.Makr is
new String'(Get_Name_String (Tmp_File));
end if;
- Args (Args'Last) := new String'
- (Dir_Name &
- Directory_Separator &
- Str (1 .. Last));
+ Args (Args'Last) :=
+ new String'
+ (Dir_Name & Directory_Separator & Str (1 .. Last));
-- Save the standard output and error
@@ -1477,7 +1476,7 @@ package body Prj.Makr is
-- Do not call itself for "." or ".."
if Is_Directory
- (Dir_Name & Directory_Separator & Str (1 .. Last))
+ (Dir_Name & Directory_Separator & Str (1 .. Last))
and then Str (1 .. Last) /= "."
and then Str (1 .. Last) /= ".."
then
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 5d3d629..2400799 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -5031,10 +5031,7 @@ package body Prj.Nmsc is
if OK then
for J in 1 .. Name_Len loop
- if Name_Buffer (J) = '/'
- or else
- Name_Buffer (J) = Directory_Separator
- then
+ if Is_Directory_Separator (Name_Buffer (J)) then
OK := False;
exit;
end if;
@@ -5336,9 +5333,7 @@ package body Prj.Nmsc is
function Compute_Directory_Last (Dir : String) return Natural is
begin
if Dir'Length > 1
- and then (Dir (Dir'Last - 1) = Directory_Separator
- or else
- Dir (Dir'Last - 1) = '/')
+ and then Is_Directory_Separator (Dir (Dir'Last - 1))
then
return Dir'Last - 1;
else
@@ -5858,7 +5853,7 @@ package body Prj.Nmsc is
-- Check that there is no directory information
for J in 1 .. Last loop
- if Line (J) = '/' or else Line (J) = Directory_Separator then
+ if Is_Directory_Separator (Line (J)) then
Error_Msg_File_1 := Source_Name;
Error_Msg
(Data.Flags,
@@ -6485,15 +6480,12 @@ package body Prj.Nmsc is
-- Check that there is no directory information
for J in 1 .. Last loop
- if Line (J) = '/'
- or else
- Line (J) = Directory_Separator
- then
+ if Is_Directory_Separator (Line (J)) then
Error_Msg_File_1 := Name;
Error_Msg
(Data.Flags,
- "file name cannot include " &
- "directory information ({)",
+ "file name cannot include "
+ & "directory information ({)",
Location, Project.Project);
exit;
end if;
@@ -6600,10 +6592,7 @@ package body Prj.Nmsc is
-- Check that there is no directory information
for J in 1 .. Name_Len loop
- if Name_Buffer (J) = '/'
- or else
- Name_Buffer (J) = Directory_Separator
- then
+ if Is_Directory_Separator (Name_Buffer (J)) then
Error_Msg_File_1 := Name;
Error_Msg
(Data.Flags,
@@ -7394,11 +7383,11 @@ package body Prj.Nmsc is
if Name (1 .. Last) /= "." and then Name (1 .. Last) /= ".." then
declare
Path_Name : constant String :=
- Normalize_Pathname
- (Name => Name (1 .. Last),
- Directory => Path_Str,
- Resolve_Links => Resolve_Links)
- & Directory_Separator;
+ Normalize_Pathname
+ (Name => Name (1 .. Last),
+ Directory => Path_Str,
+ Resolve_Links => Resolve_Links)
+ & Directory_Separator;
Path2 : Path_Information;
OK : Boolean := True;
@@ -7475,8 +7464,7 @@ package body Prj.Nmsc is
if Search_For = Search_Files then
while Pattern_End >= Pattern'First
- and then Pattern (Pattern_End) /= '/'
- and then Pattern (Pattern_End) /= Directory_Separator
+ and then not Is_Directory_Separator (Pattern (Pattern_End))
loop
Pattern_End := Pattern_End - 1;
end loop;
@@ -7512,9 +7500,9 @@ package body Prj.Nmsc is
Recursive :=
Pattern_End - 1 >= Pattern'First
and then Pattern (Pattern_End - 1 .. Pattern_End) = "**"
- and then (Pattern_End - 1 = Pattern'First
- or else Pattern (Pattern_End - 2) = '/'
- or else Pattern (Pattern_End - 2) = Directory_Separator);
+ and then
+ (Pattern_End - 1 = Pattern'First
+ or else Is_Directory_Separator (Pattern (Pattern_End - 2)));
if Recursive then
Pattern_End := Pattern_End - 2;
@@ -7631,7 +7619,7 @@ package body Prj.Nmsc is
declare
Source_Directory : constant String :=
Get_Name_String (Element.Value)
- & Directory_Separator;
+ & Directory_Separator;
Dir_Last : constant Natural :=
Compute_Directory_Last (Source_Directory);
diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb
index bc6a566..5f04158 100644
--- a/gcc/ada/prj-part.adb
+++ b/gcc/ada/prj-part.adb
@@ -349,8 +349,7 @@ package body Prj.Part is
Get_Name_String (Path_Name_Of (Main_Project, In_Tree));
while Name_Len > 0
- and then Name_Buffer (Name_Len) /= Directory_Separator
- and then Name_Buffer (Name_Len) /= '/'
+ and then not Is_Directory_Separator (Name_Buffer (Name_Len))
loop
Name_Len := Name_Len - 1;
end loop;
diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
index f2e6a1f..13732fb7 100644
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -1533,7 +1533,8 @@ package body Restrict is
begin
return not Restrictions.Set (No_Tasking)
and then (not Restrictions.Set (Max_Tasks)
- or else Restrictions.Value (Max_Tasks) > 0);
+ or else Restrictions.Value (Max_Tasks) > 0)
+ and then not No_Run_Time_Mode;
end Tasking_Allowed;
end Restrict;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 9ab019a..c8cfd03 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -10304,7 +10304,8 @@ package body Sem_Ch13 is
-- Check Ada derivation of CPP type
- if Expander_Active -- why? losing errors in -gnatc mode???
+ if Expander_Active -- why? losing errors in -gnatc mode???
+ and then Present (Etype (E)) -- defend against errors
and then Tagged_Type_Expansion
and then Ekind (E) = E_Record_Type
and then Etype (E) /= E
diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index 6be4f55..f48c7bd 100644
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -2894,7 +2894,20 @@ package body Sem_Ch9 is
T : Entity_Id;
begin
- Check_Restriction (No_Tasking, N);
+ -- Attempt to use tasking in no run time mode is not allowe. Issue hard
+ -- error message to disable expansion which leads to crashes.
+
+ if Opt.No_Run_Time_Mode then
+ Error_Msg_N ("tasking not allowed in No_Run_Time mode", N);
+
+ -- Otherwise soft check for no tasking restriction
+
+ else
+ Check_Restriction (No_Tasking, N);
+ end if;
+
+ -- Proceed ahead with analysis of task type declaration
+
Tasking_Used := True;
-- The sequential partition elaboration policy is supported only in the