[multiple changes]
2014-08-04 Hristian Kirtchev <kirtchev@adacore.com> * sem_prag.adb (Analyze_Pragma): Ensure that an internally generated spec for a stand alone body is recognized as a proper context for pragma SPARK_Mode. 2014-08-04 Robert Dewar <dewar@adacore.com> * erroutc.adb (Delete_Msg): Do not decrement Warnings_Treated_As_Errors. 2014-08-04 Arnaud Charlet <charlet@adacore.com> * adabkend.adb (Scan_Back_End_Switches): Ignore extra -o when -gnatO has already been specified, for compatibility with gcc driver. (Scan_Compiler_Args): Do not call Set_Output_Object_File_Name in codepeer mode. * g-expect.ads: Fix typo. 2014-08-04 Thomas Quinot <quinot@adacore.com> * exp_ch4.adb (Insert_Dereference_Action): the actual Size must account for the bounds template if the designated type is an unconstrained array. From-SVN: r213579
This commit is contained in:
Arnaud Charlet
parent
df9107226f
commit
51dcceecdf
|
|
@ -1,3 +1,28 @@
|
|||
2014-08-04 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* sem_prag.adb (Analyze_Pragma): Ensure that an
|
||||
internally generated spec for a stand alone body is recognized
|
||||
as a proper context for pragma SPARK_Mode.
|
||||
|
||||
2014-08-04 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* erroutc.adb (Delete_Msg): Do not decrement Warnings_Treated_As_Errors.
|
||||
|
||||
2014-08-04 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* adabkend.adb (Scan_Back_End_Switches): Ignore extra -o
|
||||
when -gnatO has already been specified, for compatibility
|
||||
with gcc driver.
|
||||
(Scan_Compiler_Args): Do not call Set_Output_Object_File_Name in
|
||||
codepeer mode.
|
||||
* g-expect.ads: Fix typo.
|
||||
|
||||
2014-08-04 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* exp_ch4.adb (Insert_Dereference_Action): the actual Size
|
||||
must account for the bounds template if the designated type is
|
||||
an unconstrained array.
|
||||
|
||||
2014-08-04 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* a-cfhama.adb, a-cfhase.adb, a-cforma.adb, a-cforse.adb Add
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2001-2013, AdaCore --
|
||||
-- Copyright (C) 2001-2014, 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- --
|
||||
|
|
@ -108,7 +108,16 @@ package body Adabkend is
|
|||
|
||||
elsif Switch_Chars (First .. Last) = "o" then
|
||||
if First = Last then
|
||||
Opt.Output_File_Name_Present := True;
|
||||
if Opt.Output_File_Name_Present then
|
||||
|
||||
-- Ignore extra -o when -gnatO has already been specified
|
||||
|
||||
Next_Arg := Next_Arg + 1;
|
||||
|
||||
else
|
||||
Opt.Output_File_Name_Present := True;
|
||||
end if;
|
||||
|
||||
return;
|
||||
else
|
||||
Fail ("invalid switch: " & Switch_Chars);
|
||||
|
|
@ -237,10 +246,11 @@ package body Adabkend is
|
|||
|
||||
-- In GNATprove_Mode, such an object file is never written, and
|
||||
-- the call to Set_Output_Object_File_Name may fail (e.g. when
|
||||
-- the object file name does not have the expected suffix). So
|
||||
-- we skip that call when GNATprove_Mode is set.
|
||||
-- the object file name does not have the expected suffix).
|
||||
-- So we skip that call when GNATprove_Mode is set. Same for
|
||||
-- CodePeer_Mode.
|
||||
|
||||
elsif GNATprove_Mode then
|
||||
elsif GNATprove_Mode or CodePeer_Mode then
|
||||
Output_File_Name_Seen := True;
|
||||
|
||||
else
|
||||
|
|
|
|||
|
|
@ -141,10 +141,9 @@ package body Erroutc is
|
|||
if Errors.Table (D).Warn or else Errors.Table (D).Style then
|
||||
Warnings_Detected := Warnings_Detected - 1;
|
||||
|
||||
if Errors.Table (D).Warn_Err then
|
||||
Warnings_Treated_As_Errors :=
|
||||
Warnings_Treated_As_Errors - 1;
|
||||
end if;
|
||||
-- Note: we do not need to decrement Warnings_Treated_As_Errors
|
||||
-- because this only gets incremented if we actually output the
|
||||
-- message, which we won't do if we are deleting it here!
|
||||
|
||||
else
|
||||
Total_Errors_Detected := Total_Errors_Detected - 1;
|
||||
|
|
|
|||
|
|
@ -11569,11 +11569,12 @@ package body Exp_Ch4 is
|
|||
Pool : constant Entity_Id := Associated_Storage_Pool (Typ);
|
||||
Pnod : constant Node_Id := Parent (N);
|
||||
|
||||
Addr : Entity_Id;
|
||||
Alig : Entity_Id;
|
||||
Deref : Node_Id;
|
||||
Size : Entity_Id;
|
||||
Stmt : Node_Id;
|
||||
Addr : Entity_Id;
|
||||
Alig : Entity_Id;
|
||||
Deref : Node_Id;
|
||||
Size : Entity_Id;
|
||||
Size_Bits : Node_Id;
|
||||
Stmt : Node_Id;
|
||||
|
||||
-- Start of processing for Insert_Dereference_Action
|
||||
|
||||
|
|
@ -11624,23 +11625,36 @@ package body Exp_Ch4 is
|
|||
Prefix => Duplicate_Subexpr_Move_Checks (N));
|
||||
Set_Has_Dereference_Action (Deref);
|
||||
|
||||
Size := Make_Temporary (Loc, 'S');
|
||||
Size_Bits :=
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix => Deref,
|
||||
Attribute_Name => Name_Size);
|
||||
|
||||
-- Special case of an unconstrained array: need to add descriptor size
|
||||
|
||||
if Is_Array_Type (Desig)
|
||||
and then not Is_Constrained (First_Subtype (Desig))
|
||||
then
|
||||
Size_Bits :=
|
||||
Make_Op_Add (Loc,
|
||||
Left_Opnd =>
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix =>
|
||||
New_Occurrence_Of (First_Subtype (Desig), Loc),
|
||||
Attribute_Name => Name_Descriptor_Size),
|
||||
Right_Opnd => Size_Bits);
|
||||
end if;
|
||||
|
||||
Size := Make_Temporary (Loc, 'S');
|
||||
Insert_Action (N,
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Size,
|
||||
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (RTE (RE_Storage_Count), Loc),
|
||||
|
||||
Expression =>
|
||||
Make_Op_Divide (Loc,
|
||||
Left_Opnd =>
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix => Deref,
|
||||
Attribute_Name => Name_Size),
|
||||
Right_Opnd =>
|
||||
Make_Integer_Literal (Loc, System_Storage_Unit))));
|
||||
Left_Opnd => Size_Bits,
|
||||
Right_Opnd => Make_Integer_Literal (Loc, System_Storage_Unit))));
|
||||
|
||||
-- Calculate the alignment of the dereferenced object. Generate:
|
||||
-- Alig : constant Storage_Count := <N>.all'Alignment;
|
||||
|
|
@ -11651,7 +11665,6 @@ package body Exp_Ch4 is
|
|||
Set_Has_Dereference_Action (Deref);
|
||||
|
||||
Alig := Make_Temporary (Loc, 'A');
|
||||
|
||||
Insert_Action (N,
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Alig,
|
||||
|
|
|
|||
|
|
@ -178,7 +178,7 @@ package GNAT.Expect is
|
|||
-- till Expect matches), but this is slower.
|
||||
--
|
||||
-- If Err_To_Out is True, then the standard error of the spawned process is
|
||||
-- connected to the standard output. This is the only way to get the Except
|
||||
-- connected to the standard output. This is the only way to get the Expect
|
||||
-- subprograms to also match on output on standard error.
|
||||
--
|
||||
-- Invalid_Process is raised if the process could not be spawned.
|
||||
|
|
|
|||
|
|
@ -19304,12 +19304,9 @@ package body Sem_Prag is
|
|||
raise Pragma_Exit;
|
||||
end if;
|
||||
|
||||
-- Skip internally generated code
|
||||
|
||||
elsif not Comes_From_Source (Stmt) then
|
||||
null;
|
||||
|
||||
-- The pragma applies to a [generic] subprogram declaration
|
||||
-- The pragma applies to a [generic] subprogram declaration.
|
||||
-- Note that this case covers an internally generated spec
|
||||
-- for a stand alone body.
|
||||
|
||||
-- [generic]
|
||||
-- procedure Proc ...;
|
||||
|
|
@ -19329,6 +19326,11 @@ package body Sem_Prag is
|
|||
Set_SPARK_Pragma_Inherited (Spec_Id, False);
|
||||
return;
|
||||
|
||||
-- Skip internally generated code
|
||||
|
||||
elsif not Comes_From_Source (Stmt) then
|
||||
null;
|
||||
|
||||
-- Otherwise the pragma does not apply to a legal construct
|
||||
-- or it does not appear at the top of a declarative or a
|
||||
-- statement list. Issue an error and stop the analysis.
|
||||
|
|
|
|||
Loading…
Reference in New Issue