+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
-- --
-- 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- --
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);
-- 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
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;
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
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;
Set_Has_Dereference_Action (Deref);
Alig := Make_Temporary (Loc, 'A');
-
Insert_Action (N,
Make_Object_Declaration (Loc,
Defining_Identifier => Alig,
-- 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.
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 ...;
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.
projects / gcc.git / commitdiff