diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 33 | ||||
| -rw-r--r-- | gcc/ada/env.c | 4 | ||||
| -rw-r--r-- | gcc/ada/makeutl.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/par-ch13.adb | 30 | ||||
| -rw-r--r-- | gcc/ada/par.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/prj.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 35 |
8 files changed, 111 insertions, 18 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e9a56978c94..3aa9c77ab88 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,38 @@ 2011-08-04 Yannick Moy <moy@adacore.com> + * par-ch13.adb (Aspect_Specifications_Present): recognize + "with Identifier'Class =>" as an aspect, so that a meaningful warning + is issued in Strict mode. + * par.adb: Fix typos in comments. + +2011-08-04 Yannick Moy <moy@adacore.com> + + * sem_attr.adb (Result): modify error message to take into account Post + aspect when compiling Ada 2012 (or newer) code. + +2011-08-04 Nicolas Roche <roche@adacore.com> + + * env.c (__gnat_clearenv): Avoid use of dynamic size array in order to + remove need for GCC exceptions. + +2011-08-04 Vincent Celier <celier@adacore.com> + + * makeutl.adb (Do_Complete): Call Debug_Output with the name of the + project, not the source file name. + * prj.adb (Find_Sources.Look_For_Sources): If the source has been + excluded, continue looking. This excluded source will only be returned + if there is no other source with the same base name that is not locally + removed. + +2011-08-04 Ed Schonberg <schonberg@adacore.com> + + * sem_res.adb (Resolve_Intrinsic_Operator): if the result type is + private and one of the operands is a real literal, use a qualified + expression rather than a conversion which is not meaningful to the + back-end. + +2011-08-04 Yannick Moy <moy@adacore.com> + * sem_ch13.adb (Aspect_Loop): when an aspect X and its classwise corresponding aspect X'Class are allowed, proceed with analysis of the aspect instead of skipping it. diff --git a/gcc/ada/env.c b/gcc/ada/env.c index dc18e4e6a21..c58139a2d68 100644 --- a/gcc/ada/env.c +++ b/gcc/ada/env.c @@ -316,10 +316,12 @@ void __gnat_clearenv (void) { /* create a string that contains "name" */ size++; { - char expression[size]; + char *expression; + expression = (char *) xmalloc (size * sizeof (char)); strncpy (expression, env[0], size); expression[size - 1] = 0; __gnat_unsetenv (expression); + free (expression); } } #else diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 16a245c0553..cced36f007d 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -1377,7 +1377,7 @@ package body Makeutl is if Source /= No_Source then Debug_Output ("Found main in project", - Name_Id (Source.File)); + Source.Project.Name); Names.Table (J).File := Source.File; Names.Table (J).Project := File.Project; diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb index 099f0e44b15..ecbf58f980e 100644 --- a/gcc/ada/par-ch13.adb +++ b/gcc/ada/par-ch13.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- -- -- 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- -- @@ -89,9 +89,9 @@ package body Ch13 is Result := Token = Tok_Arrow; end if; - -- If earlier than Ada 2012, check for valid aspect identifier followed - -- by an arrow, and consider that this is still an aspect specification - -- so we give an appropriate message. + -- If earlier than Ada 2012, check for valid aspect identifier (possibly + -- completed with 'CLASS) followed by an arrow, and consider that this + -- is still an aspect specification so we give an appropriate message. else if Get_Aspect_Id (Token_Name) = No_Aspect then @@ -100,10 +100,26 @@ package body Ch13 is else Scan; -- past aspect name - if Token /= Tok_Arrow then - Result := False; + Result := False; - else + if Token = Tok_Arrow then + Result := True; + + elsif Token = Tok_Apostrophe then + Scan; -- past apostrophe + + if Token = Tok_Identifier + and then Token_Name = Name_Class + then + Scan; -- past CLASS + + if Token = Tok_Arrow then + Result := True; + end if; + end if; + end if; + + if Result then Restore_Scan_State (Scan_State); Error_Msg_SC ("|aspect specification is an Ada 2012 feature"); Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch"); diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index 32276c5084b..39b8387fb36 100644 --- a/gcc/ada/par.adb +++ b/gcc/ada/par.adb @@ -858,8 +858,8 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- attempt at an aspect specification. The default is more strict for -- Ada versions before Ada 2012 (where aspect specifications are not -- permitted). Note: this routine never checks the terminator token - -- for aspects so it does not matter whether the aspect speficiations - -- are terminated by semicolon or some other character + -- for aspects so it does not matter whether the aspect specifications + -- are terminated by semicolon or some other character. procedure P_Aspect_Specifications (Decl : Node_Id; diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 2f4dea1ee6c..62a3fa98e67 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -557,7 +557,14 @@ package body Prj is and then (Index = 0 or else Element (Iterator).Index = Index) then Src := Element (Iterator); - return; + + -- If the source has been excluded, continue looking. We will + -- get the excluded source only if there is no other source + -- with the same base name that is not locally removed. + + if not Element (Iterator).Locally_Removed then + return; + end if; end if; Next (Iterator); diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 240b2812631..d1f927aceb1 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -4102,9 +4102,15 @@ package body Sem_Attr is Analyze_And_Resolve (N, Etype (PS)); else - Error_Attr - ("% attribute can only appear" & - " in function Postcondition pragma", P); + if Ada_Version >= Ada_2012 then + Error_Attr + ("% attribute can only appear" & + " in function Postcondition pragma or Post aspect", P); + else + Error_Attr + ("% attribute can only appear" & + " in function Postcondition pragma", P); + end if; end if; end if; end Result; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index f5bf3689912..294322df06a 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -5261,6 +5261,9 @@ package body Sem_Res is -- decrease false positives, without losing too many good -- warnings. The idea is that these previous statements -- may affect global variables the procedure depends on. + -- We also exclude raise statements, that may arise from + -- constraint checks and are probably unrelated to the + -- intended control flow. if Nkind (N) = N_Procedure_Call_Statement and then Is_List_Member (N) @@ -5270,7 +5273,10 @@ package body Sem_Res is begin P := Prev (N); while Present (P) loop - if Nkind (P) /= N_Assignment_Statement then + if not Nkind_In (P, + N_Assignment_Statement, + N_Raise_Constraint_Error) + then exit Scope_Loop; end if; @@ -7026,6 +7032,28 @@ package body Sem_Res is Arg1 : Node_Id; Arg2 : Node_Id; + function Convert_Operand (Opnd : Node_Id) return Node_Id; + -- If the operand is a literal, it cannot be the expression in a + -- conversion. Use a qualified expression instead. + + function Convert_Operand (Opnd : Node_Id) return Node_Id is + Loc : constant Source_Ptr := Sloc (Opnd); + Res : Node_Id; + begin + if Nkind_In (Opnd, N_Integer_Literal, N_Real_Literal) then + Res := + Make_Qualified_Expression (Loc, + Subtype_Mark => New_Occurrence_Of (Btyp, Loc), + Expression => Relocate_Node (Opnd)); + Analyze (Res); + + else + Res := Unchecked_Convert_To (Btyp, Opnd); + end if; + + return Res; + end Convert_Operand; + begin -- We must preserve the original entity in a generic setting, so that -- the legality of the operation can be verified in an instance. @@ -7048,12 +7076,13 @@ package body Sem_Res is -- type. if Is_Private_Type (Typ) then - Arg1 := Unchecked_Convert_To (Btyp, Left_Opnd (N)); + Arg1 := Convert_Operand (Left_Opnd (N)); + -- Unchecked_Convert_To (Btyp, Left_Opnd (N)); if Nkind (N) = N_Op_Expon then Arg2 := Unchecked_Convert_To (Standard_Integer, Right_Opnd (N)); else - Arg2 := Unchecked_Convert_To (Btyp, Right_Opnd (N)); + Arg2 := Convert_Operand (Right_Opnd (N)); end if; if Nkind (Arg1) = N_Type_Conversion then |