Commit 78efd712 by Arnaud Charlet

[multiple changes]

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.

From-SVN: r177342
parent 0170a691
2011-08-04 Yannick Moy <moy@adacore.com> 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 * sem_ch13.adb (Aspect_Loop): when an aspect X and its classwise
corresponding aspect X'Class are allowed, proceed with analysis of the corresponding aspect X'Class are allowed, proceed with analysis of the
aspect instead of skipping it. aspect instead of skipping it.
......
...@@ -316,10 +316,12 @@ void __gnat_clearenv (void) { ...@@ -316,10 +316,12 @@ void __gnat_clearenv (void) {
/* create a string that contains "name" */ /* create a string that contains "name" */
size++; size++;
{ {
char expression[size]; char *expression;
expression = (char *) xmalloc (size * sizeof (char));
strncpy (expression, env[0], size); strncpy (expression, env[0], size);
expression[size - 1] = 0; expression[size - 1] = 0;
__gnat_unsetenv (expression); __gnat_unsetenv (expression);
free (expression);
} }
} }
#else #else
......
...@@ -1377,7 +1377,7 @@ package body Makeutl is ...@@ -1377,7 +1377,7 @@ package body Makeutl is
if Source /= No_Source then if Source /= No_Source then
Debug_Output ("Found main in project", Debug_Output ("Found main in project",
Name_Id (Source.File)); Source.Project.Name);
Names.Table (J).File := Source.File; Names.Table (J).File := Source.File;
Names.Table (J).Project := File.Project; Names.Table (J).Project := File.Project;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -89,9 +89,9 @@ package body Ch13 is ...@@ -89,9 +89,9 @@ package body Ch13 is
Result := Token = Tok_Arrow; Result := Token = Tok_Arrow;
end if; end if;
-- If earlier than Ada 2012, check for valid aspect identifier followed -- If earlier than Ada 2012, check for valid aspect identifier (possibly
-- by an arrow, and consider that this is still an aspect specification -- completed with 'CLASS) followed by an arrow, and consider that this
-- so we give an appropriate message. -- is still an aspect specification so we give an appropriate message.
else else
if Get_Aspect_Id (Token_Name) = No_Aspect then if Get_Aspect_Id (Token_Name) = No_Aspect then
...@@ -100,10 +100,26 @@ package body Ch13 is ...@@ -100,10 +100,26 @@ package body Ch13 is
else else
Scan; -- past aspect name 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); Restore_Scan_State (Scan_State);
Error_Msg_SC ("|aspect specification is an Ada 2012 feature"); Error_Msg_SC ("|aspect specification is an Ada 2012 feature");
Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch"); Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
......
...@@ -858,8 +858,8 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is ...@@ -858,8 +858,8 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
-- attempt at an aspect specification. The default is more strict for -- attempt at an aspect specification. The default is more strict for
-- Ada versions before Ada 2012 (where aspect specifications are not -- Ada versions before Ada 2012 (where aspect specifications are not
-- permitted). Note: this routine never checks the terminator token -- permitted). Note: this routine never checks the terminator token
-- for aspects so it does not matter whether the aspect speficiations -- for aspects so it does not matter whether the aspect specifications
-- are terminated by semicolon or some other character -- are terminated by semicolon or some other character.
procedure P_Aspect_Specifications procedure P_Aspect_Specifications
(Decl : Node_Id; (Decl : Node_Id;
......
...@@ -557,7 +557,14 @@ package body Prj is ...@@ -557,7 +557,14 @@ package body Prj is
and then (Index = 0 or else Element (Iterator).Index = Index) and then (Index = 0 or else Element (Iterator).Index = Index)
then then
Src := Element (Iterator); 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; end if;
Next (Iterator); Next (Iterator);
......
...@@ -4102,9 +4102,15 @@ package body Sem_Attr is ...@@ -4102,9 +4102,15 @@ package body Sem_Attr is
Analyze_And_Resolve (N, Etype (PS)); Analyze_And_Resolve (N, Etype (PS));
else else
Error_Attr if Ada_Version >= Ada_2012 then
("% attribute can only appear" & Error_Attr
" in function Postcondition pragma", P); ("% 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 if; end if;
end Result; end Result;
......
...@@ -5261,6 +5261,9 @@ package body Sem_Res is ...@@ -5261,6 +5261,9 @@ package body Sem_Res is
-- decrease false positives, without losing too many good -- decrease false positives, without losing too many good
-- warnings. The idea is that these previous statements -- warnings. The idea is that these previous statements
-- may affect global variables the procedure depends on. -- 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 if Nkind (N) = N_Procedure_Call_Statement
and then Is_List_Member (N) and then Is_List_Member (N)
...@@ -5270,7 +5273,10 @@ package body Sem_Res is ...@@ -5270,7 +5273,10 @@ package body Sem_Res is
begin begin
P := Prev (N); P := Prev (N);
while Present (P) loop 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; exit Scope_Loop;
end if; end if;
...@@ -7026,6 +7032,28 @@ package body Sem_Res is ...@@ -7026,6 +7032,28 @@ package body Sem_Res is
Arg1 : Node_Id; Arg1 : Node_Id;
Arg2 : 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 begin
-- We must preserve the original entity in a generic setting, so that -- We must preserve the original entity in a generic setting, so that
-- the legality of the operation can be verified in an instance. -- the legality of the operation can be verified in an instance.
...@@ -7048,12 +7076,13 @@ package body Sem_Res is ...@@ -7048,12 +7076,13 @@ package body Sem_Res is
-- type. -- type.
if Is_Private_Type (Typ) then 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 if Nkind (N) = N_Op_Expon then
Arg2 := Unchecked_Convert_To (Standard_Integer, Right_Opnd (N)); Arg2 := Unchecked_Convert_To (Standard_Integer, Right_Opnd (N));
else else
Arg2 := Unchecked_Convert_To (Btyp, Right_Opnd (N)); Arg2 := Convert_Operand (Right_Opnd (N));
end if; end if;
if Nkind (Arg1) = N_Type_Conversion then if Nkind (Arg1) = N_Type_Conversion then
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment