+2011-08-04 Robert Dewar <dewar@adacore.com>
+
+ * sem_aggr.adb, par_sco.adb, sem_type.adb, exp_util.adb, exp_ch9.adb,
+ prj-nmsc.adb, sem_ch13.adb, exp_strm.adb: Minor reformatting.
+
+2011-08-04 Robert Dewar <dewar@adacore.com>
+
+ * gnat_rm.texi: Minor documentation fix for pragma Annotate.
+
+2011-08-04 Yannick Moy <moy@adacore.com>
+
+ * sem_attr.adb (Analyze_Attribute): add check during pre-analysis that
+ 'Result only appears in postcondition of function.
+
+2011-08-04 Thomas Quinot <quinot@adacore.com>
+
+ * a-tags.adb (Check_TSD): When raising PROGRAM_ERROR for a duplicated
+ external tag, include the value of the external tag in the exception
+ message.
+
2011-08-04 Yannick Moy <moy@adacore.com>
* sem_attr.adb (Result): modify error message for misplaced 'Result
procedure Check_TSD (TSD : Type_Specific_Data_Ptr) is
T : Tag;
+ E_Tag_Len : constant Integer := Length (TSD.External_Tag);
+ E_Tag : String (1 .. E_Tag_Len);
+ for E_Tag'Address use TSD.External_Tag.all'Address;
+ pragma Import (Ada, E_Tag);
+
+ -- Start of processing for Check_TSD
+
begin
-- Verify that the external tag of this TSD is not registered in the
-- runtime hash table.
T := External_Tag_HTable.Get (To_Address (TSD.External_Tag));
if T /= null then
- raise Program_Error with "duplicated external tag";
+ raise Program_Error with "duplicated external tag " & E_Tag;
end if;
end Check_TSD;
-- Length --
------------
+ -- Should this be reimplemented using the strlen GCC builtin???
+
function Length (Str : Cstring_Ptr) return Natural is
Len : Integer;
if Opt.Suppress_Control_Flow_Optimizations then
Stmt := Make_Implicit_If_Statement (Cond,
- Condition =>
- Cond,
+ Condition => Cond,
Then_Statements => New_List (
Make_Simple_Return_Statement (Loc,
New_Occurrence_Of (Standard_True, Loc))),
Make_Object_Declaration (Loc,
Defining_Identifier => Make_Defining_Identifier (Loc, Name_V),
Object_Definition => New_Occurrence_Of (Typ, Loc));
+
else
Odecl :=
Make_Object_Declaration (Loc,
for J in 1 .. Number_Dimensions (Typ) loop
Append_To (Stms,
Make_Attribute_Reference (Loc,
- Prefix =>
+ Prefix =>
New_Occurrence_Of (Stream_Base_Type (Etype (Indx)), Loc),
Attribute_Name => Name_Write,
- Expressions => New_List (
+ Expressions => New_List (
Make_Identifier (Loc, Name_S),
Make_Attribute_Reference (Loc,
Prefix => Make_Identifier (Loc, Name_V),
Append_To (Stms,
Make_Attribute_Reference (Loc,
- Prefix =>
+ Prefix =>
New_Occurrence_Of (Stream_Base_Type (Etype (Indx)), Loc),
Attribute_Name => Name_Write,
- Expressions => New_List (
+ Expressions => New_List (
Make_Identifier (Loc, Name_S),
Make_Attribute_Reference (Loc,
Prefix => Make_Identifier (Loc, Name_V),
Append_To (Stms,
Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Typ, Loc),
+ Prefix => New_Occurrence_Of (Typ, Loc),
Attribute_Name => Name_Write,
Expressions => New_List (
Make_Identifier (Loc, Name_S),
-- then the representation is unsigned
elsif not Is_Unsigned_Type (FST)
+
+ -- The following set of tests gets repeated many times, we should
+ -- have an abstraction defined ???
+
and then
(Is_Fixed_Point_Type (U_Type)
or else
or else
(Is_Signed_Integer_Type (U_Type)
and then not Has_Biased_Representation (FST)))
+
then
if P_Size <= Standard_Short_Short_Integer_Size then
Lib_RE := RE_I_SSI;
N_Selected_Component)
then
Ren_Obj := Prefix (Ren_Obj);
- Change := True;
+ Change := True;
elsif Nkind_In (Ren_Obj, N_Type_Conversion,
N_Unchecked_Type_Conversion)
then
Ren_Obj := Expression (Ren_Obj);
- Change := True;
+ Change := True;
end if;
end loop;
begin
-- If a previous invocation of this routine has determined that a
- -- list has no renamings, there is no point in repeating the same
- -- scan.
+ -- list has no renamings, then no point in repeating the same scan.
if not Has_Rens then
return False;
unambiguous.
The analyzed pragma is retained in the tree, but not otherwise processed
-by any part of the GNAT compiler. This pragma is intended for use by
-external tools, including ASIS@.
+by any part of the GNAT compiler, except to generate corresponding note
+lines in the generated ALI file. For the format of these note lines, see
+the compiler source file lib-writ.ads. This pragma is intended for use by
+external tools, including ASIS@. The use of pragma Annotate does not
+affect the compilation process in any way.
@node Pragma Assert
@unnumberedsec Pragma Assert
when N_Case_Expression =>
return OK; -- ???
- -- Conditional expression, processed like an IF statement
+ -- Conditional expression, processed like an if statement
when N_Conditional_Expression =>
declare
begin
Debug_Output ("Path_Name_Of file_name=", Name_Id (File_Name));
- Debug_Output ("Path_Name_Of directory=",
- Name_Id (Directory));
+ Debug_Output ("Path_Name_Of directory=", Name_Id (Directory));
Get_Name_String (File_Name);
Result :=
Locate_Regular_File
Insert_Actions (N, Freeze_Entity (Typ, N));
exit;
end if;
+
Next (Comp);
end loop;
end;
-- source subprogram to which the postcondition applies. During
-- pre-analysis, CS is the scope of the subprogram declaration.
+ Prag : Node_Id;
+ -- During pre-analysis, Prag is the enclosing pragma node if any
+
begin
-- Find enclosing scopes, excluding loops
Error_Attr;
end if;
+ -- Check in postcondition of function
+
+ Prag := N;
+ while not Nkind_In (Prag, N_Pragma, N_Function_Specification,
+ N_Subprogram_Body)
+ loop
+ Prag := Parent (Prag);
+ end loop;
+
+ if Nkind (Prag) /= N_Pragma
+ or else Get_Pragma_Id (Prag) /= Pragma_Postcondition
+ then
+ Error_Attr
+ ("% attribute can only appear in postcondition of function",
+ P);
+ end if;
+
-- The attribute reference is a primary. If expressions follow,
-- the attribute reference is really an indexable object, so
-- rewrite and analyze as an indexed component.
Arg1 := Get_Pragma_Arg (Arg1);
Arg2 := Get_Pragma_Arg (Arg2);
- -- See if this predicate pragma is for the current type
- -- or for its full view. A predicate on a private completion
- -- is placed on the partial view beause this is the visible
- -- entity that is frozen..
+ -- See if this predicate pragma is for the current type or for
+ -- its full view. A predicate on a private completion is placed
+ -- on the partial view beause this is the visible entity that
+ -- is frozen.
if Entity (Arg1) = Typ
or else Full_View (Entity (Arg1)) = Typ
function Operand_Type return Entity_Id;
-- Determine type of operand for an equality operation, to apply
- -- Ada2005 rules to equality on anonymous access types.
+ -- Ada 2005 rules to equality on anonymous access types.
function Standard_Operator return Boolean;
-- Check whether subprogram is predefined operator declared in Standard.
function Operand_Type return Entity_Id is
Opnd : Node_Id;
+
begin
if Nkind (N) = N_Function_Call then
Opnd := First_Actual (N);
else
Opnd := Left_Opnd (N);
end if;
- return Etype (Opnd);
+ return Etype (Opnd);
end Operand_Type;
------------------------
-- may be an operator or a function call.
elsif (Chars (Nam1) = Name_Op_Eq
- or else
- Chars (Nam1) = Name_Op_Ne)
+ or else
+ Chars (Nam1) = Name_Op_Ne)
and then Ada_Version >= Ada_2005
and then Etype (User_Subp) = Standard_Boolean
and then Ekind (Operand_Type) = E_Anonymous_Access_Type
and then
In_Same_List (Parent (Designated_Type (Operand_Type)),
- Unit_Declaration_Node (User_Subp))
+ Unit_Declaration_Node (User_Subp))
then
if It2.Nam = Predef_Subp then
return It1;
end if;
Par := Etype (Full_View (BT2));
+
else
Par := Etype (BT2);
end if;
projects / gcc.git / commitdiff