Skip to content

R
riscv-gcc-1
Commit b0f26df5 by Arnaud Charlet
Options

re PR ada/12014 (strcpy used with overlapping arguments) 

	* adadecode.c (ostrcpy): New function.
	(__gnat_decode): Use ostrcpy of strcpy.
	(has_prefix): Set first parameter a const.
	(has_suffix): Set first parameter a const.
	Update copyright notice. Fix source name in header.
	Removes a trailing space.
	PR ada/12014.

	* exp_disp.adb:
	Remove the test against being in No_Run_Time_Mode before generating a
	call to Register_Tag. It is redundant with the test against the
	availability of the function Register_Tag.

	* g-catiio.adb: (Month_Name): Correct spelling of February

	* make.adb: (Mains): New package
	(Initialize): Call Mains.Delete
	(Gnatmake): Check that each main on the command line is a source of a
	project file and, if there are several mains, each of them is a source
	of the same project file.
	(Gnatmake): When a foreign language is specified in attribute Languages,
	no main is specified on the command line and attribute Mains is not
	empty, only build the Ada main. If there is no Ada main, just compile
	the Ada sources and their closure.
	(Gnatmake): If a main is specified on the command line with directory
	information, check that the source exists and, if it does, that the path
	is the actual path of a source of a project.

	* prj-env.adb:
	(File_Name_Of_Library_Unit_Body): New Boolean parameter Full_Path. When
	Full_Path is True, return the full path instead of the simple file name.
	(Project_Of): New function

	* prj-env.ads:
	(File_Name_Of_Library_Unit_Body): New Boolean parameter Full_Path,
	defaulted to False.
	(Project_Of): New function

	* Makefile.generic:
	Ensure objects of main project are always checked and rebuilt if needed.
	Set CC to gcc by default.
	Prepare new handling of link by creating a global archive (not activated
	yet).

	* adadecode.h, atree.h, elists.h, nlists.h, raise.h,
	stringt.h: Update copyright notice. Remove trailing blanks.
	Fix source name in header.

	* sem_ch12.adb: Minor reformatting

	* sem_ch3.adb:
	Minor reformatting (including new function return style throughout)

	* sem_ch3.ads:
	Minor reformatting (including new function return style throughout)

	* Make-lang.in: Makefile automatically updated

