diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 22 | ||||
| -rw-r--r-- | gcc/ada/einfo.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/s-fatgen.ads | 13 | ||||
| -rw-r--r-- | gcc/ada/s-valllu.ads | 12 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 32 | ||||
| -rw-r--r-- | gcc/ada/sem_ch12.adb | 21 | ||||
| -rw-r--r-- | gcc/ada/sem_warn.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/snames.ads-tmpl | 3 | ||||
| -rw-r--r-- | gcc/ada/usage.adb | 2 |
10 files changed, 91 insertions, 23 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 82a7b793b7c..5b95b206a8f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +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 diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 938559a0fcd..7d19e15f557 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -320,7 +320,7 @@ package Einfo is -- 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 diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 340462cf1f9..0e1b7ff9034 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -9982,7 +9982,9 @@ package body Exp_Ch4 is 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 @@ -10518,6 +10520,7 @@ package body Exp_Ch4 is 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 diff --git a/gcc/ada/s-fatgen.ads b/gcc/ada/s-fatgen.ads index d8d761eaaed..88f641b5f7f 100644 --- a/gcc/ada/s-fatgen.ads +++ b/gcc/ada/s-fatgen.ads @@ -88,13 +88,12 @@ package System.Fat_Gen is 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; diff --git a/gcc/ada/s-valllu.ads b/gcc/ada/s-valllu.ads index 3977e95473f..993ea8b0dd8 100644 --- a/gcc/ada/s-valllu.ads +++ b/gcc/ada/s-valllu.ads @@ -61,7 +61,17 @@ package System.Val_LLU is -- 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 diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 7b6ae24f831..8eb85dc5e01 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -9853,8 +9853,38 @@ package body Sem_Attr is 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 diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index e65b9095c96..311161ed660 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3706,9 +3706,7 @@ package body Sem_Ch12 is 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; @@ -7678,7 +7676,6 @@ package body Sem_Ch12 is while Present (T) loop if In_Open_Scopes (Scope (T)) then return T; - elsif Is_Generic_Actual_Type (T) then return T; end if; @@ -9546,8 +9543,7 @@ package body Sem_Ch12 is Name => New_Occurrence_Of (Get_Instance_Of (Gen_Parent), Sloc (Actual)), - Generic_Associations => - Generic_Associations (Formal))); + Generic_Associations => Generic_Associations (Formal))); end; end if; @@ -10057,12 +10053,15 @@ package body Sem_Ch12 is 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 := @@ -10070,7 +10069,7 @@ package body Sem_Ch12 is 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); @@ -10148,8 +10147,10 @@ package body Sem_Ch12 is -- 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 := diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 484509602c0..ec3eb07c577 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -898,7 +898,7 @@ package body Sem_Warn is 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 diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 3c86c9ceedd..fec0545ad98 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -676,11 +676,12 @@ package Snames is 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 + $; diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index 9cb198f6fc8..15d8ecbf3be 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -501,6 +501,8 @@ begin "(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"); |