+2015-01-07 Bob Duff <duff@adacore.com>
+
+ * usage.adb (Usage): Document -gnatw.f switch.
+
+2015-01-07 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch12.adb: Code clean up and minor reformatting.
+
+2015-01-07 Robert Dewar <dewar@adacore.com>
+
+ * exp_ch4.adb (Expand_N_Type_Conversion): Add guard for
+ Raise_Accessibility_Error call.
+ * s-valllu.ads (Scan_Raw_Long_Long_Unsigned): Add documentation
+ on handling of invalid digits in based constants.
+ * s-fatgen.ads: Minor reformatting.
+ * sem_attr.adb (Analyze_Attribute, case Unrestricted_Access):
+ Avoid noting bogus modification for Valid test.
+ * snames.ads-tmpl (Name_Attr_Long_Float): New Name.
+ * einfo.ads: Minor reformatting.
+ * sem_warn.adb: Minor comment clarification.
+ * sem_ch12.adb: Minor reformatting.
+
2015-01-07 Ed Schonberg <schonberg@adacore.com>
* exp_ch5.adb (Expand_Predicated_Loop): Handle properly loops
-- Other attributes are noted as applying to the [implementation base type
-- only]. These are representation attributes which must always apply to a
-- full non-private type, and where the attributes are always on the full
--- type. The attribute can be referenced on a subtype (and automatically
+-- type. The attribute can be referenced on a subtype (and automatically
-- retries the value from the implementation base type). However, it is an
-- error to try to set the attribute on other than the implementation base
-- type, and if assertions are enabled, an attempt to set the attribute on a
procedure Raise_Accessibility_Error;
-- Called when we know that an accessibility check will fail. Rewrites
-- node N to an appropriate raise statement and outputs warning msgs.
- -- The Etype of the raise node is set to Target_Type.
+ -- The Etype of the raise node is set to Target_Type. Note that in this
+ -- case the rest of the processing should be skipped (i.e. the call to
+ -- this procedure will be followed by "goto Done").
procedure Real_Range_Check;
-- Handles generation of range check for real target value
Type_Access_Level (Operand_Type) > Type_Access_Level (Target_Type)
then
Raise_Accessibility_Error;
+ goto Done;
-- When the operand is a selected access discriminant the check needs
-- to be made against the level of the object denoted by the prefix
function Unbiased_Rounding (X : T) return T;
function Valid (X : not null access T) return Boolean;
- -- This function checks if the object of type T referenced by X
- -- is valid, and returns True/False accordingly. The parameter is
- -- passed by reference (access) here, as the object of type T may
- -- be an abnormal value that cannot be passed in a floating-point
- -- register, and the whole point of 'Valid is to prevent exceptions.
- -- Note that the object of type T must have the natural alignment
- -- for type T.
+ -- This function checks if the object of type T referenced by X is valid,
+ -- and returns True/False accordingly. The parameter is passed by reference
+ -- (access) here, as the object of type T may be an abnormal value that
+ -- cannot be passed in a floating-point register, and the whole point of
+ -- 'Valid is to prevent exceptions. Note that the object of type T must
+ -- have the natural alignment for type T.
type S is new String (1 .. T'Size / Character'Size);
type P is access all S with Storage_Size => 0;
-- Constraint_Error is raised.
--
-- Note: these rules correspond to the requirements for leaving the pointer
- -- positioned in Text_IO.Get
+ -- positioned in Text_IO.Get. Note that the rules as stated in the RM would
+ -- seem to imply that for a case like
+ --
+ -- 8#12345670009#
+
+ -- the pointer should be left at the first # having scanned out the longest
+ -- valid integer literal (8), but in fact in this case the pointer points
+ -- to the invalid based digit (9 in this case). Not only would the strict
+ -- reading of the RM require unlimited backup, which is unreasonable, but
+ -- in addition, the intepretation as given here is the one expected and
+ -- enforced by the ACATS tests.
--
-- Note: if Str is empty, i.e. if Max is less than Ptr, then this is a
-- special case of an all-blank string, and Ptr is unchanged, and hence
Access_Attribute :
begin
+ -- Note possible modification if we have a variable
+
if Is_Variable (P) then
- Note_Possible_Modification (P, Sure => False);
+ declare
+ PN : constant Node_Id := Parent (N);
+ Nm : Node_Id;
+
+ Note : Boolean := True;
+ -- Skip this for the case of Unrestricted_Access occuring in
+ -- the context of a Valid check, since this otherwise leads
+ -- to a missed warning (the Valid check does not really
+ -- modify!) If this case, Note will be reset to False.
+
+ begin
+ if Attr_Id = Attribute_Unrestricted_Access
+ and then Nkind (PN) = N_Function_Call
+ then
+ Nm := Name (PN);
+
+ if Nkind (Nm) = N_Expanded_Name
+ and then Chars (Nm) = Name_Valid
+ and then Nkind (Prefix (Nm)) = N_Identifier
+ and then Chars (Prefix (Nm)) = Name_Attr_Long_Float
+ then
+ Note := False;
+ end if;
+ end if;
+
+ if Note then
+ Note_Possible_Modification (P, Sure => False);
+ end if;
+ end;
end if;
-- The following comes from a query concerning improper use of
and then not Is_Child_Unit (Gen_Unit)
then
Scop := Scope (Gen_Unit);
- while Present (Scop)
- and then Scop /= Standard_Standard
- loop
+ while Present (Scop) and then Scop /= Standard_Standard loop
if Unit_Requires_Body (Scop) then
Enclosing_Body_Present := True;
exit;
while Present (T) loop
if In_Open_Scopes (Scope (T)) then
return T;
-
elsif Is_Generic_Actual_Type (T) then
return T;
end if;
Name =>
New_Occurrence_Of
(Get_Instance_Of (Gen_Parent), Sloc (Actual)),
- Generic_Associations =>
- Generic_Associations (Formal)));
+ Generic_Associations => Generic_Associations (Formal)));
end;
end if;
else
-- The instantiation of a generic formal in-parameter is constant
-- declaration. The actual is the expression for that declaration.
+ -- Its type is a full copy of the type of the formal. This may be
+ -- an access to subprogram, for which we need to generate entities
+ -- for the formals in the new signature.
if Present (Actual) then
if Present (Subt_Mark) then
- Def := Subt_Mark;
+ Def := New_Copy_Tree (Subt_Mark);
else pragma Assert (Present (Acc_Def));
- Def := Acc_Def;
+ Def := Copy_Separate_Tree (Acc_Def);
end if;
Decl_Node :=
Defining_Identifier => New_Copy (Gen_Obj),
Constant_Present => True,
Null_Exclusion_Present => Null_Exclusion_Present (Formal),
- Object_Definition => New_Copy_Tree (Def),
+ Object_Definition => Def,
Expression => Actual);
Set_Corresponding_Generic_Association (Decl_Node, Act_Assoc);
-- If formal is an anonymous access, copy access definition of
-- formal for object declaration.
+ -- In the case of an access to subprogram we need to
+ -- generate new formals for the signature of the default.
- Def := New_Copy_Tree (Acc_Def);
+ Def := Copy_Separate_Tree (Acc_Def);
end if;
Decl_Node :=
procedure Output_Reference_Error (M : String) is
begin
- -- Never issue messages for internal names, nor for renamings
+ -- Never issue messages for internal names or renamings
if Is_Internal_Name (Chars (E1))
or else Nkind (Parent (E1)) = N_Object_Renaming_Declaration
Name_DLL : constant Name_Id := N + $;
Name_Win32 : constant Name_Id := N + $;
- -- Other special names used in processing pragmas
+ -- Other special names used in processing attributes and pragmas
Name_Allow : constant Name_Id := N + $;
Name_Amount : constant Name_Id := N + $;
Name_As_Is : constant Name_Id := N + $;
+ Name_Attr_Long_Float : constant Name_Id := N + $;
Name_Assertion : constant Name_Id := N + $;
Name_Assertions : constant Name_Id := N + $;
Name_Attribute_Name : constant Name_Id := N + $;
"(no exceptions)");
Write_Line (" f+ turn on warnings for unreferenced formal");
Write_Line (" F* turn off warnings for unreferenced formal");
+ Write_Line (" .f turn on warnings for suspicious Subp'Access");
+ Write_Line (" .F turn off warnings for suspicious Subp'Access");
Write_Line (" g*+ turn on warnings for unrecognized pragma");
Write_Line (" G turn off warnings for unrecognized pragma");
Write_Line (" .g turn on GNAT warnings");
projects / platform / upstream / gcc.git / commitdiff