From-SVN: r72893
parent bf22935f
Showing with 266 additions and 108 deletions
gcc/ada/Make-lang.in
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/Makefile.generic
......@@ -47,6 +47,7 @@
# CXX name of the C++ compiler (optional, default to gcc)
# AR_CMD command to create an archive (optional, default to "ar rc")
# AR_EXT file extension of an archive (optional, default to ".a")
# RANLIB command to generate an index (optional, default to "ranlib")
# GNATMAKE name of the GNAT builder (optional, default to "gnatmake")
# ADAFLAGS additional Ada compilation switches, e.g "-gnatf" (optional)
# CFLAGS default C compilation switches, e.g "-O2 -g" (optional)
......@@ -56,6 +57,7 @@
# ADA_SOURCES list of main Ada sources (optional)
# EXEC name of the final executable (optional)
# MAIN language of the main program (optional)
# MAIN_OBJECT main object file (optional)
# PROJECT_FILE name of the project file, without the .gpr extension
# DEPS_PROJECTS list of project dependencies (optional)
......@@ -65,6 +67,10 @@ ifndef MAIN
MAIN=ada
endif
ifndef CC
CC=gcc
endif
ifndef ADA_SPEC
ADA_SPEC=.ads
endif
......@@ -100,10 +106,18 @@ ifndef AR_CMD
AR_CMD=ar rc
endif
ifndef RANLIB
RANLIB=ranlib
endif
ifndef GNATMAKE
GNATMAKE=gnatmake
endif
ifndef ARCHIVE
ARCHIVE=$(OBJ_DIR)/lib$(PROJECT_BASE)-full$(AR_EXT)
endif
ifeq ($(EXEC_DIR),)
EXEC_DIR=$(OBJ_DIR)
endif
......@@ -120,6 +134,7 @@ vpath %$(AR_EXT) $(OBJ_DIR)
clean_deps = $(subst :,|,$(DEPS_PROJECTS:%=clean_%))
compile_deps = $(subst :,|,$(DEPS_PROJECTS:%=compile_%))
object_deps = $(subst :,|,$(DEPS_PROJECTS:%=object_%))
ada_deps = $(subst :,|,$(DEPS_PROJECTS:%=ada_%))
c_deps = $(subst :,|,$(DEPS_PROJECTS:%=c_%))
c++_deps = $(subst :,|,$(DEPS_PROJECTS:%=c++_%))
......@@ -131,6 +146,7 @@ clean: $(clean_deps) internal-clean
build: $(compile_deps) internal-compile internal-build
compile: $(compile_deps) internal-compile $(ADA_SOURCES)
ada: $(ada_deps) internal-ada
archive-objects: $(object_deps) internal-archive-objects
c: $(c_deps) internal-c
c++: $(c++deps) internal-c++
......@@ -140,6 +156,9 @@ $(clean_deps): force
$(compile_deps): force
@$(MAKE) -C $(dir $(subst |,:,$(@:compile_%=%))) -f Makefile.$(notdir $@) internal-compile
$(object_deps): force
@$(MAKE) -C $(dir $(@:object_%=%)) -f Makefile.$(notdir $@) internal-archive-objects ARCHIVE=$(ARCHIVE)
$(ada_deps): force
@$(MAKE) -C $(dir $(subst |,:,$(@:ada_%=%))) -f Makefile.$(notdir $@) internal-ada
......@@ -238,6 +257,7 @@ DEP_FILES := $(OBJ_FILES:$(OBJ_EXT)=.d)
ifeq ($(strip $(OBJECTS)),)
internal-compile:
internal-archive-objects:
else
internal-compile: lib$(PROJECT_BASE)$(AR_EXT)
......@@ -245,7 +265,13 @@ internal-compile: lib$(PROJECT_BASE)$(AR_EXT)
lib$(PROJECT_BASE)$(AR_EXT): $(OBJECTS)
@echo creating archive file for $(PROJECT_BASE)
cd $(OBJ_DIR); $(AR_CMD) $@ $(strip $(OBJECTS))
-ranlib $(OBJ_DIR)/$@
-$(RANLIB) $(OBJ_DIR)/$@
internal-archive-objects: $(OBJECTS)
# @echo $(AR_CMD) $(ARCHIVE) $(strip $(OBJECTS))
# cd $(OBJ_DIR); $(AR_CMD) $(ARCHIVE) $(strip $(OBJECTS))
# -$(RANLIB) $(OBJ_DIR)/$@
endif
# Linking rules
......@@ -260,9 +286,24 @@ endif
ifeq ($(strip $(filter-out c c++,$(LANGUAGES))),)
# link with C/C++
link: $(EXEC_DIR)/$(EXEC)
ifeq ($(MAIN_OBJECT),)
link:
@echo link: no main object specified, exiting...
exit 1
else
ifeq ($(EXEC),)
link:
@echo link: no executable specified, exiting...
exit 1
else
link: $(EXEC_DIR)/$(EXEC) archive-objects
$(EXEC_DIR)/$(EXEC): $(OBJ_FILES)
$(LINKER) $(OBJ_FILES) -o $(EXEC_DIR)/$(EXEC) $(LDFLAGS)
@echo $(LINKER) -o $(EXEC_DIR)/$(EXEC) $(OBJ_DIR)/$(MAIN_OBJECT) $(LDFLAGS)
$(LINKER) -o $(EXEC_DIR)/$(EXEC) $(OBJ_DIR)/$(MAIN_OBJECT) $(LDFLAGS)
endif
endif
internal-build: internal-compile link
......@@ -272,11 +313,11 @@ ifeq ($(strip $(filter-out c c++ ada,$(LANGUAGES))),)
ifeq ($(MAIN),ada)
# Ada main
link: $(LINKER) force
link: $(LINKER) archive-objects force
$(GNATMAKE) -b -l -P$(PROJECT_FILE) $(ADA_SOURCES) \
-largs $(LARGS) $(LDFLAGS)
internal-build: $(LINKER) force
internal-build: $(LINKER) archive-objects force
@echo $(GNATMAKE) -P$(PROJECT_FILE) $(ADA_SOURCES) $(EXEC_RULE) $(ADAFLAGS)
@$(GNATMAKE) -P$(PROJECT_FILE) $(EXEC_RULE) $(ADA_SOURCES) $(ADAFLAGS) \
-largs $(LARGS) $(LDFLAGS)
......@@ -288,11 +329,11 @@ else
# close enough to our needs, and the usual -n gnatbind switch and --LINK=
# gnatlink switch.
link: $(LINKER) force
link: $(LINKER) archive-objects force
$(GNATMAKE) $(EXEC_RULE) -z -P$(PROJECT_FILE) $(ADA_SOURCES) \
-bargs -n -largs $(LARGS) $(LDFLAGS)
internal-build: $(LINKER) force
internal-build: $(LINKER) archive-objects force
@echo $(GNATMAKE) -z -P$(PROJECT_FILE) $(ADA_SOURCES) $(EXEC_RULE) $(ADAFLAGS)
@$(GNATMAKE) $(EXEC_RULE) -z \
-P$(PROJECT_FILE) $(ADA_SOURCES) $(ADAFLAGS) \
......@@ -385,7 +426,7 @@ internal-c : $(C_OBJECTS)
# Compile all C++ files in the project
internal-c++ : $(CXX_OBJECTS)
.PHONY: force internal-clean internal-build internal-compile internal-ada internal-c internal-c++ build compile clean ada c c++
.PHONY: force internal-clean internal-archive internal-build internal-compile internal-ada internal-c internal-c++ build compile clean ada c c++
internal-clean:
@echo $(RM) $(OBJ_DIR)/*$(OBJ_EXT)
......
gcc/ada/adadecode.c
......@@ -2,11 +2,11 @@
* *
* GNAT COMPILER COMPONENTS *
* *
* G N A T D E C O *
* A D A D E C O D E *
* *
* C Implementation File *
* *
* Copyright (C) 2001-2002, Free Software Foundation, Inc. *
* Copyright (C) 2001-2003, 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- *
......@@ -42,8 +42,12 @@
#include "adadecode.h"
static void add_verbose PARAMS ((const char *, char *));
static int has_prefix PARAMS ((char *, const char *));
static int has_suffix PARAMS ((char *, const char *));
static int has_prefix PARAMS ((const char *, const char *));
static int has_suffix PARAMS ((const char *, const char *));
/* This is a safe version of strcpy that can be used with overlapped
pointers. Does nothing if s2 <= s1. */
static void ostrcpy (char *s1, char *s2);
/* Set to nonzero if we have written any verbose info. */
static int verbose_info;
......@@ -65,7 +69,7 @@ static void add_verbose (text, ada_name)
static int
has_prefix (name, prefix)
char *name;
const char *name;
const char *prefix;
{
return strncmp (name, prefix, strlen (prefix)) == 0;
......@@ -75,7 +79,7 @@ has_prefix (name, prefix)
static int
has_suffix (name, suffix)
char *name;
const char *name;
const char *suffix;
{
int nlen = strlen (name);
......@@ -84,6 +88,18 @@ has_suffix (name, suffix)
return nlen > slen && strncmp (name + nlen - slen, suffix, slen) == 0;
}
/* Safe overlapped pointers version of strcpy. */
static void
ostrcpy (char *s1, char *s2)
{
if (s2 > s1)
{
while (*s2) *s1++ = *s2++;
*s1 = '\0';
}
}
/* This function will return the Ada name from the encoded form.
The Ada coding is done in exp_dbug.ads and this is the inverse function.
see exp_dbug.ads for full encoding rules, a short description is added
......@@ -142,16 +158,14 @@ __gnat_decode (coded_name, ada_name, verbose)
int in_task = 0;
int body_nested = 0;
/* Copy the coded name into the ada name string, the rest of the code will
just replace or add characters into the ada_name. */
strcpy (ada_name, coded_name);
/* Check for library level subprogram. */
if (has_prefix (ada_name, "_ada_"))
if (has_prefix (coded_name, "_ada_"))
{
strcpy (ada_name, ada_name + 5);
strcpy (ada_name, coded_name + 5);
lib_subprog = 1;
}
else
strcpy (ada_name, coded_name);
/* Check for task body. */
if (has_suffix (ada_name, "TKB"))
......@@ -191,7 +205,7 @@ __gnat_decode (coded_name, ada_name, verbose)
while ((tktoken = (char *) strstr (ada_name, "TK__")) != NULL)
{
strcpy (tktoken, tktoken + 2);
ostrcpy (tktoken, tktoken + 2);
in_task = 1;
}
}
......@@ -229,7 +243,7 @@ __gnat_decode (coded_name, ada_name, verbose)
if (ada_name[k] == '_' && ada_name[k+1] == '_')
{
ada_name[k] = '.';
strcpy (ada_name + k + 1, ada_name + k + 2);
ostrcpy (ada_name + k + 1, ada_name + k + 2);
len = len - 1;
}
k++;
......@@ -259,7 +273,7 @@ __gnat_decode (coded_name, ada_name, verbose)
if (codedlen > oplen)
/* We shrink the space. */
strcpy (optoken, optoken + codedlen - oplen);
ostrcpy (optoken, optoken + codedlen - oplen);
else if (oplen > codedlen)
{
/* We need more space. */
......@@ -285,7 +299,7 @@ __gnat_decode (coded_name, ada_name, verbose)
}
/* If verbose mode is on, we add some information to the Ada name. */
if (verbose)
if (verbose)
{
if (overloaded)
add_verbose ("overloaded", ada_name);
......
gcc/ada/adadecode.h
......@@ -2,11 +2,11 @@
* *
* GNAT COMPILER COMPONENTS *
* *
* G N A T D E C O *
* A D A D E C O D E *
* *
* C Header File *
* *
* Copyright (C) 2001-2002, Free Software Foundation, Inc. *
* Copyright (C) 2001-2003, 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- *
......
gcc/ada/atree.h
......@@ -6,7 +6,7 @@
* *
* C Header File *
* *
* Copyright (C) 1992-2001, Free Software Foundation, Inc. *
* Copyright (C) 1992-2003, 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- *
......@@ -235,7 +235,7 @@ struct Extended
Int field8;
Int field9;
Int field10;
union
union
{
Int field11;
struct Flag_Word3 fw3;
......
gcc/ada/elists.h
......@@ -6,7 +6,7 @@
* *
* C Header File *
* *
* Copyright (C) 1992-2001 Free Software Foundation, Inc. *
* Copyright (C) 1992-2003 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- *
......
gcc/ada/exp_disp.adb
......@@ -922,11 +922,10 @@ package body Exp_Disp is
-- Register_Tag (Dt_Ptr);
-- Skip this if routine not available, or in No_Run_Time mode
-- Skip this if routine not available
if RTE_Available (RE_Register_Tag)
and then Is_RTE (Generalized_Tag, RE_Tag)
and then not No_Run_Time_Mode
then
Append_To (Elab_Code,
Make_Procedure_Call_Statement (Loc,
......
gcc/ada/g-catiio.adb
......@@ -44,7 +44,7 @@ package body GNAT.Calendar.Time_IO is
type Month_Name is
(January,
Febuary,
February,
March,
April,
May,
......
gcc/ada/nlists.h
......@@ -6,7 +6,7 @@
* *
* C Header File *
* *
* Copyright (C) 1992-2001, Free Software Foundation, Inc. *
* Copyright (C) 1992-2003, 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- *
......
gcc/ada/prj-env.adb
......@@ -1060,7 +1060,8 @@ package body Prj.Env is
function File_Name_Of_Library_Unit_Body
(Name : String;
Project : Project_Id;
Main_Project_Only : Boolean := True)
Main_Project_Only : Boolean := True;
Full_Path : Boolean := False)
return String
is
The_Project : Project_Id := Project;
......@@ -1151,7 +1152,13 @@ package body Prj.Env is
Write_Line (" OK");
end if;
return Get_Name_String (Current_Name);
if Full_Path then
return Get_Name_String
(Unit.File_Names (Body_Part).Path);
else
return Get_Name_String (Current_Name);
end if;
-- If it has the name of the extended body name,
-- return the extended body name
......@@ -1161,7 +1168,13 @@ package body Prj.Env is
Write_Line (" OK");
end if;
return Extended_Body_Name;
if Full_Path then
return Get_Name_String
(Unit.File_Names (Body_Part).Path);
else
return Extended_Body_Name;
end if;
else
if Current_Verbosity = High then
......@@ -1202,7 +1215,14 @@ package body Prj.Env is
Write_Line (" OK");
end if;
return Get_Name_String (Current_Name);
if Full_Path then
return Get_Name_String
(Unit.File_Names (Specification).Path);
else
return Get_Name_String (Current_Name);
end if;
-- If it has the same name as the extended spec name,
-- return the extended spec name.
......@@ -1212,7 +1232,13 @@ package body Prj.Env is
Write_Line (" OK");
end if;
return Extended_Spec_Name;
if Full_Path then
return Get_Name_String
(Unit.File_Names (Specification).Path);
else
return Extended_Spec_Name;
end if;
else
if Current_Verbosity = High then
......@@ -1701,6 +1727,101 @@ package body Prj.Env is
Write_Line ("end of List of Sources.");
end Print_Sources;
----------------
-- Project_Of --
----------------
function Project_Of
(Name : String;
Main_Project : Project_Id)
return Project_Id
is
Result : Project_Id := No_Project;
Original_Name : String := Name;
Data : constant Project_Data := Projects.Table (Main_Project);
Extended_Spec_Name : String :=
Name & Namet.Get_Name_String
(Data.Naming.Current_Spec_Suffix);
Extended_Body_Name : String :=
Name & Namet.Get_Name_String
(Data.Naming.Current_Body_Suffix);
Unit : Unit_Data;
Current_Name : Name_Id;
The_Original_Name : Name_Id;
The_Spec_Name : Name_Id;
The_Body_Name : Name_Id;
begin
Canonical_Case_File_Name (Original_Name);
Name_Len := Original_Name'Length;
Name_Buffer (1 .. Name_Len) := Original_Name;
The_Original_Name := Name_Find;
Canonical_Case_File_Name (Extended_Spec_Name);
Name_Len := Extended_Spec_Name'Length;
Name_Buffer (1 .. Name_Len) := Extended_Spec_Name;
The_Spec_Name := Name_Find;
Canonical_Case_File_Name (Extended_Body_Name);
Name_Len := Extended_Body_Name'Length;
Name_Buffer (1 .. Name_Len) := Extended_Body_Name;
The_Body_Name := Name_Find;
for Current in reverse Units.First .. Units.Last loop
Unit := Units.Table (Current);
-- Check for body
Current_Name := Unit.File_Names (Body_Part).Name;
-- Case of a body present
if Current_Name /= No_Name then
-- If it has the name of the original name or the body name,
-- we have found the project.
if Unit.Name = The_Original_Name
or else Current_Name = The_Original_Name
or else Current_Name = The_Body_Name
then
Result := Unit.File_Names (Body_Part).Project;
exit;
end if;
end if;
-- Check for spec
Current_Name := Unit.File_Names (Specification).Name;
if Current_Name /= No_Name then
-- If name same as the original name, or the spec name, we have
-- found the project.
if Unit.Name = The_Original_Name
or else Current_Name = The_Original_Name
or else Current_Name = The_Spec_Name
then
Result := Unit.File_Names (Specification).Project;
exit;
end if;
end if;
end loop;
-- Get the ultimate extending project
if Result /= No_Project then
while Projects.Table (Result).Extended_By /= No_Project loop
Result := Projects.Table (Result).Extended_By;
end loop;
end if;
return Result;
end Project_Of;
-------------------
-- Set_Ada_Paths --
-------------------
......
gcc/ada/prj-env.ads
......@@ -101,17 +101,29 @@ package Prj.Env is
function File_Name_Of_Library_Unit_Body
(Name : String;
Project : Project_Id;
Main_Project_Only : Boolean := True)
Main_Project_Only : Boolean := True;
Full_Path : Boolean := False)
return String;
-- Returns the file name of a library unit, in canonical case. Name may or
-- may not have an extension (corresponding to the naming scheme of the
-- project). If there is no body with this name, but there is a spec, the
-- name of the spec is returned. If neither a body or a spec can be found,
-- return an empty string.
-- name of the spec is returned.
-- If Full_Path is False (the default), the simple file name is returned.
-- If Full_Path is True, the absolute path name is returned.
-- If neither a body nor a spec can be found, an empty string is returned.
-- If Main_Project_Only is True, the unit must be an immediate source of
-- Project. If it is False, it may be a source of one of its imported
-- projects.
function Project_Of
(Name : String;
Main_Project : Project_Id)
return Project_Id;
-- Get the project of a source. The source file name may be truncated
-- (".adb" or ".ads" may be missing). If the source is in a project being
-- extended, return the ultimate extending project. If it is not a source
-- of any project, return No_Project.
procedure Get_Reference
(Source_File_Name : String;
Project : out Project_Id;
......
gcc/ada/raise.h
......@@ -6,7 +6,7 @@
* *
* C Header File *
* *
* Copyright (C) 1992-2002, Free Software Foundation, Inc. *
* Copyright (C) 1992-2003, 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- *
......
gcc/ada/sem_ch12.adb
......@@ -7688,7 +7688,6 @@ package body Sem_Ch12 is
or else
Ekind (Get_Instance_Of (A_Gen_T)) = E_Record_Type_With_Private
then
-- Check whether the parent is another derived formal type
-- in the same generic unit.
......@@ -7697,19 +7696,19 @@ package body Sem_Ch12 is
and then Scope (Etype (A_Gen_T)) = Scope (A_Gen_T)
and then Etype (Etype (A_Gen_T)) /= Etype (A_Gen_T)
then
-- Locate ancestor of parent from the subtype declaration
-- created for the actual.
declare
Decl : Node_Id;
begin
Decl := First (Actual_Decls);
while (Present (Decl)) loop
if Nkind (Decl) = N_Subtype_Declaration
and then Chars (Defining_Identifier (Decl))
= Chars (Etype (A_Gen_T))
and then Chars (Defining_Identifier (Decl)) =
Chars (Etype (A_Gen_T))
then
Ancestor := Generic_Parent_Type (Decl);
exit;
......
gcc/ada/sem_ch3.ads
......@@ -42,8 +42,7 @@ package Sem_Ch3 is
function Access_Definition
(Related_Nod : Node_Id;
N : Node_Id)
return Entity_Id;
N : Node_Id) return Entity_Id;
-- An access definition defines a general access type for a formal
-- parameter. The procedure is called when processing formals, when
-- the current scope is the subprogram. The Implicit type is attached
......@@ -129,10 +128,9 @@ package Sem_Ch3 is
-- private type.
function Get_Discriminant_Value
(Discriminant : Entity_Id;
Typ_For_Constraint : Entity_Id;
Constraint : Elist_Id)
return Node_Id;
(Discriminant : Entity_Id;
Typ_For_Constraint : Entity_Id;
Constraint : Elist_Id) return Node_Id;
-- ??? MORE DOCUMENTATION
-- Given a discriminant somewhere in the Typ_For_Constraint tree
-- and a Constraint, return the value of that discriminant.
......@@ -195,8 +193,7 @@ package Sem_Ch3 is
(S : Node_Id;
Related_Nod : Node_Id;
Related_Id : Entity_Id := Empty;
Suffix : Character := ' ')
return Entity_Id;
Suffix : Character := ' ') return Entity_Id;
-- Process a subtype indication S and return corresponding entity.
-- Related_Nod is the node where the potential generated implicit types
-- will be inserted. The Related_Id and Suffix parameters are used to
......
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