+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
-- 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
-- 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.
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);
-- 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).
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;
-- 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);
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;
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;
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
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;
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;
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;
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;
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;
-- $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);
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
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;
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
-- 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
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;
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
-- 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,
-- 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;
-- 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,
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;
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;
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;
declare
Source_Directory : constant String :=
Get_Name_String (Element.Value)
- & Directory_Separator;
+ & Directory_Separator;
Dir_Last : constant Natural :=
Compute_Directory_Last (Source_Directory);
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;
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;
-- 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
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
projects / gcc.git / commitdiff